New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14571 for NEMO/branches/2021 – NEMO

Changeset 14571 for NEMO/branches/2021


Ignore:
Timestamp:
2021-03-02T21:18:11+01:00 (3 years ago)
Author:
smueller
Message:

Synchronisation of the OSMOSIS boundary layer scheme with the version developed in branch /NEMO/branches/NERC/dev_r11078_OSMOSIS_IMMERSE_Nurser_4.0: transfer of changesets [14406,14518,14521,14534,14539,14540] (ticket #2353)

Location:
NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining/cfgs/SHARED/field_def_nemo-oce.xml

    r14072 r14571  
    275275    <field id="dh"                  long_name="Pycnocline thickness"                     unit=" m"      /> 
    276276    <field id="ibld"                long_name="index of boundary layer depth"            unit="#"       /> 
    277     <field id="imld"                long_name="index of mixed layer depth"            unit="#"       /> 
    278     <field id="zhbl"                long_name="boundary layer depth -grid"                     unit="m"       /> 
    279     <field id="zhml"                long_name="mixed layer depth - grid"                        unit="m"       /> 
     277    <field id="imld"                long_name="index of mixed layer depth"               unit="#"       /> 
     278    <field id="jp_ext"              long_name="flag =1 if pycnocline well resolved"      unit="#"       /> 
     279    <field id="j_ddh"               long_name="index of mixed layer depth"               unit="#"       /> 
     280    <field id="zshear"              long_name="shear production of TKE "                 unit="m^3/s^3" /> 
     281    <field id="zhbl"                long_name="boundary layer depth -grid"               unit="m"       /> 
     282    <field id="zhml"                long_name="mixed layer depth - grid"                 unit="m"       /> 
    280283    <field id="zdh"                 long_name="Pycnocline  depth - grid"                 unit=" m"      /> 
    281284    <field id="zustke"              long_name="magnitude of stokes drift  at T-points"   unit="m/s"     /> 
    282     <field id="us_x"        long_name="i component of active Stokes drift"                      unit="m/s"     /> 
    283     <field id="us_y"        long_name="j component of active Stokes drift"                      unit="m/s"     /> 
     285    <field id="us_x"                long_name="i component of active Stokes drift"       unit="m/s"     /> 
     286    <field id="us_y"                long_name="j component of active Stokes drift"       unit="m/s"     /> 
    284287    <field id="dstokes"             long_name="stokes drift  depth scale"                unit="m"       /> 
    285288    <field id="zwth0"               long_name="surface non-local temperature flux"       unit="deg m/s" /> 
    286289    <field id="zws0"                long_name="surface non-local salinity flux"          unit="psu m/s" /> 
     290    <field id="zwb0"                long_name="surface non-local buoyancy flux"          unit="m^2/s^3" /> 
    287291    <field id="zwstrc"              long_name="convective velocity scale"                unit="m/s"     /> 
    288292    <field id="zustar"              long_name="friction velocity"                        unit="m/s"     /> 
    … …  
    295299 
    296300    <!-- interior BL OSMOSIS diagnostics --> 
    297     <field id="zwthav"              long_name="av turb flux of T in ml"                  unit="deg m/s" /> 
     301    <field id="zwbav"               long_name="av turb flux of buoyancy in ml"           unit="m^2/s^3" /> 
    298302    <field id="zt_ml"               long_name="av T in ml"                               unit="deg"     /> 
    299303    <field id="zhol"                long_name="Hoenekker number"                         unit="#"       /> 
    … …  
    302306    <field id="zwb_ent"            long_name="entrainment turb flux of buoyancy"         unit="m^2/s^-3" /> 
    303307 
    304     <field id="zdt_bl"             long_name="temperature jump at base of BL"                 unit="deg"      /> 
    305     <field id="zds_bl"             long_name="salinity jump at base of BL"                 unit="10^-3"      /> 
    306     <field id="zdb_bl"             long_name="buoyancy jump at base of BL"                 unit="m/s^2"      /> 
    307     <field id="zdu_bl"             long_name="u jump at base of BL"                       unit="m/s"      /> 
    308     <field id="zdv_bl"             long_name="v jump at base of BL"                       unit="m/s"      /> 
    309  
     308    <field id="zdt_bl"             long_name="temperature jump at base of BL"            unit="deg"      /> 
     309    <field id="zds_bl"             long_name="salinity jump at base of BL"               unit="10^-3"    /> 
     310    <field id="zdb_bl"             long_name="buoyancy jump at base of BL"               unit="m/s^2"    /> 
     311    <field id="zdu_bl"             long_name="u jump at base of BL"                      unit="m/s"      /> 
     312    <field id="zdv_bl"             long_name="v jump at base of BL"                      unit="m/s"      /> 
     313    <field id="zdt_ml"             long_name="temperature jump at base of ML"            unit="deg"      /> 
     314    <field id="zds_ml"             long_name="salinity jump at base of ML"               unit="10^-3"    /> 
     315    <field id="zdb_ml"             long_name="buoyancy jump at base of ML"               unit="m/s^2"    /> 
    310316    <!-- extra OSMOSIS diagnostics for debugging --> 
    311317    <field id="zsc_uw_1_0"       long_name="zsc u-momentum flux on T after Stokes"                       unit="m^2/s^2" /> 
    … …  
    314320    <field id="zsc_uw_2_f"       long_name="2nd zsc u-momentum flux on T after Coriolis"                       unit="m^2/s^2" /> 
    315321    <field id="zsc_vw_2_f"       long_name="2nd zsc v-momentum flux on T after Coriolis"                       unit="m^2/s^2" /> 
    316     <field id="zuw_bse"       long_name="base u-flux T-points"                          unit="m^2/s^2" /> 
    317     <field id="zvw_bse"       long_name="base v-flux T-points"                          unit="m^2/s^2" /> 
    318322 
    319323    <!-- FK_OSM OSMOSIS diagnostics (require also ln_osm_mle=.true.--> 

  • NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining/src/OCE/ZDF/zdfosm.F90

    r14567 r14571  
    123123   REAL(wp) ::   rn_difconv = 1._wp     ! diffusivity when unstable below BL  (m2/s) 
    124124 
    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 
    126131   INTEGER  ::   nn_osm_mle             ! = 0/1 flag for horizontal average on avt 
    127132   REAL(wp) ::   rn_osm_mle_ce           ! MLE coefficient 
    … …  
    165170      !!                 ***  FUNCTION zdf_osm_alloc  *** 
    166171      !!---------------------------------------------------------------------- 
    167      ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), & 
    168           &       hbl(jpi,jpj), dh(jpi,jpj), hml(jpi,jpj), dstokes(jpi, jpj), & 
    169           &       etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 
    170  
    171      ALLOCATE(  hmle(jpi,jpj), r1_ft(jpi,jpj), dbdx_mle(jpi,jpj), dbdy_mle(jpi,jpj), & 
    172           &       mld_prof(jpi,jpj), STAT= zdf_osm_alloc ) 
    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') 
    176181 
    177182   END FUNCTION zdf_osm_alloc 
    … …  
    234239      REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 
    235240      REAL(wp) :: zt,zs,zu,zv,zrh               ! variables used in constructing averages 
    236 ! Scales 
     241      ! Scales 
    237242      REAL(wp), DIMENSION(jpi,jpj) :: zrad0     ! Surface solar temperature flux (deg m/s) 
    238243      REAL(wp), DIMENSION(jpi,jpj) :: zradh     ! Radiative flux at bl base (Buoyancy units) 
    … …  
    295300      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 
    296301      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 pycnocline 
     302      !      REAL(wp), DIMENSION(jpi,jpj) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 
    298303      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdbdz_pyc    ! parametrised gradient of buoyancy in the pycnocline 
    299304      REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle    ! Magnitude of horizontal buoyancy gradient. 
    … …  
    370375      ghams(:,:,:)   = 0._wp ; ghamu(:,:,:)   = 0._wp ; ghamv(:,:,:) = 0._wp 
    371376 
     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       
    372398      ! hbl = MAX(hbl,epsln) 
    373399      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    388414         zwthav(ji,jj) = 0.5_wp * zwth0(ji,jj) -                       &   ! Turbulent heat flux averaged over depth of OSBL 
    389415            &            ( 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 ) 
    526574         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      ! ########################################################################## 
    541598      hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,4,Kmm) ) 
    542599      ibld(:,:) = 4 
    … …  
    546603         ENDIF 
    547604      END_3D 
    548      ! ########################################################################## 
     605      ! ########################################################################## 
    549606 
    550607      DO_2D( 0, 0, 0, 0 ) 
    … …  
    554611         zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    555612      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 
    557636      jp_ext(:,:) = 2 
    558637      CALL zdf_osm_vertical_average( Kbb, Kmm,                                          & 
    559638         &                           ibld, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl,           & 
    560639         &                           jp_ext, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 
    561 !      jp_ext(:,:) = ibld(:,:) - imld(:,:) + 1 
     640      !      jp_ext(:,:) = ibld(:,:) - imld(:,:) + 1 
    562641      CALL zdf_osm_vertical_average( Kbb, Kmm,                                               & 
    563642         &                           imld-1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, ibld-imld+1,   & 
    564643         &                           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. 
    566659      CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 
    567660      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 
    569673      CALL zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear ) 
    570674 
     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 
    571684      IF ( ln_osm_mle ) THEN 
    572 ! Fox-Kemper Scheme 
     685         ! Fox-Kemper Scheme 
    573686         mld_prof = 4 
    574687         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) 
    576689         END_3D 
    577690         CALL zdf_osm_vertical_average( Kbb, Kmm,                                            & 
    … …  
    579692 
    580693         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) 
    582695         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 
    585708         CALL zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 
    586 !! Calculate vertical gradients immediately below zmld 
     709         !! Calculate vertical gradients immediately below zmld 
    587710         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 descriptors 
     711         !! Calculate max vertical FK flux zwb_fk & set logical descriptors 
    589712         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 hmle 
     713         !! recalculate hmle, zmle, zvel_mle, zdiff_mle & redefine mld_proc to be index for new hmle 
    591714         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 
    592731      ELSE    ! ln_osm_mle 
    593 ! FK not selected, Boundary Layer only. 
     732         ! FK not selected, Boundary Layer only. 
    594733         lpyc(:,:) = .TRUE. 
    595734         lflux(:,:) = .FALSE. 
    596735         lmle(:,:) = .FALSE. 
    597736         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. 
    599738         END_2D 
    600739      ENDIF   ! ln_osm_mle 
    601740 
    602 !! External gradient below BL needed both with and w/o FK 
     741      !! External gradient below BL needed both with and w/o FK 
    603742      CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 
    604743 
    605 ! Test if pycnocline well resolved 
     744      ! Test if pycnocline well resolved 
    606745      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 
    614757            jp_ext(ji,jj) = 0 
    615           ENDIF 
    616        ELSE 
    617    ! Stable conditions 
    618          jp_ext(ji,jj) = 0 
    619        ENDIF 
     758         ENDIF 
    620759      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 
    621770 
    622771      ! Recalculate bl averages using jp_ext & ml averages .... note no rotation of u & v here.. 
    … …  
    624773         &                           ibld, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl,           & 
    625774         &                           jp_ext, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 
    626 !      jp_ext = ibld-imld+1 
     775      !      jp_ext = ibld-imld+1 
    627776      CALL zdf_osm_vertical_average( Kbb, Kmm,                                               & 
    628777         &                           imld-1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml,              & 
    629778         &                           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 
    630795! Rate of change of hbl 
    631796      CALL zdf_osm_calculate_dhdt( zdhdt ) 
    632797      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 
    639811      END_2D 
    640812 
    … …  
    648820      END_3D 
    649821 
    650 ! 
    651 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 
    652 ! 
     822      ! 
     823      ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 
     824      ! 
    653825      CALL zdf_osm_timestep_hbl( zdhdt ) 
    654 ! is external level in bounds? 
    655  
    656 !   Recalculate BL averages and differences using new BL depth 
     826      ! is external level in bounds? 
     827 
     828      !   Recalculate BL averages and differences using new BL depth 
    657829      CALL zdf_osm_vertical_average( Kbb, Kmm,                                          & 
    658830         &                           ibld, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl,           & 
    659831         &                           jp_ext, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 
    660 ! 
    661 ! 
    662 ! Check to see if lpyc needs to be changed 
     832      ! 
     833      ! 
     834      ! Check to see if lpyc needs to be changed 
    663835 
    664836      CALL zdf_osm_pycnocline_thickness( dh, zdh ) 
    665837 
    666838      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. 
    668840      END_2D 
    669841 
    670842      dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. )  !  Limit delta for shallow boundary layers for calculating flux-gradient terms. 
    671 ! 
     843      ! 
    672844      ! Average over the depth of the mixed layer in the convective boundary layer 
    673 !      jp_ext = ibld - imld +1 
    674 !     Recalculate ML averages and differences using new ML depth 
     845      !      jp_ext = ibld - imld +1 
     846      !     Recalculate ML averages and differences using new ML depth 
    675847      CALL zdf_osm_vertical_average( Kbb, Kmm,                                               & 
    676848         &                           imld-1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml,              & 
    … …  
    678850      ! rotate mean currents and changes onto wind align co-ordinates 
    679851      ! 
     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 
    680866      CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 
    681867      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 
    682878      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    683879      !  Pycnocline gradients for scalars and velocity 
    … …  
    686882      CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 
    687883      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 
    692915 
    693916      ! 
    … …  
    699922         &                    zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext, zdbdz_pyc, zalpha_pyc, zdiffut, zviscos ) 
    700923 
    701        !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    702        ! Need to put in code for contributions that are applied explicitly to 
    703        ! the prognostic variables 
    704        !  1. Entrainment flux 
    705        ! 
    706        !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    707  
    708  
    709  
    710        ! rotate non-gradient velocity terms back to model reference frame 
    711  
    712        DO_2D( 0, 0, 0, 0 ) 
    713           DO jk = 2, ibld(ji,jj) 
    714              ztemp = ghamu(ji,jj,jk) 
    715              ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj) 
    716              ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj) 
    717           END DO 
    718        END_2D 
     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 
    719942 
    720943      ! KPP-style Ri# mixing 
    721944      IF ( ln_kpprimix ) THEN 
    722           jkflt = jpk 
    723           DO_2D( 0, 0, 0, 0 ) 
    724              IF ( ibld(ji,jj) < jkflt ) jkflt = ibld(ji,jj) 
    725           END_2D 
    726           DO jk = jkflt+1, jpkm1 
    727              ! Shear production at uw- and vw-points (energy conserving form) 
    728              DO_2D( 1, 0, 1, 0 ) 
    729                 IF ( jk > MIN( ibld(ji,jj), ibld(ji+1,jj) ) ) THEN 
    730                    z2du(ji,jj) = 0.5_wp * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) *                      & 
    731                       &                   ( uu(ji,jj,jk-1,Kbb) - uu(ji,jj,jk,Kbb) ) * wumask(ji,jj,jk) /   & 
    732                       &                   ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) 
    733                 END IF 
    734                 IF ( jk > MIN( ibld(ji,jj), ibld(ji,jj+1) ) ) THEN 
    735                    z2dv(ji,jj) = 0.5_wp * ( vv(ji,jj,jk-1,Kmm) - vv(ji,jj,jk,Kmm) ) *                      & 
    736                       &                   ( vv(ji,jj,jk-1,Kbb) - vv(ji,jj,jk,Kbb) ) * wvmask(ji,jj,jk) /   & 
    737                       &                   ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) 
    738                 END IF 
    739              END_2D 
    740              DO_2D( 0, 0, 0, 0 ) 
    741                 IF ( jk > ibld(ji,jj) ) THEN 
    742                    ! Shear prod. at w-point weightened by mask 
    743                    zesh2  =  ( z2du(ji-1,jj) + z2du(ji,jj) ) / MAX( 1.0_wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
    744                       &    + ( z2dv(ji,jj-1) + z2dv(ji,jj) ) / MAX( 1.0_wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 
    745                    ! Local Richardson number 
    746                    zri   = MAX( rn2b(ji,jj,jk), 0.0_wp ) / MAX(zesh2, epsln) 
    747                    zfri =  MIN( zri / rn_riinfty , 1.0_wp ) 
    748                    zfri  = ( 1.0_wp - zfri * zfri ) 
    749                    zrimix  =  zfri * zfri  * zfri * wmask(ji, jj, jk) 
    750                    zdiffut(ji,jj,jk) = zrimix*rn_difri 
    751                    zviscos(ji,jj,jk) = zrimix*rn_difri 
    752                 END IF 
    753              END_2D 
    754           END DO 
    755        END IF ! ln_kpprimix = .true. 
    756  
    757 ! KPP-style set diffusivity large if unstable below BL 
    758        IF( ln_convmix) THEN 
    759           DO_2D( 0, 0, 0, 0 ) 
    760              DO jk = ibld(ji,jj) + 1, jpkm1 
     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 
    761984               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) 
    7731007                  znd = gdepw(ji,jj,jk,Kmm) / MAX(zhbl(ji,jj),epsln) 
    7741008                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - ( zwth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0 - znd ) 
    7751009                  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 
    8071053      ! 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        DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    811             ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 
    812                &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) 
    813  
    814             ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) & 
    815                 &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 
    816  
    817             ghamt(ji,jj,jk) =  ghamt(ji,jj,jk) * tmask(ji,jj,jk) 
    818             ghams(ji,jj,jk) =  ghams(ji,jj,jk) * tmask(ji,jj,jk) 
    819        END_3D 
    820         ! Lateral boundary conditions on final outputs for hbl,  on T-grid (sign unchanged) 
    821         CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 
    822         ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged) 
    823         ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign changed) 
    824         CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W',  1.0_wp , ghams, 'W',  1.0_wp,   & 
     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,   & 
    8251071         &                            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 
    8261087 
    8271088      IF(ln_dia_osm) THEN 
    8281089         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). 
    8301091         CASE(0:1) 
    8311092            IF ( iom_use("us_x") ) CALL iom_put( "us_x", tmask(:,:,1)*zustke*zcos_wind )   ! x surface Stokes drift 
    8321093            IF ( iom_use("us_y") ) CALL iom_put( "us_y", tmask(:,:,1)*zustke*zsin_wind )  ! y surface Stokes drift 
    8331094            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). 
    8351096         CASE(2:3) 
    8361097            IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd*umask(:,:,1) )               ! x surface Stokes drift 
    … …  
    8421103            IF ( iom_use("wndm") ) CALL iom_put( "wndm", wndm*tmask(:,:,1) )                   ! U_10 
    8431104            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2* & 
    844                  & SQRT(ut0sd**2 + vt0sd**2 ) ) 
     1105               & SQRT(ut0sd**2 + vt0sd**2 ) ) 
    8451106         END SELECT 
    8461107         IF ( iom_use("ghamt") ) CALL iom_put( "ghamt", tmask*ghamt )            ! <Tw_NL> 
    … …  
    8501111         IF ( iom_use("zwth0") ) CALL iom_put( "zwth0", tmask(:,:,1)*zwth0 )            ! <Tw_0> 
    8511112         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 
    8521115         IF ( iom_use("hbl") ) CALL iom_put( "hbl", tmask(:,:,1)*hbl )                  ! boundary-layer depth 
    8531116         IF ( iom_use("ibld") ) CALL iom_put( "ibld", tmask(:,:,1)*ibld )               ! boundary-layer max k 
    … …  
    8591122         IF ( iom_use("dh") ) CALL iom_put( "dh", tmask(:,:,1)*dh )               ! Initial boundary-layer depth 
    8601123         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 
    8611127         IF ( iom_use("dstokes") ) CALL iom_put( "dstokes", tmask(:,:,1)*dstokes )      ! Stokes drift penetration depth 
    8621128         IF ( iom_use("zustke") ) CALL iom_put( "zustke", tmask(:,:,1)*zustke )            ! Stokes drift magnitude at T-points 
    … …  
    8711137         IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml )               ! ML depth internal to zdf_osm routine 
    8721138         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 
    8731142         IF ( iom_use("zdh") ) CALL iom_put( "zdh", tmask(:,:,1)*zdh )                  ! pyc thicknessh internal to zdf_osm routine 
    8741143         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 flux 
    8761144         IF ( iom_use("zwb_ent") ) CALL iom_put( "zwb_ent", tmask(:,:,1)*zwb_ent )      ! upward turb buoyancy entrainment flux 
    8771145         IF ( iom_use("zt_ml") ) CALL iom_put( "zt_ml", tmask(:,:,1)*zt_ml )            ! average T in ML 
    … …  
    8941162      IF( ln_timing ) CALL timing_stop('zdf_osm') 
    8951163 
    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 
    9591271            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. 
    9621389            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) 
    10951551            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 
    11081683               ELSE 
    1109                   j_ddh(ji,jj) = 1 
    1110 !                 IF ( zri_b <= 1.5 .and. zshear(ji,jj) > 0._wp ) THEN 
    1111 ! shear production large enough to determine layer charcteristics, but can't maintain a shear layer. 
    1112                   lshear(ji,jj) = .TRUE. 
    1113 !             ELSE 
    1114                END IF 
    1115             ELSE 
    1116                j_ddh(ji,jj) = 2 
    1117                lshear(ji,jj) = .FALSE. 
    1118             END IF 
    1119 ! 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 !             ENDIF 
    1123          ELSE                ! zdb_bl test, note zshear set to zero 
    1124            j_ddh(ji,jj) = 2 
    1125            lshear(ji,jj) = .FALSE. 
    1126          ENDIF 
    1127        ENDIF 
    1128      END_2D 
    1129  
    1130 ! Calculate entrainment buoyancy flux due to surface fluxes. 
    1131  
    1132      DO_2D( 0, 0, 0, 0 ) 
    1133       IF ( lconv(ji,jj) ) THEN 
    1134         zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln 
    1135         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 ) THEN 
    1139         ! Effective Stokes drift already reduced from surface value 
    1140            zr_stokes = 1.0_wp 
    1141         ELSE 
    1142          ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd, 
    1143           ! requires further reduction where BL is deep 
    1144            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 IF 
    1147         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       ENDIF 
    1153      END_2D 
    1154  
    1155      zwb_min(:,:) = 0._wp 
    1156  
    1157      DO_2D( 0, 0, 0, 0 ) 
    1158       IF ( lshear(ji,jj) ) THEN 
    1159         IF ( lconv(ji,jj) ) THEN 
    1160 ! Unstable OSBL 
    1161            zwb_shr = -1.0_wp * za_wb_s * zri_b(ji,jj) * zshear(ji,jj) 
    1162            IF ( j_ddh(ji,jj) == 0 ) THEN 
    1163  
    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            ENDIF 
    1174            zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr 
    1175 !           zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj) 
    1176         ELSE    ! IF ( lconv ) THEN - ENDIF 
    1177 ! Stable OSBL  - shear production not coded for first attempt. 
    1178         ENDIF  ! lconv 
    1179       END IF  ! lshear 
    1180       IF ( lconv(ji,jj) ) THEN 
    1181 ! Unstable OSBL 
    1182          zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * 2.0_wp * zwbav(ji,jj) 
    1183       END IF  ! lconv 
    1184      END_2D 
    1185      IF( ln_timing ) CALL timing_stop('zdf_osm_os') 
    1186    END SUBROUTINE zdf_osm_osbl_state 
    1187  
    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_w 
    1196      !! 
    1197      !!---------------------------------------------------------------------- 
    1198  
    1199         REAL(wp), DIMENSION(jpi,jpj) :: zcos_w, zsin_w       ! Cos and Sin of rotation angle 
    1200         REAL(wp), DIMENSION(jpi,jpj) :: zu, zv               ! Components of current 
    1201         REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv             ! Change in velocity components across pycnocline 
    1202  
    1203         INTEGER :: ji, jj 
    1204         REAL(wp) :: ztemp 
    1205  
    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_2D 
    1215         IF( ln_timing ) CALL timing_stop('zdf_osm_vr') 
    1216     END SUBROUTINE zdf_osm_velocity_rotation 
    1217  
    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 determined 
    1224      !!  lflux :: determines whether effects of surface flux extend below the base of the OSBL 
    1225      !!  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 ! Outputs 
    1233       LOGICAL,  DIMENSION(jpi,jpj)  :: lpyc, lflux, lmle 
    1234       REAL(wp), DIMENSION(jpi,jpj)  :: zwb_fk 
    1235 ! 
    1236       REAL(wp), DIMENSION(jpi,jpj)  :: znd_param 
    1237       REAL(wp)                      :: zbuoy, ztmp, zpe_mle_layer 
    1238       REAL(wp)                      :: zpe_mle_ref, zdbdz_mle_int 
    1239  
    1240       IF( ln_timing ) CALL timing_start('zdf_osm_osf') 
    1241       znd_param(:,:) = 0._wp 
    1242  
    1243         DO_2D( 0, 0, 0, 0 ) 
    1244           ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 
    1245           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_2D 
    1247         DO_2D( 0, 0, 0, 0 ) 
    1248                  ! 
    1249          IF ( lconv(ji,jj) ) THEN 
    1250            IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 
    1251              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._wp 
    1257              zpe_mle_ref = 0._wp 
    1258              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 DO 
    1265 ! Non-dimensional parameter to diagnose the presence of thermocline 
    1266  
    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            ENDIF 
    1269          ENDIF 
    1270         END_2D 
    1271  
    1272 ! Diagnosis 
    1273         DO_2D( 0, 0, 0, 0 ) 
    1274           IF ( lconv(ji,jj) ) THEN 
    1275             IF ( -2.0 * zwb_fk(ji,jj) / zwb_ent(ji,jj) > 0.5 ) THEN 
    1276               IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 
    1277 ! MLE layer growing 
    1278                 IF ( znd_param (ji,jj) > 100. ) THEN 
    1279 ! Thermocline present 
    1280                   lflux(ji,jj) = .FALSE. 
    1281                   lmle(ji,jj) =.FALSE. 
    1282                 ELSE 
    1283 ! Thermocline not present 
    1284                   lflux(ji,jj) = .TRUE. 
    1285                   lmle(ji,jj) = .TRUE. 
    1286                 ENDIF  ! znd_param > 100 
    1287 ! 
    1288                 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 
    1289                   lpyc(ji,jj) = .FALSE. 
    1290                 ELSE 
    1291                    lpyc(ji,jj) = .TRUE. 
    1292                 ENDIF 
    1293               ELSE 
    1294 ! MLE layer restricted to OSBL or just below. 
    1295                 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 
    1296 ! Weak stratification MLE layer can grow. 
    1297                   lpyc(ji,jj) = .FALSE. 
    1298                   lflux(ji,jj) = .TRUE. 
    1299                   lmle(ji,jj) = .TRUE. 
    1300                 ELSE 
    1301 ! Strong stratification 
    13021684                  lpyc(ji,jj) = .TRUE. 
    13031685                  lflux(ji,jj) = .FALSE. 
    13041686                  lmle(ji,jj) = .FALSE. 
    1305                 ENDIF ! zdb_bl < rn_mle_thresh_bl and 
    1306               ENDIF  ! zhmle > 1.2 zhbl 
     1687                  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 
    13071689            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) ) 
    13991872                     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) 
    14031874                     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 
    14042102                  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) ) 
    14912194                     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) 
    14932204                     ENDIF 
    1494                      ! Relaxation to dh_ref = zari * hbl 
    1495                      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 ) THEN 
    1499                      ! Growing shear layer 
    1500                      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 ) ) * zddhdt 
    15032205                  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 
    17582455               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 
    17602457               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 
    20052476 
    20062477   SUBROUTINE zdf_osm_vertical_average( Kbb, Kmm,                           & 
    … …  
    21692640      ! 
    21702641      INTEGER                     ::   ji, jj, jk, jkm_bld, jkf_mld, jkm_mld   ! Loop indices 
     2642#ifdef key_osm_debug 
     2643      INTEGER                     ::   jl, jm 
     2644#endif 
    21712645      INTEGER                     ::   istat                                   ! Memory allocation status 
    21722646      REAL(wp)                    ::   zznd_d, zznd_ml, zznd_pyc, znd          ! Temporary non-dimensional depths 
    … …  
    22742748         END IF 
    22752749      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 
    22762769      ! 
    22772770      ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio 
    … …  
    23192812               zbuoy_pyc_sc        = 2.0_wp * MAX( pdb_ml(ji,jj), 0.0_wp ) / pdh(ji,jj) 
    23202813               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 ) ) 
    23222815               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) 
    23242817               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) 
    23262819               zzeta_pyc(ji,jj)    = 0.15_wp - 0.175_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * phol(ji,jj) ) ) ) 
    23272820            END IF 
    … …  
    24102903      END_3D 
    24112904      ! 
     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 
    24122925      IF(ln_dia_osm) THEN 
    24132926         IF ( iom_use("ghamu_0") )    CALL iom_put( "ghamu_0",    wmask*ghamu           ) 
    … …  
    24512964                  znd    = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj) 
    24522965                  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                                       7.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_wth_1(ji,jj) 
     2966                     7.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_wth_1(ji,jj) 
    24542967                  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                                       7.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_ws_1(ji,jj) 
     2968                     7.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_ws_1(ji,jj) 
    24562969               END IF 
    24572970            ENDIF 
    … …  
    25003013         END IF 
    25013014      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 
    25023034      ! 
    25033035      IF(ln_dia_osm) THEN 
    … …  
    26453177         ghamv(ji,jj,kbld(ji,jj)) = 0.0_wp 
    26463178      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 
    26473192      ! 
    26483193      IF(ln_dia_osm) THEN 
    … …  
    26573202 
    26583203   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. 
    26803230      NAMELIST/namosm_mle/ nn_osm_mle, rn_osm_mle_ce, rn_osm_mle_lf, rn_osm_mle_time, rn_osm_mle_lat,& 
    2681            & rn_osm_mle_rho_c, rn_osm_mle_thresh, rn_osm_mle_tau, ln_osm_hmle_limit, rn_osm_hmle_limit 
    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 print 
    2694         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_la 
    2699         WRITE(numout,*) '     Use  MLE in OBL, i.e. Fox-Kemper param        ln_osm_mle = ', ln_osm_mle 
    2700         WRITE(numout,*) '     Turbulent Langmuir number                     rn_osm_la   = ', rn_osm_la 
    2701         WRITE(numout,*) '     Stokes drift reduction factor                 rn_zdfosm_adjust_sd   = ', rn_zdfosm_adjust_sd 
    2702         WRITE(numout,*) '     Initial hbl for 1D runs                       rn_osm_hbl0   = ', rn_osm_hbl0 
    2703         WRITE(numout,*) '     Depth scale of Stokes drift                   rn_osm_dstokes = ', rn_osm_dstokes 
    2704         WRITE(numout,*) '     horizontal average flag                       nn_ave      = ', nn_ave 
    2705         WRITE(numout,*) '     Stokes drift                                  nn_osm_wave = ', nn_osm_wave 
    2706         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) 
     3237901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' ) 
     3238 
     3239      READ  ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 ) 
     3240902   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' 
    27133263         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 
    27533310         READ  ( numnam_ref, namosm_mle, IOSTAT = ios, ERR = 903) 
    27543311903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namosm_mle in reference namelist') 
    … …  
    27743331            WRITE(numout,*) '         fraction of zmld to limit hmle to if ln_osm_hmle_limit =.T.  rn_osm_hmle_limit = ', rn_osm_hmle_limit 
    27753332         ENDIF         ! 
    2776      ENDIF 
     3333      ENDIF 
    27773334      ! 
    27783335      IF(lwp) THEN 
    … …  
    27953352         ! 
    27963353         IF( nn_osm_mle == 0 ) THEN           ! MLE array allocation & initialisation            ! 
    2797 ! 
     3354            ! 
    27983355         ELSEIF( nn_osm_mle == 1 ) THEN           ! MLE array allocation & initialisation 
    27993356            rc_f = rn_osm_mle_ce/ (  5.e3_wp * 2._wp * omega * SIN( rad * rn_osm_mle_lat )  ) 
    … …  
    28103367      ENDIF 
    28113368 
    2812      call osm_rst( nit000, Kmm,  'READ' ) !* read or initialize hbl, dh, hmle 
    2813  
    2814  
    2815      IF( ln_zdfddm) THEN 
    2816         IF(lwp) THEN 
    2817            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         ENDIF 
    2821      ENDIF 
    2822  
    2823  
    2824      !set constants not in namelist 
    2825      !----------------------------- 
    2826  
    2827      IF(lwp) THEN 
    2828         WRITE(numout,*) 
    2829      ENDIF 
    2830  
    2831      IF (nn_osm_wave == 0) THEN 
    2832         dstokes(:,:) = rn_osm_dstokes 
    2833      END IF 
    2834  
    2835      ! Horizontal average : initialization of weighting arrays 
    2836      ! ------------------- 
    2837  
    2838      SELECT CASE ( nn_ave ) 
    2839  
    2840      CASE ( 0 )                ! no horizontal average 
    2841         IF(lwp) WRITE(numout,*) '          no horizontal average on avt' 
    2842         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !' 
    2843         ! weighting mean arrays etmean 
    2844         !           ( 1  1 ) 
    2845         ! avt = 1/4 ( 1  1 ) 
    2846         ! 
    2847         etmean(:,:,:) = 0.e0 
    2848  
    2849         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    2850            etmean(ji,jj,jk) = tmask(ji,jj,jk)                     & 
    2851                 &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   & 
    2852                 &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  ) 
    2853         END_3D 
    2854  
    2855      CASE ( 1 )                ! horizontal average 
    2856         IF(lwp) WRITE(numout,*) '          horizontal average on avt' 
    2857         ! weighting mean arrays etmean 
    2858         !           ( 1/2  1  1/2 ) 
    2859         ! avt = 1/8 ( 1    2  1   ) 
    2860         !           ( 1/2  1  1/2 ) 
    2861         etmean(:,:,:) = 0.e0 
    2862  
    2863         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    2864            etmean(ji,jj,jk) = tmask(ji, jj,jk)                           & 
    2865                 & / MAX( 1., 2.* tmask(ji,jj,jk)                           & 
    2866                 &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   & 
    2867                 &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) & 
    2868                 &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   & 
    2869                 &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) ) 
    2870         END_3D 
    2871  
    2872      CASE DEFAULT 
    2873         WRITE(ctmp1,*) '          bad flag value for nn_ave = ', nn_ave 
    2874         CALL ctl_stop( ctmp1 ) 
    2875  
    2876      END SELECT 
    2877  
    2878      ! Initialization of vertical eddy coef. to the background value 
    2879      ! ------------------------------------------------------------- 
    2880      DO jk = 1, jpk 
    2881         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk) 
    2882      END DO 
    2883  
    2884      ! zero the surface flux for non local term and osm mixed layer depth 
    2885      ! ------------------------------------------------------------------ 
    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') 
    28923449   END SUBROUTINE zdf_osm_init 
    28933450 
    28943451 
    28953452   SUBROUTINE osm_rst( kt, Kmm, cdrw ) 
    2896      !!--------------------------------------------------------------------- 
    2897      !!                   ***  ROUTINE osm_rst  *** 
    2898      !! 
    2899      !! ** Purpose :   Read or write BL fields in restart file 
    2900      !! 
    2901      !! ** Method  :   use of IOM library. If the restart does not contain 
    2902      !!                required fields, they are recomputed from stratification 
    2903      !!---------------------------------------------------------------------- 
    2904  
    2905      INTEGER         , INTENT(in) ::   kt     ! ocean time step index 
    2906      INTEGER         , INTENT(in) ::   Kmm    ! ocean time level index (middle) 
    2907      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    2908  
    2909      INTEGER ::   id1, id2, id3   ! iom enquiry index 
    2910      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    2911      INTEGER  ::   iiki, ikt ! local integer 
    2912      REAL(wp) ::   zhbf           ! tempory scalars 
    2913      REAL(wp) ::   zN2_c           ! local scalar 
    2914      REAL(wp) ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth 
    2915      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 return 
    2921      !!----------------------------------------------------------------------------- 
    2922      IF( TRIM(cdrw) == 'READ'.AND. ln_rstart) THEN 
    2923         id1 = iom_varid( numror, 'wn'   , ldstop = .FALSE. ) 
    2924         IF( id1 > 0 ) THEN                       ! 'wn' exists; read 
    2925            CALL iom_get( numror, jpdom_auto, 'wn', ww ) 
    2926            WRITE(numout,*) ' ===>>>> :  wn read from restart file' 
    2927         ELSE 
    2928            ww(:,:,:) = 0._wp 
    2929            WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially' 
    2930         END IF 
    2931  
    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 return 
    2935            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 ) THEN 
    2939               id3 = iom_varid( numror, 'hmle'   , ldstop = .FALSE. ) 
    2940               IF( id3 > 0) THEN 
    2941                  CALL iom_get( numror, jpdom_auto, 'hmle' , hmle ) 
    2942                  WRITE(numout,*) ' ===>>>> :  hmle read from restart file' 
    2943               ELSE 
    2944                  WRITE(numout,*) ' ===>>>> :  hmle not found, set to hbl' 
    2945                  hmle(:,:) = hbl(:,:)            ! Initialise MLE depth. 
    2946               END IF 
    2947            END IF 
    2948            RETURN 
    2949         ELSE                      ! 'hbl' & 'dh' not in restart file, recalculate 
    2950            WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification' 
    2951         END IF 
    2952      END IF 
    2953  
    2954      !!----------------------------------------------------------------------------- 
    2955      ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return 
    2956      !!----------------------------------------------------------------------------- 
    2957      IF( TRIM(cdrw) == 'WRITE') THEN     !* Write hbl into the restart file, then return 
    2958         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 ----' 
    29593516         CALL iom_rstput( kt, nitrst, numrow, 'wn'     , ww  ) 
    29603517         CALL iom_rstput( kt, nitrst, numrow, 'hbl'    , hbl ) 
    … …  
    29633520            CALL iom_rstput( kt, nitrst, numrow, 'hmle', hmle ) 
    29643521         END IF 
    2965         RETURN 
    2966      END IF 
    2967  
    2968      !!----------------------------------------------------------------------------- 
    2969      ! Getting hbl, no restart file with hbl, so calculate from surface stratification 
    2970      !!----------------------------------------------------------------------------- 
    2971      IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification' 
    2972      ! w-level of the mixing and mixed layers 
    2973      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 point 
    2976      hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
    2977      zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 
    2978      ! 
    2979      hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
    2980      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 level 
    2984      END_3D 
    2985      ! 
    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 depth 
    2989         dh (ji,jj) = e3t(ji,jj,iiki-1,Kmm  )     ! Turbocline depth 
    2990      END_2D 
    2991  
    2992      WRITE(numout,*) ' ===>>>> : hbl computed from stratification' 
    2993  
    2994      IF( ln_osm_mle ) THEN 
    2995         hmle(:,:) = hbl(:,:)            ! Initialise MLE depth. 
    2996         WRITE(numout,*) ' ===>>>> : hmle set = to hbl' 
    2997      END IF 
    2998  
    2999      ww(:,:,:) = 0._wp 
    3000      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') 
    30023559   END SUBROUTINE osm_rst 
    30033560 
    … …  
    30543611      IF(sn_cfctl%l_prtctl) THEN 
    30553612         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' ) 
    30573614      ENDIF 
    30583615      ! 
Note: See TracChangeset for help on using the changeset viewer.