- Timestamp:
- 2021-03-02T21:18:11+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining/src/OCE/ZDF/zdfosm.F90
r14567 r14571 123 123 REAL(wp) :: rn_difconv = 1._wp ! diffusivity when unstable below BL (m2/s) 124 124 125 ! OSMOSIS mixed layer eddy parametrization constants 125 #ifdef key_osm_debug 126 INTEGER :: nn_idb = 297, nn_jdb = 193, nn_kdb = 35, nn_narea_db = 109 127 INTEGER :: iloc_db, jloc_db 128 #endif 129 130 ! OSMOSIS mixed layer eddy parametrization constants 126 131 INTEGER :: nn_osm_mle ! = 0/1 flag for horizontal average on avt 127 132 REAL(wp) :: rn_osm_mle_ce ! MLE coefficient … … 165 170 !! *** FUNCTION zdf_osm_alloc *** 166 171 !!---------------------------------------------------------------------- 167 ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), &168 169 170 171 ALLOCATE( hmle(jpi,jpj), r1_ft(jpi,jpj), dbdx_mle(jpi,jpj), dbdy_mle(jpi,jpj), &172 173 174 CALL mpp_sum ( 'zdfosm', zdf_osm_alloc )175 IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays')172 ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), & 173 & hbl(jpi,jpj), dh(jpi,jpj), hml(jpi,jpj), dstokes(jpi, jpj), & 174 & etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 175 176 ALLOCATE( hmle(jpi,jpj), r1_ft(jpi,jpj), dbdx_mle(jpi,jpj), dbdy_mle(jpi,jpj), & 177 & mld_prof(jpi,jpj), STAT= zdf_osm_alloc ) 178 179 CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 180 IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 176 181 177 182 END FUNCTION zdf_osm_alloc … … 234 239 REAL(wp) :: zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 235 240 REAL(wp) :: zt,zs,zu,zv,zrh ! variables used in constructing averages 236 ! Scales241 ! Scales 237 242 REAL(wp), DIMENSION(jpi,jpj) :: zrad0 ! Surface solar temperature flux (deg m/s) 238 243 REAL(wp), DIMENSION(jpi,jpj) :: zradh ! Radiative flux at bl base (Buoyancy units) … … 295 300 REAL(wp), DIMENSION(jpi,jpj) :: zdt_bl,zds_bl,zdu_bl,zdv_bl,zdb_bl ! difference between blayer average and parameter at base of blayer 296 301 REAL(wp), DIMENSION(jpi,jpj) :: zdt_ml,zds_ml,zdu_ml,zdv_ml,zdb_ml ! difference between mixed layer average and parameter at base of blayer 297 ! REAL(wp), DIMENSION(jpi,jpj) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline302 ! REAL(wp), DIMENSION(jpi,jpj) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 298 303 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdbdz_pyc ! parametrised gradient of buoyancy in the pycnocline 299 304 REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle ! Magnitude of horizontal buoyancy gradient. … … 370 375 ghams(:,:,:) = 0._wp ; ghamu(:,:,:) = 0._wp ; ghamv(:,:,:) = 0._wp 371 376 377 378 #ifdef key_osm_debug 379 IF(mi0(nn_idb)==mi1(nn_idb) .AND. mj0(nn_jdb)==mj1(nn_jdb) .AND. & 380 & mi0(nn_idb) > 1 .AND. mi0(nn_idb) < jpi .AND. mj0(nn_jdb) > 1 .AND. mj0(nn_jdb) < jpj) THEN 381 nn_narea_db = narea 382 iloc_db=mi0(nn_idb); jloc_db=mj0(nn_jdb) 383 384 WRITE(narea+100,*) 385 WRITE(narea+100,'(a,i7)')'timestep=',kt 386 WRITE(narea+100,'(3(a,i7))')'narea=',narea,' nn_idb',nn_idb,' nn_jdb=',nn_jdb 387 WRITE(narea+100,'(4(a,i7))')'iloc_db=',iloc_db,' jloc_db',jloc_db,' jpi=',jpi,' jpj=',jpj 388 ji=iloc_db; jj=jloc_db 389 WRITE(narea+100,'(a,i7,5(a,g10.2))')'mbkt=',mbkt(ji,jj),' ht_n',ht(ji,jj),& 390 &' hu_n-',hu(ji-1,jj,Kmm),' hu_n+',hu(ji,jj,Kmm), ' hv_n-',hv(ji,jj-1,Kmm),' hv_n+',hv(ji,jj,Kmm) 391 WRITE(narea+100,*) 392 FLUSH(narea+100) 393 ELSE 394 nn_narea_db = -1000 395 END IF 396 #endif 397 372 398 ! hbl = MAX(hbl,epsln) 373 399 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 388 414 zwthav(ji,jj) = 0.5_wp * zwth0(ji,jj) - & ! Turbulent heat flux averaged over depth of OSBL 389 415 & ( 0.5_wp * ( zrad0(ji,jj) + zradh(ji,jj) ) - zradav ) 390 END_2D 391 DO_2D( 0, 0, 0, 0 ) 392 zws0(ji,jj) = -1.0_wp * & ! Upwards surface salinity flux for non-local term 393 & ( ( emp(ji,jj) - rnf(ji,jj) ) * ts(ji,jj,1,jp_sal,Kmm) + sfx(ji,jj) ) * r1_rho0 * tmask(ji,jj,1) 394 zthermal = rab_n(ji,jj,1,jp_tem) 395 zbeta = rab_n(ji,jj,1,jp_sal) 396 zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) - & ! Non radiative upwards surface buoyancy flux 397 & grav * zbeta * zws0(ji,jj) 398 zwb0tot(ji,jj) = zwb0(ji,jj) - grav * zthermal * & ! Total upwards surface buoyancy flux 399 & ( zrad0(ji,jj) - zradh(ji,jj) ) 400 zwsav(ji,jj) = 0.5 * zws0(ji,jj) ! Turbulent salinity flux averaged over depth of the OBSL 401 zwbav(ji,jj) = grav * zthermal * zwthav(ji,jj) - & ! Turbulent buoyancy flux averaged over the depth of the 402 & grav * zbeta * zwsav(ji,jj) ! OBSBL 403 END_2D 404 DO_2D( 0, 0, 0, 0 ) 405 zuw0(ji,jj) = - 0.5 * (utau(ji-1,jj) + utau(ji,jj)) * & ! Surface upward velocity fluxes 406 & r1_rho0 * tmask(ji,jj,1) 407 zvw0 = - 0.5 * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) 408 zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * & ! Friction velocity (zustar), at T-point : LMD94 eq. 2 409 & zuw0(ji,jj) + zvw0 * zvw0 ) ), 1.0e-8_wp ) 410 zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 411 zsin_wind(ji,jj) = -zvw0 / ( zustar(ji,jj) * zustar(ji,jj) ) 412 END_2D 413 ! Calculate Stokes drift in direction of wind (zustke) and Stokes penetration depth (dstokes) 414 SELECT CASE (nn_osm_wave) 415 ! Assume constant La#=0.3 416 CASE(0) 417 DO_2D( 0, 0, 0, 0 ) 418 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 419 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 420 ! Linearly 421 zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 422 dstokes(ji,jj) = rn_osm_dstokes 423 END_2D 424 ! Assume Pierson-Moskovitz wind-wave spectrum 425 CASE(1) 426 DO_2D( 0, 0, 0, 0 ) 427 ! Use wind speed wndm included in sbc_oce module 428 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 429 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 430 END_2D 431 ! Use ECMWF wave fields as output from SBCWAVE 432 CASE(2) 433 zfac = 2.0_wp * rpi / 16.0_wp 434 435 DO_2D( 0, 0, 0, 0 ) 436 IF (hsw(ji,jj) > 1.e-4) THEN 437 ! Use wave fields 438 zabsstke = SQRT(ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2) 439 zustke(ji,jj) = MAX ( ( zcos_wind(ji,jj) * ut0sd(ji,jj) + zsin_wind(ji,jj) * vt0sd(ji,jj) ), 1.0e-8) 440 dstokes(ji,jj) = MAX (zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zabsstke * wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) 441 ELSE 442 ! Assume masking issue (e.g. ice in ECMWF reanalysis but not in model run) 443 ! .. so default to Pierson-Moskowitz 444 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 445 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 446 END IF 447 END_2D 448 END SELECT 449 450 IF (ln_zdfosm_ice_shelter) THEN 451 ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 452 DO_2D( 0, 0, 0, 0 ) 453 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj)) 454 dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj)) 455 END_2D 456 END IF 457 458 SELECT CASE (nn_osm_SD_reduce) 459 ! Reduce surface Stokes drift by a constant factor or following Breivik (2016) + van Roekel (2012) or Grant (2020). 460 CASE(0) 461 ! The Langmur number from the ECMWF model (or from PM) appears to give La<0.3 for wind-driven seas. 462 ! The coefficient rn_zdfosm_adjust_sd = 0.8 gives La=0.3 in this situation. 463 ! It could represent the effects of the spread of wave directions 464 ! around the mean wind. The effect of this adjustment needs to be tested. 465 IF(nn_osm_wave > 0) THEN 466 zustke(2:jpim1,2:jpjm1) = rn_zdfosm_adjust_sd * zustke(2:jpim1,2:jpjm1) 467 END IF 468 CASE(1) 469 ! van Roekel (2012): consider average SD over top 10% of boundary layer 470 ! assumes approximate depth profile of SD from Breivik (2016) 471 zsqrtpi = SQRT(rpi) 472 z_two_thirds = 2.0_wp / 3.0_wp 473 474 DO_2D( 0, 0, 0, 0 ) 475 zthickness = rn_osm_hblfrac*hbl(ji,jj) 476 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 477 zsqrt_depth = SQRT(z2k_times_thickness) 478 zexp_depth = EXP(-z2k_times_thickness) 479 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - zexp_depth & 480 & - z_two_thirds * ( zsqrtpi*zsqrt_depth*z2k_times_thickness * ERFC(zsqrt_depth) & 481 & + 1.0_wp - (1.0_wp + z2k_times_thickness)*zexp_depth ) ) / z2k_times_thickness 482 483 END_2D 484 CASE(2) 485 ! Grant (2020): Match to exponential with same SD and d/dz(Sd) at depth 10% of boundary layer 486 ! assumes approximate depth profile of SD from Breivik (2016) 487 zsqrtpi = SQRT(rpi) 488 489 DO_2D( 0, 0, 0, 0 ) 490 zthickness = rn_osm_hblfrac*hbl(ji,jj) 491 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 492 493 IF(z2k_times_thickness < 50._wp) THEN 494 zsqrt_depth = SQRT(z2k_times_thickness) 495 zexperfc = zsqrtpi * zsqrt_depth * ERFC(zsqrt_depth) * EXP(z2k_times_thickness) 496 ELSE 497 ! asymptotic expansion of sqrt(pi)*zsqrt_depth*EXP(z2k_times_thickness)*ERFC(zsqrt_depth) for large z2k_times_thickness 498 ! See Abramowitz and Stegun, Eq. 7.1.23 499 ! zexperfc = 1._wp - (1/2)/(z2k_times_thickness) + (3/4)/(z2k_times_thickness**2) - (15/8)/(z2k_times_thickness**3) 500 zexperfc = ((- 1.875_wp/z2k_times_thickness + 0.75_wp)/z2k_times_thickness - 0.5_wp)/z2k_times_thickness + 1.0_wp 501 END IF 502 zf = z2k_times_thickness*(1.0_wp/zexperfc - 1.0_wp) 503 dstokes(ji,jj) = 5.97 * zf * dstokes(ji,jj) 504 zustke(ji,jj) = zustke(ji,jj) * EXP(z2k_times_thickness * ( 1.0_wp / (2. * zf) - 1.0_wp )) * ( 1.0_wp - zexperfc) 505 END_2D 506 END SELECT 507 508 ! Langmuir velocity scale (zwstrl), La # (zla) 509 ! mixed scale (zvstr), convective velocity scale (zwstrc) 510 DO_2D( 0, 0, 0, 0 ) 511 ! Langmuir velocity scale (zwstrl), at T-point 512 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 513 zla(ji,jj) = MAX(MIN(SQRT ( zustar(ji,jj) / ( zwstrl(ji,jj) + epsln ) )**3, 4.0), 0.2) 514 IF(zla(ji,jj) > 0.45) dstokes(ji,jj) = MIN(dstokes(ji,jj), 0.5_wp*hbl(ji,jj)) 515 ! Velocity scale that tends to zustar for large Langmuir numbers 516 zvstr(ji,jj) = ( zwstrl(ji,jj)**3 + & 517 & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird 518 519 ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 520 ! Note zustke and zwstrl are not amended. 521 ! 522 ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 523 IF ( zwbav(ji,jj) > 0.0) THEN 524 zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 525 zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 416 END_2D 417 DO_2D( 0, 0, 0, 0 ) 418 zws0(ji,jj) = -1.0_wp * & ! Upwards surface salinity flux for non-local term 419 & ( ( emp(ji,jj) - rnf(ji,jj) ) * ts(ji,jj,1,jp_sal,Kmm) + sfx(ji,jj) ) * r1_rho0 * tmask(ji,jj,1) 420 zthermal = rab_n(ji,jj,1,jp_tem) 421 zbeta = rab_n(ji,jj,1,jp_sal) 422 zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) - & ! Non radiative upwards surface buoyancy flux 423 & grav * zbeta * zws0(ji,jj) 424 zwb0tot(ji,jj) = zwb0(ji,jj) - grav * zthermal * & ! Total upwards surface buoyancy flux 425 & ( zrad0(ji,jj) - zradh(ji,jj) ) 426 zwsav(ji,jj) = 0.5 * zws0(ji,jj) ! Turbulent salinity flux averaged over depth of the OBSL 427 zwbav(ji,jj) = grav * zthermal * zwthav(ji,jj) - & ! Turbulent buoyancy flux averaged over the depth of the 428 & grav * zbeta * zwsav(ji,jj) ! OBSBL 429 END_2D 430 DO_2D( 0, 0, 0, 0 ) 431 zuw0(ji,jj) = - 0.5 * (utau(ji-1,jj) + utau(ji,jj)) * & ! Surface upward velocity fluxes 432 & r1_rho0 * tmask(ji,jj,1) 433 zvw0 = - 0.5 * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) 434 zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * & ! Friction velocity (zustar), at T-point : LMD94 eq. 2 435 & zuw0(ji,jj) + zvw0 * zvw0 ) ), 1.0e-8_wp ) 436 zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 437 zsin_wind(ji,jj) = -zvw0 / ( zustar(ji,jj) * zustar(ji,jj) ) 438 #ifdef key_osm_debug 439 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 440 zthermal = rab_n(ji,jj,1,jp_tem) 441 zbeta = rab_n(ji,jj,1,jp_sal) 442 zradav = zrad0(ji,jj) * ( zz0 * ( 1.0_wp - EXP( -hbl(ji,jj)/rn_si0 ) ) * rn_si0 + & 443 & zz1 * ( 1.0_wp - EXP( -hbl(ji,jj)/rn_si1 ) ) * rn_si1 ) / hbl(ji,jj) 444 WRITE(narea+100,'(4(3(a,g11.3),/), 2(a,g11.3),/)') & 445 & 'after calculating fluxes: hbl=', hbl(ji,jj),' zthermal=',zthermal, ' zbeta=', zbeta,& 446 & ' zrad0=', zrad0(ji,jj),' zradh=', zradh(ji,jj), ' zradav=', zradav, & 447 & ' zwth0=', zwth0(ji,jj), ' zwthav=', zwthav(ji,jj), ' zws0=', zws0(ji,jj), & 448 & ' zwb0=', zwb0(ji,jj), ' zwb0tot=', zwb0tot(ji,jj), ' zwb0tot_in hbl=', zwb0tot(ji,jj) + grav * zthermal * zradh(ji,jj),& 449 & ' zwbav=', zwbav(ji,jj) 450 FLUSH(narea+100) 451 END IF 452 #endif 453 END_2D 454 ! Calculate Stokes drift in direction of wind (zustke) and Stokes penetration depth (dstokes) 455 SELECT CASE (nn_osm_wave) 456 ! Assume constant La#=0.3 457 CASE(0) 458 DO_2D( 0, 0, 0, 0 ) 459 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 460 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 461 ! Linearly 462 zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 463 dstokes(ji,jj) = rn_osm_dstokes 464 END_2D 465 ! Assume Pierson-Moskovitz wind-wave spectrum 466 CASE(1) 467 DO_2D( 0, 0, 0, 0 ) 468 ! Use wind speed wndm included in sbc_oce module 469 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 470 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 471 END_2D 472 ! Use ECMWF wave fields as output from SBCWAVE 473 CASE(2) 474 zfac = 2.0_wp * rpi / 16.0_wp 475 476 DO_2D( 0, 0, 0, 0 ) 477 IF (hsw(ji,jj) > 1.e-4) THEN 478 ! Use wave fields 479 zabsstke = SQRT(ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2) 480 zustke(ji,jj) = MAX ( ( zcos_wind(ji,jj) * ut0sd(ji,jj) + zsin_wind(ji,jj) * vt0sd(ji,jj) ), 1.0e-8) 481 dstokes(ji,jj) = MAX (zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zabsstke * wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) 482 ELSE 483 ! Assume masking issue (e.g. ice in ECMWF reanalysis but not in model run) 484 ! .. so default to Pierson-Moskowitz 485 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 486 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 487 END IF 488 END_2D 489 END SELECT 490 #ifdef key_osm_debug 491 IF(narea==nn_narea_db)THEN 492 WRITE(narea+100,'(2(a,g11.3))') & 493 & 'Before reduction: zustke=', zustke(iloc_db,jloc_db),' dstokes =',dstokes(iloc_db,jloc_db) 494 FLUSH(narea+100) 495 END IF 496 #endif 497 498 IF (ln_zdfosm_ice_shelter) THEN 499 ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 500 DO_2D( 0, 0, 0, 0 ) 501 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj)) 502 dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj)) 503 END_2D 504 END IF 505 506 SELECT CASE (nn_osm_SD_reduce) 507 ! Reduce surface Stokes drift by a constant factor or following Breivik (2016) + van Roekel (2012) or Grant (2020). 508 CASE(0) 509 ! The Langmur number from the ECMWF model (or from PM) appears to give La<0.3 for wind-driven seas. 510 ! The coefficient rn_zdfosm_adjust_sd = 0.8 gives La=0.3 in this situation. 511 ! It could represent the effects of the spread of wave directions 512 ! around the mean wind. The effect of this adjustment needs to be tested. 513 IF(nn_osm_wave > 0) THEN 514 zustke(2:jpim1,2:jpjm1) = rn_zdfosm_adjust_sd * zustke(2:jpim1,2:jpjm1) 515 END IF 516 CASE(1) 517 ! van Roekel (2012): consider average SD over top 10% of boundary layer 518 ! assumes approximate depth profile of SD from Breivik (2016) 519 zsqrtpi = SQRT(rpi) 520 z_two_thirds = 2.0_wp / 3.0_wp 521 522 DO_2D( 0, 0, 0, 0 ) 523 zthickness = rn_osm_hblfrac*hbl(ji,jj) 524 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 525 zsqrt_depth = SQRT(z2k_times_thickness) 526 zexp_depth = EXP(-z2k_times_thickness) 527 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - zexp_depth & 528 & - z_two_thirds * ( zsqrtpi*zsqrt_depth*z2k_times_thickness * ERFC(zsqrt_depth) & 529 & + 1.0_wp - (1.0_wp + z2k_times_thickness)*zexp_depth ) ) / z2k_times_thickness 530 531 END_2D 532 CASE(2) 533 ! Grant (2020): Match to exponential with same SD and d/dz(Sd) at depth 10% of boundary layer 534 ! assumes approximate depth profile of SD from Breivik (2016) 535 zsqrtpi = SQRT(rpi) 536 537 DO_2D( 0, 0, 0, 0 ) 538 zthickness = rn_osm_hblfrac*hbl(ji,jj) 539 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 540 541 IF(z2k_times_thickness < 50._wp) THEN 542 zsqrt_depth = SQRT(z2k_times_thickness) 543 zexperfc = zsqrtpi * zsqrt_depth * ERFC(zsqrt_depth) * EXP(z2k_times_thickness) 544 ELSE 545 ! asymptotic expansion of sqrt(pi)*zsqrt_depth*EXP(z2k_times_thickness)*ERFC(zsqrt_depth) for large z2k_times_thickness 546 ! See Abramowitz and Stegun, Eq. 7.1.23 547 ! zexperfc = 1._wp - (1/2)/(z2k_times_thickness) + (3/4)/(z2k_times_thickness**2) - (15/8)/(z2k_times_thickness**3) 548 zexperfc = ((- 1.875_wp/z2k_times_thickness + 0.75_wp)/z2k_times_thickness - 0.5_wp)/z2k_times_thickness + 1.0_wp 549 END IF 550 zf = z2k_times_thickness*(1.0_wp/zexperfc - 1.0_wp) 551 dstokes(ji,jj) = 5.97 * zf * dstokes(ji,jj) 552 zustke(ji,jj) = zustke(ji,jj) * EXP(z2k_times_thickness * ( 1.0_wp / (2. * zf) - 1.0_wp )) * ( 1.0_wp - zexperfc) 553 END_2D 554 END SELECT 555 556 ! Langmuir velocity scale (zwstrl), La # (zla) 557 ! mixed scale (zvstr), convective velocity scale (zwstrc) 558 DO_2D( 0, 0, 0, 0 ) 559 ! Langmuir velocity scale (zwstrl), at T-point 560 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 561 zla(ji,jj) = MAX(MIN(SQRT ( zustar(ji,jj) / ( zwstrl(ji,jj) + epsln ) )**3, 4.0), 0.2) 562 IF(zla(ji,jj) > 0.45) dstokes(ji,jj) = MIN(dstokes(ji,jj), 0.5_wp*hbl(ji,jj)) 563 ! Velocity scale that tends to zustar for large Langmuir numbers 564 zvstr(ji,jj) = ( zwstrl(ji,jj)**3 + & 565 & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird 566 567 ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 568 ! Note zustke and zwstrl are not amended. 569 ! 570 ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 571 IF ( zwbav(ji,jj) > 0.0) THEN 572 zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 573 zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 526 574 ELSE 527 zhol(ji,jj) = -hbl(ji,jj) * 2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3 + epsln ) 528 ENDIF 529 END_2D 530 531 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 532 ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth 533 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 534 ! BL must be always 4 levels deep. 535 ! For calculation of lateral buoyancy gradients for FK in 536 ! zdf_osm_zmld_horizontal_gradients need halo values for ibld, so must 537 ! previously exist for hbl also. 538 539 ! agn 23/6/20: not clear all this is needed, as hbl checked after it is re-calculated anyway 540 ! ########################################################################## 575 zhol(ji,jj) = -hbl(ji,jj) * 2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3 + epsln ) 576 ENDIF 577 #ifdef key_osm_debug 578 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 579 WRITE(narea+100,'(2(a,g11.3),/,3(a,g11.3),/,2(a,g11.3),/)') & 580 & 'After reduction: zustke=', zustke(ji,jj), ' dstokes=', dstokes(ji,jj), & 581 & ' zustar =', zustar(ji,jj), ' zwstrl=', zwstrl(ji,jj), ' zwstrc=', zwstrc(ji,jj),& 582 & ' zhol=', zhol(ji,jj), ' zla=', zla(ji,jj) 583 FLUSH(narea+100) 584 END IF 585 #endif 586 END_2D 587 588 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 589 ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth 590 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 591 ! BL must be always 4 levels deep. 592 ! For calculation of lateral buoyancy gradients for FK in 593 ! zdf_osm_zmld_horizontal_gradients need halo values for ibld, so must 594 ! previously exist for hbl also. 595 596 ! agn 23/6/20: not clear all this is needed, as hbl checked after it is re-calculated anyway 597 ! ########################################################################## 541 598 hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,4,Kmm) ) 542 599 ibld(:,:) = 4 … … 546 603 ENDIF 547 604 END_3D 548 ! ##########################################################################605 ! ########################################################################## 549 606 550 607 DO_2D( 0, 0, 0, 0 ) … … 554 611 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 555 612 END_2D 556 ! Averages over well-mixed and boundary layer 613 #ifdef key_osm_debug 614 IF(narea==nn_narea_db) THEN 615 ji=iloc_db; jj=jloc_db 616 WRITE(narea+100,'(2(a,g11.3),/,3(a,g11.3),/,2(a,i7),/)') & 617 & 'Before updating hbl: hbl=', hbl(ji,jj), ' dh=', dh(ji,jj), & 618 &' zhbl =',zhbl(ji,jj) , ' zhml=', zhml(ji,jj), ' zdh=', zdh(ji,jj),& 619 &' imld=', imld(ji,jj), ' ibld=', ibld(ji,jj) 620 621 WRITE(narea+100,'(a,g11.3,a,2g11.3)') 'Physics: ssh ',ssh(ji,jj,Kmm),' T S surface=',ts(ji,jj,1,jp_tem,Kmm),ts(ji,jj,1,jp_sal,Kmm) 622 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 623 WRITE(narea+100,'(a,*(g11.3))') ' T[imld-1..ibld+2] =', ( ts(ji,jj,jk,jp_tem,Kmm), jk=jl,jm ) 624 WRITE(narea+100,'(a,*(g11.3))') ' S[imld-1..ibld+2] =', ( ts(ji,jj,jk,jp_sal,Kmm), jk=jl,jm ) 625 WRITE(narea+100,'(a,*(g11.3))') ' U+[imld-1..ibld+2] =', ( uu(ji,jj,jk,Kmm), jk=jl,jm ) 626 WRITE(narea+100,'(a,*(g11.3))') ' U-[imld-1..ibld+2] =', ( uu(ji-1,jj,jk,Kmm), jk=jl,jm ) 627 WRITE(narea+100,'(a,*(g11.3))') ' V+[imld-1..ibld+2] =', ( vv(ji,jj,jk,Kmm), jk=jl,jm ) 628 WRITE(narea+100,'(a,*(g11.3))') ' V-[imld-1..ibld+2] =', ( vv(ji,jj-1,jk,Kmm), jk=jl,jm ) 629 WRITE(narea+100,'(a,*(g11.3))') ' W[imld-1..ibld+2] =', ( ww(ji,jj-1,jk), jk=jl,jm ) 630 WRITE(narea+100,*) 631 FLUSH(narea+100) 632 END IF 633 #endif 634 635 ! Averages over well-mixed and boundary layer, note BL averages use jp_ext=2 everywhere 557 636 jp_ext(:,:) = 2 558 637 CALL zdf_osm_vertical_average( Kbb, Kmm, & 559 638 & ibld, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, & 560 639 & jp_ext, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 561 ! jp_ext(:,:) = ibld(:,:) - imld(:,:) + 1640 ! jp_ext(:,:) = ibld(:,:) - imld(:,:) + 1 562 641 CALL zdf_osm_vertical_average( Kbb, Kmm, & 563 642 & imld-1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, ibld-imld+1, & 564 643 & zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml ) 565 ! Velocity components in frame aligned with surface stress. 644 #ifdef key_osm_debug 645 IF(narea==nn_narea_db) THEN 646 ji=iloc_db; jj=jloc_db 647 WRITE(narea+100,'(4(3(a,g11.3),/), 2(4(a,g11.3),/))') & 648 & 'After averaging, with old hbl (& jp_ext==2), hml: zt_bl=', zt_bl(ji,jj),& 649 & ' zs_bl=', zs_bl(ji,jj), ' zb_bl=', zb_bl(ji,jj),& 650 & 'zdt_bl=', zdt_bl(ji,jj), ' zds_bl=', zds_bl(ji,jj), ' zdb_bl=', zdb_bl(ji,jj),& 651 & 'zt_ml=', zt_ml(ji,jj), ' zs_ml=', zs_ml(ji,jj), ' zb_ml=', zb_ml(ji,jj),& 652 & 'zdt_ml=', zdt_ml(ji,jj), ' zds_ml=', zds_ml(ji,jj), ' zdb_ml=', zdb_ml(ji,jj),& 653 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 654 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 655 FLUSH(narea+100) 656 END IF 657 #endif 658 ! Velocity components in frame aligned with surface stress. 566 659 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 567 660 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 568 ! Determine the state of the OSBL, stable/unstable, shear/no shear 661 #ifdef key_osm_debug 662 IF(narea==nn_narea_db) THEN 663 ji=iloc_db; jj=jloc_db 664 WRITE(narea+100,'(a,/, 2(4(a,g11.3),/))') & 665 & 'After rotation, with old hbl (& jp_ext==2), hml:', & 666 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 667 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 668 FLUSH(narea+100) 669 END IF 670 #endif 671 672 ! Determine the state of the OSBL, stable/unstable, shear/no shear 569 673 CALL zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear ) 570 674 675 #ifdef key_osm_debug 676 IF(narea==nn_narea_db) THEN 677 ji=iloc_db; jj=jloc_db 678 WRITE(narea+100,'(2(a,l7),a, i7,/,3(a,g11.3),/)') & 679 & 'After zdf_osm_osbl_state: lconv=', lconv(ji,jj), ' lshear=', lshear(ji,jj), ' j_ddh=', j_ddh(ji,jj),& 680 & 'zwb_ent=', zwb_ent(ji,jj), ' zwb_min=', zwb_min(ji,jj), ' zshear=', zshear(ji,jj) 681 FLUSH(narea+100) 682 END IF 683 #endif 571 684 IF ( ln_osm_mle ) THEN 572 ! Fox-Kemper Scheme685 ! Fox-Kemper Scheme 573 686 mld_prof = 4 574 687 DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 575 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk)688 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 576 689 END_3D 577 690 CALL zdf_osm_vertical_average( Kbb, Kmm, & … … 579 692 580 693 DO_2D( 0, 0, 0, 0 ) 581 zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm)694 zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 582 695 END_2D 583 584 !! Calculate fairly-well-mixed depth zmld & its index mld_prof + lateral zmld-averaged gradients 696 #ifdef key_osm_debug 697 IF(narea==nn_narea_db) THEN 698 ji=iloc_db; jj=jloc_db 699 WRITE(narea+100,'(2(a,g11.3), a, i7,/,(3(a,g11.3),/),2(a,g11.3),/)') & 700 & 'Before updating hmle: hmle =',hmle(ji,jj) , ' zhmle=', zhmle(ji,jj), ' mld_prof=', mld_prof(ji,jj), & 701 & 'averaging over hmle: zt_mle=', zt_mle(ji,jj), ' zs_mle=', zs_mle(ji,jj), ' zb_mle=', zb_mle(ji,jj),& 702 & 'zu_mle =', zu_mle(ji,jj), ' zv_mle=', zv_mle(ji,jj) 703 FLUSH(narea+100) 704 END IF 705 #endif 706 707 !! Calculate fairly-well-mixed depth zmld & its index mld_prof + lateral zmld-averaged gradients 585 708 CALL zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 586 !! Calculate vertical gradients immediately below zmld709 !! Calculate vertical gradients immediately below zmld 587 710 CALL zdf_osm_external_gradients( mld_prof, zdtdz_mle_ext, zdsdz_mle_ext, zdbdz_mle_ext ) 588 !! Calculate max vertical FK flux zwb_fk & set logical descriptors711 !! Calculate max vertical FK flux zwb_fk & set logical descriptors 589 712 CALL zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk ) 590 !! recalculate hmle, zmle, zvel_mle, zdiff_mle & redefine mld_proc to be index for new hmle713 !! recalculate hmle, zmle, zvel_mle, zdiff_mle & redefine mld_proc to be index for new hmle 591 714 CALL zdf_osm_mle_parameters( zmld, mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 715 #ifdef key_osm_debug 716 IF(narea==nn_narea_db) THEN 717 ji=iloc_db; jj=jloc_db 718 WRITE(narea+100,'(a,g11.3,a,i7,/, 2(4(a,g11.3),/),2(a,g11.3),/,2(3(a,g11.3),/),a,i7,2(a,g11.3),/,3(a,g11.3),/,/)') & 719 & 'Before updating hmle: zmld =',zmld(ji,jj),' mld_prof=', mld_prof(ji,jj), & 720 & 'zdtdx+=', zdtdx(ji,jj),' zdtdx-=', zdtdx(ji-1,jj),' zdsdx+=', zdsdx(ji,jj),' zdsdx-=',zdsdx(ji-1,jj), & 721 & 'zdtdy+=', zdtdy(ji,jj),' zdtdy-=', zdtdy(ji,jj-1),' zdsdy+=', zdsdy(ji,jj),' zdsdy-=',zdsdy(ji,jj-1), & 722 & 'dbdx_mle+=', dbdx_mle(ji,jj),' dbdx_mle-=', dbdx_mle(ji-1,jj),& 723 & 'dbdy_mle+=', dbdy_mle(ji,jj),' dbdy_mle-=',dbdy_mle(ji,jj-1),' zdbds_mle=',zdbds_mle(ji,jj), & 724 & 'zdtdz_mle_ext=', zdtdz_mle_ext(ji,jj), ' zdsdz_mle_ext=', zdsdz_mle_ext(ji,jj), & 725 & ' zdbdz_mle_ext=', zdbdz_mle_ext(ji,jj), & 726 & 'After updating hmle: mld_prof=', mld_prof(ji,jj),' hmle=', hmle(ji,jj), ' zhmle=', zhmle(ji,jj),& 727 & 'zvel_mle =', zvel_mle(ji,jj), ' zdiff_mle=', zdiff_mle(ji,jj), ' zwb_fk=', zwb_fk(ji,jj) 728 FLUSH(narea+100) 729 END IF 730 #endif 592 731 ELSE ! ln_osm_mle 593 ! FK not selected, Boundary Layer only.732 ! FK not selected, Boundary Layer only. 594 733 lpyc(:,:) = .TRUE. 595 734 lflux(:,:) = .FALSE. 596 735 lmle(:,:) = .FALSE. 597 736 DO_2D( 0, 0, 0, 0 ) 598 IF ( lconv(ji,jj) .AND. zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE.737 IF ( lconv(ji,jj) .AND. zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 599 738 END_2D 600 739 ENDIF ! ln_osm_mle 601 740 602 !! External gradient below BL needed both with and w/o FK741 !! External gradient below BL needed both with and w/o FK 603 742 CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 604 743 605 ! Test if pycnocline well resolved744 ! Test if pycnocline well resolved 606 745 DO_2D( 0, 0, 0, 0 ) 607 IF (lconv(ji,jj) ) THEN 608 ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,ibld(ji,jj),Kmm) 609 IF ( ztmp > 6 ) THEN 610 ! pycnocline well resolved 611 jp_ext(ji,jj) = 1 612 ELSE 613 ! pycnocline poorly resolved 746 IF (lconv(ji,jj) ) THEN 747 ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,ibld(ji,jj),Kmm) 748 IF ( ztmp > 6 ) THEN 749 ! pycnocline well resolved 750 jp_ext(ji,jj) = 1 751 ELSE 752 ! pycnocline poorly resolved 753 jp_ext(ji,jj) = 0 754 ENDIF 755 ELSE 756 ! Stable conditions 614 757 jp_ext(ji,jj) = 0 615 ENDIF 616 ELSE 617 ! Stable conditions 618 jp_ext(ji,jj) = 0 619 ENDIF 758 ENDIF 620 759 END_2D 760 #ifdef key_osm_debug 761 IF(narea==nn_narea_db) THEN 762 ji=iloc_db; jj=jloc_db 763 WRITE(narea+100,'(4(a,l7),a,i7,/, 3(a,g11.3),/)') & 764 & 'BL logical descriptors: lconv =',lconv(ji,jj),' lpyc=', lpyc(ji,jj),' lflux=', lflux(ji,jj),' lmle=', lmle(ji,jj),& 765 & ' jp_ext=', jp_ext(ji,jj), & 766 & 'sub-BL strat: zdtdz_bl_ext=', zdtdz_bl_ext(ji,jj),' zdsdz_bl_ext=', zdsdz_bl_ext(ji,jj),' zdbdz_bl_ext=', zdbdz_bl_ext(ji,jj) 767 FLUSH(narea+100) 768 END IF 769 #endif 621 770 622 771 ! Recalculate bl averages using jp_ext & ml averages .... note no rotation of u & v here.. … … 624 773 & ibld, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, & 625 774 & jp_ext, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 626 ! jp_ext = ibld-imld+1775 ! jp_ext = ibld-imld+1 627 776 CALL zdf_osm_vertical_average( Kbb, Kmm, & 628 777 & imld-1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, & 629 778 & ibld-imld+1, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml ) 779 #ifdef key_osm_debug 780 IF(narea==nn_narea_db) THEN 781 ji=iloc_db; jj=jloc_db 782 WRITE(narea+100,'(4(3(a,g11.3),/), 2(4(a,g11.3),/))') & 783 & 'After averaging, with old hbl (&correct jp_ext), hml: zt_bl=', zt_bl(ji,jj),& 784 & ' zs_bl=', zs_bl(ji,jj), ' zb_bl=', zb_bl(ji,jj),& 785 & 'zdt_bl=', zdt_bl(ji,jj), ' zds_bl=', zds_bl(ji,jj), ' zdb_bl=', zdb_bl(ji,jj),& 786 & 'zt_ml=', zt_ml(ji,jj), ' zs_ml=', zs_ml(ji,jj), ' zb_ml=', zb_ml(ji,jj),& 787 & 'zdt_ml=', zdt_ml(ji,jj), ' zds_ml=', zds_ml(ji,jj), ' zdb_ml=', zdb_ml(ji,jj),& 788 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 789 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 790 FLUSH(narea+100) 791 END IF 792 #endif 793 794 630 795 ! Rate of change of hbl 631 796 CALL zdf_osm_calculate_dhdt( zdhdt ) 632 797 DO_2D( 0, 0, 0, 0 ) 633 zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need ww here, so subtract it 634 ! adjustment to represent limiting by ocean bottom 635 IF ( zhbl_t(ji,jj) >= gdepw(ji, jj, mbkt(ji,jj) + 1, Kmm ) ) THEN 636 zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw(ji,jj, mbkt(ji,jj) + 1, Kmm) - depth_tol)! ht(:,:)) 637 lpyc(ji,jj) = .FALSE. 638 ENDIF 798 zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need ww here, so subtract it 799 ! adjustment to represent limiting by ocean bottom 800 IF ( zhbl_t(ji,jj) >= gdepw(ji, jj, mbkt(ji,jj) + 1, Kmm ) ) THEN 801 zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw(ji,jj, mbkt(ji,jj) + 1, Kmm) - depth_tol)! ht(:,:)) 802 lpyc(ji,jj) = .FALSE. 803 ENDIF 804 #ifdef key_osm_debug 805 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 806 WRITE(narea+100,'(2(a,g11.3),/,2(a,g11.3))')'after zdf_osm_calculate_dhdt: zhbl_t=',zhbl_t(ji,jj), 'hbl=', hbl(ji,jj),& 807 & 'delta hbl from dzdhdt', zdhdt(ji,jj)*rn_Dt,' delta hbl from w ', ww(ji,jj,ibld(ji,jj))*rn_Dt 808 FLUSH(narea+100) 809 END IF 810 #endif 639 811 END_2D 640 812 … … 648 820 END_3D 649 821 650 !651 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt652 !822 ! 823 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 824 ! 653 825 CALL zdf_osm_timestep_hbl( zdhdt ) 654 ! is external level in bounds?655 656 ! Recalculate BL averages and differences using new BL depth826 ! is external level in bounds? 827 828 ! Recalculate BL averages and differences using new BL depth 657 829 CALL zdf_osm_vertical_average( Kbb, Kmm, & 658 830 & ibld, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, & 659 831 & jp_ext, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 660 !661 !662 ! Check to see if lpyc needs to be changed832 ! 833 ! 834 ! Check to see if lpyc needs to be changed 663 835 664 836 CALL zdf_osm_pycnocline_thickness( dh, zdh ) 665 837 666 838 DO_2D( 0, 0, 0, 0 ) 667 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE.839 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE. 668 840 END_2D 669 841 670 842 dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. ) ! Limit delta for shallow boundary layers for calculating flux-gradient terms. 671 !843 ! 672 844 ! Average over the depth of the mixed layer in the convective boundary layer 673 ! jp_ext = ibld - imld +1674 ! Recalculate ML averages and differences using new ML depth845 ! jp_ext = ibld - imld +1 846 ! Recalculate ML averages and differences using new ML depth 675 847 CALL zdf_osm_vertical_average( Kbb, Kmm, & 676 848 & imld-1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, & … … 678 850 ! rotate mean currents and changes onto wind align co-ordinates 679 851 ! 852 #ifdef key_osm_debug 853 IF(narea==nn_narea_db) THEN 854 ji=iloc_db; jj=jloc_db 855 WRITE(narea+100,'(4(3(a,g11.3),/), 2(4(a,g11.3),/))') & 856 & 'After averaging, with new hbl (&correct jp_ext), hml: zt_bl=', zt_bl(ji,jj),& 857 & ' zs_bl=', zs_bl(ji,jj), ' zb_bl=', zb_bl(ji,jj),& 858 & 'zdt_bl=', zdt_bl(ji,jj), ' zds_bl=', zds_bl(ji,jj), ' zdb_bl=', zdb_bl(ji,jj),& 859 & 'zt_ml=', zt_ml(ji,jj), ' zs_ml=', zs_ml(ji,jj), ' zb_ml=', zb_ml(ji,jj),& 860 & 'zdt_ml=', zdt_ml(ji,jj), ' zds_ml=', zds_ml(ji,jj), ' zdb_ml=', zdb_ml(ji,jj),& 861 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 862 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 863 FLUSH(narea+100) 864 END IF 865 #endif 680 866 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 681 867 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 868 #ifdef key_osm_debug 869 IF(narea==nn_narea_db) THEN 870 ji=iloc_db; jj=jloc_db 871 WRITE(narea+100,'(a,/, 2(4(a,g11.3),/))') & 872 & 'After rotation, with new hbl (& correct jp_ext), hml:', & 873 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 874 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 875 FLUSH(narea+100) 876 END IF 877 #endif 682 878 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 683 879 ! Pycnocline gradients for scalars and velocity … … 686 882 CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 687 883 CALL zdf_osm_pycnocline_buoyancy_profiles( zdbdz_pyc, zalpha_pyc ) 688 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 689 ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship 690 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 691 CALL zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 884 #ifdef key_osm_debug 885 IF(narea==nn_narea_db) THEN 886 ji=iloc_db; jj=jloc_db 887 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 888 WRITE(narea+100,'(a,l7,/,3(a,g11.3),/)') & 889 & 'After pycnocline profiles BL lpyc=', lpyc(ji,jj),& 890 & 'sub-BL strat: zdtdz_bl_ext=', zdtdz_bl_ext(ji,jj),' zdsdz_bl_ext=', zdsdz_bl_ext(ji,jj),' zdbdz_bl_ext=', zdbdz_bl_ext(ji,jj), & 891 & 'Pycnocline: zalpha_pyc=', zalpha_pyc(ji,jj) 892 ! WRITE(narea+100,'(a,*(g11.3))') ' zdtdz_pyc[imld-1..ibld+2] =', ( zdtdz_pyc(ji,jj,jk), jk=jl,jm ) 893 ! WRITE(narea+100,'(a,*(g11.3))') ' zdsdz_pyc[imld-1..ibld+2] =', ( zdsdz_pyc(ji,jj,jk), jk=jl,jm ) 894 WRITE(narea+100,'(a,*(g11.3))') ' zdbdz_pyc[imld-1..ibld+2] =', ( zdbdz_pyc(ji,jj,jk), jk=jl,jm ) 895 ! WRITE(narea+100,'(a,*(g11.3))') ' zdudz_pyc[imld-1..ibld+2] =', ( zdudz_pyc(ji,jj,jk), jk=jl,jm ) 896 ! WRITE(narea+100,'(a,*(g11.3))') ' zdvdz_pyc[imld-1..ibld+2] =', ( zdvdz_pyc(ji,jj,jk), jk=jl,jm ) 897 WRITE(narea+100,*) 898 FLUSH(narea+100) 899 END IF 900 #endif 901 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 902 ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship 903 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 904 CALL zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 905 #ifdef key_osm_debug 906 IF(narea==nn_narea_db) THEN 907 ji=iloc_db; jj=jloc_db 908 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 909 WRITE(narea+100,'(a,*(g11.3))') ' zdiffut[imld-1..ibld+2] =', ( zdiffut(ji,jj,jk), jk=jl,jm ) 910 WRITE(narea+100,'(a,*(g11.3))') ' zviscos[imld-1..ibld+2] =', ( zviscos(ji,jj,jk), jk=jl,jm ) 911 WRITE(narea+100,*) 912 FLUSH(narea+100) 913 END IF 914 #endif 692 915 693 916 ! … … 699 922 & zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext, zdbdz_pyc, zalpha_pyc, zdiffut, zviscos ) 700 923 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 924 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 925 ! Need to put in code for contributions that are applied explicitly to 926 ! the prognostic variables 927 ! 1. Entrainment flux 928 ! 929 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 930 931 932 933 ! rotate non-gradient velocity terms back to model reference frame 934 935 DO_2D( 0, 0, 0, 0 ) 936 DO jk = 2, ibld(ji,jj) 937 ztemp = ghamu(ji,jj,jk) 938 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj) 939 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj) 940 END DO 941 END_2D 719 942 720 943 ! KPP-style Ri# mixing 721 944 IF ( ln_kpprimix ) THEN 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 ! KPP-style set diffusivity large if unstable below BL758 759 760 945 jkflt = jpk 946 DO_2D( 0, 0, 0, 0 ) 947 IF ( ibld(ji,jj) < jkflt ) jkflt = ibld(ji,jj) 948 END_2D 949 DO jk = jkflt+1, jpkm1 950 ! Shear production at uw- and vw-points (energy conserving form) 951 DO_2D( 1, 0, 1, 0 ) 952 IF ( jk > MIN( ibld(ji,jj), ibld(ji+1,jj) ) ) THEN 953 z2du(ji,jj) = 0.5_wp * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) * & 954 & ( uu(ji,jj,jk-1,Kbb) - uu(ji,jj,jk,Kbb) ) * wumask(ji,jj,jk) / & 955 & ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) 956 END IF 957 IF ( jk > MIN( ibld(ji,jj), ibld(ji,jj+1) ) ) THEN 958 z2dv(ji,jj) = 0.5_wp * ( vv(ji,jj,jk-1,Kmm) - vv(ji,jj,jk,Kmm) ) * & 959 & ( vv(ji,jj,jk-1,Kbb) - vv(ji,jj,jk,Kbb) ) * wvmask(ji,jj,jk) / & 960 & ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) 961 END IF 962 END_2D 963 DO_2D( 0, 0, 0, 0 ) 964 IF ( jk > ibld(ji,jj) ) THEN 965 ! Shear prod. at w-point weightened by mask 966 zesh2 = ( z2du(ji-1,jj) + z2du(ji,jj) ) / MAX( 1.0_wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 967 & + ( z2dv(ji,jj-1) + z2dv(ji,jj) ) / MAX( 1.0_wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 968 ! Local Richardson number 969 zri = MAX( rn2b(ji,jj,jk), 0.0_wp ) / MAX(zesh2, epsln) 970 zfri = MIN( zri / rn_riinfty , 1.0_wp ) 971 zfri = ( 1.0_wp - zfri * zfri ) 972 zrimix = zfri * zfri * zfri * wmask(ji, jj, jk) 973 zdiffut(ji,jj,jk) = zrimix*rn_difri 974 zviscos(ji,jj,jk) = zrimix*rn_difri 975 END IF 976 END_2D 977 END DO 978 END IF ! ln_kpprimix = .true. 979 980 ! KPP-style set diffusivity large if unstable below BL 981 IF( ln_convmix) THEN 982 DO_2D( 0, 0, 0, 0 ) 983 DO jk = ibld(ji,jj) + 1, jpkm1 761 984 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv 762 END DO 763 END_2D 764 END IF ! ln_convmix = .true. 765 766 767 768 IF ( ln_osm_mle ) THEN ! set up diffusivity and non-gradient mixing 769 DO_2D( 0, 0, 0, 0 ) 770 IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer 771 ! Calculate MLE flux contribution from surface fluxes 772 DO jk = 1, ibld(ji,jj) 985 END DO 986 END_2D 987 END IF ! ln_convmix = .true. 988 #ifdef key_osm_debug 989 IF(narea==nn_narea_db) THEN 990 ji=iloc_db; jj=jloc_db 991 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 992 WRITE(narea+100,'(a)') ' After including KPP Ri# diffusivity & viscosity' 993 WRITE(narea+100,'(a,*(g11.3))') ' zdiffut[imld-1..ibld+2] =', ( zdiffut(ji,jj,jk), jk=jl,jm ) 994 WRITE(narea+100,'(a,*(g11.3))') ' zviscos[imld-1..ibld+2] =', ( zviscos(ji,jj,jk), jk=jl,jm ) 995 WRITE(narea+100,*) 996 FLUSH(narea+100) 997 END IF 998 #endif 999 1000 1001 1002 IF ( ln_osm_mle ) THEN ! set up diffusivity and non-gradient mixing 1003 DO_2D( 0, 0, 0, 0 ) 1004 IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer 1005 ! Calculate MLE flux contribution from surface fluxes 1006 DO jk = 1, ibld(ji,jj) 773 1007 znd = gdepw(ji,jj,jk,Kmm) / MAX(zhbl(ji,jj),epsln) 774 1008 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - ( zwth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0 - znd ) 775 1009 ghams(ji,jj,jk) = ghams(ji,jj,jk) - zws0(ji,jj) * ( 1.0 - znd ) 776 END DO 777 DO jk = 1, mld_prof(ji,jj) 778 znd = gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 779 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + ( zwth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0 - znd ) 780 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws0(ji,jj) * ( 1.0 -znd ) 781 END DO 782 ! Viscosity for MLEs 783 DO jk = 1, mld_prof(ji,jj) 784 znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 785 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 786 END DO 787 ELSE 788 ! Surface transports limited to OSBL. 789 ! Viscosity for MLEs 790 DO jk = 1, mld_prof(ji,jj) 791 znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 792 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 793 END DO 794 ENDIF 795 END_2D 796 ENDIF 797 798 ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 799 !CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp ) 800 801 ! GN 25/8: need to change tmask --> wmask 802 803 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 804 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 805 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 806 END_3D 1010 END DO 1011 DO jk = 1, mld_prof(ji,jj) 1012 znd = gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 1013 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + ( zwth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0 - znd ) 1014 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws0(ji,jj) * ( 1.0 -znd ) 1015 END DO 1016 ! Viscosity for MLEs 1017 DO jk = 1, mld_prof(ji,jj) 1018 znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 1019 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 1020 END DO 1021 ELSE 1022 ! Surface transports limited to OSBL. 1023 ! Viscosity for MLEs 1024 DO jk = 1, mld_prof(ji,jj) 1025 znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 1026 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 1027 END DO 1028 ENDIF 1029 END_2D 1030 #ifdef key_osm_debug 1031 IF(narea==nn_narea_db) THEN 1032 ji=iloc_db; jj=jloc_db 1033 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 1034 WRITE(narea+100,'(a)') ' After including FK diffusivity & non-local terms' 1035 WRITE(narea+100,'(a,*(g11.3))') ' zdiffut[imld-1..ibld+2] =', ( zdiffut(ji,jj,jk), jk=jl,jm ) 1036 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 1037 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 1038 WRITE(narea+100,*) 1039 FLUSH(narea+100) 1040 END IF 1041 #endif 1042 ENDIF 1043 1044 ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 1045 !CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp ) 1046 1047 ! GN 25/8: need to change tmask --> wmask 1048 1049 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1050 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 1051 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 1052 END_3D 807 1053 ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid (sign unchanged), needed to caclulate gham[uv] on u and v grids 808 CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp, &809 & ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp )810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 1054 CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp, & 1055 & ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 1056 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1057 ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 1058 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) 1059 1060 ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) & 1061 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 1062 1063 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) * tmask(ji,jj,jk) 1064 ghams(ji,jj,jk) = ghams(ji,jj,jk) * tmask(ji,jj,jk) 1065 END_3D 1066 ! Lateral boundary conditions on final outputs for hbl, on T-grid (sign unchanged) 1067 CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 1068 ! Lateral boundary conditions on final outputs for gham[ts], on W-grid (sign unchanged) 1069 ! Lateral boundary conditions on final outputs for gham[uv], on [UV]-grid (sign changed) 1070 CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W', 1.0_wp, & 825 1071 & ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 1072 #ifdef key_osm_debug 1073 IF(narea==nn_narea_db) THEN 1074 ji=iloc_db; jj=jloc_db 1075 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 1076 WRITE(narea+100,'(a)') ' Final diffusivity & viscosity, & non-local terms' 1077 WRITE(narea+100,'(a,*(g11.3))') ' p_avt[imld-1..ibld+2] =', ( p_avt(ji,jj,jk), jk=jl,jm ) 1078 WRITE(narea+100,'(a,*(g11.3))') ' p_avm[imld-1..ibld+2] =', ( p_avm(ji,jj,jk), jk=jl,jm ) 1079 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 1080 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 1081 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 1082 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 1083 WRITE(narea+100,*) 1084 FLUSH(narea+100) 1085 END IF 1086 #endif 826 1087 827 1088 IF(ln_dia_osm) THEN 828 1089 SELECT CASE (nn_osm_wave) 829 ! Stokes drift set by assumimg onstant La#=0.3(=0) or Pierson-Moskovitz spectrum (=1).1090 ! Stokes drift set by assumimg onstant La#=0.3(=0) or Pierson-Moskovitz spectrum (=1). 830 1091 CASE(0:1) 831 1092 IF ( iom_use("us_x") ) CALL iom_put( "us_x", tmask(:,:,1)*zustke*zcos_wind ) ! x surface Stokes drift 832 1093 IF ( iom_use("us_y") ) CALL iom_put( "us_y", tmask(:,:,1)*zustke*zsin_wind ) ! y surface Stokes drift 833 1094 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 834 ! Stokes drift read in from sbcwave (=2).1095 ! Stokes drift read in from sbcwave (=2). 835 1096 CASE(2:3) 836 1097 IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd*umask(:,:,1) ) ! x surface Stokes drift … … 842 1103 IF ( iom_use("wndm") ) CALL iom_put( "wndm", wndm*tmask(:,:,1) ) ! U_10 843 1104 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2* & 844 1105 & SQRT(ut0sd**2 + vt0sd**2 ) ) 845 1106 END SELECT 846 1107 IF ( iom_use("ghamt") ) CALL iom_put( "ghamt", tmask*ghamt ) ! <Tw_NL> … … 850 1111 IF ( iom_use("zwth0") ) CALL iom_put( "zwth0", tmask(:,:,1)*zwth0 ) ! <Tw_0> 851 1112 IF ( iom_use("zws0") ) CALL iom_put( "zws0", tmask(:,:,1)*zws0 ) ! <Sw_0> 1113 IF ( iom_use("zwb0") ) CALL iom_put( "zwb0", tmask(:,:,1)*zwb0 ) ! <Sw_0> 1114 IF ( iom_use("zwbav") ) CALL iom_put( "zwbav", tmask(:,:,1)*zwth0 ) ! upward BL-avged turb buoyancy flux 852 1115 IF ( iom_use("hbl") ) CALL iom_put( "hbl", tmask(:,:,1)*hbl ) ! boundary-layer depth 853 1116 IF ( iom_use("ibld") ) CALL iom_put( "ibld", tmask(:,:,1)*ibld ) ! boundary-layer max k … … 859 1122 IF ( iom_use("dh") ) CALL iom_put( "dh", tmask(:,:,1)*dh ) ! Initial boundary-layer depth 860 1123 IF ( iom_use("hml") ) CALL iom_put( "hml", tmask(:,:,1)*hml ) ! Initial boundary-layer depth 1124 IF ( iom_use("zdt_ml") ) CALL iom_put( "zdt_ml", tmask(:,:,1)*zdt_ml ) ! dt at ml base 1125 IF ( iom_use("zds_ml") ) CALL iom_put( "zds_ml", tmask(:,:,1)*zds_ml ) ! ds at ml base 1126 IF ( iom_use("zdb_ml") ) CALL iom_put( "zdb_ml", tmask(:,:,1)*zdb_ml ) ! db at ml base 861 1127 IF ( iom_use("dstokes") ) CALL iom_put( "dstokes", tmask(:,:,1)*dstokes ) ! Stokes drift penetration depth 862 1128 IF ( iom_use("zustke") ) CALL iom_put( "zustke", tmask(:,:,1)*zustke ) ! Stokes drift magnitude at T-points … … 871 1137 IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml ) ! ML depth internal to zdf_osm routine 872 1138 IF ( iom_use("imld") ) CALL iom_put( "imld", tmask(:,:,1)*imld ) ! index for ML depth internal to zdf_osm routine 1139 IF ( iom_use("jp_ext") ) CALL iom_put( "jp_ext", tmask(:,:,1)*jp_ext ) ! =1 if pycnocline resolved internal to zdf_osm routine 1140 IF ( iom_use("j_ddh") ) CALL iom_put( "j_ddh", tmask(:,:,1)*j_ddh ) ! index forpyc thicknessh internal to zdf_osm routine 1141 IF ( iom_use("zshear") ) CALL iom_put( "zshear", tmask(:,:,1)*zshear ) ! shear production of TKE internal to zdf_osm routine 873 1142 IF ( iom_use("zdh") ) CALL iom_put( "zdh", tmask(:,:,1)*zdh ) ! pyc thicknessh internal to zdf_osm routine 874 1143 IF ( iom_use("zhol") ) CALL iom_put( "zhol", tmask(:,:,1)*zhol ) ! ML depth internal to zdf_osm routine 875 IF ( iom_use("zwthav") ) CALL iom_put( "zwthav", tmask(:,:,1)*zwthav ) ! upward BL-avged turb temp flux876 1144 IF ( iom_use("zwb_ent") ) CALL iom_put( "zwb_ent", tmask(:,:,1)*zwb_ent ) ! upward turb buoyancy entrainment flux 877 1145 IF ( iom_use("zt_ml") ) CALL iom_put( "zt_ml", tmask(:,:,1)*zt_ml ) ! average T in ML … … 894 1162 IF( ln_timing ) CALL timing_stop('zdf_osm') 895 1163 896 CONTAINS 897 ! subroutine code changed, needs syntax checking. 898 SUBROUTINE zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 899 900 !!--------------------------------------------------------------------- 901 !! *** ROUTINE zdf_osm_diffusivity_viscosity *** 902 !! 903 !! ** Purpose : Determines the eddy diffusivity and eddy viscosity profiles in the mixed layer and the pycnocline. 904 !! 905 !! ** Method : 906 !! 907 !! !!---------------------------------------------------------------------- 908 REAL(wp), DIMENSION(:,:,:) :: zdiffut 909 REAL(wp), DIMENSION(:,:,:) :: zviscos 910 ! local 911 912 ! Scales used to calculate eddy diffusivity and viscosity profiles 913 REAL(wp), DIMENSION(jpi,jpj) :: zdifml_sc, zvisml_sc 914 REAL(wp), DIMENSION(jpi,jpj) :: zdifpyc_n_sc, zdifpyc_s_sc, zdifpyc_shr 915 REAL(wp), DIMENSION(jpi,jpj) :: zvispyc_n_sc, zvispyc_s_sc,zvispyc_shr 916 REAL(wp), DIMENSION(jpi,jpj) :: zbeta_d_sc, zbeta_v_sc 917 ! 918 REAL(wp) :: zvel_sc_pyc, zvel_sc_ml, zstab_fac 919 REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! Coefficients in cubic polynomial specifying diffusivity in pycnocline 920 921 REAL(wp), PARAMETER :: rn_dif_ml = 0.8, rn_vis_ml = 0.375 922 REAL(wp), PARAMETER :: rn_dif_pyc = 0.15, rn_vis_pyc = 0.142 923 REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 924 925 IF( ln_timing ) CALL timing_start('zdf_osm_dv') 926 DO_2D( 0, 0, 0, 0 ) 927 IF ( lconv(ji,jj) ) THEN 928 929 zvel_sc_pyc = ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.25 * zshear(ji,jj) * zhbl(ji,jj) )**pthird 930 zvel_sc_ml = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 931 zstab_fac = ( zhml(ji,jj) / zvel_sc_ml * ( 1.4 - 0.4 / ( 1.0 + EXP(-3.5 * LOG10(-zhol(ji,jj) ) ) )**1.25 ) )**2 932 933 zdifml_sc(ji,jj) = rn_dif_ml * zhml(ji,jj) * zvel_sc_ml 934 zvisml_sc(ji,jj) = rn_vis_ml * zdifml_sc(ji,jj) 935 936 IF ( lpyc(ji,jj) ) THEN 937 zdifpyc_n_sc(ji,jj) = rn_dif_pyc * zvel_sc_ml * zdh(ji,jj) 938 939 IF ( lshear(ji,jj) .AND. j_ddh(ji,jj) /= 2 ) THEN 940 zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj) )**pthird * zhbl(ji,jj) 941 ENDIF 942 943 zdifpyc_s_sc(ji,jj) = zwb_ent(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) 944 zdifpyc_s_sc(ji,jj) = 0.09 * zdifpyc_s_sc(ji,jj) * zstab_fac 945 zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5 * zdifpyc_n_sc(ji,jj) ) 946 947 zvispyc_n_sc(ji,jj) = 0.09 * zvel_sc_pyc * ( 1.0 - zhbl(ji,jj) / zdh(ji,jj) )**2 * ( 0.005 * ( zu_ml(ji,jj)-zu_bl(ji,jj) )**2 + 0.0075 * ( zv_ml(ji,jj)-zv_bl(ji,jj) )**2 ) / zdh(ji,jj) 948 zvispyc_n_sc(ji,jj) = rn_vis_pyc * zvel_sc_ml * zdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac 949 IF ( lshear(ji,jj) .AND. j_ddh(ji,jj) /= 2 ) THEN 950 zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj ) )**pthird * zhbl(ji,jj) 951 ENDIF 952 953 zvispyc_s_sc(ji,jj) = 0.09 * ( zwb_min(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) ) 954 zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac 955 zvispyc_s_sc(ji,jj) = MAX( zvispyc_s_sc(ji,jj), -0.5_wp * zvispyc_n_sc(ji,jj) ) 956 957 zbeta_d_sc(ji,jj) = 1.0 - ( ( zdifpyc_n_sc(ji,jj) + 1.4 * zdifpyc_s_sc(ji,jj) ) / ( zdifml_sc(ji,jj) + epsln ) )**p2third 958 zbeta_v_sc(ji,jj) = 1.0 - 2.0 * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) / ( zvisml_sc(ji,jj) + epsln ) 1164 CONTAINS 1165 ! subroutine code changed, needs syntax checking. 1166 SUBROUTINE zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 1167 1168 !!--------------------------------------------------------------------- 1169 !! *** ROUTINE zdf_osm_diffusivity_viscosity *** 1170 !! 1171 !! ** Purpose : Determines the eddy diffusivity and eddy viscosity profiles in the mixed layer and the pycnocline. 1172 !! 1173 !! ** Method : 1174 !! 1175 !! !!---------------------------------------------------------------------- 1176 REAL(wp), DIMENSION(:,:,:) :: zdiffut 1177 REAL(wp), DIMENSION(:,:,:) :: zviscos 1178 ! local 1179 1180 ! Scales used to calculate eddy diffusivity and viscosity profiles 1181 REAL(wp), DIMENSION(jpi,jpj) :: zdifml_sc, zvisml_sc 1182 REAL(wp), DIMENSION(jpi,jpj) :: zdifpyc_n_sc, zdifpyc_s_sc, zdifpyc_shr 1183 REAL(wp), DIMENSION(jpi,jpj) :: zvispyc_n_sc, zvispyc_s_sc,zvispyc_shr 1184 REAL(wp), DIMENSION(jpi,jpj) :: zbeta_d_sc, zbeta_v_sc 1185 ! 1186 REAL(wp) :: zvel_sc_pyc, zvel_sc_ml, zstab_fac 1187 REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! Coefficients in cubic polynomial specifying diffusivity in pycnocline 1188 1189 REAL(wp), PARAMETER :: rn_dif_ml = 0.8, rn_vis_ml = 0.375 1190 REAL(wp), PARAMETER :: rn_dif_pyc = 0.15, rn_vis_pyc = 0.142 1191 REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 1192 1193 IF( ln_timing ) CALL timing_start('zdf_osm_dv') 1194 DO_2D( 0, 0, 0, 0 ) 1195 IF ( lconv(ji,jj) ) THEN 1196 1197 zvel_sc_pyc = ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.25 * zshear(ji,jj) * zhbl(ji,jj) )**pthird 1198 zvel_sc_ml = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 1199 zstab_fac = ( zhml(ji,jj) / zvel_sc_ml * ( 1.4 - 0.4 / ( 1.0 + EXP(-3.5 * LOG10(-zhol(ji,jj) ) ) )**1.25 ) )**2 1200 1201 zdifml_sc(ji,jj) = rn_dif_ml * zhml(ji,jj) * zvel_sc_ml 1202 zvisml_sc(ji,jj) = rn_vis_ml * zdifml_sc(ji,jj) 1203 #ifdef key_osm_debug 1204 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1205 WRITE(narea+100,'(2(a,g11.3))')'Start of 1st major loop of osm_diffusivity_viscositys, lconv=T: zdifml_sc=',zdifml_sc(ji,jj),' zvisml_sc=',zvisml_sc(ji,jj) 1206 WRITE(narea+100,'(3(a,g11.3))')'zvel_sc_pyc=',zvel_sc_pyc,' zvel_sc_ml=',zvel_sc_ml,' zstab_fac=',zstab_fac 1207 FLUSH(narea+100) 1208 END IF 1209 #endif 1210 1211 IF ( lpyc(ji,jj) ) THEN 1212 zdifpyc_n_sc(ji,jj) = rn_dif_pyc * zvel_sc_ml * zdh(ji,jj) 1213 zvispyc_n_sc(ji,jj) = 0.09 * zvel_sc_pyc * ( 1.0 - zhbl(ji,jj) / zdh(ji,jj) )**2 * ( 0.005 * ( zu_ml(ji,jj)-zu_bl(ji,jj) )**2 + 0.0075 * ( zv_ml(ji,jj)-zv_bl(ji,jj) )**2 ) / zdh(ji,jj) 1214 zvispyc_n_sc(ji,jj) = rn_vis_pyc * zvel_sc_ml * zdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac 1215 #ifdef key_osm_debug 1216 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1217 WRITE(narea+100,'(2(a,g11.3))')' lpyc=lconv=T, variables w/o shear contributions: zdifpyc_n_sc',zdifpyc_n_sc(ji,jj) ,' zvispyc_n_sc=',zvispyc_n_sc(ji,jj) 1218 FLUSH(narea+100) 1219 END IF 1220 #endif 1221 1222 IF ( lshear(ji,jj) .AND. j_ddh(ji,jj) /= 2 ) THEN 1223 zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj) )**pthird * zhbl(ji,jj) 1224 zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj ) )**pthird * zhbl(ji,jj) 1225 ENDIF 1226 #ifdef key_osm_debug 1227 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1228 WRITE(narea+100,'(2(a,g11.3))')' lpyc=lconv=T, variables w shear contributions: zdifpyc_n_sc',zdifpyc_n_sc(ji,jj) ,' zvispyc_n_sc=',zvispyc_n_sc(ji,jj) 1229 FLUSH(narea+100) 1230 END IF 1231 #endif 1232 1233 zdifpyc_s_sc(ji,jj) = zwb_ent(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) 1234 zvispyc_s_sc(ji,jj) = 0.09 * ( zwb_min(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) ) 1235 #ifdef key_osm_debug 1236 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1237 WRITE(narea+100,'(2(a,g11.3))')' 1st shot at: zdifpyc_s_sc',zdifpyc_s_sc(ji,jj) ,' zvispyc_s_sc=',zvispyc_s_sc(ji,jj) 1238 FLUSH(narea+100) 1239 END IF 1240 #endif 1241 zdifpyc_s_sc(ji,jj) = 0.09 * zdifpyc_s_sc(ji,jj) * zstab_fac 1242 zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac 1243 #ifdef key_osm_debug 1244 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1245 WRITE(narea+100,'(2(a,g11.3))')' 2nd shot at: zdifpyc_s_sc',zdifpyc_s_sc(ji,jj) ,' zvispyc_s_sc=',zvispyc_s_sc(ji,jj) 1246 FLUSH(narea+100) 1247 END IF 1248 #endif 1249 1250 zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5 * zdifpyc_n_sc(ji,jj) ) 1251 zvispyc_s_sc(ji,jj) = MAX( zvispyc_s_sc(ji,jj), -0.5_wp * zvispyc_n_sc(ji,jj) ) 1252 #ifdef key_osm_debug 1253 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1254 WRITE(narea+100,'(2(a,g11.3))')' Final zdifpyc_s_sc',zdifpyc_s_sc(ji,jj) ,' zvispyc_s_sc=',zvispyc_s_sc(ji,jj) 1255 FLUSH(narea+100) 1256 END IF 1257 #endif 1258 1259 zbeta_d_sc(ji,jj) = 1.0 - ( ( zdifpyc_n_sc(ji,jj) + 1.4 * zdifpyc_s_sc(ji,jj) ) / ( zdifml_sc(ji,jj) + epsln ) )**p2third 1260 zbeta_v_sc(ji,jj) = 1.0 - 2.0 * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) / ( zvisml_sc(ji,jj) + epsln ) 1261 ELSE 1262 zbeta_d_sc(ji,jj) = 1.0 1263 zbeta_v_sc(ji,jj) = 1.0 1264 ENDIF 1265 #ifdef key_osm_debug 1266 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1267 WRITE(narea+100,'(2(a,g11.3))')'lconv=T: zbeta_d_sc',zbeta_d_sc(ji,jj) ,' zbeta_v_sc=',zbeta_v_sc(ji,jj) 1268 FLUSH(narea+100) 1269 END IF 1270 #endif 959 1271 ELSE 960 zbeta_d_sc(ji,jj) = 1.0 961 zbeta_v_sc(ji,jj) = 1.0 1272 zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 1273 zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 1274 #ifdef key_osm_debug 1275 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1276 WRITE(narea+100,'(a,g11.3)')'End of 1st major loop of osm_diffusivity_viscositys, lconv=F: zdifml_sc=',zdifml_sc(ji,jj),' zvisml_sc=',zvisml_sc(ji,jj) 1277 FLUSH(narea+100) 1278 END IF 1279 #endif 1280 END IF 1281 END_2D 1282 ! 1283 DO_2D( 0, 0, 0, 0 ) 1284 IF ( lconv(ji,jj) ) THEN 1285 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity 1286 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 1287 ! 1288 zdiffut(ji,jj,jk) = zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5 1289 ! 1290 zviscos(ji,jj,jk) = zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) & 1291 & * ( 1.0 - 0.5 * zznd_ml**2 ) 1292 END DO 1293 ! pycnocline 1294 IF ( lpyc(ji,jj) ) THEN 1295 ! Diffusivity profile in the pycnocline given by cubic polynomial. 1296 za_cubic = 0.5 1297 zb_cubic = -1.75 * zdifpyc_s_sc(ji,jj) / zdifpyc_n_sc(ji,jj) 1298 zd_cubic = ( zdh(ji,jj) * zdifml_sc(ji,jj) / zhml(ji,jj) * SQRT( 1.0 - zbeta_d_sc(ji,jj) ) * ( 2.5 * zbeta_d_sc(ji,jj) - 1.0 ) & 1299 & - 0.85 * zdifpyc_s_sc(ji,jj) ) / MAX(zdifpyc_n_sc(ji,jj), 1.e-8) 1300 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zb_cubic ) 1301 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 1302 DO jk = imld(ji,jj) , ibld(ji,jj) 1303 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 1304 ! 1305 zdiffut(ji,jj,jk) = zdifpyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 1306 1307 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdifpyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ) 1308 END DO 1309 ! viscosity profiles. 1310 za_cubic = 0.5 1311 zb_cubic = -1.75 * zvispyc_s_sc(ji,jj) / zvispyc_n_sc(ji,jj) 1312 zd_cubic = ( 0.5 * zvisml_sc(ji,jj) * zdh(ji,jj) / zhml(ji,jj) - 0.85 * zvispyc_s_sc(ji,jj) ) / MAX(zvispyc_n_sc(ji,jj), 1.e-8) 1313 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zb_cubic ) 1314 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 1315 DO jk = imld(ji,jj) , ibld(ji,jj) 1316 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 1317 zviscos(ji,jj,jk) = zvispyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 1318 zviscos(ji,jj,jk) = zviscos(ji,jj,jk) + zvispyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 -0.2 * zznd_pyc**3 ) 1319 END DO 1320 IF ( zdhdt(ji,jj) > 0._wp ) THEN 1321 zdiffut(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 ) 1322 zviscos(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 ) 1323 ELSE 1324 zdiffut(ji,jj,ibld(ji,jj)) = 0._wp 1325 zviscos(ji,jj,ibld(ji,jj)) = 0._wp 1326 ENDIF 1327 ENDIF 1328 ELSE 1329 ! stable conditions 1330 DO jk = 2, ibld(ji,jj) 1331 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1332 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 1333 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 1334 END DO 1335 1336 IF ( zdhdt(ji,jj) > 0._wp ) THEN 1337 zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm) 1338 zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm) 1339 ENDIF 1340 ENDIF ! end if ( lconv ) 1341 ! 1342 END_2D 1343 IF( ln_timing ) CALL timing_stop('zdf_osm_dv') 1344 1345 END SUBROUTINE zdf_osm_diffusivity_viscosity 1346 1347 SUBROUTINE zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear ) 1348 1349 !!--------------------------------------------------------------------- 1350 !! *** ROUTINE zdf_osm_osbl_state *** 1351 !! 1352 !! ** Purpose : Determines the state of the OSBL, stable/unstable, shear/ noshear. Also determines shear production, entrainment buoyancy flux and interfacial Richardson number 1353 !! 1354 !! ** Method : 1355 !! 1356 !! !!---------------------------------------------------------------------- 1357 1358 INTEGER, DIMENSION(jpi,jpj) :: j_ddh ! j_ddh = 0, active shear layer; j_ddh=1, shear layer not active; j_ddh=2 shear production low. 1359 1360 LOGICAL, DIMENSION(jpi,jpj) :: lconv, lshear 1361 1362 REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent, zwb_min ! Buoyancy fluxes at base of well-mixed layer. 1363 REAL(wp), DIMENSION(jpi,jpj) :: zshear ! production of TKE due to shear across the pycnocline 1364 1365 ! Local Variables 1366 1367 INTEGER :: jj, ji 1368 1369 REAL(wp), DIMENSION(jpi,jpj) :: zekman 1370 REAL(wp), DIMENSION(jpi,jpj) :: zri_p, zri_b ! Richardson numbers 1371 REAL(wp) :: zshear_u, zshear_v, zwb_shr 1372 REAL(wp) :: zwcor, zrf_conv, zrf_shear, zrf_langmuir, zr_stokes 1373 1374 REAL, PARAMETER :: za_shr = 0.4, zb_shr = 6.5, za_wb_s = 0.8 1375 REAL, PARAMETER :: zalpha_c = 0.2, zalpha_lc = 0.03 1376 REAL, PARAMETER :: zalpha_ls = 0.06, zalpha_s = 0.15 1377 REAL, PARAMETER :: rn_ri_p_thresh = 27.0 1378 REAL, PARAMETER :: zri_c = 0.25 1379 REAL, PARAMETER :: zek = 4.0 1380 REAL, PARAMETER :: zrot=0._wp ! dummy rotation rate of surface stress. 1381 1382 IF( ln_timing ) CALL timing_start('zdf_osm_os') 1383 ! Determins stability and set flag lconv 1384 DO_2D( 0, 0, 0, 0 ) 1385 IF ( zhol(ji,jj) < 0._wp ) THEN 1386 lconv(ji,jj) = .TRUE. 1387 ELSE 1388 lconv(ji,jj) = .FALSE. 962 1389 ENDIF 963 ELSE 964 zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 965 zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 966 END IF 967 END_2D 968 ! 969 DO_2D( 0, 0, 0, 0 ) 970 IF ( lconv(ji,jj) ) THEN 971 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity 972 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 973 ! 974 zdiffut(ji,jj,jk) = zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5 975 ! 976 zviscos(ji,jj,jk) = zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) & 977 & * ( 1.0 - 0.5 * zznd_ml**2 ) 978 END DO 979 ! pycnocline 980 IF ( lpyc(ji,jj) ) THEN 981 ! Diffusivity profile in the pycnocline given by cubic polynomial. 982 za_cubic = 0.5 983 zb_cubic = -1.75 * zdifpyc_s_sc(ji,jj) / zdifpyc_n_sc(ji,jj) 984 zd_cubic = ( zdh(ji,jj) * zdifml_sc(ji,jj) / zhml(ji,jj) * SQRT( 1.0 - zbeta_d_sc(ji,jj) ) * ( 2.5 * zbeta_d_sc(ji,jj) - 1.0 ) & 985 & - 0.85 * zdifpyc_s_sc(ji,jj) ) / MAX(zdifpyc_n_sc(ji,jj), 1.e-8) 986 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zb_cubic ) 987 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 988 DO jk = imld(ji,jj) , ibld(ji,jj) 989 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 990 ! 991 zdiffut(ji,jj,jk) = zdifpyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 992 993 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdifpyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ) 994 END DO 995 ! viscosity profiles. 996 za_cubic = 0.5 997 zb_cubic = -1.75 * zvispyc_s_sc(ji,jj) / zvispyc_n_sc(ji,jj) 998 zd_cubic = ( 0.5 * zvisml_sc(ji,jj) * zdh(ji,jj) / zhml(ji,jj) - 0.85 * zvispyc_s_sc(ji,jj) ) / MAX(zvispyc_n_sc(ji,jj), 1.e-8) 999 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zb_cubic ) 1000 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 1001 DO jk = imld(ji,jj) , ibld(ji,jj) 1002 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 1003 zviscos(ji,jj,jk) = zvispyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 1004 zviscos(ji,jj,jk) = zviscos(ji,jj,jk) + zvispyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 -0.2 * zznd_pyc**3 ) 1005 END DO 1006 IF ( zdhdt(ji,jj) > 0._wp ) THEN 1007 zdiffut(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 ) 1008 zviscos(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 ) 1009 ELSE 1010 zdiffut(ji,jj,ibld(ji,jj)) = 0._wp 1011 zviscos(ji,jj,ibld(ji,jj)) = 0._wp 1012 ENDIF 1013 ENDIF 1014 ELSE 1015 ! stable conditions 1016 DO jk = 2, ibld(ji,jj) 1017 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1018 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 1019 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 1020 END DO 1021 1022 IF ( zdhdt(ji,jj) > 0._wp ) THEN 1023 zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm) 1024 zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm) 1025 ENDIF 1026 ENDIF ! end if ( lconv ) 1027 ! 1028 END_2D 1029 IF( ln_timing ) CALL timing_stop('zdf_osm_dv') 1030 1031 END SUBROUTINE zdf_osm_diffusivity_viscosity 1032 1033 SUBROUTINE zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear ) 1034 1035 !!--------------------------------------------------------------------- 1036 !! *** ROUTINE zdf_osm_osbl_state *** 1037 !! 1038 !! ** Purpose : Determines the state of the OSBL, stable/unstable, shear/ noshear. Also determines shear production, entrainment buoyancy flux and interfacial Richardson number 1039 !! 1040 !! ** Method : 1041 !! 1042 !! !!---------------------------------------------------------------------- 1043 1044 INTEGER, DIMENSION(jpi,jpj) :: j_ddh ! j_ddh = 0, active shear layer; j_ddh=1, shear layer not active; j_ddh=2 shear production low. 1045 1046 LOGICAL, DIMENSION(jpi,jpj) :: lconv, lshear 1047 1048 REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent, zwb_min ! Buoyancy fluxes at base of well-mixed layer. 1049 REAL(wp), DIMENSION(jpi,jpj) :: zshear ! production of TKE due to shear across the pycnocline 1050 1051 ! Local Variables 1052 1053 INTEGER :: jj, ji 1054 1055 REAL(wp), DIMENSION(jpi,jpj) :: zekman 1056 REAL(wp), DIMENSION(jpi,jpj) :: zri_p, zri_b ! Richardson numbers 1057 REAL(wp) :: zshear_u, zshear_v, zwb_shr 1058 REAL(wp) :: zwcor, zrf_conv, zrf_shear, zrf_langmuir, zr_stokes 1059 1060 REAL, PARAMETER :: za_shr = 0.4, zb_shr = 6.5, za_wb_s = 0.8 1061 REAL, PARAMETER :: zalpha_c = 0.2, zalpha_lc = 0.03 1062 REAL, PARAMETER :: zalpha_ls = 0.06, zalpha_s = 0.15 1063 REAL, PARAMETER :: rn_ri_p_thresh = 27.0 1064 REAL, PARAMETER :: zri_c = 0.25 1065 REAL, PARAMETER :: zek = 4.0 1066 REAL, PARAMETER :: zrot=0._wp ! dummy rotation rate of surface stress. 1067 1068 IF( ln_timing ) CALL timing_start('zdf_osm_os') 1069 ! Determins stability and set flag lconv 1070 DO_2D( 0, 0, 0, 0 ) 1071 IF ( zhol(ji,jj) < 0._wp ) THEN 1072 lconv(ji,jj) = .TRUE. 1073 ELSE 1074 lconv(ji,jj) = .FALSE. 1075 ENDIF 1076 END_2D 1077 1078 zekman(:,:) = EXP( -1.0_wp * zek * ABS( ff_t(:,:) ) * zhbl(:,:) / MAX(zustar(:,:), 1.e-8 ) ) 1079 1080 zshear(:,:) = 0._wp 1081 j_ddh(:,:) = 1 1082 1083 DO_2D( 0, 0, 0, 0 ) 1084 IF ( lconv(ji,jj) ) THEN 1085 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 1086 zri_p(ji,jj) = MAX ( SQRT( zdb_bl(ji,jj) * zdh(ji,jj) / MAX( zdu_bl(ji,jj)**2 + zdv_bl(ji,jj)**2, 1.e-8) ) * ( zhbl(ji,jj) / zdh(ji,jj) ) * ( zvstr(ji,jj) / MAX( zustar(ji,jj), 1.e-6 ) )**2 & 1087 & / MAX( zekman(ji,jj), 1.e-6 ) , 5._wp ) 1088 1089 IF ( ff_t(ji,jj) >= 0.0_wp ) THEN 1090 ! Northern hemisphere 1091 zri_b(ji,jj) = zdb_ml(ji,jj) * zdh(ji,jj) / ( MAX( zdu_ml(ji,jj), 1e-5_wp )**2 + MAX( -1.0_wp * zdv_ml(ji,jj), 1e-5_wp)**2 ) 1092 ELSE 1093 ! Southern hemisphere 1094 zri_b(ji,jj) = zdb_ml(ji,jj) * zdh(ji,jj) / ( MAX( zdu_ml(ji,jj), 1e-5_wp )**2 + MAX( zdv_ml(ji,jj), 1e-5_wp)**2 ) 1390 END_2D 1391 1392 zekman(:,:) = EXP( -1.0_wp * zek * ABS( ff_t(:,:) ) * zhbl(:,:) / MAX(zustar(:,:), 1.e-8 ) ) 1393 1394 zshear(:,:) = 0._wp 1395 #ifdef key_osm_debug 1396 IF(narea==nn_narea_db) THEN 1397 ji=iloc_db; jj=jloc_db 1398 WRITE(narea+100,'(a,g11.3)') & 1399 & 'zdf_osm_osbl_state start: zekman=', zekman(ji,jj) 1400 FLUSH(narea+100) 1401 END IF 1402 #endif 1403 j_ddh(:,:) = 1 1404 1405 DO_2D( 0, 0, 0, 0 ) 1406 IF ( lconv(ji,jj) ) THEN 1407 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 1408 zri_p(ji,jj) = MAX ( SQRT( zdb_bl(ji,jj) * zdh(ji,jj) / MAX( zdu_bl(ji,jj)**2 + zdv_bl(ji,jj)**2, 1.e-8) ) * ( zhbl(ji,jj) / zdh(ji,jj) ) * ( zvstr(ji,jj) / MAX( zustar(ji,jj), 1.e-6 ) )**2 & 1409 & / MAX( zekman(ji,jj), 1.e-6 ) , 5._wp ) 1410 1411 IF ( ff_t(ji,jj) >= 0.0_wp ) THEN 1412 ! Northern hemisphere 1413 zri_b(ji,jj) = zdb_ml(ji,jj) * zdh(ji,jj) / ( MAX( zdu_ml(ji,jj), 1e-5_wp )**2 + MAX( -1.0_wp * zdv_ml(ji,jj), 1e-5_wp)**2 ) 1414 ELSE 1415 ! Southern hemisphere 1416 zri_b(ji,jj) = zdb_ml(ji,jj) * zdh(ji,jj) / ( MAX( zdu_ml(ji,jj), 1e-5_wp )**2 + MAX( zdv_ml(ji,jj), 1e-5_wp)**2 ) 1417 END IF 1418 zshear(ji,jj) = za_shr * zekman(ji,jj) * ( MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) / zhbl(ji,jj), 0._wp ) + zb_shr * MAX( -ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) * zdv_ml(ji,jj) / zhbl(ji,jj), 0._wp ) ) 1419 #ifdef key_osm_debug 1420 ! IF(narea==nn_narea_db)THEN 1421 ! WRITE(narea+100,'(2(a,i10.4))')'ji',ji,'jj',jj 1422 ! WRITE(narea+100,'(2(a,i10.4))')'iloc_db',iloc_db,'jloc_db',jloc_db 1423 ! WRITE(narea+100,'(2(a,i10.4))')'iloc_db+',mi0(nn_idb),'jloc_db+',mj0(nn_jdb) 1424 ! FLUSH(narea+100) 1425 ! END IF 1426 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1427 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state 1st zshear: zshear=',zshear(ji,jj) 1428 WRITE(narea+100,'(2(a,g11.3))')'zdf_osm_osbl_state 1st zshear: zri_b=',zri_b(ji,jj),' zri_p=',zri_p(ji,jj) 1429 FLUSH(narea+100) 1430 END IF 1431 #endif 1432 ! Stability dependence 1433 zshear(ji,jj) = zshear(ji,jj) * EXP( -0.75_wp * MAX( 0.0_wp, ( zri_b(ji,jj) - zri_c ) / zri_c ) ) 1434 #ifdef key_osm_debug 1435 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1436 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state 1st zshear: zshear inc ri part=',zshear(ji,jj) 1437 FLUSH(narea+100) 1438 END IF 1439 #endif 1440 1441 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1442 ! Test ensures j_ddh=0 is not selected. Change to zri_p<27 when ! 1443 ! full code available ! 1444 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1445 IF ( zshear(ji,jj) > 1e-10 ) THEN 1446 IF ( zri_p(ji,jj) < rn_ri_p_thresh .AND. MIN( hu(ji,jj,Kmm), hu(ji-1,jj,Kmm), hv(ji,jj,Kmm), hv(ji,jj-1,Kmm) ) > 100.0_wp ) THEN 1447 ! Growing shear layer 1448 j_ddh(ji,jj) = 0 1449 lshear(ji,jj) = .TRUE. 1450 ELSE 1451 j_ddh(ji,jj) = 1 1452 ! IF ( zri_b <= 1.5 .and. zshear(ji,jj) > 0._wp ) THEN 1453 ! shear production large enough to determine layer charcteristics, but can't maintain a shear layer. 1454 lshear(ji,jj) = .TRUE. 1455 ! ELSE 1456 END IF 1457 ELSE 1458 j_ddh(ji,jj) = 2 1459 lshear(ji,jj) = .FALSE. 1460 END IF 1461 ! Shear production may not be zero, but is small and doesn't determine characteristics of pycnocline. 1462 ! zshear(ji,jj) = 0.5 * zshear(ji,jj) 1463 ! lshear(ji,jj) = .FALSE. 1464 ! ENDIF 1465 ELSE ! zdb_bl test, note zshear set to zero 1466 j_ddh(ji,jj) = 2 1467 lshear(ji,jj) = .FALSE. 1468 ENDIF 1469 ENDIF 1470 END_2D 1471 1472 ! Calculate entrainment buoyancy flux due to surface fluxes. 1473 1474 DO_2D( 0, 0, 0, 0 ) 1475 IF ( lconv(ji,jj) ) THEN 1476 zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln 1477 zrf_conv = TANH( ( zwstrc(ji,jj) / zwcor )**0.69 ) 1478 zrf_shear = TANH( ( zustar(ji,jj) / zwcor )**0.69 ) 1479 zrf_langmuir = TANH( ( zwstrl(ji,jj) / zwcor )**0.69 ) 1480 IF (nn_osm_SD_reduce > 0 ) THEN 1481 ! Effective Stokes drift already reduced from surface value 1482 zr_stokes = 1.0_wp 1483 ELSE 1484 ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd, 1485 ! requires further reduction where BL is deep 1486 zr_stokes = 1.0 - EXP( -25.0 * dstokes(ji,jj) / hbl(ji,jj) & 1487 & * ( 1.0 + 4.0 * dstokes(ji,jj) / hbl(ji,jj) ) ) 1488 END IF 1489 zwb_ent(ji,jj) = -2.0_wp * zalpha_c * zrf_conv * zwbav(ji,jj) & 1490 & - zalpha_s * zrf_shear * zustar(ji,jj)**3 / zhml(ji,jj) & 1491 & + zr_stokes * ( zalpha_s * EXP( -1.5_wp * zla(ji,jj) ) * zrf_shear * zustar(ji,jj)**3 & 1492 & - zrf_langmuir * zalpha_lc * zwstrl(ji,jj)**3 ) / zhml(ji,jj) 1493 ! 1494 #ifdef key_osm_debug 1495 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1496 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state conv+shear0/lang: zwb_ent=',zwb_ent(ji,jj) 1497 FLUSH(narea+100) 1498 END IF 1499 #endif 1500 1501 ENDIF 1502 END_2D 1503 1504 zwb_min(:,:) = 0._wp 1505 1506 DO_2D( 0, 0, 0, 0 ) 1507 IF ( lshear(ji,jj) ) THEN 1508 IF ( lconv(ji,jj) ) THEN 1509 ! Unstable OSBL 1510 zwb_shr = -1.0_wp * za_wb_s * zri_b(ji,jj) * zshear(ji,jj) 1511 #ifdef key_osm_debug 1512 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1513 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state 1st zwb_shr: zwb_shr=',zwb_shr 1514 FLUSH(narea+100) 1515 END IF 1516 #endif 1517 IF ( j_ddh(ji,jj) == 0 ) THEN 1518 1519 ! ! Developing shear layer, additional shear production possible. 1520 1521 ! zshear_u = MAX( zustar(ji,jj)**2 * MAX( zdu_ml(ji,jj), 0._wp ) / zhbl(ji,jj), 0._wp ) 1522 ! zshear(ji,jj) = zshear(ji,jj) + zshear_u * ( 1.0 - MIN( zri_p(ji,jj) / rn_ri_p_thresh, 1.d0 )**2 ) 1523 ! zshear(ji,jj) = MIN( zshear(ji,jj), zshear_u ) 1524 1525 ! zwb_shr = zwb_shr - 0.25 * MAX ( zshear_u, 0._wp) * ( 1.0 - MIN( zri_p(ji,jj) / rn_ri_p_thresh, 1._wp )**2 ) 1526 ! zwb_shr = MAX( zwb_shr, -0.25 * zshear_u ) 1527 #ifdef key_osm_debug 1528 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1529 WRITE(narea+100,'(3(a,g11.3))')'zdf_osm_osbl_state j_ddh(ji,jj) == 0:zwb_shr=',zwb_shr, & 1530 & ' zshear=',zshear(ji,jj),' zshear_u=', zshear_u 1531 FLUSH(narea+100) 1532 END IF 1533 #endif 1534 1535 ENDIF 1536 zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr 1537 ! zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj) 1538 ELSE ! IF ( lconv ) THEN - ENDIF 1539 ! Stable OSBL - shear production not coded for first attempt. 1540 ENDIF ! lconv 1541 END IF ! lshear 1542 IF ( lconv(ji,jj) ) THEN 1543 ! Unstable OSBL 1544 zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * 2.0_wp * zwbav(ji,jj) 1545 END IF ! lconv 1546 #ifdef key_osm_debug 1547 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1548 WRITE(narea+100,'(3(a,g11.3))')'end of zdf_osm_osbl_state:zwb_ent=',zwb_ent(ji,jj), & 1549 & ' zwb_min=',zwb_min(ji,jj), ' zwb0tot=', zwb0tot(ji,jj), ' zwbav= ', zwbav(ji,jj) 1550 FLUSH(narea+100) 1095 1551 END IF 1096 zshear(ji,jj) = za_shr * zekman(ji,jj) * ( MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) / zhbl(ji,jj), 0._wp ) + zb_shr * MAX( -ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) * zdv_ml(ji,jj) / zhbl(ji,jj), 0._wp ) ) 1097 ! Stability dependence 1098 zshear(ji,jj) = zshear(ji,jj) * EXP( -0.75_wp * MAX( 0.0_wp, ( zri_b(ji,jj) - zri_c ) / zri_c ) ) 1099 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1100 ! Test ensures j_ddh=0 is not selected. Change to zri_p<27 when ! 1101 ! full code available ! 1102 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1103 IF ( zshear(ji,jj) > 1e-10 ) THEN 1104 IF ( zri_p(ji,jj) < rn_ri_p_thresh .AND. MIN( hu(ji,jj,Kmm), hu(ji-1,jj,Kmm), hv(ji,jj,Kmm), hv(ji,jj-1,Kmm) ) > 100.0_wp ) THEN 1105 ! Growing shear layer 1106 j_ddh(ji,jj) = 0 1107 lshear(ji,jj) = .TRUE. 1552 #endif 1553 END_2D 1554 IF( ln_timing ) CALL timing_stop('zdf_osm_os') 1555 END SUBROUTINE zdf_osm_osbl_state 1556 1557 1558 SUBROUTINE zdf_osm_velocity_rotation( zcos_w, zsin_w, zu, zv, zdu, zdv ) 1559 !!--------------------------------------------------------------------- 1560 !! *** ROUTINE zdf_velocity_rotation *** 1561 !! 1562 !! ** Purpose : Rotates frame of reference of averaged velocity components. 1563 !! 1564 !! ** Method : The velocity components are rotated into frame specified by zcos_w and zsin_w 1565 !! 1566 !!---------------------------------------------------------------------- 1567 1568 REAL(wp), DIMENSION(jpi,jpj) :: zcos_w, zsin_w ! Cos and Sin of rotation angle 1569 REAL(wp), DIMENSION(jpi,jpj) :: zu, zv ! Components of current 1570 REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv ! Change in velocity components across pycnocline 1571 1572 INTEGER :: ji, jj 1573 REAL(wp) :: ztemp 1574 1575 IF( ln_timing ) CALL timing_start('zdf_osm_vr') 1576 DO_2D( 0, 0, 0, 0 ) 1577 ztemp = zu(ji,jj) 1578 zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj) 1579 zv(ji,jj) = zv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj) 1580 ztemp = zdu(ji,jj) 1581 zdu(ji,jj) = zdu(ji,jj) * zcos_w(ji,jj) + zdv(ji,jj) * zsin_w(ji,jj) 1582 zdv(ji,jj) = zdv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj) 1583 END_2D 1584 IF( ln_timing ) CALL timing_stop('zdf_osm_vr') 1585 END SUBROUTINE zdf_osm_velocity_rotation 1586 1587 SUBROUTINE zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk ) 1588 !!--------------------------------------------------------------------- 1589 !! *** ROUTINE zdf_osm_osbl_state_fk *** 1590 !! 1591 !! ** Purpose : Determines the state of the OSBL and MLE layer. Info is returned in the logicals lpyc,lflux and lmle. Used with Fox-Kemper scheme. 1592 !! lpyc :: determines whether pycnocline flux-grad relationship needs to be determined 1593 !! lflux :: determines whether effects of surface flux extend below the base of the OSBL 1594 !! lmle :: determines whether the layer with MLE is increasing with time or if base is relaxing towards hbl. 1595 !! 1596 !! ** Method : 1597 !! 1598 !! 1599 !!---------------------------------------------------------------------- 1600 1601 ! Outputs 1602 LOGICAL, DIMENSION(jpi,jpj) :: lpyc, lflux, lmle 1603 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk 1604 ! 1605 REAL(wp), DIMENSION(jpi,jpj) :: znd_param 1606 REAL(wp) :: zbuoy, ztmp, zpe_mle_layer 1607 REAL(wp) :: zpe_mle_ref, zdbdz_mle_int 1608 1609 IF( ln_timing ) CALL timing_start('zdf_osm_osf') 1610 znd_param(:,:) = 0._wp 1611 1612 DO_2D( 0, 0, 0, 0 ) 1613 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 1614 zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * zdbds_mle(ji,jj) * zdbds_mle(ji,jj) 1615 END_2D 1616 DO_2D( 0, 0, 0, 0 ) 1617 ! 1618 IF ( lconv(ji,jj) ) THEN 1619 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 1620 zt_mle(ji,jj) = ( zt_mle(ji,jj) * zhmle(ji,jj) - zt_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 1621 zs_mle(ji,jj) = ( zs_mle(ji,jj) * zhmle(ji,jj) - zs_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 1622 zb_mle(ji,jj) = ( zb_mle(ji,jj) * zhmle(ji,jj) - zb_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 1623 zdbdz_mle_int = ( zb_bl(ji,jj) - ( 2.0 * zb_mle(ji,jj) -zb_bl(ji,jj) ) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 1624 ! Calculate potential energies of actual profile and reference profile. 1625 zpe_mle_layer = 0._wp 1626 zpe_mle_ref = 0._wp 1627 zthermal = rab_n(ji,jj,1,jp_tem) 1628 zbeta = rab_n(ji,jj,1,jp_sal) 1629 DO jk = ibld(ji,jj), mld_prof(ji,jj) 1630 zbuoy = grav * ( zthermal * ts(ji,jj,jk,jp_tem,Kmm) - zbeta * ts(ji,jj,jk,jp_sal,Kmm) ) 1631 zpe_mle_layer = zpe_mle_layer + zbuoy * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 1632 zpe_mle_ref = zpe_mle_ref + ( zb_bl(ji,jj) - zdbdz_mle_int * ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) ) * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 1633 END DO 1634 ! Non-dimensional parameter to diagnose the presence of thermocline 1635 1636 znd_param(ji,jj) = ( zpe_mle_layer - zpe_mle_ref ) * ABS( ff_t(ji,jj) ) / ( MAX( zwb_fk(ji,jj), 1.0e-10 ) * zhmle(ji,jj) ) 1637 ENDIF 1638 ENDIF 1639 #ifdef key_osm_debug 1640 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1641 WRITE(narea+100,'(4(a,g11.3))')'start of zdf_osm_osbl_state_fk: zwb_fk=',zwb_fk(ji,jj), & 1642 & ' znd_param=',znd_param(ji,jj), ' zpe_mle_ref=', zpe_mle_ref, ' zpe_mle_layer=', zpe_mle_layer 1643 FLUSH(narea+100) 1644 END IF 1645 #endif 1646 END_2D 1647 1648 ! Diagnosis 1649 DO_2D( 0, 0, 0, 0 ) 1650 IF ( lconv(ji,jj) ) THEN 1651 IF ( -2.0 * zwb_fk(ji,jj) / zwb_ent(ji,jj) > 0.5 ) THEN 1652 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 1653 ! MLE layer growing 1654 IF ( znd_param (ji,jj) > 100. ) THEN 1655 ! Thermocline present 1656 lflux(ji,jj) = .FALSE. 1657 lmle(ji,jj) =.FALSE. 1658 ELSE 1659 ! Thermocline not present 1660 lflux(ji,jj) = .TRUE. 1661 lmle(ji,jj) = .TRUE. 1662 ENDIF ! znd_param > 100 1663 ! 1664 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 1665 lpyc(ji,jj) = .FALSE. 1666 ELSE 1667 lpyc(ji,jj) = .TRUE. 1668 ENDIF 1669 ELSE 1670 ! MLE layer restricted to OSBL or just below. 1671 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 1672 ! Weak stratification MLE layer can grow. 1673 lpyc(ji,jj) = .FALSE. 1674 lflux(ji,jj) = .TRUE. 1675 lmle(ji,jj) = .TRUE. 1676 ELSE 1677 ! Strong stratification 1678 lpyc(ji,jj) = .TRUE. 1679 lflux(ji,jj) = .FALSE. 1680 lmle(ji,jj) = .FALSE. 1681 ENDIF ! zdb_bl < rn_mle_thresh_bl and 1682 ENDIF ! zhmle > 1.2 zhbl 1108 1683 ELSE 1109 j_ddh(ji,jj) = 11110 ! IF ( zri_b <= 1.5 .and. zshear(ji,jj) > 0._wp ) THEN1111 ! shear production large enough to determine layer charcteristics, but can't maintain a shear layer.1112 lshear(ji,jj) = .TRUE.1113 ! ELSE1114 END IF1115 ELSE1116 j_ddh(ji,jj) = 21117 lshear(ji,jj) = .FALSE.1118 END IF1119 ! Shear production may not be zero, but is small and doesn't determine characteristics of pycnocline.1120 ! zshear(ji,jj) = 0.5 * zshear(ji,jj)1121 ! lshear(ji,jj) = .FALSE.1122 ! ENDIF1123 ELSE ! zdb_bl test, note zshear set to zero1124 j_ddh(ji,jj) = 21125 lshear(ji,jj) = .FALSE.1126 ENDIF1127 ENDIF1128 END_2D1129 1130 ! Calculate entrainment buoyancy flux due to surface fluxes.1131 1132 DO_2D( 0, 0, 0, 0 )1133 IF ( lconv(ji,jj) ) THEN1134 zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln1135 zrf_conv = TANH( ( zwstrc(ji,jj) / zwcor )**0.69 )1136 zrf_shear = TANH( ( zustar(ji,jj) / zwcor )**0.69 )1137 zrf_langmuir = TANH( ( zwstrl(ji,jj) / zwcor )**0.69 )1138 IF (nn_osm_SD_reduce > 0 ) THEN1139 ! Effective Stokes drift already reduced from surface value1140 zr_stokes = 1.0_wp1141 ELSE1142 ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd,1143 ! requires further reduction where BL is deep1144 zr_stokes = 1.0 - EXP( -25.0 * dstokes(ji,jj) / hbl(ji,jj) &1145 & * ( 1.0 + 4.0 * dstokes(ji,jj) / hbl(ji,jj) ) )1146 END IF1147 zwb_ent(ji,jj) = -2.0_wp * zalpha_c * zrf_conv * zwbav(ji,jj) &1148 & - zalpha_s * zrf_shear * zustar(ji,jj)**3 / zhml(ji,jj) &1149 & + zr_stokes * ( zalpha_s * EXP( -1.5_wp * zla(ji,jj) ) * zrf_shear * zustar(ji,jj)**3 &1150 & - zrf_langmuir * zalpha_lc * zwstrl(ji,jj)**3 ) / zhml(ji,jj)1151 !1152 ENDIF1153 END_2D1154 1155 zwb_min(:,:) = 0._wp1156 1157 DO_2D( 0, 0, 0, 0 )1158 IF ( lshear(ji,jj) ) THEN1159 IF ( lconv(ji,jj) ) THEN1160 ! Unstable OSBL1161 zwb_shr = -1.0_wp * za_wb_s * zri_b(ji,jj) * zshear(ji,jj)1162 IF ( j_ddh(ji,jj) == 0 ) THEN1163 1164 ! ! Developing shear layer, additional shear production possible.1165 1166 ! zshear_u = MAX( zustar(ji,jj)**2 * MAX( zdu_ml(ji,jj), 0._wp ) / zhbl(ji,jj), 0._wp )1167 ! zshear(ji,jj) = zshear(ji,jj) + zshear_u * ( 1.0 - MIN( zri_p(ji,jj) / rn_ri_p_thresh, 1.d0 )**2 )1168 ! zshear(ji,jj) = MIN( zshear(ji,jj), zshear_u )1169 1170 ! zwb_shr = zwb_shr - 0.25 * MAX ( zshear_u, 0._wp) * ( 1.0 - MIN( zri_p(ji,jj) / rn_ri_p_thresh, 1._wp )**2 )1171 ! zwb_shr = MAX( zwb_shr, -0.25 * zshear_u )1172 1173 ENDIF1174 zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr1175 ! zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj)1176 ELSE ! IF ( lconv ) THEN - ENDIF1177 ! Stable OSBL - shear production not coded for first attempt.1178 ENDIF ! lconv1179 END IF ! lshear1180 IF ( lconv(ji,jj) ) THEN1181 ! Unstable OSBL1182 zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * 2.0_wp * zwbav(ji,jj)1183 END IF ! lconv1184 END_2D1185 IF( ln_timing ) CALL timing_stop('zdf_osm_os')1186 END SUBROUTINE zdf_osm_osbl_state1187 1188 1189 SUBROUTINE zdf_osm_velocity_rotation( zcos_w, zsin_w, zu, zv, zdu, zdv )1190 !!---------------------------------------------------------------------1191 !! *** ROUTINE zdf_velocity_rotation ***1192 !!1193 !! ** Purpose : Rotates frame of reference of averaged velocity components.1194 !!1195 !! ** Method : The velocity components are rotated into frame specified by zcos_w and zsin_w1196 !!1197 !!----------------------------------------------------------------------1198 1199 REAL(wp), DIMENSION(jpi,jpj) :: zcos_w, zsin_w ! Cos and Sin of rotation angle1200 REAL(wp), DIMENSION(jpi,jpj) :: zu, zv ! Components of current1201 REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv ! Change in velocity components across pycnocline1202 1203 INTEGER :: ji, jj1204 REAL(wp) :: ztemp1205 1206 IF( ln_timing ) CALL timing_start('zdf_osm_vr')1207 DO_2D( 0, 0, 0, 0 )1208 ztemp = zu(ji,jj)1209 zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj)1210 zv(ji,jj) = zv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj)1211 ztemp = zdu(ji,jj)1212 zdu(ji,jj) = zdu(ji,jj) * zcos_w(ji,jj) + zdv(ji,jj) * zsin_w(ji,jj)1213 zdv(ji,jj) = zdv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj)1214 END_2D1215 IF( ln_timing ) CALL timing_stop('zdf_osm_vr')1216 END SUBROUTINE zdf_osm_velocity_rotation1217 1218 SUBROUTINE zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk )1219 !!---------------------------------------------------------------------1220 !! *** ROUTINE zdf_osm_osbl_state_fk ***1221 !!1222 !! ** Purpose : Determines the state of the OSBL and MLE layer. Info is returned in the logicals lpyc,lflux and lmle. Used with Fox-Kemper scheme.1223 !! lpyc :: determines whether pycnocline flux-grad relationship needs to be determined1224 !! lflux :: determines whether effects of surface flux extend below the base of the OSBL1225 !! lmle :: determines whether the layer with MLE is increasing with time or if base is relaxing towards hbl.1226 !!1227 !! ** Method :1228 !!1229 !!1230 !!----------------------------------------------------------------------1231 1232 ! Outputs1233 LOGICAL, DIMENSION(jpi,jpj) :: lpyc, lflux, lmle1234 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk1235 !1236 REAL(wp), DIMENSION(jpi,jpj) :: znd_param1237 REAL(wp) :: zbuoy, ztmp, zpe_mle_layer1238 REAL(wp) :: zpe_mle_ref, zdbdz_mle_int1239 1240 IF( ln_timing ) CALL timing_start('zdf_osm_osf')1241 znd_param(:,:) = 0._wp1242 1243 DO_2D( 0, 0, 0, 0 )1244 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf1245 zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * zdbds_mle(ji,jj) * zdbds_mle(ji,jj)1246 END_2D1247 DO_2D( 0, 0, 0, 0 )1248 !1249 IF ( lconv(ji,jj) ) THEN1250 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN1251 zt_mle(ji,jj) = ( zt_mle(ji,jj) * zhmle(ji,jj) - zt_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )1252 zs_mle(ji,jj) = ( zs_mle(ji,jj) * zhmle(ji,jj) - zs_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )1253 zb_mle(ji,jj) = ( zb_mle(ji,jj) * zhmle(ji,jj) - zb_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )1254 zdbdz_mle_int = ( zb_bl(ji,jj) - ( 2.0 * zb_mle(ji,jj) -zb_bl(ji,jj) ) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )1255 ! Calculate potential energies of actual profile and reference profile.1256 zpe_mle_layer = 0._wp1257 zpe_mle_ref = 0._wp1258 zthermal = rab_n(ji,jj,1,jp_tem)1259 zbeta = rab_n(ji,jj,1,jp_sal)1260 DO jk = ibld(ji,jj), mld_prof(ji,jj)1261 zbuoy = grav * ( zthermal * ts(ji,jj,jk,jp_tem,Kmm) - zbeta * ts(ji,jj,jk,jp_sal,Kmm) )1262 zpe_mle_layer = zpe_mle_layer + zbuoy * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)1263 zpe_mle_ref = zpe_mle_ref + ( zb_bl(ji,jj) - zdbdz_mle_int * ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) ) * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)1264 END DO1265 ! Non-dimensional parameter to diagnose the presence of thermocline1266 1267 znd_param(ji,jj) = ( zpe_mle_layer - zpe_mle_ref ) * ABS( ff_t(ji,jj) ) / ( MAX( zwb_fk(ji,jj), 1.0e-10 ) * zhmle(ji,jj) )1268 ENDIF1269 ENDIF1270 END_2D1271 1272 ! Diagnosis1273 DO_2D( 0, 0, 0, 0 )1274 IF ( lconv(ji,jj) ) THEN1275 IF ( -2.0 * zwb_fk(ji,jj) / zwb_ent(ji,jj) > 0.5 ) THEN1276 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN1277 ! MLE layer growing1278 IF ( znd_param (ji,jj) > 100. ) THEN1279 ! Thermocline present1280 lflux(ji,jj) = .FALSE.1281 lmle(ji,jj) =.FALSE.1282 ELSE1283 ! Thermocline not present1284 lflux(ji,jj) = .TRUE.1285 lmle(ji,jj) = .TRUE.1286 ENDIF ! znd_param > 1001287 !1288 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN1289 lpyc(ji,jj) = .FALSE.1290 ELSE1291 lpyc(ji,jj) = .TRUE.1292 ENDIF1293 ELSE1294 ! MLE layer restricted to OSBL or just below.1295 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN1296 ! Weak stratification MLE layer can grow.1297 lpyc(ji,jj) = .FALSE.1298 lflux(ji,jj) = .TRUE.1299 lmle(ji,jj) = .TRUE.1300 ELSE1301 ! Strong stratification1302 1684 lpyc(ji,jj) = .TRUE. 1303 1685 lflux(ji,jj) = .FALSE. 1304 1686 lmle(ji,jj) = .FALSE. 1305 ENDIF ! zdb_bl < rn_mle_thresh_bl and1306 ENDIF ! zhmle > 1.2 zhbl1687 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 1688 ENDIF ! -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5 1307 1689 ELSE 1308 lpyc(ji,jj) = .TRUE. 1309 lflux(ji,jj) = .FALSE. 1310 lmle(ji,jj) = .FALSE. 1311 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 1312 ENDIF ! -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5 1313 ELSE 1314 ! Stable Boundary Layer 1315 lpyc(ji,jj) = .FALSE. 1316 lflux(ji,jj) = .FALSE. 1317 lmle(ji,jj) = .FALSE. 1318 ENDIF ! lconv 1319 END_2D 1320 IF( ln_timing ) CALL timing_stop('zdf_osm_osf') 1321 END SUBROUTINE zdf_osm_osbl_state_fk 1322 1323 SUBROUTINE zdf_osm_external_gradients(jbase, zdtdz, zdsdz, zdbdz ) 1324 !!--------------------------------------------------------------------- 1325 !! *** ROUTINE zdf_osm_external_gradients *** 1326 !! 1327 !! ** Purpose : Calculates the gradients below the OSBL 1328 !! 1329 !! ** Method : Uses ibld and ibld_ext to determine levels to calculate the gradient. 1330 !! 1331 !!---------------------------------------------------------------------- 1332 1333 INTEGER, DIMENSION(jpi,jpj) :: jbase 1334 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz, zdsdz, zdbdz ! External gradients of temperature, salinity and buoyancy. 1335 1336 INTEGER :: jj, ji, jkb, jkb1 1337 REAL(wp) :: zthermal, zbeta 1338 1339 1340 IF( ln_timing ) CALL timing_start('zdf_osm_eg') 1341 DO_2D( 0, 0, 0, 0 ) 1342 IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN 1343 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 1344 zbeta = rab_n(ji,jj,1,jp_sal) 1345 jkb = jbase(ji,jj) 1346 jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 1347 zdtdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_tem,Kmm) - ts(ji,jj,jkb,jp_tem,Kmm ) ) & 1348 & / e3w(ji,jj,jkb1,Kmm) 1349 zdsdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_sal,Kmm) - ts(ji,jj,jkb,jp_sal,Kmm ) ) & 1350 & / e3w(ji,jj,jkb1,Kmm) 1351 zdbdz(ji,jj) = grav * zthermal * zdtdz(ji,jj) - grav * zbeta * zdsdz(ji,jj) 1352 ELSE 1353 zdtdz(ji,jj) = 0._wp 1354 zdsdz(ji,jj) = 0._wp 1355 zdbdz(ji,jj) = 0._wp 1356 END IF 1357 END_2D 1358 IF( ln_timing ) CALL timing_stop('zdf_osm_eg') 1359 END SUBROUTINE zdf_osm_external_gradients 1360 1361 SUBROUTINE zdf_osm_pycnocline_buoyancy_profiles( pdbdz, palpha ) 1362 REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: pdbdz ! Gradients in the pycnocline 1363 REAL(wp), DIMENSION(:,:), INTENT( inout ) :: palpha 1364 INTEGER :: jk, jj, ji 1365 REAL(wp) :: zbgrad 1366 REAL(wp) :: zgamma_b_nd, znd 1367 REAL(wp) :: zzeta_m 1368 REAL(wp), PARAMETER :: ppgamma_b = 2.25_wp 1369 ! 1370 IF( ln_timing ) CALL timing_start('zdf_osm_pscp') 1371 ! 1372 DO_2D( 0, 0, 0, 0 ) 1373 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 1374 IF ( lconv(ji,jj) ) THEN ! convective conditions 1375 IF ( lpyc(ji,jj) ) THEN 1376 zzeta_m = 0.1_wp + 0.3_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * zhol(ji,jj) ) ) ) 1377 palpha(ji,jj) = 2.0_wp * ( 1.0_wp - ( 0.80_wp * zzeta_m + 0.5_wp * SQRT( 3.14159_wp / ppgamma_b ) ) * & 1378 & zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / zdb_ml(ji,jj) ) / & 1379 & ( 0.723_wp + SQRT( 3.14159_wp / ppgamma_b ) ) 1380 palpha(ji,jj) = MAX( palpha(ji,jj), 0.0_wp ) 1381 ztmp = 1.0_wp / MAX( zdh(ji,jj), epsln ) 1382 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1383 ! Commented lines in this section are not needed in new code, once tested ! 1384 ! can be removed ! 1385 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1386 ! ztgrad = zalpha * zdt_ml(ji,jj) * ztmp + zdtdz_bl_ext(ji,jj) 1387 ! zsgrad = zalpha * zds_ml(ji,jj) * ztmp + zdsdz_bl_ext(ji,jj) 1388 zbgrad = palpha(ji,jj) * zdb_ml(ji,jj) * ztmp + zdbdz_bl_ext(ji,jj) 1389 zgamma_b_nd = zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / MAX(zdb_ml(ji,jj), epsln) 1390 DO jk = 2, ibld(ji,jj) 1391 znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) * ztmp 1392 IF ( znd <= zzeta_m ) THEN 1393 ! zdtdz(ji,jj,jk) = zdtdz_bl_ext(ji,jj) + zalpha * zdt_ml(ji,jj) * ztmp * & 1394 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1395 ! zdsdz(ji,jj,jk) = zdsdz_bl_ext(ji,jj) + zalpha * zds_ml(ji,jj) * ztmp * & 1396 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1397 pdbdz(ji,jj,jk) = zdbdz_bl_ext(ji,jj) + palpha(ji,jj) * zdb_ml(ji,jj) * ztmp * & 1398 & EXP( -6.0_wp * ( znd -zzeta_m )**2 ) 1690 ! Stable Boundary Layer 1691 lpyc(ji,jj) = .FALSE. 1692 lflux(ji,jj) = .FALSE. 1693 lmle(ji,jj) = .FALSE. 1694 ENDIF ! lconv 1695 #ifdef key_osm_debug 1696 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1697 WRITE(narea+100,'(3(a,g11.3),/,4(a,l2))')'end of zdf_osm_osbl_state_fk:zwb_ent=',zwb_ent(ji,jj), & 1698 & ' zhmle=',zhmle(ji,jj), ' zhbl=', zhbl(ji,jj), & 1699 & ' lpyc= ', lpyc(ji,jj), ' lflux= ', lflux(ji,jj), ' lmle= ', lmle(ji,jj), ' lconv= ', lconv(ji,jj) 1700 FLUSH(narea+100) 1701 END IF 1702 #endif 1703 END_2D 1704 IF( ln_timing ) CALL timing_stop('zdf_osm_osf') 1705 END SUBROUTINE zdf_osm_osbl_state_fk 1706 1707 SUBROUTINE zdf_osm_external_gradients(jbase, zdtdz, zdsdz, zdbdz ) 1708 !!--------------------------------------------------------------------- 1709 !! *** ROUTINE zdf_osm_external_gradients *** 1710 !! 1711 !! ** Purpose : Calculates the gradients below the OSBL 1712 !! 1713 !! ** Method : Uses ibld and ibld_ext to determine levels to calculate the gradient. 1714 !! 1715 !!---------------------------------------------------------------------- 1716 1717 INTEGER, DIMENSION(jpi,jpj) :: jbase 1718 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz, zdsdz, zdbdz ! External gradients of temperature, salinity and buoyancy. 1719 1720 INTEGER :: jj, ji, jkb, jkb1 1721 REAL(wp) :: zthermal, zbeta 1722 1723 1724 IF( ln_timing ) CALL timing_start('zdf_osm_eg') 1725 DO_2D( 0, 0, 0, 0 ) 1726 IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN 1727 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 1728 zbeta = rab_n(ji,jj,1,jp_sal) 1729 jkb = jbase(ji,jj) 1730 jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 1731 zdtdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_tem,Kmm) - ts(ji,jj,jkb,jp_tem,Kmm ) ) & 1732 & / e3w(ji,jj,jkb1,Kmm) 1733 zdsdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_sal,Kmm) - ts(ji,jj,jkb,jp_sal,Kmm ) ) & 1734 & / e3w(ji,jj,jkb1,Kmm) 1735 zdbdz(ji,jj) = grav * zthermal * zdtdz(ji,jj) - grav * zbeta * zdsdz(ji,jj) 1736 ELSE 1737 zdtdz(ji,jj) = 0._wp 1738 zdsdz(ji,jj) = 0._wp 1739 zdbdz(ji,jj) = 0._wp 1740 END IF 1741 END_2D 1742 IF( ln_timing ) CALL timing_stop('zdf_osm_eg') 1743 END SUBROUTINE zdf_osm_external_gradients 1744 1745 SUBROUTINE zdf_osm_pycnocline_buoyancy_profiles( pdbdz, palpha ) 1746 REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: pdbdz ! Gradients in the pycnocline 1747 REAL(wp), DIMENSION(:,:), INTENT( inout ) :: palpha 1748 INTEGER :: jk, jj, ji 1749 REAL(wp) :: zbgrad 1750 REAL(wp) :: zgamma_b_nd, znd 1751 REAL(wp) :: zzeta_m 1752 REAL(wp), PARAMETER :: ppgamma_b = 2.25_wp 1753 ! 1754 IF( ln_timing ) CALL timing_start('zdf_osm_pscp') 1755 ! 1756 DO_2D( 0, 0, 0, 0 ) 1757 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 1758 IF ( lconv(ji,jj) ) THEN ! convective conditions 1759 IF ( lpyc(ji,jj) ) THEN 1760 zzeta_m = 0.1_wp + 0.3_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * zhol(ji,jj) ) ) ) 1761 palpha(ji,jj) = 2.0_wp * ( 1.0_wp - ( 0.80_wp * zzeta_m + 0.5_wp * SQRT( 3.14159_wp / ppgamma_b ) ) * & 1762 & zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / zdb_ml(ji,jj) ) / & 1763 & ( 0.723_wp + SQRT( 3.14159_wp / ppgamma_b ) ) 1764 palpha(ji,jj) = MAX( palpha(ji,jj), 0.0_wp ) 1765 ztmp = 1.0_wp / MAX( zdh(ji,jj), epsln ) 1766 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1767 ! Commented lines in this section are not needed in new code, once tested ! 1768 ! can be removed ! 1769 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1770 ! ztgrad = zalpha * zdt_ml(ji,jj) * ztmp + zdtdz_bl_ext(ji,jj) 1771 ! zsgrad = zalpha * zds_ml(ji,jj) * ztmp + zdsdz_bl_ext(ji,jj) 1772 zbgrad = palpha(ji,jj) * zdb_ml(ji,jj) * ztmp + zdbdz_bl_ext(ji,jj) 1773 zgamma_b_nd = zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / MAX(zdb_ml(ji,jj), epsln) 1774 DO jk = 2, ibld(ji,jj) 1775 znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) * ztmp 1776 IF ( znd <= zzeta_m ) THEN 1777 ! zdtdz(ji,jj,jk) = zdtdz_bl_ext(ji,jj) + zalpha * zdt_ml(ji,jj) * ztmp * & 1778 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1779 ! zdsdz(ji,jj,jk) = zdsdz_bl_ext(ji,jj) + zalpha * zds_ml(ji,jj) * ztmp * & 1780 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1781 pdbdz(ji,jj,jk) = zdbdz_bl_ext(ji,jj) + palpha(ji,jj) * zdb_ml(ji,jj) * ztmp * & 1782 & EXP( -6.0_wp * ( znd -zzeta_m )**2 ) 1783 ELSE 1784 ! zdtdz(ji,jj,jk) = ztgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1785 ! zdsdz(ji,jj,jk) = zsgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1786 pdbdz(ji,jj,jk) = zbgrad * EXP( -1.0_wp * ppgamma_b * ( znd - zzeta_m )**2 ) 1787 ENDIF 1788 END DO 1789 #ifdef key_osm_debug 1790 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1791 WRITE(narea+100,'(a,/,3(a,g11.3),/,2(a,g11.3),/)')'end of zdf_osm_pycnocline_buoyancy_profiles:lconv=lpyc=T',& 1792 & 'zzeta_m=', zzeta_m, ' zalpha=', palpha(ji,jj), ' ztmp=', ztmp,& 1793 & ' zbgrad=', zbgrad, ' zgamma_b_nd=', zgamma_b_nd 1794 FLUSH(narea+100) 1795 END IF 1796 #endif 1797 ENDIF ! If no pycnocline pycnocline gradients set to zero 1798 ELSE ! Stable conditions 1799 ! If pycnocline profile only defined when depth steady of increasing. 1800 IF ( zdhdt(ji,jj) > 0.0_wp ) THEN ! Depth increasing, or steady. 1801 IF ( zdb_bl(ji,jj) > 0.0_wp ) THEN 1802 IF ( zhol(ji,jj) >= 0.5_wp ) THEN ! Very stable - 'thick' pycnocline 1803 ztmp = 1.0_wp / MAX( zhbl(ji,jj), epsln ) 1804 zbgrad = zdb_bl(ji,jj) * ztmp 1805 DO jk = 2, ibld(ji,jj) 1806 znd = gdepw(ji,jj,jk,Kmm) * ztmp 1807 pdbdz(ji,jj,jk) = zbgrad * EXP( -15.0_wp * ( znd - 0.9_wp )**2 ) 1808 END DO 1809 ELSE ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 1810 ztmp = 1.0_wp / MAX( zdh(ji,jj), epsln ) 1811 zbgrad = zdb_bl(ji,jj) * ztmp 1812 DO jk = 2, ibld(ji,jj) 1813 znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) * ztmp 1814 pdbdz(ji,jj,jk) = zbgrad * EXP( -1.75_wp * ( znd + 0.75_wp )**2 ) 1815 END DO 1816 ENDIF ! IF (zhol >=0.5) 1817 #ifdef key_osm_debug 1818 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1819 WRITE(narea+100,'(1(a,g11.3))')'end of zdf_osm_pycnocline_buoyancy_profiles:lconv=F zbgrad=', zbgrad 1820 ! WRITE(narea+100,'(1(a,g11.3))')'end of zdf_osm_pycnocline_scalar_profiles:lconv=F ztgrad=',& 1821 ! & ztgrad, ' zsgrad=', zsgrad, ' zbgrad=', zbgrad 1822 FLUSH(narea+100) 1823 END IF 1824 #endif 1825 ENDIF ! IF (zdb_bl> 0.) 1826 ENDIF ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero 1827 ENDIF ! IF (lconv) 1828 ENDIF ! IF ( ibld(ji,jj) < mbkt(ji,jj) ) 1829 END_2D 1830 ! 1831 IF ( ln_dia_pyc_scl ) THEN ! Output of pycnocline gradient profiles 1832 IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask(:,:,:) * pdbdz(:,:,:) ) 1833 END IF 1834 ! 1835 IF( ln_timing ) CALL timing_stop('zdf_osm_pscp') 1836 ! 1837 END SUBROUTINE zdf_osm_pycnocline_buoyancy_profiles 1838 1839 SUBROUTINE zdf_osm_calculate_dhdt( zdhdt ) 1840 !!--------------------------------------------------------------------- 1841 !! *** ROUTINE zdf_osm_calculate_dhdt *** 1842 !! 1843 !! ** Purpose : Calculates the rate at which hbl changes. 1844 !! 1845 !! ** Method : 1846 !! 1847 !!---------------------------------------------------------------------- 1848 1849 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! Rate of change of hbl 1850 1851 INTEGER :: jj, ji 1852 REAL(wp) :: zgamma_b_nd, zgamma_dh_nd, zpert, zpsi 1853 REAL(wp) :: zvel_max, zddhdt 1854 REAL(wp), PARAMETER :: zzeta_m = 0.3_wp 1855 REAL(wp), PARAMETER :: zgamma_c = 2.0_wp 1856 REAL(wp), PARAMETER :: zdhoh = 0.1_wp 1857 REAL(wp), PARAMETER :: zalpha_b = 0.3_wp 1858 REAL(wp), PARAMETER :: a_ddh = 2.5_wp, a_ddh_2 = 3.5 ! also in pycnocline_depth 1859 1860 IF( ln_timing ) CALL timing_start('zdf_osm_cd') 1861 DO_2D( 0, 0, 0, 0 ) 1862 1863 IF ( lshear(ji,jj) ) THEN 1864 IF ( lconv(ji,jj) ) THEN ! Convective 1865 1866 IF ( ln_osm_mle ) THEN 1867 1868 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 1869 ! Fox-Kemper buoyancy flux average over OSBL 1870 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 1871 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 1399 1872 ELSE 1400 ! zdtdz(ji,jj,jk) = ztgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1401 ! zdsdz(ji,jj,jk) = zsgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1402 pdbdz(ji,jj,jk) = zbgrad * EXP( -1.0_wp * ppgamma_b * ( znd - zzeta_m )**2 ) 1873 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 1403 1874 ENDIF 1875 zvel_max = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 1876 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 1877 ! OSBL is deepening, entrainment > restratification 1878 IF ( zdb_bl(ji,jj) > 1e-15 ) THEN 1879 zgamma_b_nd = MAX( zdbdz_bl_ext(ji,jj), 0.0_wp ) * zdh(ji,jj) / ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 1880 zpsi = ( 1.0_wp - 0.5_wp * zdh(ji,jj) / zhbl(ji,jj) ) * & 1881 & ( zwb0(ji,jj) - MIN( ( zwb_min(ji,jj) + 2.0_wp * zwb_fk_b(ji,jj) ), 0.0_wp ) ) * zdh(ji,jj) / zhbl(ji,jj) 1882 zpsi = zpsi + 1.75_wp * ( 1.0_wp - 0.5_wp * zdh(ji,jj) / zhbl(ji,jj) ) * & 1883 & ( zdh(ji,jj) / zhbl(ji,jj) + zgamma_b_nd ) * MIN( ( zwb_min(ji,jj) + 2.0_wp * zwb_fk_b(ji,jj) ), 0.0_wp ) 1884 zpsi = zalpha_b * MAX( zpsi, 0.0_wp ) 1885 zdhdt(ji,jj) = -1.0_wp * ( zwb_ent(ji,jj) + 2.0_wp * zwb_fk_b(ji,jj) ) / & 1886 & ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15_wp ) ) + & 1887 & zpsi / ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 1888 #ifdef key_osm_debug 1889 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1890 WRITE(narea+100,'(a,g11.3)')'Inside 1st major loop of zdf_osm_calculate_dhdt, OSBL is deepening, entrainment > restratification: zdhdt=',zdhdt(ji,jj) 1891 WRITE(narea+100,'(3(a,g11.3))') ' zpsi=',zpsi, ' zgamma_b_nd=', zgamma_b_nd, ' zdh=', zdh(ji,jj) 1892 FLUSH(narea+100) 1893 END IF 1894 #endif 1895 IF ( j_ddh(ji,jj) == 1 ) THEN 1896 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 1897 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1898 ELSE 1899 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1900 ENDIF 1901 ! Relaxation to dh_ref = zari * hbl 1902 zddhdt = -1.0_wp * a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / & 1903 & ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 1904 #ifdef key_osm_debug 1905 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1906 WRITE(narea+100,'(a,g11.3)')'Inside 1st major loop of zdf_osm_calculate_dhdt,j_ddh(ji,jj) == 1: zari=',zari 1907 FLUSH(narea+100) 1908 END IF 1909 #endif 1910 1911 ELSE IF ( j_ddh(ji,jj) == 0 ) THEN 1912 ! Growing shear layer 1913 zddhdt = -1.0_wp * a_ddh * ( 1.0 - 1.6_wp * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / & 1914 & ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 1915 zddhdt = EXP( -4.0_wp * ABS( ff_t(ji,jj) ) * zhbl(ji,jj) / MAX(zustar(ji,jj), 1e-8_wp ) ) * zddhdt 1916 ELSE 1917 zddhdt = 0.0_wp 1918 ENDIF ! j_ddh 1919 zdhdt(ji,jj) = zdhdt(ji,jj) + zalpha_b * ( 1.0_wp - 0.5_wp * zdh(ji,jj) / zhbl(ji,jj) ) * & 1920 & zdb_ml(ji,jj) * MAX( zddhdt, 0.0_wp ) / ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 1921 ELSE ! zdb_bl >0 1922 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 1923 ENDIF 1924 ELSE ! zwb_min + 2*zwb_fk_b < 0 1925 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 1926 zdhdt(ji,jj) = -1.0_wp * MIN( zvel_mle(ji,jj), hbl(ji,jj) / 10800.0_wp ) 1927 1928 1929 ENDIF 1930 1931 ELSE 1932 ! Fox-Kemper not used. 1933 1934 zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 1935 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 1936 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 1937 ! added ajgn 23 July as temporay fix 1938 1939 ENDIF ! ln_osm_mle 1940 1941 ELSE ! lconv - Stable 1942 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 1943 IF ( zdhdt(ji,jj) < 0._wp ) THEN 1944 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 1945 zpert = 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_Dt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj) 1946 ELSE 1947 zpert = MAX( zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 1948 ENDIF 1949 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 1950 zdhdt(ji,jj) = MAX( zdhdt(ji,jj), -1.0_wp * hbl(ji,jj) / 5400.0_wp ) 1951 ENDIF ! lconv 1952 ELSE ! lshear 1953 IF ( lconv(ji,jj) ) THEN ! Convective 1954 1955 IF ( ln_osm_mle ) THEN 1956 1957 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 1958 ! Fox-Kemper buoyancy flux average over OSBL 1959 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 1960 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 1961 ELSE 1962 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 1963 ENDIF 1964 zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 1965 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 1966 ! OSBL is deepening, entrainment > restratification 1967 IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN 1968 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 1969 ELSE 1970 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 1971 ENDIF 1972 ELSE 1973 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 1974 zdhdt(ji,jj) = -1.0_wp * MIN( zvel_mle(ji,jj), hbl(ji,jj) / 10800.0_wp ) 1975 1976 1977 ENDIF 1978 1979 ELSE 1980 ! Fox-Kemper not used. 1981 1982 zvel_max = -zwb_ent(ji,jj) / & 1983 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 1984 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 1985 ! added ajgn 23 July as temporay fix 1986 1987 ENDIF ! ln_osm_mle 1988 1989 ELSE ! Stable 1990 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 1991 IF ( zdhdt(ji,jj) < 0._wp ) THEN 1992 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 1993 zpert = 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj) 1994 ELSE 1995 zpert = MAX( zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 1996 ENDIF 1997 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 1998 zdhdt(ji,jj) = MAX( zdhdt(ji,jj), -1.0_wp * hbl(ji,jj) / 5400.0_wp ) 1999 ENDIF ! lconv 2000 ENDIF ! lshear 2001 #ifdef key_osm_debug 2002 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2003 WRITE(narea+100,'(4(a,g11.3))')'end of 1st major loop of zdf_osm_calculate_dhdt: zdhdt=',zdhdt(ji,jj), & 2004 & ' zpert=', zpert, ' zddhdt=', zddhdt, ' zvel_max=', zvel_max 2005 2006 IF ( ln_osm_mle ) THEN 2007 WRITE(narea+100,'(3(a,g11.3),/)') 'zvel_mle=',zvel_mle(ji,jj), ' zwb_fk_b=', zwb_fk_b(ji,jj), & 2008 & ' zwb_ent + 2*zwb_fk_b =', zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) 2009 FLUSH(narea+100) 2010 END IF 2011 END IF 2012 #endif 2013 END_2D 2014 IF( ln_timing ) CALL timing_stop('zdf_osm_cd') 2015 END SUBROUTINE zdf_osm_calculate_dhdt 2016 2017 SUBROUTINE zdf_osm_timestep_hbl( zdhdt ) 2018 !!--------------------------------------------------------------------- 2019 !! *** ROUTINE zdf_osm_timestep_hbl *** 2020 !! 2021 !! ** Purpose : Increments hbl. 2022 !! 2023 !! ** Method : If thechange in hbl exceeds one model level the change is 2024 !! is calculated by moving down the grid, changing the buoyancy 2025 !! jump. This is to ensure that the change in hbl does not 2026 !! overshoot a stable layer. 2027 !! 2028 !!---------------------------------------------------------------------- 2029 2030 2031 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! rates of change of hbl. 2032 2033 INTEGER :: jk, jj, ji, jm 2034 REAL(wp) :: zhbl_s, zvel_max, zdb 2035 REAL(wp) :: zthermal, zbeta 2036 2037 IF( ln_timing ) CALL timing_start('zdf_osm_th') 2038 DO_2D( 0, 0, 0, 0 ) 2039 #ifdef key_osm_debug 2040 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2041 WRITE(narea+100,'(2(a,i7))')'start of zdf_osm_timestep_hbl: old ibld=',imld(ji,jj),' trial ibld=', ibld(ji,jj) 2042 FLUSH(narea+100) 2043 END IF 2044 #endif 2045 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 2046 ! 2047 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 2048 ! 2049 zhbl_s = hbl(ji,jj) 2050 jm = imld(ji,jj) 2051 zthermal = rab_n(ji,jj,1,jp_tem) 2052 zbeta = rab_n(ji,jj,1,jp_sal) 2053 2054 2055 IF ( lconv(ji,jj) ) THEN 2056 !unstable 2057 2058 IF( ln_osm_mle ) THEN 2059 zvel_max = ( zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2060 ELSE 2061 2062 zvel_max = -( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 2063 & ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 2064 2065 ENDIF 2066 #ifdef key_osm_debug 2067 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2068 WRITE(narea+100,'(a,g11.3)')'In zdf_osm_timestep_hbl, ibld - imld > 1, lconv=T: zvel_max=',zvel_max 2069 FLUSH(narea+100) 2070 END IF 2071 #endif 2072 2073 DO jk = imld(ji,jj), ibld(ji,jj) 2074 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 2075 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), & 2076 & 0.0 ) + zvel_max 2077 2078 2079 IF ( ln_osm_mle ) THEN 2080 zhbl_s = zhbl_s + MIN( & 2081 & rn_Dt * ( ( -zwb_ent(ji,jj) - 2.0 * zwb_fk_b(ji,jj) )/ zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 2082 & e3w(ji,jj,jm,Kmm) ) 2083 ELSE 2084 zhbl_s = zhbl_s + MIN( & 2085 & rn_Dt * ( -zwb_ent(ji,jj) / zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 2086 & e3w(ji,jj,jm,Kmm) ) 2087 ENDIF 2088 2089 ! zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 2090 IF ( zhbl_s >= gdepw(ji,jj,mbkt(ji,jj) + 1,Kmm) ) THEN 2091 zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 2092 lpyc(ji,jj) = .FALSE. 2093 ENDIF 2094 IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 2095 #ifdef key_osm_debug 2096 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2097 WRITE(narea+100,'(2(a,i7))')' jk=',jk,' jm=', jm 2098 WRITE(narea+100,'(2(a,g11.3),a,l7)')'zdb=',zdb,' zhbl_s=', zhbl_s,' lpyc=',lpyc(ji,jj) 2099 FLUSH(narea+100) 2100 END IF 2101 #endif 1404 2102 END DO 1405 ENDIF ! If no pycnocline pycnocline gradients set to zero 1406 ELSE ! Stable conditions 1407 ! If pycnocline profile only defined when depth steady of increasing. 1408 IF ( zdhdt(ji,jj) > 0.0_wp ) THEN ! Depth increasing, or steady. 1409 IF ( zdb_bl(ji,jj) > 0.0_wp ) THEN 1410 IF ( zhol(ji,jj) >= 0.5_wp ) THEN ! Very stable - 'thick' pycnocline 1411 ztmp = 1.0_wp / MAX( zhbl(ji,jj), epsln ) 1412 zbgrad = zdb_bl(ji,jj) * ztmp 1413 DO jk = 2, ibld(ji,jj) 1414 znd = gdepw(ji,jj,jk,Kmm) * ztmp 1415 pdbdz(ji,jj,jk) = zbgrad * EXP( -15.0_wp * ( znd - 0.9_wp )**2 ) 1416 END DO 1417 ELSE ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 1418 ztmp = 1.0_wp / MAX( zdh(ji,jj), epsln ) 1419 zbgrad = zdb_bl(ji,jj) * ztmp 1420 DO jk = 2, ibld(ji,jj) 1421 znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) * ztmp 1422 pdbdz(ji,jj,jk) = zbgrad * EXP( -1.75_wp * ( znd + 0.75_wp )**2 ) 1423 END DO 1424 ENDIF ! IF (zhol >=0.5) 1425 ENDIF ! IF (zdb_bl> 0.) 1426 ENDIF ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero 1427 ENDIF ! IF (lconv) 1428 ENDIF ! IF ( ibld(ji,jj) < mbkt(ji,jj) ) 1429 END_2D 1430 ! 1431 IF ( ln_dia_pyc_scl ) THEN ! Output of pycnocline gradient profiles 1432 IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask(:,:,:) * pdbdz(:,:,:) ) 1433 END IF 1434 ! 1435 IF( ln_timing ) CALL timing_stop('zdf_osm_pscp') 1436 ! 1437 END SUBROUTINE zdf_osm_pycnocline_buoyancy_profiles 1438 1439 SUBROUTINE zdf_osm_calculate_dhdt( zdhdt ) 1440 !!--------------------------------------------------------------------- 1441 !! *** ROUTINE zdf_osm_calculate_dhdt *** 1442 !! 1443 !! ** Purpose : Calculates the rate at which hbl changes. 1444 !! 1445 !! ** Method : 1446 !! 1447 !!---------------------------------------------------------------------- 1448 1449 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! Rate of change of hbl 1450 1451 INTEGER :: jj, ji 1452 REAL(wp) :: zgamma_b_nd, zgamma_dh_nd, zpert, zpsi 1453 REAL(wp) :: zvel_max, zddhdt 1454 REAL(wp), PARAMETER :: zzeta_m = 0.3_wp 1455 REAL(wp), PARAMETER :: zgamma_c = 2.0_wp 1456 REAL(wp), PARAMETER :: zdhoh = 0.1_wp 1457 REAL(wp), PARAMETER :: zalpha_b = 0.3_wp 1458 REAL(wp), PARAMETER :: a_ddh = 2.5_wp, a_ddh_2 = 3.5 ! also in pycnocline_depth 1459 1460 IF( ln_timing ) CALL timing_start('zdf_osm_cd') 1461 DO_2D( 0, 0, 0, 0 ) 1462 1463 IF ( lshear(ji,jj) ) THEN 1464 IF ( lconv(ji,jj) ) THEN ! Convective 1465 1466 IF ( ln_osm_mle ) THEN 1467 1468 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 1469 ! Fox-Kemper buoyancy flux average over OSBL 1470 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 1471 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 1472 ELSE 1473 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 1474 ENDIF 1475 zvel_max = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 1476 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 1477 ! OSBL is deepening, entrainment > restratification 1478 IF ( zdb_bl(ji,jj) > 1e-15 ) THEN 1479 zgamma_b_nd = MAX( zdbdz_bl_ext(ji,jj), 0.0_wp ) * zdh(ji,jj) / ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 1480 zpsi = ( 1.0_wp - 0.5_wp * zdh(ji,jj) / zhbl(ji,jj) ) * & 1481 & ( zwb0(ji,jj) - MIN( ( zwb_min(ji,jj) + 2.0_wp * zwb_fk_b(ji,jj) ), 0.0_wp ) ) * zdh(ji,jj) / zhbl(ji,jj) 1482 zpsi = zpsi + 1.75_wp * ( 1.0_wp - 0.5_wp * zdh(ji,jj) / zhbl(ji,jj) ) * & 1483 & ( zdh(ji,jj) / zhbl(ji,jj) + zgamma_b_nd ) * MIN( ( zwb_min(ji,jj) + 2.0_wp * zwb_fk_b(ji,jj) ), 0.0_wp ) 1484 zpsi = zalpha_b * MAX( zpsi, 0.0_wp ) 1485 zdhdt(ji,jj) = -1.0_wp * ( zwb_ent(ji,jj) + 2.0_wp * zwb_fk_b(ji,jj) ) / & 1486 & ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15_wp ) ) + & 1487 & zpsi / ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 1488 IF ( j_ddh(ji,jj) == 1 ) THEN 1489 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 1490 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2103 hbl(ji,jj) = zhbl_s 2104 ibld(ji,jj) = jm 2105 ELSE 2106 ! stable 2107 #ifdef key_osm_debug 2108 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2109 WRITE(narea+100,'(a)')'In zdf_osm_timestep_hbl, ibld - imld > 1, lconv=F' 2110 FLUSH(narea+100) 2111 END IF 2112 #endif 2113 DO jk = imld(ji,jj), ibld(ji,jj) 2114 zdb = MAX( & 2115 & grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) )& 2116 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ),& 2117 & 0.0 ) + & 2118 & 2.0 * zvstr(ji,jj)**2 / zhbl_s 2119 2120 ! Alan is thuis right? I have simply changed hbli to hbl 2121 zhol(ji,jj) = -zhbl_s / ( ( zvstr(ji,jj)**3 + epsln )/ zwbav(ji,jj) ) 2122 zdhdt(ji,jj) = -( zwbav(ji,jj) - 0.04 / 2.0 * zwstrl(ji,jj)**3 / zhbl_s - 0.15 / 2.0 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * & 2123 & zustar(ji,jj)**3 / zhbl_s ) * ( 0.725 + 0.225 * EXP( -7.5 * zhol(ji,jj) ) ) 2124 zdhdt(ji,jj) = zdhdt(ji,jj) + zwbav(ji,jj) 2125 zhbl_s = zhbl_s + MIN( zdhdt(ji,jj) / zdb * rn_Dt / FLOAT( ibld(ji,jj) - imld(ji,jj) ), e3w(ji,jj,jm,Kmm) ) 2126 2127 ! zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 2128 IF ( zhbl_s >= mbkt(ji,jj) + 1 ) THEN 2129 zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 2130 lpyc(ji,jj) = .FALSE. 2131 ENDIF 2132 IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 2133 #ifdef key_osm_debug 2134 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2135 WRITE(narea+100,'(2(a,i7))')' jk=',jk,' jm=', jm 2136 WRITE(narea+100,'(4(a,g11.3),a,l7)')'zdb=',zdb,' zhol',zhol(ji,jj),' zdhdt',zdhdt(ji,jj),' zhbl_s=', zhbl_s,' lpyc=',lpyc(ji,jj) 2137 FLUSH(narea+100) 2138 END IF 2139 #endif 2140 END DO 2141 ENDIF ! IF ( lconv ) 2142 hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,4,Kmm) ) 2143 ibld(ji,jj) = MAX(jm, 4 ) 2144 ELSE 2145 ! change zero or one model level. 2146 hbl(ji,jj) = MAX(zhbl_t(ji,jj), gdepw(ji,jj,4,Kmm) ) 2147 ENDIF 2148 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 2149 #ifdef key_osm_debug 2150 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2151 WRITE(narea+100,'(2(a,g11.3),a,i7,/)')'end of zdf_osm_timestep_hbl: hbl=', hbl(ji,jj),' zhbl=', zhbl(ji,jj),' ibld=', ibld(ji,jj) 2152 FLUSH(narea+100) 2153 END IF 2154 #endif 2155 END_2D 2156 IF( ln_timing ) CALL timing_stop('zdf_osm_th') 2157 2158 END SUBROUTINE zdf_osm_timestep_hbl 2159 2160 SUBROUTINE zdf_osm_pycnocline_thickness( dh, zdh ) 2161 !!--------------------------------------------------------------------- 2162 !! *** ROUTINE zdf_osm_pycnocline_thickness *** 2163 !! 2164 !! ** Purpose : Calculates thickness of the pycnocline 2165 !! 2166 !! ** Method : The thickness is calculated from a prognostic equation 2167 !! that relaxes the pycnocine thickness to a diagnostic 2168 !! value. The time change is calculated assuming the 2169 !! thickness relaxes exponentially. This is done to deal 2170 !! with large timesteps. 2171 !! 2172 !!---------------------------------------------------------------------- 2173 2174 REAL(wp), DIMENSION(jpi,jpj) :: dh, zdh ! pycnocline thickness. 2175 ! 2176 INTEGER :: jj, ji 2177 INTEGER :: inhml 2178 REAL(wp) :: zari, ztau, zdh_ref, zddhdt, zvel_max 2179 REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 2180 2181 IF( ln_timing ) CALL timing_start('zdf_osm_pt') 2182 DO_2D( 0, 0, 0, 0 ) 2183 2184 IF ( lshear(ji,jj) ) THEN 2185 IF ( lconv(ji,jj) ) THEN 2186 IF ( zdb_bl(ji,jj) > 1e-15_wp ) THEN 2187 IF ( j_ddh(ji,jj) == 0 ) THEN 2188 zvel_max = ( zvstr(ji,jj)**3 + 0.5_wp * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2189 ! ddhdt for pycnocline determined in osm_calculate_dhdt 2190 zddhdt = -a_ddh * ( 1.0 - 1.6 * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 2191 zddhdt = EXP( -4.0_wp * ABS( ff_t(ji,jj) ) * zhbl(ji,jj) / MAX( zustar(ji,jj), 1e-8 ) ) * zddhdt 2192 ! maximum limit for how thick the shear layer can grow relative to the thickness of the boundary kayer 2193 dh(ji,jj) = MIN( dh(ji,jj) + zddhdt * rn_Dt, 0.625_wp * hbl(ji,jj) ) 1491 2194 ELSE 1492 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2195 ! Need to recalculate because hbl has been updated. 2196 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 2197 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2198 ELSE 2199 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2200 ENDIF 2201 ztau = MAX( zdb_bl(ji,jj) * ( zari * hbl(ji,jj) ) / ( a_ddh_2 * MAX(-zwb_ent(ji,jj), 1.e-12) ), 2.0 * rn_Dt ) 2202 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zari * zhbl(ji,jj) * ( 1.0 - EXP( -rn_Dt / ztau ) ) 2203 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * zhbl(ji,jj) 1493 2204 ENDIF 1494 ! Relaxation to dh_ref = zari * hbl1495 zddhdt = -1.0_wp * a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / &1496 & ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) )1497 1498 ELSE IF ( j_ddh(ji,jj) == 0 ) THEN1499 ! Growing shear layer1500 zddhdt = -1.0_wp * a_ddh * ( 1.0 - 1.6_wp * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / &1501 & ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) )1502 zddhdt = EXP( -4.0_wp * ABS( ff_t(ji,jj) ) * zhbl(ji,jj) / MAX(zustar(ji,jj), 1e-8_wp ) ) * zddhdt1503 2205 ELSE 1504 zddhdt = 0.0_wp 1505 ENDIF ! j_ddh 1506 zdhdt(ji,jj) = zdhdt(ji,jj) + zalpha_b * ( 1.0_wp - 0.5_wp * zdh(ji,jj) / zhbl(ji,jj) ) * & 1507 & zdb_ml(ji,jj) * MAX( zddhdt, 0.0_wp ) / ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 1508 ELSE ! zdb_bl >0 1509 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 1510 ENDIF 1511 ELSE ! zwb_min + 2*zwb_fk_b < 0 1512 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 1513 zdhdt(ji,jj) = -1.0_wp * MIN( zvel_mle(ji,jj), hbl(ji,jj) / 10800.0_wp ) 1514 1515 1516 ENDIF 1517 1518 ELSE 1519 ! Fox-Kemper not used. 1520 1521 zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 1522 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 1523 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 1524 ! added ajgn 23 July as temporay fix 1525 1526 ENDIF ! ln_osm_mle 1527 1528 ELSE ! lconv - Stable 1529 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 1530 IF ( zdhdt(ji,jj) < 0._wp ) THEN 1531 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 1532 zpert = 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_Dt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj) 1533 ELSE 1534 zpert = MAX( zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 1535 ENDIF 1536 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 1537 zdhdt(ji,jj) = MAX( zdhdt(ji,jj), -1.0_wp * hbl(ji,jj) / 5400.0_wp ) 1538 ENDIF ! lconv 1539 ELSE ! lshear 1540 IF ( lconv(ji,jj) ) THEN ! Convective 1541 1542 IF ( ln_osm_mle ) THEN 1543 1544 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 1545 ! Fox-Kemper buoyancy flux average over OSBL 1546 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 1547 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 1548 ELSE 1549 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 1550 ENDIF 1551 zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 1552 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 1553 ! OSBL is deepening, entrainment > restratification 1554 IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN 1555 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 1556 ELSE 1557 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 1558 ENDIF 1559 ELSE 1560 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 1561 zdhdt(ji,jj) = -1.0_wp * MIN( zvel_mle(ji,jj), hbl(ji,jj) / 10800.0_wp ) 1562 1563 1564 ENDIF 1565 1566 ELSE 1567 ! Fox-Kemper not used. 1568 1569 zvel_max = -zwb_ent(ji,jj) / & 1570 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 1571 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 1572 ! added ajgn 23 July as temporay fix 1573 1574 ENDIF ! ln_osm_mle 1575 1576 ELSE ! Stable 1577 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 1578 IF ( zdhdt(ji,jj) < 0._wp ) THEN 1579 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 1580 zpert = 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj) 1581 ELSE 1582 zpert = MAX( zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 1583 ENDIF 1584 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 1585 zdhdt(ji,jj) = MAX( zdhdt(ji,jj), -1.0_wp * hbl(ji,jj) / 5400.0_wp ) 1586 ENDIF ! lconv 1587 ENDIF ! lshear 1588 END_2D 1589 IF( ln_timing ) CALL timing_stop('zdf_osm_cd') 1590 END SUBROUTINE zdf_osm_calculate_dhdt 1591 1592 SUBROUTINE zdf_osm_timestep_hbl( zdhdt ) 1593 !!--------------------------------------------------------------------- 1594 !! *** ROUTINE zdf_osm_timestep_hbl *** 1595 !! 1596 !! ** Purpose : Increments hbl. 1597 !! 1598 !! ** Method : If thechange in hbl exceeds one model level the change is 1599 !! is calculated by moving down the grid, changing the buoyancy 1600 !! jump. This is to ensure that the change in hbl does not 1601 !! overshoot a stable layer. 1602 !! 1603 !!---------------------------------------------------------------------- 1604 1605 1606 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! rates of change of hbl. 1607 1608 INTEGER :: jk, jj, ji, jm 1609 REAL(wp) :: zhbl_s, zvel_max, zdb 1610 REAL(wp) :: zthermal, zbeta 1611 1612 IF( ln_timing ) CALL timing_start('zdf_osm_th') 1613 DO_2D( 0, 0, 0, 0 ) 1614 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 1615 ! 1616 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 1617 ! 1618 zhbl_s = hbl(ji,jj) 1619 jm = imld(ji,jj) 1620 zthermal = rab_n(ji,jj,1,jp_tem) 1621 zbeta = rab_n(ji,jj,1,jp_sal) 1622 1623 1624 IF ( lconv(ji,jj) ) THEN 1625 !unstable 1626 1627 IF( ln_osm_mle ) THEN 1628 zvel_max = ( zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 1629 ELSE 1630 1631 zvel_max = -( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 1632 & ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 1633 1634 ENDIF 1635 1636 DO jk = imld(ji,jj), ibld(ji,jj) 1637 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 1638 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), & 1639 & 0.0 ) + zvel_max 1640 1641 1642 IF ( ln_osm_mle ) THEN 1643 zhbl_s = zhbl_s + MIN( & 1644 & rn_Dt * ( ( -zwb_ent(ji,jj) - 2.0 * zwb_fk_b(ji,jj) )/ zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 1645 & e3w(ji,jj,jm,Kmm) ) 1646 ELSE 1647 zhbl_s = zhbl_s + MIN( & 1648 & rn_Dt * ( -zwb_ent(ji,jj) / zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 1649 & e3w(ji,jj,jm,Kmm) ) 1650 ENDIF 1651 1652 ! zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 1653 IF ( zhbl_s >= gdepw(ji,jj,mbkt(ji,jj) + 1,Kmm) ) THEN 1654 zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 1655 lpyc(ji,jj) = .FALSE. 1656 ENDIF 1657 IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 1658 END DO 1659 hbl(ji,jj) = zhbl_s 1660 ibld(ji,jj) = jm 1661 ELSE 1662 ! stable 1663 DO jk = imld(ji,jj), ibld(ji,jj) 1664 zdb = MAX( & 1665 & grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) )& 1666 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ),& 1667 & 0.0 ) + & 1668 & 2.0 * zvstr(ji,jj)**2 / zhbl_s 1669 1670 ! Alan is thuis right? I have simply changed hbli to hbl 1671 zhol(ji,jj) = -zhbl_s / ( ( zvstr(ji,jj)**3 + epsln )/ zwbav(ji,jj) ) 1672 zdhdt(ji,jj) = -( zwbav(ji,jj) - 0.04 / 2.0 * zwstrl(ji,jj)**3 / zhbl_s - 0.15 / 2.0 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * & 1673 & zustar(ji,jj)**3 / zhbl_s ) * ( 0.725 + 0.225 * EXP( -7.5 * zhol(ji,jj) ) ) 1674 zdhdt(ji,jj) = zdhdt(ji,jj) + zwbav(ji,jj) 1675 zhbl_s = zhbl_s + MIN( zdhdt(ji,jj) / zdb * rn_Dt / FLOAT( ibld(ji,jj) - imld(ji,jj) ), e3w(ji,jj,jm,Kmm) ) 1676 1677 ! zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 1678 IF ( zhbl_s >= mbkt(ji,jj) + 1 ) THEN 1679 zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 1680 lpyc(ji,jj) = .FALSE. 1681 ENDIF 1682 IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 1683 END DO 1684 ENDIF ! IF ( lconv ) 1685 hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,4,Kmm) ) 1686 ibld(ji,jj) = MAX(jm, 4 ) 1687 ELSE 1688 ! change zero or one model level. 1689 hbl(ji,jj) = MAX(zhbl_t(ji,jj), gdepw(ji,jj,4,Kmm) ) 1690 ENDIF 1691 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 1692 END_2D 1693 IF( ln_timing ) CALL timing_stop('zdf_osm_th') 1694 1695 END SUBROUTINE zdf_osm_timestep_hbl 1696 1697 SUBROUTINE zdf_osm_pycnocline_thickness( dh, zdh ) 1698 !!--------------------------------------------------------------------- 1699 !! *** ROUTINE zdf_osm_pycnocline_thickness *** 1700 !! 1701 !! ** Purpose : Calculates thickness of the pycnocline 1702 !! 1703 !! ** Method : The thickness is calculated from a prognostic equation 1704 !! that relaxes the pycnocine thickness to a diagnostic 1705 !! value. The time change is calculated assuming the 1706 !! thickness relaxes exponentially. This is done to deal 1707 !! with large timesteps. 1708 !! 1709 !!---------------------------------------------------------------------- 1710 1711 REAL(wp), DIMENSION(jpi,jpj) :: dh, zdh ! pycnocline thickness. 1712 ! 1713 INTEGER :: jj, ji 1714 INTEGER :: inhml 1715 REAL(wp) :: zari, ztau, zdh_ref, zddhdt, zvel_max 1716 REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 1717 1718 IF( ln_timing ) CALL timing_start('zdf_osm_pt') 1719 DO_2D( 0, 0, 0, 0 ) 1720 1721 IF ( lshear(ji,jj) ) THEN 1722 IF ( lconv(ji,jj) ) THEN 1723 IF ( zdb_bl(ji,jj) > 1e-15_wp ) THEN 1724 IF ( j_ddh(ji,jj) == 0 ) THEN 1725 zvel_max = ( zvstr(ji,jj)**3 + 0.5_wp * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 1726 ! ddhdt for pycnocline determined in osm_calculate_dhdt 1727 zddhdt = -a_ddh * ( 1.0 - 1.6 * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / ( zvel_max + MAX( zdb_bl(ji,jj), 1e-15 ) ) 1728 zddhdt = EXP( -4.0_wp * ABS( ff_t(ji,jj) ) * zhbl(ji,jj) / MAX( zustar(ji,jj), 1e-8 ) ) * zddhdt 1729 ! maximum limit for how thick the shear layer can grow relative to the thickness of the boundary kayer 1730 dh(ji,jj) = MIN( dh(ji,jj) + zddhdt * rn_Dt, 0.625_wp * hbl(ji,jj) ) 1731 ELSE 1732 ! Need to recalculate because hbl has been updated. 1733 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 1734 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1735 ELSE 1736 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1737 ENDIF 1738 ztau = MAX( zdb_bl(ji,jj) * ( zari * hbl(ji,jj) ) / ( a_ddh_2 * MAX(-zwb_ent(ji,jj), 1.e-12) ), 2.0 * rn_Dt ) 1739 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zari * zhbl(ji,jj) * ( 1.0 - EXP( -rn_Dt / ztau ) ) 1740 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * zhbl(ji,jj) 1741 ENDIF 1742 ELSE 1743 ztau = MAX( MAX( hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5_wp * zwstrc(ji,jj)**3 )**pthird, epsln), 2.0_wp * rn_Dt ) 1744 dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) + 0.2_wp * zhbl(ji,jj) * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) ) 1745 IF ( dh(ji,jj) > hbl(ji,jj) ) dh(ji,jj) = 0.2_wp * hbl(ji,jj) 1746 END IF 1747 ELSE ! lconv 1748 ! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL 1749 1750 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 1751 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 1752 ! boundary layer deepening 1753 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 1754 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 1755 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 1756 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 1757 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 2206 ztau = MAX( MAX( hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5_wp * zwstrc(ji,jj)**3 )**pthird, epsln), 2.0_wp * rn_Dt ) 2207 dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) + 0.2_wp * zhbl(ji,jj) * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) ) 2208 IF ( dh(ji,jj) > hbl(ji,jj) ) dh(ji,jj) = 0.2_wp * hbl(ji,jj) 2209 END IF 2210 ELSE ! lconv 2211 ! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL 2212 2213 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 2214 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 2215 ! boundary layer deepening 2216 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 2217 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 2218 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 2219 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 2220 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 2221 ELSE 2222 zdh_ref = 0.2 * hbl(ji,jj) 2223 ENDIF 2224 ELSE ! IF(dhdt < 0) 2225 zdh_ref = 0.2 * hbl(ji,jj) 2226 ENDIF ! IF (dhdt >= 0) 2227 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 2228 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 2229 ENDIF 2230 2231 ELSE ! lshear 2232 ! for lshear = .FALSE. calculate ddhdt here 2233 2234 IF ( lconv(ji,jj) ) THEN 2235 2236 IF( ln_osm_mle ) THEN 2237 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0._wp ) THEN 2238 ! OSBL is deepening. Note wb_fk_b is zero if ln_osm_mle=F 2239 IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 2240 IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN ! near neutral stability 2241 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2242 ELSE ! unstable 2243 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2244 ENDIF 2245 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2246 zdh_ref = zari * hbl(ji,jj) 2247 ELSE 2248 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2249 zdh_ref = 0.2 * hbl(ji,jj) 2250 ENDIF 2251 ELSE 2252 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2253 zdh_ref = 0.2 * hbl(ji,jj) 2254 ENDIF 2255 ELSE ! ln_osm_mle 2256 IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 2257 IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN ! near neutral stability 2258 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2259 ELSE ! unstable 2260 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2261 ENDIF 2262 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2263 zdh_ref = zari * hbl(ji,jj) 2264 ELSE 2265 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2266 zdh_ref = 0.2 * hbl(ji,jj) 2267 ENDIF 2268 2269 END IF ! ln_osm_mle 2270 2271 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 2272 ! IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 2273 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 2274 ! Alan: this hml is never defined or used 2275 ELSE ! IF (lconv) 2276 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 2277 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 2278 ! boundary layer deepening 2279 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 2280 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 2281 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 2282 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 2283 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 2284 ELSE 2285 zdh_ref = 0.2 * hbl(ji,jj) 2286 ENDIF 2287 ELSE ! IF(dhdt < 0) 2288 zdh_ref = 0.2 * hbl(ji,jj) 2289 ENDIF ! IF (dhdt >= 0) 2290 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 2291 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 2292 ENDIF ! IF (lconv) 2293 ENDIF ! lshear 2294 2295 hml(ji,jj) = hbl(ji,jj) - dh(ji,jj) 2296 inhml = MAX( INT( dh(ji,jj) / MAX(e3t(ji,jj,ibld(ji,jj) - 1,Kmm), 1.e-3) ) , 1 ) 2297 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 3) 2298 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 2299 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 2300 #ifdef key_osm_debug 2301 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2302 WRITE(narea+100,'(4(a,g11.3),2(a,i7),/,5(a,g11.3),/)') 'end of zdf_osm_pycnocline_thickness:hml=',hml(ji,jj), & 2303 & ' zhml=',zhml(ji,jj),' zdh=', zdh(ji,jj), ' dh=', dh(ji,jj), ' imld=', imld(ji,jj), ' inhml=', inhml, & 2304 & 'zvel_max=', zvel_max, ' ztau=', ztau,' zdh_ref=', zdh_ref, ' zar=', zari, ' zddhdt=', zddhdt 2305 FLUSH(narea+100) 2306 END IF 2307 #endif 2308 END_2D 2309 IF( ln_timing ) CALL timing_stop('zdf_osm_pt') 2310 2311 END SUBROUTINE zdf_osm_pycnocline_thickness 2312 2313 2314 SUBROUTINE zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 2315 !!---------------------------------------------------------------------- 2316 !! *** ROUTINE zdf_osm_horizontal_gradients *** 2317 !! 2318 !! ** Purpose : Calculates horizontal gradients of buoyancy for use with Fox-Kemper parametrization. 2319 !! 2320 !! ** Method : 2321 !! 2322 !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 2323 !! Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 2324 2325 2326 REAL(wp), DIMENSION(jpi,jpj) :: dbdx_mle, dbdy_mle ! MLE horiz gradients at u & v points 2327 REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle ! Magnitude of horizontal buoyancy gradient. 2328 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! == estimated FK BLD used for MLE horiz gradients == ! 2329 REAL(wp), DIMENSION(jpi,jpj) :: zdtdx, zdtdy, zdsdx, zdsdy 2330 2331 INTEGER :: ji, jj, jk ! dummy loop indices 2332 INTEGER :: ii, ij, ik, ikmax ! local integers 2333 REAL(wp) :: zc 2334 REAL(wp) :: zN2_c ! local buoyancy difference from 10m value 2335 REAL(wp), DIMENSION(jpi,jpj) :: ztm, zsm, zLf_NH, zLf_MH 2336 REAL(wp), DIMENSION(jpi,jpj,jpts):: ztsm_midu, ztsm_midv, zabu, zabv 2337 REAL(wp), DIMENSION(jpi,jpj) :: zmld_midu, zmld_midv 2338 !!---------------------------------------------------------------------- 2339 ! 2340 IF( ln_timing ) CALL timing_start('zdf_osm_zhg') 2341 ! !== MLD used for MLE ==! 2342 2343 mld_prof(:,:) = nlb10 ! Initialization to the number of w ocean point 2344 zmld(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 2345 zN2_c = grav * rn_osm_mle_rho_c * r1_rho0 ! convert density criteria into N^2 criteria 2346 DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 2347 ikt = mbkt(ji,jj) 2348 zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 2349 IF( zmld(ji,jj) < zN2_c ) mld_prof(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 2350 END_3D 2351 DO_2D( 1, 1, 1, 1 ) 2352 mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj)) 2353 zmld(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 2354 END_2D 2355 ! ensure mld_prof .ge. ibld 2356 ! 2357 ikmax = MIN( MAXVAL( mld_prof(:,:) ), jpkm1 ) ! max level of the computation 2358 ! 2359 ztm(:,:) = 0._wp 2360 zsm(:,:) = 0._wp 2361 DO_3D( 1, 1, 1, 1, 1, ikmax ) 2362 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 2363 ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem,Kmm) 2364 zsm(ji,jj) = zsm(ji,jj) + zc * ts(ji,jj,jk,jp_sal,Kmm) 2365 END_3D 2366 ! average temperature and salinity. 2367 ztm(:,:) = ztm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 2368 zsm(:,:) = zsm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 2369 ! calculate horizontal gradients at u & v points 2370 2371 zmld_midu(:,:) = 0.0_wp 2372 ztsm_midu(:,:,:) = 10.0_wp 2373 DO_2D( 0, 0, 1, 0 ) 2374 zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) 2375 zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) 2376 zmld_midu(ji,jj) = 0.25_wp * (zmld(ji+1,jj) + zmld( ji,jj)) 2377 ztsm_midu(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji+1,jj) + ztm( ji,jj) ) 2378 ztsm_midu(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji+1,jj) + zsm( ji,jj) ) 2379 END_2D 2380 2381 zmld_midv(:,:) = 0.0_wp 2382 ztsm_midv(:,:,:) = 10.0_wp 2383 DO_2D( 1, 0, 0, 0 ) 2384 zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 2385 zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 2386 zmld_midv(ji,jj) = 0.25_wp * (zmld(ji,jj+1) + zmld( ji,jj)) 2387 ztsm_midv(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji,jj+1) + ztm( ji,jj) ) 2388 ztsm_midv(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji,jj+1) + zsm( ji,jj) ) 2389 END_2D 2390 2391 CALL eos_rab(ztsm_midu, zmld_midu, zabu, Kmm) 2392 CALL eos_rab(ztsm_midv, zmld_midv, zabv, Kmm) 2393 2394 DO_2D( 0, 0, 1, 0 ) 2395 dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal)) 2396 END_2D 2397 DO_2D( 1, 0, 0, 0 ) 2398 dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal)) 2399 END_2D 2400 2401 DO_2D( 0, 0, 0, 0 ) 2402 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 2403 zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) & 2404 & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) ) 2405 END_2D 2406 IF( ln_timing ) CALL timing_stop('zdf_osm_zhg') 2407 2408 END SUBROUTINE zdf_osm_zmld_horizontal_gradients 2409 SUBROUTINE zdf_osm_mle_parameters( pmld, mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 2410 !!---------------------------------------------------------------------- 2411 !! *** ROUTINE zdf_osm_mle_parameters *** 2412 !! 2413 !! ** Purpose : Timesteps the mixed layer eddy depth, hmle and calculates the mixed layer eddy fluxes for buoyancy, heat and salinity. 2414 !! 2415 !! ** Method : 2416 !! 2417 !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 2418 !! Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 2419 2420 REAL(wp), DIMENSION(jpi,jpj) :: pmld ! == estimated FK BLD used for MLE horiz gradients == ! 2421 INTEGER, DIMENSION(jpi,jpj) :: mld_prof 2422 REAL(wp), DIMENSION(jpi,jpj) :: hmle, zhmle, zwb_fk, zvel_mle, zdiff_mle 2423 INTEGER :: ji, jj, jk ! dummy loop indices 2424 INTEGER :: ii, ij, ik, jkb, jkb1 ! local integers 2425 INTEGER , DIMENSION(jpi,jpj) :: inml_mle 2426 REAL(wp) :: ztmp, zdbdz, zdtdz, zdsdz, zthermal,zbeta, zbuoy, zdb_mle 2427 2428 IF( ln_timing ) CALL timing_start('zdf_osm_mp') 2429 ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE. 2430 2431 DO_2D( 0, 0, 0, 0 ) 2432 IF ( lconv(ji,jj) ) THEN 2433 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 2434 ! This velocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt. 2435 zvel_mle(ji,jj) = zdbds_mle(ji,jj) * ztmp * hmle(ji,jj) * tmask(ji,jj,1) 2436 zdiff_mle(ji,jj) = 5.e-4_wp * rn_osm_mle_ce * ztmp * zdbds_mle(ji,jj) * zhmle(ji,jj)**2 2437 ENDIF 2438 END_2D 2439 ! Timestep mixed layer eddy depth. 2440 DO_2D( 0, 0, 0, 0 ) 2441 IF ( lmle(ji,jj) ) THEN ! MLE layer growing. 2442 ! Buoyancy gradient at base of MLE layer. 2443 zthermal = rab_n(ji,jj,1,jp_tem) 2444 zbeta = rab_n(ji,jj,1,jp_sal) 2445 jkb = mld_prof(ji,jj) 2446 jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 2447 ! 2448 zbuoy = grav * ( zthermal * ts(ji,jj,mld_prof(ji,jj)+2,jp_tem,Kmm) - zbeta * ts(ji,jj,mld_prof(ji,jj)+2,jp_sal,Kmm) ) 2449 zdb_mle = zb_bl(ji,jj) - zbuoy 2450 ! Timestep hmle. 2451 hmle(ji,jj) = hmle(ji,jj) + zwb0tot(ji,jj) * rn_Dt / zdb_mle 2452 ELSE 2453 IF ( zhmle(ji,jj) > zhbl(ji,jj) ) THEN 2454 hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau 1758 2455 ELSE 1759 zdh_ref = 0.2 * hbl(ji,jj)2456 hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt /rn_osm_mle_tau 1760 2457 ENDIF 1761 ELSE ! IF(dhdt < 0) 1762 zdh_ref = 0.2 * hbl(ji,jj) 1763 ENDIF ! IF (dhdt >= 0) 1764 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 1765 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 1766 ENDIF 1767 1768 ELSE ! lshear 1769 ! for lshear = .FALSE. calculate ddhdt here 1770 1771 IF ( lconv(ji,jj) ) THEN 1772 1773 IF( ln_osm_mle ) THEN 1774 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0._wp ) THEN 1775 ! OSBL is deepening. Note wb_fk_b is zero if ln_osm_mle=F 1776 IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 1777 IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN ! near neutral stability 1778 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1779 ELSE ! unstable 1780 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1781 ENDIF 1782 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 1783 zdh_ref = zari * hbl(ji,jj) 1784 ELSE 1785 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 1786 zdh_ref = 0.2 * hbl(ji,jj) 1787 ENDIF 1788 ELSE 1789 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 1790 zdh_ref = 0.2 * hbl(ji,jj) 1791 ENDIF 1792 ELSE ! ln_osm_mle 1793 IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 1794 IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN ! near neutral stability 1795 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1796 ELSE ! unstable 1797 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1798 ENDIF 1799 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 1800 zdh_ref = zari * hbl(ji,jj) 1801 ELSE 1802 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 1803 zdh_ref = 0.2 * hbl(ji,jj) 1804 ENDIF 1805 1806 END IF ! ln_osm_mle 1807 1808 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 1809 ! IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 1810 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 1811 ! Alan: this hml is never defined or used 1812 ELSE ! IF (lconv) 1813 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 1814 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 1815 ! boundary layer deepening 1816 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 1817 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 1818 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 1819 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 1820 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 1821 ELSE 1822 zdh_ref = 0.2 * hbl(ji,jj) 1823 ENDIF 1824 ELSE ! IF(dhdt < 0) 1825 zdh_ref = 0.2 * hbl(ji,jj) 1826 ENDIF ! IF (dhdt >= 0) 1827 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 1828 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 1829 ENDIF ! IF (lconv) 1830 ENDIF ! lshear 1831 1832 hml(ji,jj) = hbl(ji,jj) - dh(ji,jj) 1833 inhml = MAX( INT( dh(ji,jj) / MAX(e3t(ji,jj,ibld(ji,jj) - 1,Kmm), 1.e-3) ) , 1 ) 1834 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 3) 1835 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 1836 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 1837 END_2D 1838 IF( ln_timing ) CALL timing_stop('zdf_osm_pt') 1839 1840 END SUBROUTINE zdf_osm_pycnocline_thickness 1841 1842 1843 SUBROUTINE zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 1844 !!---------------------------------------------------------------------- 1845 !! *** ROUTINE zdf_osm_horizontal_gradients *** 1846 !! 1847 !! ** Purpose : Calculates horizontal gradients of buoyancy for use with Fox-Kemper parametrization. 1848 !! 1849 !! ** Method : 1850 !! 1851 !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 1852 !! Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 1853 1854 1855 REAL(wp), DIMENSION(jpi,jpj) :: dbdx_mle, dbdy_mle ! MLE horiz gradients at u & v points 1856 REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle ! Magnitude of horizontal buoyancy gradient. 1857 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! == estimated FK BLD used for MLE horiz gradients == ! 1858 REAL(wp), DIMENSION(jpi,jpj) :: zdtdx, zdtdy, zdsdx, zdsdy 1859 1860 INTEGER :: ji, jj, jk ! dummy loop indices 1861 INTEGER :: ii, ij, ik, ikmax ! local integers 1862 REAL(wp) :: zc 1863 REAL(wp) :: zN2_c ! local buoyancy difference from 10m value 1864 REAL(wp), DIMENSION(jpi,jpj) :: ztm, zsm, zLf_NH, zLf_MH 1865 REAL(wp), DIMENSION(jpi,jpj,jpts):: ztsm_midu, ztsm_midv, zabu, zabv 1866 REAL(wp), DIMENSION(jpi,jpj) :: zmld_midu, zmld_midv 1867 !!---------------------------------------------------------------------- 1868 ! 1869 IF( ln_timing ) CALL timing_start('zdf_osm_zhg') 1870 ! !== MLD used for MLE ==! 1871 1872 mld_prof(:,:) = nlb10 ! Initialization to the number of w ocean point 1873 zmld(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 1874 zN2_c = grav * rn_osm_mle_rho_c * r1_rho0 ! convert density criteria into N^2 criteria 1875 DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 1876 ikt = mbkt(ji,jj) 1877 zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 1878 IF( zmld(ji,jj) < zN2_c ) mld_prof(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 1879 END_3D 1880 DO_2D( 1, 1, 1, 1 ) 1881 mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj)) 1882 zmld(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 1883 END_2D 1884 ! ensure mld_prof .ge. ibld 1885 ! 1886 ikmax = MIN( MAXVAL( mld_prof(:,:) ), jpkm1 ) ! max level of the computation 1887 ! 1888 ztm(:,:) = 0._wp 1889 zsm(:,:) = 0._wp 1890 DO_3D( 1, 1, 1, 1, 1, ikmax ) 1891 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 1892 ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem,Kmm) 1893 zsm(ji,jj) = zsm(ji,jj) + zc * ts(ji,jj,jk,jp_sal,Kmm) 1894 END_3D 1895 ! average temperature and salinity. 1896 ztm(:,:) = ztm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 1897 zsm(:,:) = zsm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 1898 ! calculate horizontal gradients at u & v points 1899 1900 zmld_midu(:,:) = 0.0_wp 1901 ztsm_midu(:,:,:) = 10.0_wp 1902 DO_2D( 0, 0, 1, 0 ) 1903 zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) 1904 zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) 1905 zmld_midu(ji,jj) = 0.25_wp * (zmld(ji+1,jj) + zmld( ji,jj)) 1906 ztsm_midu(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji+1,jj) + ztm( ji,jj) ) 1907 ztsm_midu(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji+1,jj) + zsm( ji,jj) ) 1908 END_2D 1909 1910 zmld_midv(:,:) = 0.0_wp 1911 ztsm_midv(:,:,:) = 10.0_wp 1912 DO_2D( 1, 0, 0, 0 ) 1913 zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 1914 zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 1915 zmld_midv(ji,jj) = 0.25_wp * (zmld(ji,jj+1) + zmld( ji,jj)) 1916 ztsm_midv(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji,jj+1) + ztm( ji,jj) ) 1917 ztsm_midv(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji,jj+1) + zsm( ji,jj) ) 1918 END_2D 1919 1920 CALL eos_rab(ztsm_midu, zmld_midu, zabu, Kmm) 1921 CALL eos_rab(ztsm_midv, zmld_midv, zabv, Kmm) 1922 1923 DO_2D( 0, 0, 1, 0 ) 1924 dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal)) 1925 END_2D 1926 DO_2D( 1, 0, 0, 0 ) 1927 dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal)) 1928 END_2D 1929 1930 DO_2D( 0, 0, 0, 0 ) 1931 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 1932 zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) & 1933 & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) ) 1934 END_2D 1935 IF( ln_timing ) CALL timing_stop('zdf_osm_zhg') 1936 1937 END SUBROUTINE zdf_osm_zmld_horizontal_gradients 1938 SUBROUTINE zdf_osm_mle_parameters( pmld, mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 1939 !!---------------------------------------------------------------------- 1940 !! *** ROUTINE zdf_osm_mle_parameters *** 1941 !! 1942 !! ** Purpose : Timesteps the mixed layer eddy depth, hmle and calculates the mixed layer eddy fluxes for buoyancy, heat and salinity. 1943 !! 1944 !! ** Method : 1945 !! 1946 !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 1947 !! Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 1948 1949 REAL(wp), DIMENSION(jpi,jpj) :: pmld ! == estimated FK BLD used for MLE horiz gradients == ! 1950 INTEGER, DIMENSION(jpi,jpj) :: mld_prof 1951 REAL(wp), DIMENSION(jpi,jpj) :: hmle, zhmle, zwb_fk, zvel_mle, zdiff_mle 1952 INTEGER :: ji, jj, jk ! dummy loop indices 1953 INTEGER :: ii, ij, ik, jkb, jkb1 ! local integers 1954 INTEGER , DIMENSION(jpi,jpj) :: inml_mle 1955 REAL(wp) :: ztmp, zdbdz, zdtdz, zdsdz, zthermal,zbeta, zbuoy, zdb_mle 1956 1957 IF( ln_timing ) CALL timing_start('zdf_osm_mp') 1958 ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE. 1959 1960 DO_2D( 0, 0, 0, 0 ) 1961 IF ( lconv(ji,jj) ) THEN 1962 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 1963 ! This velocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt. 1964 zvel_mle(ji,jj) = zdbds_mle(ji,jj) * ztmp * hmle(ji,jj) * tmask(ji,jj,1) 1965 zdiff_mle(ji,jj) = 5.e-4_wp * rn_osm_mle_ce * ztmp * zdbds_mle(ji,jj) * zhmle(ji,jj)**2 1966 ENDIF 1967 END_2D 1968 ! Timestep mixed layer eddy depth. 1969 DO_2D( 0, 0, 0, 0 ) 1970 IF ( lmle(ji,jj) ) THEN ! MLE layer growing. 1971 ! Buoyancy gradient at base of MLE layer. 1972 zthermal = rab_n(ji,jj,1,jp_tem) 1973 zbeta = rab_n(ji,jj,1,jp_sal) 1974 jkb = mld_prof(ji,jj) 1975 jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 1976 ! 1977 zbuoy = grav * ( zthermal * ts(ji,jj,mld_prof(ji,jj)+2,jp_tem,Kmm) - zbeta * ts(ji,jj,mld_prof(ji,jj)+2,jp_sal,Kmm) ) 1978 zdb_mle = zb_bl(ji,jj) - zbuoy 1979 ! Timestep hmle. 1980 hmle(ji,jj) = hmle(ji,jj) + zwb0tot(ji,jj) * rn_Dt / zdb_mle 1981 ELSE 1982 IF ( zhmle(ji,jj) > zhbl(ji,jj) ) THEN 1983 hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau 1984 ELSE 1985 hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt /rn_osm_mle_tau 1986 ENDIF 1987 ENDIF 1988 hmle(ji,jj) = MAX( MIN( hmle(ji,jj), ht(ji,jj) ), gdepw(ji,jj,4,Kmm) ) 1989 IF(ln_osm_hmle_limit) hmle(ji,jj) = MIN( hmle(ji,jj), rn_osm_hmle_limit*hbl(ji,jj) ) 1990 ! For now try just set hmle to zmld 1991 hmle(ji,jj) = pmld(ji,jj) 1992 END_2D 1993 1994 mld_prof = 4 1995 DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 1996 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 1997 END_3D 1998 DO_2D( 0, 0, 0, 0 ) 1999 zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj),Kmm) 2000 END_2D 2001 IF( ln_timing ) CALL timing_stop('zdf_osm_mp') 2002 END SUBROUTINE zdf_osm_mle_parameters 2003 2004 END SUBROUTINE zdf_osm 2458 ENDIF 2459 hmle(ji,jj) = MAX( MIN( hmle(ji,jj), ht(ji,jj) ), gdepw(ji,jj,4,Kmm) ) 2460 IF(ln_osm_hmle_limit) hmle(ji,jj) = MIN( hmle(ji,jj), rn_osm_hmle_limit*hbl(ji,jj) ) 2461 ! For now try just set hmle to zmld 2462 hmle(ji,jj) = pmld(ji,jj) 2463 END_2D 2464 2465 mld_prof = 4 2466 DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 2467 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 2468 END_3D 2469 DO_2D( 0, 0, 0, 0 ) 2470 zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj),Kmm) 2471 END_2D 2472 IF( ln_timing ) CALL timing_stop('zdf_osm_mp') 2473 END SUBROUTINE zdf_osm_mle_parameters 2474 2475 END SUBROUTINE zdf_osm 2005 2476 2006 2477 SUBROUTINE zdf_osm_vertical_average( Kbb, Kmm, & … … 2169 2640 ! 2170 2641 INTEGER :: ji, jj, jk, jkm_bld, jkf_mld, jkm_mld ! Loop indices 2642 #ifdef key_osm_debug 2643 INTEGER :: jl, jm 2644 #endif 2171 2645 INTEGER :: istat ! Memory allocation status 2172 2646 REAL(wp) :: zznd_d, zznd_ml, zznd_pyc, znd ! Temporary non-dimensional depths … … 2274 2748 END IF 2275 2749 END_3D 2750 #ifdef key_osm_debug 2751 IF(narea==nn_narea_db) THEN 2752 ji=iloc_db; jj=jloc_db 2753 jl = kmld(ji,jj) - 1; jm = MIN(kbld(ji,jj) + 2, mbkt(ji,jj) ) 2754 WRITE(narea+100,'(a,g11.3)')'Stokes contrib to ghamt/s: zsc_wth_1=',zsc_wth_1(ji,jj), ' zsc_ws_1=',zsc_ws_1(ji,jj) 2755 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 2756 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 2757 IF( ldconv(ji,jj) ) THEN 2758 WRITE(narea+100,'(3(a,g11.3))')'Stokes contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj), & 2759 &' zsc_uw_2=',zsc_uw_2(ji,jj) 2760 ELSE 2761 WRITE(narea+100,'(2(a,g11.3))')'Stokes contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj) 2762 END IF 2763 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 2764 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 2765 WRITE(narea+100,*) 2766 FLUSH(narea+100) 2767 END IF 2768 #endif 2276 2769 ! 2277 2770 ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio … … 2319 2812 zbuoy_pyc_sc = 2.0_wp * MAX( pdb_ml(ji,jj), 0.0_wp ) / pdh(ji,jj) 2320 2813 zdelta_pyc = ( pvstr(ji,jj)**3 + pwstrc(ji,jj)**3 )**pthird / & 2321 & SQRT( MAX( zbuoy_pyc_sc, ( pvstr(ji,jj)**3 + pwstrc(ji,jj)**3 )**p2third / pdh(ji,jj)**2 ) )2814 & SQRT( MAX( zbuoy_pyc_sc, ( pvstr(ji,jj)**3 + pwstrc(ji,jj)**3 )**p2third / pdh(ji,jj)**2 ) ) 2322 2815 zwt_pyc_sc_1(ji,jj) = 0.325_wp * ( palpha_pyc(ji,jj) * pdt_ml(ji,jj) / pdh(ji,jj) + pdtdz_bl_ext(ji,jj) ) * & 2323 & zdelta_pyc**2 / pdh(ji,jj)2816 & zdelta_pyc**2 / pdh(ji,jj) 2324 2817 zws_pyc_sc_1(ji,jj) = 0.325_wp * ( palpha_pyc(ji,jj) * pds_ml(ji,jj) / pdh(ji,jj) + pdsdz_bl_ext(ji,jj) ) * & 2325 & zdelta_pyc**2 / pdh(ji,jj)2818 & zdelta_pyc**2 / pdh(ji,jj) 2326 2819 zzeta_pyc(ji,jj) = 0.15_wp - 0.175_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * phol(ji,jj) ) ) ) 2327 2820 END IF … … 2410 2903 END_3D 2411 2904 ! 2905 #ifdef key_osm_debug 2906 IF(narea==nn_narea_db) THEN 2907 ji=iloc_db; jj=jloc_db 2908 jl = kmld(ji,jj) - 1; jm = MIN(kbld(ji,jj) + 2, mbkt(ji,jj) ) 2909 WRITE(narea+100,'(2(a,g11.3))')'Stokes + buoy + pyc contribs to ghamt/s: zsc_wth_1=',zsc_wth_1(ji,jj), ' zsc_ws_1=',zsc_ws_1(ji,jj) 2910 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 2911 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 2912 IF( ldconv(ji,jj) ) THEN 2913 WRITE(narea+100,'(3(a,g11.3))')'Stokes + buoy + pyc contribs to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj), & 2914 &' zsc_uw_2=',zsc_uw_2(ji,jj) 2915 ELSE 2916 WRITE(narea+100,'(2(a,g11.3))')'Stokes + buoy + pyc contribs to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj) 2917 END IF 2918 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 2919 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 2920 WRITE(narea+100,*) 2921 FLUSH(narea+100) 2922 END IF 2923 #endif 2924 2412 2925 IF(ln_dia_osm) THEN 2413 2926 IF ( iom_use("ghamu_0") ) CALL iom_put( "ghamu_0", wmask*ghamu ) … … 2451 2964 znd = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj) 2452 2965 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3_wp * ( -4.06_wp * EXP( -2.0_wp * zznd_d ) * ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) + & 2453 2966 7.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_wth_1(ji,jj) 2454 2967 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3_wp * ( -4.06_wp * EXP( -2.0_wp * zznd_d ) * ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) + & 2455 2968 7.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_ws_1(ji,jj) 2456 2969 END IF 2457 2970 ENDIF … … 2500 3013 END IF 2501 3014 END_3D 3015 #ifdef key_osm_debug 3016 IF(narea==nn_narea_db) THEN 3017 ji=iloc_db; jj=jloc_db 3018 jl = kmld(ji,jj) - 1; jm = MIN(kbld(ji,jj) + 2, mbkt(ji,jj) ) 3019 WRITE(narea+100,'(2(a,g11.3))')'Stokes + buoy + pyc + transport contribs to ghamt/contrib to ghamt/s: zsc_wth_1=',zsc_wth_1(ji,jj), ' zsc_ws_1=',zsc_ws_1(ji,jj) 3020 IF (ldpyc(ji,jj)) WRITE(narea+100,'(2(a,g11.3))') 'zsc_wth_pyc=', zsc_wth_pyc(ji,jj), ' zsc_wth_pyc=',zsc_wth_pyc(ji,jj) 3021 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 3022 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 3023 IF( ldconv(ji,jj) ) THEN 3024 WRITE(narea+100,'(2(a,g11.3))')'Unstable; transport contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj) 3025 ELSE 3026 WRITE(narea+100,'(3(a,g11.3))')'Stable; transport contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj), & 3027 &' zsc_uw_2=',zsc_uw_2(ji,jj) 3028 END IF 3029 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 3030 WRITE(narea+100,*) 3031 FLUSH(narea+100) 3032 END IF 3033 #endif 2502 3034 ! 2503 3035 IF(ln_dia_osm) THEN … … 2645 3177 ghamv(ji,jj,kbld(ji,jj)) = 0.0_wp 2646 3178 END_2D 3179 #ifdef key_osm_debug 3180 IF(narea==nn_narea_db) THEN 3181 ji=iloc_db; jj=jloc_db 3182 jl = kmld(ji,jj) - 1; jm = MIN(kbld(ji,jj) + 2, mbkt(ji,jj) ) 3183 WRITE(narea+100,'(a)')'Tweak gham[uv] to go to zero near surface, add pycnocline viscosity/diffusivity & set=0 at ibld' 3184 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 3185 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 3186 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 3187 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 3188 WRITE(narea+100,*) 3189 FLUSH(narea+100) 3190 END IF 3191 #endif 2647 3192 ! 2648 3193 IF(ln_dia_osm) THEN … … 2657 3202 2658 3203 SUBROUTINE zdf_osm_init( Kmm ) 2659 !!---------------------------------------------------------------------- 2660 !! *** ROUTINE zdf_osm_init *** 2661 !! 2662 !! ** Purpose : Initialization of the vertical eddy diffivity and 2663 !! viscosity when using a osm turbulent closure scheme 2664 !! 2665 !! ** Method : Read the namosm namelist and check the parameters 2666 !! called at the first timestep (nit000) 2667 !! 2668 !! ** input : Namlist namosm 2669 !!---------------------------------------------------------------------- 2670 INTEGER, INTENT(in) :: Kmm ! time level 2671 INTEGER :: ios ! local integer 2672 INTEGER :: ji, jj, jk ! dummy loop indices 2673 REAL z1_t2 2674 !! 2675 NAMELIST/namzdf_osm/ ln_use_osm_la, rn_osm_la, rn_osm_dstokes, nn_ave & 2676 & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0, rn_zdfosm_adjust_sd & 2677 & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv, nn_osm_wave & 2678 & ,nn_osm_SD_reduce, ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter 2679 ! Namelist for Fox-Kemper parametrization. 3204 !!---------------------------------------------------------------------- 3205 !! *** ROUTINE zdf_osm_init *** 3206 !! 3207 !! ** Purpose : Initialization of the vertical eddy diffivity and 3208 !! viscosity when using a osm turbulent closure scheme 3209 !! 3210 !! ** Method : Read the namosm namelist and check the parameters 3211 !! called at the first timestep (nit000) 3212 !! 3213 !! ** input : Namlist namosm 3214 !!---------------------------------------------------------------------- 3215 INTEGER, INTENT(in) :: Kmm ! time level 3216 INTEGER :: ios ! local integer 3217 INTEGER :: ji, jj, jk ! dummy loop indices 3218 REAL z1_t2 3219 !! 3220 NAMELIST/namzdf_osm/ ln_use_osm_la, rn_osm_la, rn_osm_dstokes, nn_ave & 3221 & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0, rn_zdfosm_adjust_sd & 3222 & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv, nn_osm_wave & 3223 #ifdef key_osm_debug 3224 & ,nn_osm_SD_reduce, ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter & 3225 & ,nn_idb, nn_jdb, nn_kdb, nn_narea_db 3226 #else 3227 & ,nn_osm_SD_reduce, ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter 3228 #endif 3229 ! Namelist for Fox-Kemper parametrization. 2680 3230 NAMELIST/namosm_mle/ nn_osm_mle, rn_osm_mle_ce, rn_osm_mle_lf, rn_osm_mle_time, rn_osm_mle_lat,& 2681 2682 2683 !!----------------------------------------------------------------------2684 !2685 IF( ln_timing ) CALL timing_start('zdf_osm_init')2686 READ ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901)2687 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' )2688 2689 READ ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 )2690 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' )2691 IF(lwm) WRITE ( numond, namzdf_osm )2692 2693 IF(lwp) THEN ! Control print2694 WRITE(numout,*)2695 WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation'2696 WRITE(numout,*) '~~~~~~~~~~~~'2697 WRITE(numout,*) ' Namelist namzdf_osm : set osm mixing parameters'2698 WRITE(numout,*) ' Use rn_osm_la ln_use_osm_la = ', ln_use_osm_la2699 WRITE(numout,*) ' Use MLE in OBL, i.e. Fox-Kemper param ln_osm_mle = ', ln_osm_mle2700 WRITE(numout,*) ' Turbulent Langmuir number rn_osm_la = ', rn_osm_la2701 WRITE(numout,*) ' Stokes drift reduction factor rn_zdfosm_adjust_sd = ', rn_zdfosm_adjust_sd2702 WRITE(numout,*) ' Initial hbl for 1D runs rn_osm_hbl0 = ', rn_osm_hbl02703 WRITE(numout,*) ' Depth scale of Stokes drift rn_osm_dstokes = ', rn_osm_dstokes2704 WRITE(numout,*) ' horizontal average flag nn_ave = ', nn_ave2705 WRITE(numout,*) ' Stokes drift nn_osm_wave = ', nn_osm_wave2706 SELECT CASE (nn_osm_wave)2707 CASE(0)2708 WRITE(numout,*) ' calculated assuming constant La#=0.3'2709 CASE(1)2710 WRITE(numout,*) ' calculated from Pierson Moskowitz wind-waves'2711 CASE(2)2712 WRITE(numout,*) ' calculated from ECMWF wave fields'3231 & rn_osm_mle_rho_c, rn_osm_mle_thresh, rn_osm_mle_tau, ln_osm_hmle_limit, rn_osm_hmle_limit 3232 3233 !!---------------------------------------------------------------------- 3234 ! 3235 IF( ln_timing ) CALL timing_start('zdf_osm_init') 3236 READ ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901) 3237 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' ) 3238 3239 READ ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 ) 3240 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' ) 3241 IF(lwm) WRITE ( numond, namzdf_osm ) 3242 3243 IF(lwp) THEN ! Control print 3244 WRITE(numout,*) 3245 WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation' 3246 WRITE(numout,*) '~~~~~~~~~~~~' 3247 WRITE(numout,*) ' Namelist namzdf_osm : set osm mixing parameters' 3248 WRITE(numout,*) ' Use rn_osm_la ln_use_osm_la = ', ln_use_osm_la 3249 WRITE(numout,*) ' Use MLE in OBL, i.e. Fox-Kemper param ln_osm_mle = ', ln_osm_mle 3250 WRITE(numout,*) ' Turbulent Langmuir number rn_osm_la = ', rn_osm_la 3251 WRITE(numout,*) ' Stokes drift reduction factor rn_zdfosm_adjust_sd = ', rn_zdfosm_adjust_sd 3252 WRITE(numout,*) ' Initial hbl for 1D runs rn_osm_hbl0 = ', rn_osm_hbl0 3253 WRITE(numout,*) ' Depth scale of Stokes drift rn_osm_dstokes = ', rn_osm_dstokes 3254 WRITE(numout,*) ' horizontal average flag nn_ave = ', nn_ave 3255 WRITE(numout,*) ' Stokes drift nn_osm_wave = ', nn_osm_wave 3256 SELECT CASE (nn_osm_wave) 3257 CASE(0) 3258 WRITE(numout,*) ' calculated assuming constant La#=0.3' 3259 CASE(1) 3260 WRITE(numout,*) ' calculated from Pierson Moskowitz wind-waves' 3261 CASE(2) 3262 WRITE(numout,*) ' calculated from ECMWF wave fields' 2713 3263 END SELECT 2714 WRITE(numout,*) ' Stokes drift reduction nn_osm_SD_reduce', nn_osm_SD_reduce 2715 WRITE(numout,*) ' fraction of hbl to average SD over/fit' 2716 WRITE(numout,*) ' exponential with nn_osm_SD_reduce = 1 or 2 rn_osm_hblfrac = ', rn_osm_hblfrac 2717 SELECT CASE (nn_osm_SD_reduce) 2718 CASE(0) 2719 WRITE(numout,*) ' No reduction' 2720 CASE(1) 2721 WRITE(numout,*) ' Average SD over upper rn_osm_hblfrac of BL' 2722 CASE(2) 2723 WRITE(numout,*) ' Fit exponential to slope rn_osm_hblfrac of BL' 2724 END SELECT 2725 WRITE(numout,*) ' reduce surface SD and depth scale under ice ln_zdfosm_ice_shelter=', ln_zdfosm_ice_shelter 2726 WRITE(numout,*) ' Output osm diagnostics ln_dia_osm = ', ln_dia_osm 2727 WRITE(numout,*) ' Threshold used to define BL rn_osm_bl_thresh = ', rn_osm_bl_thresh, 'm^2/s' 2728 WRITE(numout,*) ' Use KPP-style shear instability mixing ln_kpprimix = ', ln_kpprimix 2729 WRITE(numout,*) ' local Richardson Number limit for shear instability rn_riinfty = ', rn_riinfty 2730 WRITE(numout,*) ' maximum shear diffusivity at Rig = 0 (m2/s) rn_difri = ', rn_difri 2731 WRITE(numout,*) ' Use large mixing below BL when unstable ln_convmix = ', ln_convmix 2732 WRITE(numout,*) ' diffusivity when unstable below BL (m2/s) rn_difconv = ', rn_difconv 2733 ENDIF 2734 2735 2736 ! ! Check wave coupling settings ! 2737 ! ! Further work needed - see ticket #2447 ! 2738 IF( nn_osm_wave == 2 ) THEN 2739 IF (.NOT. ( ln_wave .AND. ln_sdw )) & 2740 & CALL ctl_stop( 'zdf_osm_init : ln_zdfosm and nn_osm_wave=2, ln_wave and ln_sdw must be true' ) 2741 END IF 2742 2743 ! Flags associated with diagnostic output 2744 IF ( ln_dia_osm .AND. ( iom_use("zdudz_pyc") .OR. iom_use("zdvdz_pyc") ) ) ln_dia_pyc_shr = .TRUE. 2745 IF ( ln_dia_osm .AND. ( iom_use("zdtdz_pyc") .OR. iom_use("zdsdz_pyc") .OR. iom_use("zdbdz_pyc" ) ) ) ln_dia_pyc_scl = .TRUE. 2746 2747 ! ! allocate zdfosm arrays 2748 IF( zdf_osm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 2749 2750 2751 IF( ln_osm_mle ) THEN 2752 ! Initialise Fox-Kemper parametrization 3264 WRITE(numout,*) ' Stokes drift reduction nn_osm_SD_reduce', nn_osm_SD_reduce 3265 WRITE(numout,*) ' fraction of hbl to average SD over/fit' 3266 WRITE(numout,*) ' exponential with nn_osm_SD_reduce = 1 or 2 rn_osm_hblfrac = ', rn_osm_hblfrac 3267 SELECT CASE (nn_osm_SD_reduce) 3268 CASE(0) 3269 WRITE(numout,*) ' No reduction' 3270 CASE(1) 3271 WRITE(numout,*) ' Average SD over upper rn_osm_hblfrac of BL' 3272 CASE(2) 3273 WRITE(numout,*) ' Fit exponential to slope rn_osm_hblfrac of BL' 3274 END SELECT 3275 WRITE(numout,*) ' reduce surface SD and depth scale under ice ln_zdfosm_ice_shelter=', ln_zdfosm_ice_shelter 3276 WRITE(numout,*) ' Output osm diagnostics ln_dia_osm = ', ln_dia_osm 3277 WRITE(numout,*) ' Threshold used to define BL rn_osm_bl_thresh = ', rn_osm_bl_thresh, 'm^2/s' 3278 WRITE(numout,*) ' Use KPP-style shear instability mixing ln_kpprimix = ', ln_kpprimix 3279 WRITE(numout,*) ' local Richardson Number limit for shear instability rn_riinfty = ', rn_riinfty 3280 WRITE(numout,*) ' maximum shear diffusivity at Rig = 0 (m2/s) rn_difri = ', rn_difri 3281 WRITE(numout,*) ' Use large mixing below BL when unstable ln_convmix = ', ln_convmix 3282 WRITE(numout,*) ' diffusivity when unstable below BL (m2/s) rn_difconv = ', rn_difconv 3283 #ifdef key_osm_debug 3284 WRITE(numout,*) 'nn_idb', nn_idb, 'nn_jdb', nn_jdb, 'nn_kdb', nn_kdb, 'nn_narea_db', nn_narea_db 3285 3286 iloc_db = mi0(nn_idb) 3287 jloc_db = mj0(nn_jdb) 3288 WRITE(numout,*) 'iloc_db ', iloc_db , 'jloc_db', jloc_db 3289 #endif 3290 ENDIF 3291 3292 3293 ! ! Check wave coupling settings ! 3294 ! ! Further work needed - see ticket #2447 ! 3295 IF( nn_osm_wave == 2 ) THEN 3296 IF (.NOT. ( ln_wave .AND. ln_sdw )) & 3297 & CALL ctl_stop( 'zdf_osm_init : ln_zdfosm and nn_osm_wave=2, ln_wave and ln_sdw must be true' ) 3298 END IF 3299 3300 ! Flags associated with diagnostic output 3301 IF ( ln_dia_osm .AND. ( iom_use("zdudz_pyc") .OR. iom_use("zdvdz_pyc") ) ) ln_dia_pyc_shr = .TRUE. 3302 IF ( ln_dia_osm .AND. ( iom_use("zdtdz_pyc") .OR. iom_use("zdsdz_pyc") .OR. iom_use("zdbdz_pyc" ) ) ) ln_dia_pyc_scl = .TRUE. 3303 3304 ! ! allocate zdfosm arrays 3305 IF( zdf_osm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 3306 3307 3308 IF( ln_osm_mle ) THEN 3309 ! Initialise Fox-Kemper parametrization 2753 3310 READ ( numnam_ref, namosm_mle, IOSTAT = ios, ERR = 903) 2754 3311 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namosm_mle in reference namelist') … … 2774 3331 WRITE(numout,*) ' fraction of zmld to limit hmle to if ln_osm_hmle_limit =.T. rn_osm_hmle_limit = ', rn_osm_hmle_limit 2775 3332 ENDIF ! 2776 ENDIF3333 ENDIF 2777 3334 ! 2778 3335 IF(lwp) THEN … … 2795 3352 ! 2796 3353 IF( nn_osm_mle == 0 ) THEN ! MLE array allocation & initialisation ! 2797 !3354 ! 2798 3355 ELSEIF( nn_osm_mle == 1 ) THEN ! MLE array allocation & initialisation 2799 3356 rc_f = rn_osm_mle_ce/ ( 5.e3_wp * 2._wp * omega * SIN( rad * rn_osm_mle_lat ) ) … … 2810 3367 ENDIF 2811 3368 2812 call osm_rst( nit000, Kmm, 'READ' ) !* read or initialize hbl, dh, hmle2813 2814 2815 IF( ln_zdfddm) THEN2816 IF(lwp) THEN2817 WRITE(numout,*)2818 WRITE(numout,*) ' Double diffusion mixing on temperature and salinity '2819 WRITE(numout,*) ' CAUTION : done in routine zdfosm, not in routine zdfddm '2820 ENDIF2821 ENDIF2822 2823 2824 !set constants not in namelist2825 !-----------------------------2826 2827 IF(lwp) THEN2828 WRITE(numout,*)2829 ENDIF2830 2831 IF (nn_osm_wave == 0) THEN2832 dstokes(:,:) = rn_osm_dstokes2833 END IF2834 2835 ! Horizontal average : initialization of weighting arrays2836 ! -------------------2837 2838 SELECT CASE ( nn_ave )2839 2840 CASE ( 0 ) ! no horizontal average2841 IF(lwp) WRITE(numout,*) ' no horizontal average on avt'2842 IF(lwp) WRITE(numout,*) ' only in very high horizontal resolution !'2843 ! weighting mean arrays etmean2844 ! ( 1 1 )2845 ! avt = 1/4 ( 1 1 )2846 !2847 etmean(:,:,:) = 0.e02848 2849 DO_3D( 0, 0, 0, 0, 1, jpkm1 )2850 etmean(ji,jj,jk) = tmask(ji,jj,jk) &2851 2852 2853 END_3D2854 2855 CASE ( 1 ) ! horizontal average2856 IF(lwp) WRITE(numout,*) ' horizontal average on avt'2857 ! weighting mean arrays etmean2858 ! ( 1/2 1 1/2 )2859 ! avt = 1/8 ( 1 2 1 )2860 ! ( 1/2 1 1/2 )2861 etmean(:,:,:) = 0.e02862 2863 DO_3D( 0, 0, 0, 0, 1, jpkm1 )2864 etmean(ji,jj,jk) = tmask(ji, jj,jk) &2865 2866 2867 2868 2869 2870 END_3D2871 2872 CASE DEFAULT2873 WRITE(ctmp1,*) ' bad flag value for nn_ave = ', nn_ave2874 CALL ctl_stop( ctmp1 )2875 2876 END SELECT2877 2878 ! Initialization of vertical eddy coef. to the background value2879 ! -------------------------------------------------------------2880 DO jk = 1, jpk2881 avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)2882 END DO2883 2884 ! zero the surface flux for non local term and osm mixed layer depth2885 ! ------------------------------------------------------------------2886 ghamt(:,:,:) = 0.2887 ghams(:,:,:) = 0.2888 ghamu(:,:,:) = 0.2889 ghamv(:,:,:) = 0.2890 !2891 IF( ln_timing ) CALL timing_stop('zdf_osm_init')3369 call osm_rst( nit000, Kmm, 'READ' ) !* read or initialize hbl, dh, hmle 3370 3371 3372 IF( ln_zdfddm) THEN 3373 IF(lwp) THEN 3374 WRITE(numout,*) 3375 WRITE(numout,*) ' Double diffusion mixing on temperature and salinity ' 3376 WRITE(numout,*) ' CAUTION : done in routine zdfosm, not in routine zdfddm ' 3377 ENDIF 3378 ENDIF 3379 3380 3381 !set constants not in namelist 3382 !----------------------------- 3383 3384 IF(lwp) THEN 3385 WRITE(numout,*) 3386 ENDIF 3387 3388 IF (nn_osm_wave == 0) THEN 3389 dstokes(:,:) = rn_osm_dstokes 3390 END IF 3391 3392 ! Horizontal average : initialization of weighting arrays 3393 ! ------------------- 3394 3395 SELECT CASE ( nn_ave ) 3396 3397 CASE ( 0 ) ! no horizontal average 3398 IF(lwp) WRITE(numout,*) ' no horizontal average on avt' 3399 IF(lwp) WRITE(numout,*) ' only in very high horizontal resolution !' 3400 ! weighting mean arrays etmean 3401 ! ( 1 1 ) 3402 ! avt = 1/4 ( 1 1 ) 3403 ! 3404 etmean(:,:,:) = 0.e0 3405 3406 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 3407 etmean(ji,jj,jk) = tmask(ji,jj,jk) & 3408 & / MAX( 1., umask(ji-1,jj ,jk) + umask(ji,jj,jk) & 3409 & + vmask(ji ,jj-1,jk) + vmask(ji,jj,jk) ) 3410 END_3D 3411 3412 CASE ( 1 ) ! horizontal average 3413 IF(lwp) WRITE(numout,*) ' horizontal average on avt' 3414 ! weighting mean arrays etmean 3415 ! ( 1/2 1 1/2 ) 3416 ! avt = 1/8 ( 1 2 1 ) 3417 ! ( 1/2 1 1/2 ) 3418 etmean(:,:,:) = 0.e0 3419 3420 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 3421 etmean(ji,jj,jk) = tmask(ji, jj,jk) & 3422 & / MAX( 1., 2.* tmask(ji,jj,jk) & 3423 & +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk) & 3424 & +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) & 3425 & +1. * ( tmask(ji-1,jj ,jk) + tmask(ji ,jj+1,jk) & 3426 & +tmask(ji ,jj-1,jk) + tmask(ji+1,jj ,jk) ) ) 3427 END_3D 3428 3429 CASE DEFAULT 3430 WRITE(ctmp1,*) ' bad flag value for nn_ave = ', nn_ave 3431 CALL ctl_stop( ctmp1 ) 3432 3433 END SELECT 3434 3435 ! Initialization of vertical eddy coef. to the background value 3436 ! ------------------------------------------------------------- 3437 DO jk = 1, jpk 3438 avt (:,:,jk) = avtb(jk) * tmask(:,:,jk) 3439 END DO 3440 3441 ! zero the surface flux for non local term and osm mixed layer depth 3442 ! ------------------------------------------------------------------ 3443 ghamt(:,:,:) = 0. 3444 ghams(:,:,:) = 0. 3445 ghamu(:,:,:) = 0. 3446 ghamv(:,:,:) = 0. 3447 ! 3448 IF( ln_timing ) CALL timing_stop('zdf_osm_init') 2892 3449 END SUBROUTINE zdf_osm_init 2893 3450 2894 3451 2895 3452 SUBROUTINE osm_rst( kt, Kmm, cdrw ) 2896 !!---------------------------------------------------------------------2897 !! *** ROUTINE osm_rst ***2898 !!2899 !! ** Purpose : Read or write BL fields in restart file2900 !!2901 !! ** Method : use of IOM library. If the restart does not contain2902 !! required fields, they are recomputed from stratification2903 !!----------------------------------------------------------------------2904 2905 INTEGER , INTENT(in) :: kt ! ocean time step index2906 INTEGER , INTENT(in) :: Kmm ! ocean time level index (middle)2907 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag2908 2909 INTEGER :: id1, id2, id3 ! iom enquiry index2910 INTEGER :: ji, jj, jk ! dummy loop indices2911 INTEGER :: iiki, ikt ! local integer2912 REAL(wp) :: zhbf ! tempory scalars2913 REAL(wp) :: zN2_c ! local scalar2914 REAL(wp) :: rho_c = 0.01_wp !: density criterion for mixed layer depth2915 INTEGER, DIMENSION(jpi,jpj) :: imld_rst ! level of mixed-layer depth (pycnocline top)2916 !!----------------------------------------------------------------------2917 !2918 IF( ln_timing ) CALL timing_start('osm_rst')2919 !!-----------------------------------------------------------------------------2920 ! If READ/WRITE Flag is 'READ', try to get hbl from restart file. If successful then return2921 !!-----------------------------------------------------------------------------2922 IF( TRIM(cdrw) == 'READ'.AND. ln_rstart) THEN2923 id1 = iom_varid( numror, 'wn' , ldstop = .FALSE. )2924 IF( id1 > 0 ) THEN ! 'wn' exists; read2925 CALL iom_get( numror, jpdom_auto, 'wn', ww )2926 WRITE(numout,*) ' ===>>>> : wn read from restart file'2927 ELSE2928 ww(:,:,:) = 0._wp2929 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially'2930 END IF2931 2932 id1 = iom_varid( numror, 'hbl' , ldstop = .FALSE. )2933 id2 = iom_varid( numror, 'dh' , ldstop = .FALSE. )2934 IF( id1 > 0 .AND. id2 > 0) THEN ! 'hbl' exists; read and return2935 CALL iom_get( numror, jpdom_auto, 'hbl' , hbl )2936 CALL iom_get( numror, jpdom_auto, 'dh', dh )2937 WRITE(numout,*) ' ===>>>> : hbl & dh read from restart file'2938 IF( ln_osm_mle ) THEN2939 id3 = iom_varid( numror, 'hmle' , ldstop = .FALSE. )2940 IF( id3 > 0) THEN2941 CALL iom_get( numror, jpdom_auto, 'hmle' , hmle )2942 WRITE(numout,*) ' ===>>>> : hmle read from restart file'2943 ELSE2944 WRITE(numout,*) ' ===>>>> : hmle not found, set to hbl'2945 hmle(:,:) = hbl(:,:) ! Initialise MLE depth.2946 END IF2947 END IF2948 RETURN2949 ELSE ! 'hbl' & 'dh' not in restart file, recalculate2950 WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification'2951 END IF2952 END IF2953 2954 !!-----------------------------------------------------------------------------2955 ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return2956 !!-----------------------------------------------------------------------------2957 IF( TRIM(cdrw) == 'WRITE') THEN !* Write hbl into the restart file, then return2958 IF(lwp) WRITE(numout,*) '---- osm-rst ----'3453 !!--------------------------------------------------------------------- 3454 !! *** ROUTINE osm_rst *** 3455 !! 3456 !! ** Purpose : Read or write BL fields in restart file 3457 !! 3458 !! ** Method : use of IOM library. If the restart does not contain 3459 !! required fields, they are recomputed from stratification 3460 !!---------------------------------------------------------------------- 3461 3462 INTEGER , INTENT(in) :: kt ! ocean time step index 3463 INTEGER , INTENT(in) :: Kmm ! ocean time level index (middle) 3464 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 3465 3466 INTEGER :: id1, id2, id3 ! iom enquiry index 3467 INTEGER :: ji, jj, jk ! dummy loop indices 3468 INTEGER :: iiki, ikt ! local integer 3469 REAL(wp) :: zhbf ! tempory scalars 3470 REAL(wp) :: zN2_c ! local scalar 3471 REAL(wp) :: rho_c = 0.01_wp !: density criterion for mixed layer depth 3472 INTEGER, DIMENSION(jpi,jpj) :: imld_rst ! level of mixed-layer depth (pycnocline top) 3473 !!---------------------------------------------------------------------- 3474 ! 3475 IF( ln_timing ) CALL timing_start('osm_rst') 3476 !!----------------------------------------------------------------------------- 3477 ! If READ/WRITE Flag is 'READ', try to get hbl from restart file. If successful then return 3478 !!----------------------------------------------------------------------------- 3479 IF( TRIM(cdrw) == 'READ'.AND. ln_rstart) THEN 3480 id1 = iom_varid( numror, 'wn' , ldstop = .FALSE. ) 3481 IF( id1 > 0 ) THEN ! 'wn' exists; read 3482 CALL iom_get( numror, jpdom_auto, 'wn', ww ) 3483 WRITE(numout,*) ' ===>>>> : wn read from restart file' 3484 ELSE 3485 ww(:,:,:) = 0._wp 3486 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially' 3487 END IF 3488 3489 id1 = iom_varid( numror, 'hbl' , ldstop = .FALSE. ) 3490 id2 = iom_varid( numror, 'dh' , ldstop = .FALSE. ) 3491 IF( id1 > 0 .AND. id2 > 0) THEN ! 'hbl' exists; read and return 3492 CALL iom_get( numror, jpdom_auto, 'hbl' , hbl ) 3493 CALL iom_get( numror, jpdom_auto, 'dh', dh ) 3494 WRITE(numout,*) ' ===>>>> : hbl & dh read from restart file' 3495 IF( ln_osm_mle ) THEN 3496 id3 = iom_varid( numror, 'hmle' , ldstop = .FALSE. ) 3497 IF( id3 > 0) THEN 3498 CALL iom_get( numror, jpdom_auto, 'hmle' , hmle ) 3499 WRITE(numout,*) ' ===>>>> : hmle read from restart file' 3500 ELSE 3501 WRITE(numout,*) ' ===>>>> : hmle not found, set to hbl' 3502 hmle(:,:) = hbl(:,:) ! Initialise MLE depth. 3503 END IF 3504 END IF 3505 RETURN 3506 ELSE ! 'hbl' & 'dh' not in restart file, recalculate 3507 WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification' 3508 END IF 3509 END IF 3510 3511 !!----------------------------------------------------------------------------- 3512 ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return 3513 !!----------------------------------------------------------------------------- 3514 IF( TRIM(cdrw) == 'WRITE') THEN !* Write hbl into the restart file, then return 3515 IF(lwp) WRITE(numout,*) '---- osm-rst ----' 2959 3516 CALL iom_rstput( kt, nitrst, numrow, 'wn' , ww ) 2960 3517 CALL iom_rstput( kt, nitrst, numrow, 'hbl' , hbl ) … … 2963 3520 CALL iom_rstput( kt, nitrst, numrow, 'hmle', hmle ) 2964 3521 END IF 2965 RETURN2966 END IF2967 2968 !!-----------------------------------------------------------------------------2969 ! Getting hbl, no restart file with hbl, so calculate from surface stratification2970 !!-----------------------------------------------------------------------------2971 IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification'2972 ! w-level of the mixing and mixed layers2973 CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm )2974 CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2, Kmm)2975 imld_rst(:,:) = nlb10 ! Initialization to the number of w ocean point2976 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^22977 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria2978 !2979 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^22980 DO_3D( 1, 1, 1, 1, 1, jpkm1 )2981 ikt = mbkt(ji,jj)2982 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm)2983 IF( hbl(ji,jj) < zN2_c ) imld_rst(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level2984 END_3D2985 !2986 DO_2D( 1, 1, 1, 1 )2987 iiki = MAX(4,imld_rst(ji,jj))2988 hbl (ji,jj) = gdepw(ji,jj,iiki,Kmm ) ! Turbocline depth2989 dh (ji,jj) = e3t(ji,jj,iiki-1,Kmm ) ! Turbocline depth2990 END_2D2991 2992 WRITE(numout,*) ' ===>>>> : hbl computed from stratification'2993 2994 IF( ln_osm_mle ) THEN2995 hmle(:,:) = hbl(:,:) ! Initialise MLE depth.2996 WRITE(numout,*) ' ===>>>> : hmle set = to hbl'2997 END IF2998 2999 ww(:,:,:) = 0._wp3000 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially'3001 IF( ln_timing ) CALL timing_stop('osm_rst')3522 RETURN 3523 END IF 3524 3525 !!----------------------------------------------------------------------------- 3526 ! Getting hbl, no restart file with hbl, so calculate from surface stratification 3527 !!----------------------------------------------------------------------------- 3528 IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification' 3529 ! w-level of the mixing and mixed layers 3530 CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) 3531 CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2, Kmm) 3532 imld_rst(:,:) = nlb10 ! Initialization to the number of w ocean point 3533 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 3534 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 3535 ! 3536 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 3537 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 3538 ikt = mbkt(ji,jj) 3539 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 3540 IF( hbl(ji,jj) < zN2_c ) imld_rst(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 3541 END_3D 3542 ! 3543 DO_2D( 1, 1, 1, 1 ) 3544 iiki = MAX(4,imld_rst(ji,jj)) 3545 hbl (ji,jj) = gdepw(ji,jj,iiki,Kmm ) ! Turbocline depth 3546 dh (ji,jj) = e3t(ji,jj,iiki-1,Kmm ) ! Turbocline depth 3547 END_2D 3548 3549 WRITE(numout,*) ' ===>>>> : hbl computed from stratification' 3550 3551 IF( ln_osm_mle ) THEN 3552 hmle(:,:) = hbl(:,:) ! Initialise MLE depth. 3553 WRITE(numout,*) ' ===>>>> : hmle set = to hbl' 3554 END IF 3555 3556 ww(:,:,:) = 0._wp 3557 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially' 3558 IF( ln_timing ) CALL timing_stop('osm_rst') 3002 3559 END SUBROUTINE osm_rst 3003 3560 … … 3054 3611 IF(sn_cfctl%l_prtctl) THEN 3055 3612 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' osm - Ta: ', mask1=tmask, & 3056 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )3613 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 3057 3614 ENDIF 3058 3615 !
Note: See TracChangeset
for help on using the changeset viewer.