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 14994 – NEMO

Changeset 14994


Ignore:
Timestamp:
2021-06-15T16:39:31+02:00 (3 years ago)
Author:
mathiot
Message:

ticket #2669: update to the head of trunk

Location:
NEMO/branches/2021/ticket2669_isf_fluxes
Files:
4 deleted
45 edited
9 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/ticket2669_isf_fluxes/cfgs/AGRIF_DEMO/EXPREF/AGRIF_FixedGrids.in

    r13286 r14994  
    112 
    2 41 81 49 91 1 1 1 
    3 121 152 110 143 4 4 4 
     245 85 52 94 1 1 1 
     3125 156 113 146 4 4 4 
    440 
    551 

  • NEMO/branches/2021/ticket2669_isf_fluxes/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r14840 r14994  
    4242&namtile        !   parameters of the tiling 
    4343!----------------------------------------------------------------------- 
    44    ln_tile = .false.     !  Use tiling (T) or not (F) 
    45    nn_ltile_i = 10       !  Length of tiles in i 
    46    nn_ltile_j = 10       !  Length of tiles in j 
    4744/ 
    4845!----------------------------------------------------------------------- 

  • NEMO/branches/2021/ticket2669_isf_fluxes/cfgs/SHARED/field_def_nemo-oce.xml

    r14988 r14994  
    317317    <field id="dh"                  long_name="Pycnocline thickness"                     unit=" m"      /> 
    318318    <field id="ibld"                long_name="index of boundary layer depth"            unit="#"       /> 
    319     <field id="imld"                long_name="index of mixed layer depth"            unit="#"       /> 
    320     <field id="zhbl"                long_name="boundary layer depth -grid"                     unit="m"       /> 
    321     <field id="zhml"                long_name="mixed layer depth - grid"                        unit="m"       /> 
     319    <field id="imld"                long_name="index of mixed layer depth"               unit="#"       /> 
     320    <field id="jp_ext"              long_name="flag =1 if pycnocline well resolved"      unit="#"       /> 
     321    <field id="j_ddh"               long_name="index of mixed layer depth"               unit="#"       /> 
     322    <field id="zshear"              long_name="shear production of TKE "                 unit="m^3/s^3" /> 
     323    <field id="zhbl"                long_name="boundary layer depth -grid"               unit="m"       /> 
     324    <field id="zhml"                long_name="mixed layer depth - grid"                 unit="m"       /> 
    322325    <field id="zdh"                 long_name="Pycnocline  depth - grid"                 unit=" m"      /> 
    323326    <field id="zustke"              long_name="magnitude of stokes drift  at T-points"   unit="m/s"     /> 
    324     <field id="us_x"        long_name="i component of active Stokes drift"                      unit="m/s"     /> 
    325     <field id="us_y"        long_name="j component of active Stokes drift"                      unit="m/s"     /> 
     327    <field id="us_x"                long_name="i component of active Stokes drift"       unit="m/s"     /> 
     328    <field id="us_y"                long_name="j component of active Stokes drift"       unit="m/s"     /> 
    326329    <field id="dstokes"             long_name="stokes drift  depth scale"                unit="m"       /> 
    327330    <field id="zwth0"               long_name="surface non-local temperature flux"       unit="deg m/s" /> 
    328331    <field id="zws0"                long_name="surface non-local salinity flux"          unit="psu m/s" /> 
     332    <field id="zwb0"                long_name="surface non-local buoyancy flux"          unit="m^2/s^3" /> 
    329333    <field id="zwstrc"              long_name="convective velocity scale"                unit="m/s"     /> 
    330334    <field id="zustar"              long_name="friction velocity"                        unit="m/s"     /> 
    … …  
    337341 
    338342    <!-- interior BL OSMOSIS diagnostics --> 
    339     <field id="zwthav"              long_name="av turb flux of T in ml"                  unit="deg m/s" /> 
     343    <field id="zwbav"               long_name="av turb flux of buoyancy in ml"           unit="m^2/s^3" /> 
    340344    <field id="zt_ml"               long_name="av T in ml"                               unit="deg"     /> 
    341345    <field id="zhol"                long_name="Hoenekker number"                         unit="#"       /> 
    … …  
    344348    <field id="zwb_ent"            long_name="entrainment turb flux of buoyancy"         unit="m^2/s^-3" /> 
    345349 
    346     <field id="zdt_bl"             long_name="temperature jump at base of BL"                 unit="deg"      /> 
    347     <field id="zds_bl"             long_name="salinity jump at base of BL"                 unit="10^-3"      /> 
    348     <field id="zdb_bl"             long_name="buoyancy jump at base of BL"                 unit="m/s^2"      /> 
    349     <field id="zdu_bl"             long_name="u jump at base of BL"                       unit="m/s"      /> 
    350     <field id="zdv_bl"             long_name="v jump at base of BL"                       unit="m/s"      /> 
    351  
     350    <field id="zdt_bl"             long_name="temperature jump at base of BL"            unit="deg"      /> 
     351    <field id="zds_bl"             long_name="salinity jump at base of BL"               unit="10^-3"    /> 
     352    <field id="zdb_bl"             long_name="buoyancy jump at base of BL"               unit="m/s^2"    /> 
     353    <field id="zdu_bl"             long_name="u jump at base of BL"                      unit="m/s"      /> 
     354    <field id="zdv_bl"             long_name="v jump at base of BL"                      unit="m/s"      /> 
     355    <field id="zdt_ml"             long_name="temperature jump at base of ML"            unit="deg"      /> 
     356    <field id="zds_ml"             long_name="salinity jump at base of ML"               unit="10^-3"    /> 
     357    <field id="zdb_ml"             long_name="buoyancy jump at base of ML"               unit="m/s^2"    /> 
     358    <field id="pb_coup"            long_name="bottom coupling velocity"                  unit="m/s"      /> 
    352359    <!-- extra OSMOSIS diagnostics for debugging --> 
    353360    <field id="zsc_uw_1_0"       long_name="zsc u-momentum flux on T after Stokes"                       unit="m^2/s^2" /> 
    … …  
    356363    <field id="zsc_uw_2_f"       long_name="2nd zsc u-momentum flux on T after Coriolis"                       unit="m^2/s^2" /> 
    357364    <field id="zsc_vw_2_f"       long_name="2nd zsc v-momentum flux on T after Coriolis"                       unit="m^2/s^2" /> 
    358     <field id="zuw_bse"       long_name="base u-flux T-points"                          unit="m^2/s^2" /> 
    359     <field id="zvw_bse"       long_name="base v-flux T-points"                          unit="m^2/s^2" /> 
    360365 
    361366    <!-- FK_OSM OSMOSIS diagnostics (require also ln_osm_mle=.true.--> 
    … …  
    756761    <field id="bn2"          long_name="squared Brunt-Vaisala frequency"                unit="s-2" /> 
    757762 
     763    <!-- dissipation diagnostics (note: ediss_k is only available with tke scheme) -->    
     764    <field id="avt_k"        long_name="vertical eddy diffusivity from closure schemes" standard_name="ocean_vertical_eddy_diffusivity"       unit="m2/s" /> 
     765    <field id="avm_k"        long_name="vertical eddy viscosity from closure schemes"   standard_name="ocean_vertical_eddy_viscosity"         unit="m2/s" /> 
     766    <field id="ediss_k"      long_name="Kolmogorov energy dissipation (tke scheme)"     standard_name="Kolmogorov_energy_dissipation"         unit="W/kg" /> 
     767    <field id="eshear_k"     long_name="energy source from vertical shear"              standard_name="energy_source_from_shear"              unit="W/kg" /> 
     768    <field id="estrat_k"     long_name="energy sink from stratification"                standard_name="energy_sink_from_stratification"       unit="W/kg" /> 
     769     
    758770  </field_group> 
    759771 
    … …  
    11091121    <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"        unit="m/s^2"                        /> 
    11101122    <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"              unit="m/s^2"                        /> 
     1123  </field_group> 
     1124 
     1125  <!-- shared variables available with TOP interface --> 
     1126  <field_group id="top_shared" grid_ref="grid_T_3D"> 
     1127    <field id="xeps"           long_name="Broadband light attenuation"                     unit="-"                            /> 
     1128    <field id="Heup"           long_name="Euphotic layer depth"                            unit="m"     grid_ref="grid_T_2D"   /> 
    11111129  </field_group> 
    11121130 

  • NEMO/branches/2021/ticket2669_isf_fluxes/cfgs/SHARED/namelist_ref

    r14916 r14994  
    9999!----------------------------------------------------------------------- 
    100100   ln_tile = .false.     !  Use tiling (T) or not (F) 
    101    nn_ltile_i = 10       !  Length of tiles in i 
     101   nn_ltile_i = 99999    !  Length of tiles in i 
    102102   nn_ltile_j = 10       !  Length of tiles in j 
    103103/ 
    … …  
    12421242   !                       !           = 2 roughness uses rn_hsri and is weighted by 1-fr_i 
    12431243   !                       !           = 3 roughness uses rn_hsri and is weighted by 1-MIN(1,4*fr_i) 
     1244   nn_mxlice     =     1   !  mixing under sea ice 
     1245                           !     = 0 No scaling under sea-ice 
     1246                           !     = 1 scaling with constant Ice-ocean roughness (rn_hsri) 
     1247                           !     = 2 scaling with mean sea-ice thickness 
     1248                           !     = 3 scaling with max sea-ice thickness 
    12441249   nn_bc_surf    =     1   !  surface condition (0/1=Dir/Neum) 
    12451250   nn_bc_bot     =     1   !  bottom condition (0/1=Dir/Neum) 
    … …  
    12731278                               !  = 2:use surface value of SD fit to slope at rn_osm_hblfrac*hbl below surface 
    12741279   ln_zdfosm_ice_shelter = .true.  ! reduce surface SD and depth scale under ice 
    1275    ln_osm_mle = .false.        !  Use integrated FK-OSM model 
     1280   ln_osm_mle = .true.         !  Use integrated FK-OSM model 
    12761281/ 
    12771282!----------------------------------------------------------------------- 
    … …  
    12811286   nn_osm_mle          = 0         ! MLE type: =0 standard Fox-Kemper ; =1 new formulation 
    12821287   rn_osm_mle_lf       = 5.e+3     ! typical scale of mixed layer front (meters)                      (case rn_osm_mle=0) 
    1283    rn_osm_mle_time     = 172800.   ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_osm_mle=0) 
     1288   rn_osm_mle_time     = 43200.    ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_osm_mle=0) 
    12841289   rn_osm_mle_lat      = 20.       ! reference latitude (degrees) of MLE coef.                        (case rn_mle=1) 
    1285    rn_osm_mle_rho_c =    0.01      ! delta rho criterion used to calculate MLD for FK 
    1286    rn_osm_mle_thresh  = 0.0005     ! delta b criterion used for FK MLE criterion 
    1287    rn_osm_mle_tau     = 172800.    ! time scale for FK-OSM (seconds)  (case rn_osm_mle=0) 
    1288    ln_osm_hmle_limit   = .false.   ! limit hmle to rn_osm_hmle_limit*hbl 
    1289    rn_osm_hmle_limit   = 1.2 
     1290   rn_osm_mle_rho_c    = 0.03      ! delta rho criterion used to calculate MLD for FK 
     1291   rn_osm_mle_thresh   = 0.0001    ! delta b criterion used for FK MLE criterion 
     1292   rn_osm_mle_tau      = 172800.   ! time scale for FK-OSM (seconds)  (case rn_osm_mle=0) 
     1293   ln_osm_hmle_limit   = .true.    ! If true, limit hmle to rn_osm_hmle_limit*hbl 
     1294   rn_osm_hmle_limit   = 1.5 
    12901295   / 
    12911296!----------------------------------------------------------------------- 

  • NEMO/branches/2021/ticket2669_isf_fluxes/cfgs/SHARED/namelist_top_ref

    r14032 r14994  
    101101/ 
    102102!----------------------------------------------------------------------- 
     103&namtrc_opt      !  light availability in the water column 
     104!----------------------------------------------------------------------- 
     105!              !  file name       ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     106!              !                  !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
     107   sn_par      = 'par.orca'       ,     24            , 'fr_par'  ,  .true.      , .true. , 'yearly'  , ''       , ''       , '' 
     108   cn_dir      = './'        ! root directory for the location of the dynamical files 
     109   ln_varpar   =  .true.     ! Read PAR from file 
     110   parlux      =  0.43       ! Fraction of shortwave as PAR 
     111   light_loc   = 'center'    ! Light location in the water cell ('center', 'integral') 
     112/ 
     113!----------------------------------------------------------------------- 
    103114&namtrc_dmp      !   passive tracer newtonian damping                   (ln_trcdmp=T) 
    104115!----------------------------------------------------------------------- 

  • NEMO/branches/2021/ticket2669_isf_fluxes/doc/latex/TOP/main/abstract.tex

    r11591 r14994  
    2424it includes different sub-modules: ocean water age, inorganic carbon (CFCs) \& radiocarbon (C14b), 
    2525built-in biogeochemical model (PISCES), and prototype for user-defined cases or 
    26 coupling with alternative biogeochemical models (\eg \href{http://www.bfm-community.eu}{BFM}). 
     26coupling with alternative biogeochemical models (\eg, \href{http://www.bfm-community.eu}{BFM}). 

  • NEMO/branches/2021/ticket2669_isf_fluxes/doc/latex/TOP/main/authors.tex

    r11591 r14994  
    55Georges Nurser         \\ 
    66Julien Palmi\'{e}ri    \\ 
     7Renaud Person    \\ 
    78Andrew Yool 

  • NEMO/branches/2021/ticket2669_isf_fluxes/doc/latex/TOP/main/bibliography.bib

    r14374 r14994  
    187187} 
    188188 
     189@article{         getzlaff_2013, 
     190  author        = {Getzlaff, Julia and Dietze, Heiner}, 
     191  title         = {Effects of increased isopycnal diffusivity 
     192                  mimicking the unresolved equatorial intermediate 
     193                  current system in an earth system climate model}, 
     194  year          = {2013}, 
     195  volume        = {40}, 
     196  number        = {10}, 
     197  pages         = {2166--2170}, 
     198  doi           = {10.1002/grl.50419}, 
     199  url           = {https://dx.doi.org/10.1002/grl.50419}, 
     200  journal       = {Geophysical Research Letters}, 
     201  publisher     = {Wiley Online Library} 
     202} 
     203 
    189204@techreport{      gibson_trpt86, 
    190205  title         = "Standards for software development and maintenance", 
    … …  
    271286  journal   = {Limnology and Oceanography}, 
    272287  publisher = {Wiley} 
     288} 
     289 
     290@Article{         mathiot_explicit_2017, 
     291  author        = {Mathiot, Pierre and Jenkins, Adrian and Harris, Christopher  
     292                  and Madec, Gurvan}, 
     293  title         = {Explicit representation and parametrised impacts of under  
     294                  ice shelf seas in the z∗ coordinate ocean model {NEMO} 3.6}, 
     295  year          = {2017}, 
     296  volume        = {10}, 
     297  number        = {7}, 
     298  month         = jul, 
     299  pages         = {2849--2874}, 
     300  issn          = {1991-9603}, 
     301  doi           = {10.5194/gmd-10-2849-2017}, 
     302  url           = {https://www.geosci-model-dev.net/10/2849/2017/}, 
     303  journal       = {Geoscientific Model Development}, 
     304  publisher = {Copernicus GmbH} 
    273305} 
    274306 
    … …  
    448480} 
    449481 
     482@Article{         person_sensitivity_2019, 
     483  author        = {Person, Renaud and Aumont, Olivier and Madec, Gurvan and  
     484                   Vancoppenolle, Martin and Bopp, Laurent and Merino, Nacho}, 
     485  title         = {Sensitivity of ocean biogeochemistry to the iron supply from the  
     486                  {Antarctic} {Ice} {Sheet} explored with a biogeochemical model}, 
     487  year          = {2019}, 
     488  volume        = {16}, 
     489  number        = {18}, 
     490  month         = sep, 
     491  pages         = {3583--3603}, 
     492  issn          = {1726-4189}, 
     493  doi           = {10.5194/bg-16-3583-2019}, 
     494  url           = {https://www.biogeosciences.net/16/3583/2019/}, 
     495  journal       = {Biogeosciences}, 
     496  publisher = {Copernicus GmbH} 
     497} 
     498 
    450499@Article{     reimer_2013, 
    451500  author = {Reimer, Paula J and Bard, Edouard and Bayliss, Alex and 
    … …  
    630679  publisher = {Elsevier BV} 
    631680} 
     681 
     682 

  • NEMO/branches/2021/ticket2669_isf_fluxes/doc/latex/TOP/main/introduction.tex

    r11591 r14994  
    1111\begin{itemize} 
    1212        \item a transport code TRP sharing the same advection/diffusion routines with the dynamics, with specific treatment of some features like the surface boundary 
    13 conditions, or the positivity of passive tracers concentrations 
     13conditions or the positivity of passive tracers concentrations 
    1414        \item sources and sinks - SMS - models that can be typically biogeochemical, biological or radioactive 
    15         \item an offline option which is a simplified OPA 9 model using fields of physics variables that are previously stored to disk 
     15        \item an offline option which is a simplified OPA 9 model using fields of physical variables that were previously stored on disk 
    1616\end{itemize} 
    1717 
    18 There is two ways of coupling TOP to the dynamics : 
     18There are two ways of coupling TOP to the dynamics : 
    1919 
    2020\begin{itemize} 
    2121        \item \textit{online coupling} : the evolution of passive tracers is computed along with the dynamics 
    22         \item \textit{offline coupling} : the fields of physics variables are read from files and interpolated at each model time step, with no constraints on the time sampling in the input files 
     22        \item \textit{offline coupling} : the physical variable fields are read from files and interpolated at each model time step, with no constraints on the temporal sampling in the input files 
    2323\end{itemize} 
    2424 
    25 TOP is designed to handle multiple oceanic tracers through a modular approach and it includes different sub-modules : 
     25TOP is designed to handle multiple oceanic tracers through a modular approach and includes different sub-modules : 
    2626 
    2727\begin{itemize} 
    2828        \item the ocean water age module (AGE) tracks down the time-dependent spread of surface waters into the ocean interior 
    29         \item inorganic carbon (e.g. CFCs, SF6) and radiocarbon (C14) passive tracers can be modeled to assess ocean absorption timescales of anthropogenic emissions and further address water masses ventilation 
     29        \item inorganic (\eg, CFCs, SF6) and radiocarbon (C14) passive tracers can be modeled to assess ocean absorption timescales of anthropogenic emissions and further address water masses ventilation 
    3030        \item a built-in biogeochemical model (PISCES) to simulate lower trophic levels ecosystem dynamics in the global ocean 
    31         \item a prototype tracer module (MY\_TRC) to enable user-defined cases or the coupling with alternative biogeochemical models ( e.g. BFM, MEDUSA, ERSEM, BFM, ECO3M) 
     31        \item a prototype tracer module (MY\_TRC) to enable user-defined cases or the coupling with alternative biogeochemical models (\eg, BFM, MEDUSA, ERSEM, BFM, ECO3M) 
    3232\end{itemize} 
    3333 
    … …  
    3636\vspace{0cm} 
    3737\includegraphics[width=0.80\textwidth]{Fig_TOP_design} 
    38 %\includegraphics[height=6cm,angle=-00]{Fig_TOP_design} 
    39 \caption{A schematic view of NEMO-TOP component} 
     38\caption{Schematic view of the NEMO-TOP component} 
    4039\label{topdesign} 
    4140\end{center} 

  • NEMO/branches/2021/ticket2669_isf_fluxes/doc/latex/TOP/subfiles/miscellaneous.tex

    r14239 r14994  
    77\section{TOP synthetic Workflow} 
    88 
    9 \subsection{Model initialization} 
     9A synthetic description of the TOP interface workflow is given below to summarize the steps involved in the computation of biogeochemical and physical trends and their time integration and outputs, by reporting also the principal Fortran subroutine herein involved. 
    1010 
    11 \subsection{Time marching procedure} 
     11%\begin{figure}[!h] 
     12%  \centering 
     13%  \includegraphics[width=0.80\textwidth]{Top_FlowChart} 
     14%  \caption{Schematic view of NEMO-TOP flowchart} 
     15%  \label{img_cfcatm} 
     16%\end{figure}  
     17 
     18\begin{minted}{bash} 
     19nemogcm 
     20    !                       
     21    nemo_init           !   NEMO General Initialisations 
     22         !                    
     23         trc_init                              ! TOP  Initialisations  
     24    ! 
     25    stp()                   !   NEMO Time-stepping 
     26        ! 
     27        trc_stp()                            ! TOP time-stepping 
     28            ! 
     29            trc_wri()           ! I/O manager : Output of passive tracers  
     30            trc_sms()           ! Sinks and sources program manager 
     31            trc_trp()            ! Transport of passive tracers 
     32            trc_rst_wri()      ! Write tracer restart file 
     33            trd_mxl_trc()     ! trends: Mixed-layer 
     34\end{minted} 
     35 
     36\subsection{Model initialization (./src/TOP/trcini.F90)} 
     37 
     38This module consists on inital set up of passive tracers variables and parameters  : read the namelist, set initial tracer fields (either read restart or read data or analytical formulation and  specific initailisation in each SMS module  ( analytical initialisation of tracers or constant values ) 
     39 
     40\begin{minted}{bash} 
     41trc_init                              ! TOP  Initialisations  
     42    !     
     43    IF( PISCES )    trc_ini_pisces()     !  PISCES bio model 
     44    IF( MY_TRC)    trc_ini_my_trc()    !  MY_TRC model 
     45    IF( CFCs     )    trc_ini_cfc   ()       !  CFCs 
     46    IF( C14       )    trc_ini_c14   ()       !  C14 model 
     47    IF( AGE      )    trc_ini_age   ()       !  AGE tracer 
     48    ! 
     49    IF( REST   )    trc_rst_read()         ! Restart from a file   
     50    ELSE            trc_dta()                   ! Initialisation from data 
     51\end{minted} 
     52 
     53\subsection{BGC trends computation (./src/TOP/trcsms.F90)} 
     54 
     55This is the main module where the passive tracers source minus sinks of each TOP sub-module is managed.     
     56 
     57\begin{minted}{bash} 
     58trc_sms()                               ! Sinks and sources prooram manager 
     59    !  
     60    IF( PISCES  )    trc_sms_pisces()         ! main program of PISCES  
     61    IF( CFCs     )    trc_sms_cfc()               ! surface fluxes of CFC 
     62    IF( C14       )    trc_sms_c14()               ! surface fluxes of C14 
     63    IF( AGE       )    trc_sms_age()              ! Age tracer 
     64    IF( MY_TRC)    trc_sms_my_trc()         ! MY_TRC  tracers 
     65\end{minted} 
     66 
     67\subsection{Physical trends computation (./src/TOP/TRP/trctrp.F90)} 
     68 
     69This is the main module where the passive tracers transport is managed. All the physical trends is calculated ( advective \& diffusive trends, surface BC from freshwater or external inputs )  
     70 
     71\begin{minted}{bash} 
     72trc_trp()       ! Transport of passive tracers 
     73    ! 
     74    trc_sbc()         ! Surface boundary condition of freshwater flux 
     75    trc_bc()           ! Surface and lateral Boundary Conditions  
     76    trc_ais()          ! Tracers from Antarctic Ice Sheet (icb, isf)                
     77    trc_bbl()          ! Advective (and/or diffusive) bottom boundary layer scheme 
     78    trc_dmp()        ! Internal damping trends 
     79    trc_bdy()         ! BDY damping trends 
     80    trc_adv()         ! Horizontal & Vertical advection  
     81    trc_ldf()           ! Lateral mixing 
     82    trc_zdf()          ! Vert. mixing & after tracer 
     83    trc_atf()           ! Time filtering of "now" tracer fields     
     84    trc_rad()         ! Correct artificial negative concentrations 
     85\end{minted} 
     86 
     87\subsection{Outputs  (./src/TOP/TRP/trcwri.F90)} 
     88 
     89This is the main module where the passive tracer outputs of each TOP sub-module is managed using the I/O library XIOS. 
     90 
     91\begin{minted}{bash} 
     92trc_wri()                               ! I/O manager : Output of passive tracers  
     93! 
     94IF( PISCES   )    trc_wri_pisces()      ! Output of PISCES diagnostics  
     95IF( CFCs      )    trc_wri_cfc()            ! Output of Cfcs diagnostics 
     96IF( C14         )    trc_wri_c14()           ! surface fluxes of C14 
     97IF( AGE        )    trc_wri_age()           ! Age tracer 
     98IF( MY_TRC )    trc_wri_my_trc()      ! MY_TRC  tracers 
     99\end{minted} 
    12100 
    13101\section{Coupling an external BGC model using NEMO framework} 
    … …  
    27115\end{minted} 
    28116 
    29 the compilation with \textit{makenemo} will be executed through the following syntax 
     117The compilation with \textit{makenemo} will be executed through the following syntax 
    30118 
    31119\begin{minted}{bash} 
    32120   makenemo -n NEMO_MYBGC -m <arch_my_machine> -j 8 -e <MYBGCPATH> 
    33121\end{minted} 
    34 %The makenemo feature ?-e? was introduced to readdress at compilation time the standard MY_SRC folder (usually found in NEMO configurations) with a user defined external one. 
    35 % 
    36 % 
    37 %The compilation of more articulated BGC model code & infrastructure, like in the case of BFM (?BFM-NEMO coupling manual), requires some additional features. 
    38 % 
    39 %As before, let?s assume a coupled configuration name NEMO_MYBGC, but in this case MYBGC model root becomes <MYBGCPATH> that contains 4 different subfolders for biogeochemistry, named initialization, pelagic, and benthic, and a separate one named nemo_coupling including the modified MY_SRC routines. The latter folder containing the modified NEMO coupling interface will be still linked using the makenemo ?-e? option. 
    40 % 
    41 %In order to include the BGC model subfolders in the compilation of NEMO code, it will be necessary to extend the configuration cpp_NEMO_MYBGC.fcm file to include the specific paths of MYBGC folders, as in the following example 
    42 % 
     122 
     123The makenemo feature \textit{-e} was introduced to readdress at compilation time the standard MY\_SRC folder (usually found in NEMO configurations) with a user defined external one. \\ \\ 
     124 
     125The compilation of more articulated BGC model code \& infrastructure, like in the case of BFM (BFM-NEMO coupling manual), requires some additional features. \\ \\ 
     126 
     127As before, let's assume a coupled configuration name NEMO\_MYBGC, but in this case MYBGC model root becomes <MYBGCPATH> that contains 4 different subfolders for biogeochemistry, named initialization, pelagic, and benthic, and a separate one named nemo\_coupling including the modified MY\_SRC routines. The latter folder containing the modified NEMO coupling interface will be still linked using the makenemo \textit{-e} option. \\ \\ 
     128 
     129In order to include the BGC model subfolders in the compilation of NEMO code, it will be necessary to extend the configuration \textit{cpp\_NEMO\_MYBGC.fcm} file to include the specific paths of MYBGC folders, as in the following example 
     130 
    43131\begin{minted}{bash} 
    44132   bld::tool::fppkeys   key_xios key_top 
    … …  
    49137 
    50138   bld::pp::MYBGC      1 
    51    bld::tool::fppflags::MYBGC   %FPPFLAGS 
    52    bld::tool::fppkeys   %bld::tool::fppkeys MYBGC_MACROS 
     139   bld::tool::fppflags::MYBGC   \%FPPFLAGS 
     140   bld::tool::fppkeys                  \%bld::tool::fppkeys MYBGC_MACROS 
    53141\end{minted} 
    54142 
    55 %where MYBGC_MACROS is the space delimited list of macros used in MYBGC model for selecting/excluding specific parts of the code. The BGC model code will be preprocessed in the configuration BLD folder as for NEMO, but with an independent path, like NEMO_MYBGC/BLD/MYBGC/<subforlders>. 
    56 % 
    57 %The compilation will be performed similarly to in the previous case with the following 
    58 % 
    59 %makenemo -n NEMO_MYBGC -m <arch_my_machine> -j 8 -e <MYBGCPATH>/nemo_coupling 
    60 %Note that, the additional lines specific for the BGC model source and build paths, can be written into a separate file, e.g. named MYBGC.fcm, and then simply included in the cpp_NEMO_MYBGC.fcm as follow 
    61 % 
    62 %bld::tool::fppkeys  key_zdftke key_dynspg_ts key_xios key_top 
    63 %inc <MYBGCPATH>/MYBGC.fcm 
    64 %This will enable a more portable compilation structure for all MYBGC related configurations. 
    65 % 
    66 %Important: the coupling interface contained in nemo_coupling cannot be added using the FCM syntax, as the same files already exists in NEMO and they are overridden only with the readdressing of MY_SRC contents to avoid compilation conflicts due to duplicate routines. 
    67 % 
    68 %All modifications illustrated above, can be easily implemented using shell or python scripting to edit the NEMO configuration cpp.fcm file and to create the BGC model specific FCM compilation file with code paths. 
     143where MYBGC\_MACROS is the space delimited list of macros used in MYBGC model for selecting/excluding specific parts of the code. The BGC model code will be preprocessed in the configuration BLD folder as for NEMO, but with an independent path, like NEMO\_MYBGC/BLD/MYBGC/<subfolders>.\\ 
     144 
     145The compilation will be performed similarly to in the previous case with the following 
     146 
     147\begin{minted}{bash} 
     148makenemo -n NEMO_MYBGC -m <arch_my_machine> -j 8 -e <MYBGCPATH>/nemo_coupling 
     149\end{minted} 
     150 
     151Note that, the additional lines specific for the BGC model source and build paths, can be written into a separate file, e.g. named MYBGC.fcm, and then simply included in the cpp\_NEMO\_MYBGC.fcm as follow: 
     152 
     153\begin{minted}{bash} 
     154bld::tool::fppkeys  key_zdftke key_dynspg_ts key_xios key_top 
     155inc <MYBGCPATH>/MYBGC.fcm 
     156\end{minted} 
     157 
     158This will enable a more portable compilation structure for all MYBGC related configurations.  \\ \\ 
     159 
     160Important: the coupling interface contained in nemo\_coupling cannot be added using the FCM syntax, as the same files already exists in NEMO and they are overridden only with the readdressing of MY\_SRC contents to avoid compilation conflicts due to duplicate routines.  \\ \\ 
     161 
     162All modifications illustrated above, can be easily implemented using shell or python scripting to edit the NEMO configuration cpp.fcm file and to create the BGC model specific FCM compilation file with code paths. 
    69163 
    70164\end{document} 

  • NEMO/branches/2021/ticket2669_isf_fluxes/doc/latex/TOP/subfiles/model_description.tex

    r14375 r14994  
    1717\label{sec:Bas} 
    1818 
    19 The time evolution of any passive tracer $C$ follows the transport equation, which is similar to that of active tracer - temperature or salinity : 
     19The time evolution of any passive tracer $C$ is given by the transport equation, which is similar to that of active tracer - temperature or salinity : 
    2020 
    2121\begin{equation} 
    … …  
    2424\end{equation} 
    2525 
    26 where expressions of $D^{lC}$ and $D^{vC}$ depend on the choice for the lateral and vertical subgrid scale parameterizations, see equations 5.10 and 5.11 in \citep{nemo_manual} 
    27  
    28 {S(C)} , the first term on the right hand side of \autoref{Eq_tracer}; is the SMS - Source Minus Sink - inherent to the tracer. 
    29 In the case of biological tracer such as phytoplankton, {S(C)} is the balance between phytoplankton growth and its decay through mortality and grazing. 
    30 In the case of a tracer comprising carbon,  {S(C)} accounts for gas exchange, river discharge, flux to the sediments, gravitational sinking and other biological processes. 
    31 In the case of a radioactive tracer, {S(C)} is simply loss due to radioactive decay. 
     26where expressions of $D^{lC}$ and $D^{vC}$ depend on the choice for the lateral and vertical subgrid scale parameterizations (see Equations 5.10 and 5.11 in \cite{nemo_manual}). 
     27 
     28{S(C)}, the first term on the right hand side of \autoref{Eq_tracer}, is the SMS - Sources Minus Sinks - inherent to the tracer. 
     29In the case of a biological tracer such as phytoplankton, {S(C)} is the balance between phytoplankton growth and its loss through mortality and grazing. 
     30In the case of a tracer comprising carbon,  {S(C)} accounts for gas exchange, river discharge, flux to the sediments, gravitational sinking and other biogeochemical processes. 
     31In the case of a radioactive tracer, {S(C)} is simply the loss due to radioactive decay. 
    3232 
    3333The second term (within brackets) represents the advection of the tracer in the three directions. 
    … …  
    3636The third term  represents the change due to lateral diffusion. 
    3737 
    38 The fourth term is change due to vertical diffusion, parameterized as eddy diffusion to represent vertical turbulent fluxes : 
     38The fourth term denotes the change due to vertical diffusion, parameterized as eddy diffusion to represent vertical turbulent fluxes : 
    3939 
    4040\begin{equation} 
    … …  
    4343\end{equation} 
    4444 
    45 where $A^{vT}$ is the vertical eddy diffusivity coefficient of active tracers 
     45where $A^{vT}$ is the vertical eddy diffusivity coefficient of active tracers. 
    4646 
    4747\section{The NEMO-TOP interface} 
    4848\label{sec:TopInt} 
    4949 
    50 TOP is the NEMO hardwired interface toward biogeochemical models and provide the physical constraints/boundaries for oceanic tracers. 
     50TOP is the NEMO hardwired interface toward biogeochemical models, which provides the physical constraints/boundaries for oceanic tracers. 
    5151It consists of a modular framework to handle multiple ocean tracers, including also a variety of built-in modules. 
    5252 
    53 This component of the NEMO framework allows one to exploit available modules  and further develop a range of applications, spanning from the implementation of a dye passive tracer to evaluate dispersion processes (by means of MY\_TRC), track water masses age (AGE module), assess the ocean interior penetration of persistent chemical compounds (e.g., gases like CFC or even PCBs), up to the full set of equations involving marine biogeochemical cycles. 
     53This component of the NEMO framework allows one to exploit available modules  and further develop a range of applications, spanning from the implementation of a dye passive tracer to evaluate dispersion processes (by means of MY\_TRC), track water masses age (AGE module), assess the ocean interior penetration of persistent chemical compounds (e.g., gases like CFC or even PCBs), up to the full set of equations to simulate marine biogeochemical cycles. 
    5454 
    5555TOP interface has the following location in the code repository : \path{<repository>/src/TOP/} 
    … …  
    6060\begin{itemize} 
    6161        \item \textbf{TRP}           :    Interface to NEMO physical core for computing tracers transport 
    62         \item \textbf{CFC}     :    Inert carbon tracers (CFC11,CFC12, SF6) 
     62        \item \textbf{CFC}     :    Inert tracers (CFC11,CFC12, SF6) 
    6363        \item \textbf{C14}     :    Radiocarbon passive tracer 
    6464        \item \textbf{AGE}     :    Water age tracking 
    6565        \item \textbf{MY\_TRC}  :   Template for creation of new modules and external BGC models coupling 
    66         \item \textbf{PISCES}    :   Built in BGC model. 
    67 See \citep{aumont_2015} for a throughout description. 
     66        \item \textbf{PISCES}    :   Built in BGC model. See \cite{aumont_2015} for a complete description 
    6867\end{itemize} 
    6968%  ---------------------------------------------------------- 
    … …  
    7170\section{The transport component : TRP} 
    7271 
    73 The passive tracer transport component  shares the same advection/diffusion routines with the dynamics, with specific treatment of some features like the surface boundary conditions, or the positivity of passive tracers concentrations. 
     72The passive tracer transport component shares the same advection/diffusion routines with the dynamics, with specific treatment of some features like the surface boundary conditions, or the positivity of passive tracers concentrations. 
    7473 
    7574\subsection{Advection} 
     75 
     76The advection schemes used for the passive tracers are the same as those used for $T$ and $S$. They are described in section 5.1 of \cite{nemo_manual}. 
     77The choice of an advection scheme can be selected independently and can differ from the ones used for active tracers. 
     78This choice is made in \textit{namelist\_to}p (ref or cfg) in the namelist block \textit{namtrc\_adv}, by setting to \textit{true} one and only one of the logicals \textit{ln\_trcadv\_xxx}, the same way of what is done for dynamics. 
     79cen2, MUSCL2, and UBS are not \textit{positive} schemes meaning that negative values can appear in an initially strictly positive tracer field which is advected, implying that artificial extrema are permitted. Their use is not recommended for passive tracers. 
     80 
    7681%------------------------------------------namtrc_adv---------------------------------------------------- 
    7782\nlst{namtrc_adv} 
    78 %------------------------------------------------------------------------------------------------------------- 
    79 The advection schemes used for the passive tracers are the same than the ones for $T$ and $S$ and described in section 5.1 of \citep{nemo_manual}. 
    80 The choice of an advection scheme  can be selected independently and  can differ from the ones used for active tracers. 
    81 This choice is made in the \textit{namtrc\_adv} namelist, by  setting to \textit{true} one and only one of the logicals \textit{ln\_trcadv\_xxx}, the same way of what is done for dynamics. 
    82 cen2, MUSCL2, and UBS are not \textit{positive} schemes meaning that negative values can appear in an initially strictly positive tracer field which is advected, implying that false extrema are permitted. 
    83 Their use is not recommended on passive tracers 
     83%---------------------------------------------------------------------------------------------------------- 
    8484 
    8585\subsection{Lateral diffusion} 
     86 
     87In NEMO v4.0, diffusion of passive tracers has necessarily the same form as the active tracer diffusion, meaning that the numerical scheme must be the same. 
     88However the passive tracer mixing coefficient can be chosen as a multiple of the active ones by changing the value of \textit{rn\_ldf\_multi} in namelist \textit{namtrc\_ldf}. 
     89The choice of the numerical scheme is then set in the \forcode{&namtra_ldf} namelist section for the dynamic described in section 5.2 of \cite{nemo_manual}. 
     90 
     91rn\_fact\_lap is a factor used to increase zonal equatorial diffusion for depths beyond 200 m. It can be useful to achieve a better representation of Oxygen Minimum Zone (OMZ) in some biogeochemical models, especially at coarse resolution \citep{getzlaff_2013}. 
     92 
    8693%------------------------------------------namtrc_ldf---------------------------------------------------- 
    8794\nlst{namtrc_ldf} 
    88 %------------------------------------------------------------------------------------------------------------- 
    89 In NEMO v4.0, the passive tracer diffusion has necessarily the same form as the active tracer diffusion, meaning that the numerical scheme must be the same. 
    90 However the passive tracer mixing coefficient can be chosen as a multiple of the active ones by changing the value of \textit{rn\_ldf\_multi} in namelist \textit{namtrc\_ldf}. 
    91 The choice of numerical scheme is then set in the \forcode{&namtra_ldf} namelist for the dynamic described in section 5.2 of \citep{nemo_manual}. 
     95%--------------------------------------------------------------------------------------------------------- 
    9296 
    9397%-----------------We also offers the possibility to increase zonal equatorial diffusion for passive tracers by introducing an enhanced zonal diffusivity coefficent in the equatorial domain which can be defined by the equation below : 
    … …  
    98102\subsection{Tracer damping} 
    99103 
     104The use of newtonian damping  to climatological fields or observations is also coded, sharing the same routine as that of active tracers. 
     105Boolean variables are defined in the namelist\_top\_ref to select the tracers on which restoring is applied. 
     106Options are defined through the \textit{\&namtrc\_dmp} namelist variables. 
     107The restoring term is added when the namelist parameter \textit{ln\_trcdmp} is set to \textit{true}. 
     108The restoring coefficient is a three-dimensional array read in a file, whose name is specified by the namelist variable \textit{cn\_resto\_tr}. 
     109This netcdf file can be generated using the DMP\_TOOLS tool. 
     110 
    100111%------------------------------------------namtrc_dmp---------------------------------------------------- 
    101112\nlst{namtrc_dmp} 
    102 %------------------------------------------------------------------------------------------------------------- 
    103  
    104 The use of newtonian damping  to climatological fields or observations is also coded, sharing the same routine dans active tracers. 
    105 Boolean variables are defined in the namelist\_top\_ref to select the tracers on which restoring is applied 
    106 Options are defined through the \nam{trc_dmp}{trc\_dmp} namelist variables. 
    107 The restoring term is added when the namelist parameter \np{ln\_trcdmp} is set to true. 
    108 The restoring coefficient is a three-dimensional array read in a file, which name is specified by the namelist variable \np{cn\_resto\_tr}. 
    109 This netcdf file can be generated using the DMP\_TOOLS tool. 
     113%----------------------------------------------------------------------------------------------------------- 
    110114 
    111115\subsection{Tracer positivity} 
     116 
     117Some numerical schemes can generate negative values of passive tracers concentration, which is obviously unrealistic. 
     118For example,  isopycnal diffusion can created local extrema, meaning that negative concentrations can be generated. 
     119The trcrad routine artificially corrects negative concentrations with a very crude solution that either sets negative concentrations to zero without adjusting the tracer budget (CFCs or C14 chemical coumpounds), or by removing negative concentrations while computing the corresponding tracer content that is added and then, adjusting the tracer concentration using a multiplicative factor so that the total tracer concentration is preserved (PISCES model).  
     120The treatment of negative concentrations is an option and can be selected in the namelist \textit{\&namtrc\_rad} by setting the parameter \textit{ln\_trcrad}  to true. 
    112121 
    113122%------------------------------------------namtrc_rad---------------------------------------------------- 
    114123\nlst{namtrc_rad} 
    115 %------------------------------------------------------------------------------------------------------------- 
    116  
    117 Sometimes, numerical scheme can generates negative values of passive tracers concentration that must be positive. 
    118 For exemple,  isopycnal diffusion can created extrema. 
    119 The trcrad routine artificially corrects negative concentrations with a very crude solution that either sets negative concentration to zero without adjusting the tracer budget, or by removing negative concentration and keeping mass conservation. 
    120 The treatment of negative concentrations is an option and can be selected in the namelist \nam{trc_rad}{trc\_rad} by setting the parameter \np{ln\_trcrad}  to true. 
     124%---------------------------------------------------------------------------------------------------------- 
     125 
     126\subsection{Tracer boundary conditions} 
     127 
     128In NEMO, different types of boundary conditions can be specified for biogeochemical tracers. For every single variable, it is possible to define a field of surface boundary conditions, such as deposition of dust or nitrogen, which is then interpolated to the grid and timestep using the fld\_read function. The same facility is available to include river inputs or coastal erosion (coastal boundary conditions) and the treatment of open boundary conditions. For lateral boundary conditions, spatial interpolation should not be activated. 
     129 
     130%------------------------------------------namtrc_bc---------------------------------------------------- 
     131\nlst{namtrc_cfg} 
     132%--------------------------------------------------------------------------------------------------------- 
     133 
     134\subsubsection{Surface and lateral boundaries} 
     135 
     136The namelist \textit{\&namtrc\_bc}  is in file \textit{namelist\_top\_cfg}  and allows to specify the name of the files, the frequency of the input and the time and space interpolation as done for any other field using the fld\_read interface. 
     137 
     138%------------------------------------------namtrc_bc---------------------------------------------------- 
     139\nlst{namtrc_bc} 
     140%--------------------------------------------------------------------------------------------------------- 
     141\subsubsection{Open boundaries} 
     142 
     143The BDY for passive tracer are set together with the physical oceanic variables (lnbdy  =.true.). Boundary conditions are set in the structure used to define the passive tracer properties in the « cbc » column. These boundary conditions are applied on the segments defined for the physical core of NEMO (see BDY description in the User Manual). 
     144\begin{itemize} 
     145   \item cn\_trc\_dflt : the type of OBC applied to all the tracers 
     146   \item cn\_trc :  the boundary condition used for tracers with data file 
     147\end{itemize}  
     148 
     149%------------------------------------------namtrc_bdy---------------------------------------------------- 
     150\nlst{namtrc_bdy} 
     151%---------------------------------------------------------------------------------------------------------- 
     152 
     153\subsubsection{Sedimentation of particles} 
     154 
     155This module computes the vertical flux of particulate matter due to gravitational sinking. It also offers a temporary solution for the problem that may arise in specific situation where the CFL criterion is broken for vertical sedimentation of particles. To avoid this, a time splitting algorithm has been coded. The number of iterations niter necessary to respect the CFL criterion is dynamically computed. A specific maximum number of iterations nitermax may be specified in the namelist. This is to avoid a very large number of iterations when explicit free surface is used, for instance. If niter is larger than the prescribed nitermax, sinking speeds are clipped so that the CFL criterion is respected. The numerical scheme used to compute sedimentation is based on the MUSCL advection scheme. 
     156 
     157%------------------------------------------namtrc_bdy---------------------------------------------------- 
     158\nlst{namtrc_snk} 
     159%---------------------------------------------------------------------------------------------------------- 
     160 
     161\subsubsection{Sea-ice growth and melt effect} 
     162 
     163NEMO provides three options for the specification of tracer concentrations in sea ice: (-1) identical tracer concentrations in sea ice and ocean, which corresponds to no concentration/dilution effect upon ice growth and melt; (0) zero concentrations in sea ice, which gives the largest concentration-dilution effect upon ice growth and melt; (1) specified concentrations in sea ice, which gives a possibly more realistic effect of sea ice on tracers. Option (-1) and (0) work for all tracers, but (1) is currently only available for PISCES. 
     164 
     165%------------------------------------------namtrc_ice---------------------------------------------------- 
     166\nlst{namtrc_ice} 
     167%--------------------------------------------------------------------------------------------------------- 
     168 
     169\subsubsection{Antartic Ice Sheet tracer supply} 
     170 
     171The external input of biogeochemical tracers from the Antarctic Ice Sheet (AIS) is represented by associating a tracer content with the freshwater flux from icebergs and ice shelves \citep{person_sensitivity_2019}. This supply is currently implemented only for dissolved Fe (\autoref{img_icbisf}) and is effective in model configurations with south-extended grids (eORCA1 and eORCA025). As the ORCA2 grid does not extend south into Antarctica, the external source of tracers from the AIS cannot be enabled in this configuration.  
     172 
     173For icebergs, a homogeneous distribution of biogeochemical tracers is applied from the surface to a depth that can be defined in \textit{\&namtrc\_ais}, currently set at 120 m. It should be noted that the freshwater flux from icebergs affects only the ocean properties at the surface. For ice shelves, biogeochemical tracers follow the explicit or parameterized representation of freshwater flux distribution modeled in NEMO. The AIS tracer supply is activated by setting \textit{ln\_trcais} to \textit{true} in the \textit{\&namtrc} section. 
     174 
     175\begin{figure}[!h] 
     176   \centering 
     177   \includegraphics[width=0.80\textwidth]{ICB-ISF-Feflx} 
     178   \caption{Annual Fe fluxes from icebergs and ice shelves in the Southern Ocean.} 
     179   \label{img_icbisf} 
     180\end{figure} 
     181 
     182%------------------------------------------namtrc_ais---------------------------------------------------- 
     183\nlst{namtrc_ais} 
     184%--------------------------------------------------------------------------------------------------------- 
    121185 
    122186\section{The SMS modules} 
    … …  
    129193\subsection{Ideal Age} 
    130194%------------------------------------------namage---------------------------------------------------- 
    131 % 
    132195\nlst{namage} 
    133196%---------------------------------------------------------------------------------------------------------- 
    134197 
    135198An `ideal age' tracer is integrated online in TOP when \textit{ln\_age} = \texttt{.true.} in namelist \textit{namtrc}. 
    136 This tracer marks the length of time in units of years that fluid has spent in the interior of the ocean, insulated from exposure to the atmosphere. 
     199This tracer marks the duration in units of years that fluid has spent in the interior of the ocean, insulated from exposure to the atmosphere  (\autoref{img_ageatl} and \autoref{img_age200}). 
     200 
     201\begin{figure}[!h] 
     202   \centering 
     203   \includegraphics[width=0.80\textwidth]{Age_Atl} 
     204   \caption{Vertical distribution of the Age tracer in the Atlantic Ocean at 35°W from a 62-year simulation.} 
     205   \label{img_ageatl} 
     206\end{figure} 
     207 
     208\begin{figure}[!h] 
     209   \centering 
     210   \includegraphics[width=0.80\textwidth]{Age_200m} 
     211   \caption{Age tracer at 200 m depth from a 62-year simulation.} 
     212   \label{img_age200} 
     213\end{figure} 
     214 
    137215Thus, away from the surface for $z<-H_{\mathrm{Age}}$ where $H_{\mathrm{Age}}$ is specified by the \textit{namage} namelist variable \textit{rn\_age\_depth}, whose default value is 10~m, there is a source $\mathrm{SMS_{\mathrm{Age}}}$ of the age tracer $A$: 
    138216 
    … …  
    151229 
    152230where the relaxation rate $\lambda_{\mathrm{Age}}$  (units $\mathrm{s}\;^{-1}$) is specified by the \textit{namage} namelist variable \textit{rn\_age\_kill\_rate} and has a default value of 1/7200~s. 
    153 Since this relaxation is applied explicitly, this relaxation rate in principle should not exceed $1/\Delta t$, where $\Delta t$ is the time step used to step forward passive tracers (2 * \textit{nn\_dttrc * rn\_rdt} when the default  leapfrog time-stepping scheme is employed). 
     231Since this relaxation is applied explicitly, the relaxation rate should in principle not exceed $1/\Delta t$, where $\Delta t$ is the time step used to step forward passive tracers (2 * \textit{nn\_dttrc * rn\_rdt} when the default  leapfrog time-stepping scheme is employed). 
    154232 
    155233Currently the 1-dimensional reference depth of the grid boxes is used rather than the dynamically evolving depth to determine whether the age tracer is incremented or relaxed to zero. 
    156 This means that the tracer only works correctly in z-coordinates. 
    157 To ensure that the forcing is independent of the level thicknesses, where the tracer cell at level $k$ has its upper face $z=-depw(k)$ above the depth $-H_{\mathrm{Age}}$, but its lower face $z=-depw(k+1)$ below that depth, then the age source 
     234This means that the age tracer module only works correctly in z-coordinates. 
     235To ensure that the forcing is independent of the level thicknesses, where the tracer cell at level $k$ has its upper face $z=-depw(k)$ above the depth $-H_{\mathrm{Age}}$, but its lower face $z=-depw(k+1)$ below that depth, then the age source is computed as: 
    158236 
    159237\begin{equation} 
    … …  
    169247\end{align} 
    170248 
    171  
    172 This implementation was first used in the CORE-II intercomparison runs described e.g.\ in \citet{danabasoglu_2014}. 
     249This implementation was first used in the CORE-II intercomparison runs described in \citet{danabasoglu_2014}. 
    173250 
    174251\subsection{Inert carbons tracer} 
    … …  
    184261and additionally as an aerosol propellant. 
    185262SF6 (SF$_{6}$) is also a gas at room temperature, with a range of applications based around its property as an excellent electrical insulator (often replacing more toxic alternatives). 
    186 All three are relatively inert chemicals that are both non-toxic and non-flammable, and their wide use has led to their accumulation within the Earth's atmosphere. 
    187 Large-scale production of CFC-11 and CFC-12 began in the 1930s, while production of SF6 began in the 1950s, and their atmospheric concentration time-histories are shown in Figure \autoref{img_cfcatm}. 
    188 As can be seen in the figure, while the concentration of SF6 continues to rise to the present  day, the concentrations of both CFC-11 and CFC-12 have levelled off and declined since around the 1990s. 
     263All three gases are relatively inert chemicals that are both non-toxic and non-flammable, and their wide use has led to their accumulation in the atmosphere. 
     264Large-scale production of CFC-11 and CFC-12 began in the 1930s, while production of SF6 began in the 1950s, and the time-histories of their atmospheric concentrations are shown in Figure \autoref{img_cfcatm}. 
     265As can be seen in the figure, while the concentration of SF6 continues to rise to the present day, concentrations of both CFC-11 and CFC-12 have levelled off and declined since around the 1990s. 
    189266These declines have been driven by the Montreal Protocol (effective since August 1989), which has banned the production of CFC-11 and CFC-12 (as well as other CFCs) because of their role in the depletion of 
    190 stratospheric ozone (O$_{3}$), critical in decreasing the flux of ultraviolet radiation to the Earth's surface. 
    191 Separate to this role in ozone-depletion, all three chemicals are significantly more potent greenhouse gases 
     267stratospheric ozone (O$_{3}$), critical in decreasing the flux of ultraviolet radiation to the Earth's surface. All three chemicals are also  significantly more potent greenhouse gases 
    192268than CO$_{2}$ (especially SF6), although their relatively low atmospheric concentrations limit their role in climate change. \\ 
    193269 
    … …  
    204280The ocean is a notable sink for all three gases, and their relatively recent occurrence in the atmosphere, coupled to the ease of making high precision measurements of their dissolved concentrations, has made them 
    205281valuable in oceanography. % for tracking interior ventilation and mixing. 
    206 Because they only enter the ocean via surface air-sea exchange, and are almost completely chemically and biologically inert, their distribution within the ocean interior reveals its ventilation via transport and mixing. 
    207 Measuring the dissolved concentrations of the gases -- as well as the mixing ratios between them -- shows circulation pathways within the ocean as well as water mass ages (i.e. the time since last contact with the 
     282Because they only enter the ocean via surface air-sea exchange, and are almost completely chemically and biologically inert, their distribution within the ocean interior reveals ventilation of the latter via transport and mixing. 
     283Measuring the dissolved concentrations of these gases -- as well as the mixing ratios between them -- shows circulation pathways within the ocean as well as water mass ages (i.e. the time since has been last in contact with the 
    208284atmosphere). 
    209 This feature of the gases has made them valuable across a wide range of oceanographic problems. 
    210 One use lies in ocean modelling, where they can be used to evaluate the realism of the circulation and 
    211 ventilation of models, key for understanding the behaviour of wider modelled marine biogeochemistry (e.g. \citep{dutay_2002,palmieri_2015}). \\ 
     285This feature has made them valuable across a wide range of oceanographic problems. 
     286In ocean modelling, they can be used to evaluate the realism of the simulated circulation and 
     287ventilation patterns, which is key for understanding the behaviour of modelled marine biogeochemistry (e.g. \citep{dutay_2002,palmieri_2015}). \\ 
    212288 
    213289Modelling these gases (henceforth CFCs) in NEMO is done within the passive tracer transport module, TOP, using the conservation state equation \autoref{Eq_tracer} 
    214290 
    215 Advection and diffusion of the CFCs in NEMO are calculated by the physical module, OPA, 
     291Advection and diffusion of the CFCs in NEMO are calculated by the physical module, TRP, 
    216292whereas sources and sinks are done by the CFC module within TOP. 
    217 The only source for CFCs in the ocean is via air-sea gas exchange at its surface, and since CFCs are generally 
     293The only source of CFCs to the ocean is via air-sea gas exchange at its surface, and since CFCs are generally 
    218294stable within the ocean, we assume that there are no sinks (i.e. no loss processes) within the ocean interior. 
    219295Consequently, the sinks-minus-sources term for CFCs consists only of their air-sea fluxes, $F_{cfc}$, as 
    … …  
    233309$C_{surf}$ is the local surface concentration of the CFC tracer within the model (in mol~m$^{-3}$); 
    234310and $f_{i}$ is the fractional sea-ice cover of the local ocean (ranging between 0.0 for ice-free ocean, 
    235 through to 1.0 for completely ice-covered ocean with no air-sea exchange). 
     311 to 1.0 for completely ice-covered ocean with no air-sea exchange). 
    236312 
    237313The saturation concentration of the CFC, $C_{sat}$, is calculated as follows: 
    … …  
    312388% AXY: consider an itemized list here if you've got a list of differences 
    313389 
    314 For instance, C$_{sat}$ is calculated for a fixed surface pressure of 1atm, what could be corrected in a further version of the module. 
     390For instance, C$_{sat}$ is calculated for a fixed surface pressure of 1atm. This may be corrected in a future version of the module. 
    315391 
    316392 
    … …  
    333409 
    334410\begin{table}[!t] 
    335 \caption{Coefficients for fit of the CFCs Schmidt number (Eq. \autoref{equ_Sc}). } 
     411\caption{Coefficients for fit of the CFCs Schmidt number (Eq. \autoref{equ_Sc}).} 
    336412\vskip4mm 
    337413\centering 
    … …  
    384460%---------------------------------------------------------------------------------------------------------- 
    385461 
    386 The C14 package implemented in NEMO by Anne Mouchet models ocean $\Dcq$. 
     462The C14 package has been implemented in NEMO by Anne Mouchet $\Dcq$. 
    387463It offers several possibilities: $\Dcq$ as a physical tracer of the ocean ventilation (natural $\cq$), assessment of bomb radiocarbon uptake, as well as transient studies of paleo-historical ocean radiocarbon distributions. 
    388464 
    … …  
    390466 
    391467Let  $\Rq$ represent the ratio of $\cq$ atoms to the total number of carbon atoms in the sample, i.e. $\cq/\mathrm{C}$. 
    392 Then, radiocarbon anomalies are reported as 
     468Then, radiocarbon anomalies are reported as: 
    393469 
    394470\begin{equation} 
    … …  
    397473 
    398474where $\Rq_{\textrm{ref}}$ is a reference ratio. 
    399 For the purpose of ocean ventilation studies $\Rq_{\textrm{ref}}$ is set to one. 
     475For the purpose of ocean ventilation studies, $\Rq_{\textrm{ref}}$ is set to one. 
    400476 
    401477Here we adopt the approach of \cite{fiadeiro_1982} and \cite{toggweiler_1989a,toggweiler_1989b} in which  the ratio $\Rq$ is transported rather than the individual concentrations C and $\cq$. 
    … …  
    464540The radiocarbon decay rate (\forcode{rlam14}; in \texttt{trcnam\_c14} module) is set to $\lambda=(1/8267)$ yr$^{-1}$ \citep{stuiver_1977}, which corresponds to a half-life of 5730 yr.\\[1pt] 
    465541% 
    466 The Schmidt number $Sc$, Eq. \autoref{eq:wanc14}, is calculated with the help of the formulation of \cite{wanninkhof_2014}. 
     542The Schmidt number $Sc$, Eq. \autoref{eq:wanc14}, is calculated using the formulation of \cite{wanninkhof_2014}. 
    467543The $\cd$ solubility $K_0$ in \autoref{eq:Rspeed} is taken from \cite{weiss_1974}. $K_0$ and $Sc$ are computed with the OGCM temperature and salinity fields (\texttt{trcsms\_c14} module).\\[1pt] 
    468544% 
    … …  
    522598\end{figure} 
    523599 
    524 Performing this type of experiment requires that a pre-industrial equilibrium run be performed beforehand (\forcode{ln\_rsttr} should be set to \texttt{.TRUE.}). 
    525  
    526 An exception to this rule is when wishing to perform a perturbation bomb experiment as was possible with the package \texttt{C14b}. 
     600Performing this type of experiment requires that a pre-industrial equilibrium run has been performed beforehand (\forcode{ln\_rsttr} should be set to \texttt{.TRUE.}). 
     601 
     602An exception to this rule is when performing a perturbation bomb experiment as was possible with the package \texttt{C14b}. 
    527603It is still possible to easily set-up that type of transient experiment for which no previous run is needed. 
    528 In addition to the instructions as given in this section it is however necessary to adapt the \texttt{atmc14.dat} file so that it does no longer contain any negative $\Dcq$ values (Suess effect in the pre-bomb period). 
     604In addition to the instructions given in this section, it is however necessary to adapt the \texttt{atmc14.dat} file so that it does no longer contain any negative $\Dcq$ values (Suess effect in the pre-bomb period). 
    529605 
    530606The model  is integrated from a given initial date following the observed records provided from 1765 AD on ( Fig. \autoref{fig:bomb}). 
    … …  
    535611Dates in these forcing files are expressed as yr AD. 
    536612 
    537 To ensure that the atmospheric forcing is applied properly as well as that output files contain consistent dates and inventories the experiment should be set up carefully: 
     613To ensure that the atmospheric forcing is applied properly as well as that output files contain consistent dates and inventories, the experiment should be set up carefully: 
    538614 
    539615\begin{itemize} 
    … …  
    543619\end{itemize} 
    544620 
    545 If the experiment date is outside the data time span then the first or last atmospheric concentrations are prescribed depending on whether the date is earlier or later. 
    546 Note that \forcode{tyrc14\_beg} (\texttt{namelist\_c14}) is not used in this context. 
     621If the experiment date is outside the data time span, the first or last atmospheric concentrations are then prescribed depending on whether the date is earlier or later. 
     622   Note that \forcode{tyrc14\_beg} (\texttt{namelist\_c14}) is not used in this context. 
    547623 
    548624% 
    … …  
    582658 
    583659All output fields in Table \autoref{tab:out} are routinely computed. 
    584 It depends on the actual settings in \texttt{iodef.xml} whether they are stored or not. 
     660It depends on the actual settings in \texttt{iodef.xml} whether they are saved or not. 
    585661% 
    586662\begin{table}[!h] 
    … …  
    645721\subsection{PISCES biogeochemical model} 
    646722 
    647 PISCES is a biogeochemical model which simulates the lower trophic levels of marine ecosystem (phytoplankton, microzooplankton and mesozooplankton) and the biogeochemical cycles of carbonand of the main nutrients (P, N, Fe, and Si). 
    648 The  model is intended to be used for both regional and global configurations at high or low spatial resolutions as well as for  short-term (seasonal, interannual) and long-term (climate change, paleoceanography) analyses. 
     723PISCES is a biogeochemical model that simulates the lower trophic levels of marine ecosystem (phytoplankton, microzooplankton, and mesozooplankton) and the biogeochemical cycles of carbon and of the main nutrients (P, N, Si, and Fe) (\autoref{img_piscesdesign} and \autoref{img_pisces}). 
     724 
     725\begin{figure}[ht] 
     726   \begin{center} 
     727      \vspace{0cm} 
     728      \includegraphics[width=0.80\textwidth]{Fig_PISCES_model} 
     729      \caption{Schematic view of the PISCES-v2 model (figure by Jorge Martinez-Rey).} 
     730      \label{img_piscesdesign} 
     731   \end{center} 
     732\end{figure} 
     733 
     734\begin{figure}[!h] 
     735   \centering 
     736   \includegraphics[width=0.80\textwidth]{PISCES_tracers} 
     737   \caption{Surface concentrations of NO$_{3}$, PO$_{4}$, total chlorophyll, and air-sea CO$_{2}$ flux from the last year of a 62-year simulation.} 
     738   \label{img_pisces} 
     739\end{figure} 
     740 
     741The  model is intended to be used for both regional and global configurations at high or low spatial resolutions as well as for short-term (seasonal, interannual) and long-term (climate change, paleoceanography) analyses.  
     742 
    649743Two versions of PISCES are available in NEMO v4.0 : 
    650744 
    651 PISCES-v2, by setting in namelist\_pisces\_ref  \np{ln\_p4z} to true,  can be seen as one of the many Monod models \citep{monod_1958}. 
    652 It assumes a constant Redfield ratio and phytoplankton growth depends on the external concentration in nutrients. 
    653 There are twenty-four prognostic variables (tracers) including two phytoplankton compartments  (diatoms and nanophytoplankton), two zooplankton size-classes (microzooplankton and  mesozooplankton) and a description of the carbonate chemistry. 
    654 Formulations in PISCES-v2 are based on a mixed Monod/Quota formalism: On one hand, stoichiometry of C/N/P is fixed and growth rate of phytoplankton is limited by the external availability in N, P and Si. 
    655 On the other hand, the iron and silicium quotas are variable and growth rate of phytoplankton is limited by the internal availability in Fe. 
    656 Various parameterizations can be activated in PISCES-v2, setting for instance the complexity of iron chemistry or the description of particulate organic materials. 
    657  
    658 PISCES-QUOTA has been built on the PISCES-v2 model described in \citet{aumont_2015}. 
    659 PISCES-QUOTA has thirty-nine prognostic compartments. 
    660 Phytoplankton growth can be controlled by five modeled limiting nutrients: Nitrate and Ammonium, Phosphate, Silicate and Iron. 
    661 Five living compartments are represented: Three phytoplankton size classes/groups corresponding to picophytoplankton, nanophytoplankton and diatoms, and two zooplankton size classes which are microzooplankton and mesozooplankton. 
    662 For phytoplankton, the prognostic variables are the carbon, nitrogen, phosphorus,  iron, chlorophyll and silicon biomasses (the latter only for diatoms). 
    663 This means that the N/C, P/C, Fe/C and Chl/C ratios of both phytoplankton groups as well as the Si/C ratio of diatoms are prognostically predicted  by the model. 
    664 Zooplankton are assumed to be strictly homeostatic \citep[e.g.,][]{sterner_2003,woods_2013,meunier_2014}. 
    665 As a consequence, the C/N/P/Fe ratios of these groups are maintained constant and are not allowed to vary. 
    666 In PISCES, the Redfield ratios C/N/P are set to 122/16/1 \citep{takahashi_1985} and the -O/C ratio is set to 1.34 \citep{kortzinger_2001}. 
    667 No silicified zooplankton is assumed. 
    668 The bacterial pool is not yet explicitly modeled. 
     745\begin{itemize} 
     746   \item PISCES-v2, by setting \textit{ln\_p4z} = \texttt{.true.} in \textit{namelist\_pisces\_ref}. This version can be seen as one of the many Monod models \citep{monod_1958}. It assumes a constant Redfield ratio and phytoplankton growth depends on the external concentration in nutrients. There are twenty-four prognostic variables (tracers) including two phytoplankton compartments  (diatoms and nanophytoplankton), two zooplankton size-classes (microzooplankton and  mesozooplankton) and a description of the carbonate chemistry. Formulations in PISCES-v2 are based on a mixed Monod/Quota formalism: On one hand, stoichiometry of C/N/P is fixed and growth rate of phytoplankton is limited by the external availability in N, P, and Si. On the other hand, the iron and silicium quotas are variable and growth rate of phytoplankton is limited by the internal availability in Fe. Various parameterizations can be activated in PISCES-v2, setting for instance the complexity of iron chemistry or the description of particulate organic materials. 
     747    
     748   \item PISCES-QUOTA, by setting \textit{ln\_p5z} = \texttt{.true.} in \textit{namelist\_pisces\_ref}. This version has been built on the PISCES-v2 model described in \citet{aumont_2015}. PISCES-QUOTA has thirty-nine prognostic compartments. Phytoplankton growth is controlled by five modeled limiting nutrients: Nitrate and Ammonium, Phosphate, Silicate, and Iron. Five living compartments are represented: Three phytoplankton size classes/groups corresponding to picophytoplankton, nanophytoplankton, and diatoms, and two zooplankton size classes, which are microzooplankton and mesozooplankton. For phytoplankton, the prognostic variables are the carbon, nitrogen, phosphorus,  iron, chlorophyll and silicon biomasses (the latter only for diatoms). This means that the N/C, P/C, Fe/C, and Chl/C ratios of the three phytoplankton groups as well as the Si/C ratio of diatoms are prognostically predicted by the model. Zooplankton are assumed to be strictly homeostatic \citep[e.g.,][]{sterner_2003,woods_2013,meunier_2014}. As a consequence, the C/N/P/Fe ratios of these groups are maintained constant and are not allowed to vary. In PISCES, the Redfield ratios C/N/P are set to 122/16/1 \citep{takahashi_1985} and the -O/C ratio is set to 1.34 \citep{kortzinger_2001}. No silicified zooplankton is assumed. The bacterial pool is not yet explicitly modeled. 
     749\end{itemize} 
    669750 
    670751There are three non-living compartments: Semi-labile dissolved organic matter, small sinking particles, and large sinking particles. 
    671752As a consequence of the variable stoichiometric ratios of phytoplankton and of the stoichiometric regulation of zooplankton, elemental ratios in organic matter cannot be supposed constant anymore as that was the case in PISCES-v2. 
    672 Indeed, the nitrogen, phosphorus, iron, silicon and calcite pools of the particles are now all explicitly modeled. 
     753Indeed, the nitrogen, phosphorus, iron, silicon, and calcite pools of the particles are now all explicitly modeled. 
    673754The sinking speed of the particles is not altered by their content in calcite and biogenic silicate (''The ballast effect'', \citep{honjo_1996,armstrong_2001}). 
    674755The latter particles are assumed to sink at the same speed as the large organic matter particles. 
    … …  
    678759\label{Mytrc} 
    679760 
    680 The NEMO-TOP has only one built-in biogeochemical model - PISCES - but there are several BGC models - MEDUSA, ERSEM, BFM or ECO3M - which are meant to be coupled with the NEMO dynamics. 
    681 Therefore it was necessary to provide to the users a framework for easily add their own BGCM model, that can be a single passive tracer. 
     761NEMO-TOP has one built-in biogeochemical model - PISCES - but there are several BGC models - MEDUSA, ERSEM, BFM or ECO3M - which are meant to be used within the NEMO plateform. 
     762Therefore it was necessary to provide to the users a framework to easily add their own BGCM model. 
    682763The generalized interface is pivoted on MY\_TRC module that contains template files to build the coupling between NEMO and any external BGC model. 
    683 The call to MY\_TRC is activated by setting  \textit{ln\_my\_trc} = \texttt{.true.} in namelist \textit{namtrc} 
     764Call to MY\_TRC is activated by setting  \textit{ln\_my\_trc} = \texttt{.true.} in namelist \textit{namtrc}.\\ 
    684765 
    685766The following 6 fortran files are available in MY\_TRC with the specific purposes here described. 
    … …  
    692773  \item \textit{trcsms\_my\_trc.F90} :  The routine performs the call to Boundary Conditions and its main purpose is to contain the Source-Minus-Sinks terms due to the biogeochemical processes of the external model. 
    693774Be aware that lateral boundary conditions are applied in trcnxt routine. 
    694 IMPORTANT: the routines to compute the light penetration along the water column and the tracer vertical sinking should be defined/called in here, as generalized modules are still missing in the code. 
    695  \item \textit{trcice\_my\_trc.F90} : Here it is possible to prescribe the tracers concentrations in the seaice that will be used as boundary conditions when ice melting occurs (nn\_ice\_tr =1 in namtrc\_ice). 
     775IMPORTANT: the routines to compute light penetration along the water column and the tracer vertical sinking should be defined/called in here, as generalized modules are still missing in the code. 
     776 \item \textit{trcice\_my\_trc.F90} : Here it is possible to prescribe the tracers concentrations in sea ice that will be used as boundary conditions when ice formation and melting occurs (nn\_ice\_tr =1 in namtrc\_ice). 
    696777See e.g. the correspondent PISCES subroutine. 
    697778 \item \textit{trcwri\_my\_trc.F90} : This routine performs the output of the model tracers using IOM module (see Manual Chapter Output and Diagnostics). 
    … …  
    702783\label{Offline} 
    703784 
    704 %------------------------------------------namtrc_sms---------------------------------------------------- 
    705 \nlst{namdta_dyn} 
    706 %------------------------------------------------------------------------------------------------------------- 
    707  
    708 Coupling passive tracers offline with NEMO requires precomputed  physical fields from OGCM. 
    709 Those fields are read from files and interpolated on-the-fly at each model time step 
    710 At least the following dynamical parameters should be absolutely passed to the transport : ocean velocities, temperature, salinity, mixed layer depth and for ecosystem models like PISCES, sea ice concentration, short wave radiation at the ocean surface, wind speed (or at least, wind stress). 
    711 The so-called offline mode is useful since it has lower computational costs for example to perform very longer simulations - about 3000 years - to reach equilibrium of CO2 sinks for climate-carbon studies. 
    712  
    713 The offline interface is located in the code repository : \path{<repository>/src/OFF/}. 
    714 It is activated by adding the CPP key  \textit{key\_offline} to the CPP keys list. 
    715 There are two specifics routines for the Offline code : 
     785Coupling passive tracers offline with NEMO requires precomputed physical fields 
     786 from OGCM. Those fields are read in files and interpolated on-the-fly at each model 
     787 time step. There are two sets of fields to perform offline simulations : 
    716788 
    717789\begin{itemize} 
    718    \item \textit{dtadyn.F90} :  this module allows to read and compute the dynamical fields at each model time-step 
    719    \item \textit{nemogcm.F90} :  a degraded version of the main nemogcm.F90 code of NEMO to manage the time-stepping 
     790   \item linear free surface ( ln\_linssh = .true. )  where the vertical scale factor is constant with time. At least, the following dynamical parameters should be absolutely passed 
     791   to transport : the effective ocean transport velocities (eulerian plus the eddy induced plus all others parameterizations), vertical diffusion coefficient and the freshwater flux 
     792. 
     793   %------------------------------------------namtrc_sms---------------------------------------------------- 
     794   \nlst{namdta_dyn_linssh} 
     795   %----------------------------------------------------------------------------------------------------------- 
     796   \item non linear free surface ( ln\_linssh = .false. or key\_qco ) : the same fields than the ones in the linear free surface case. In addition, the horizontal divergence transport is needed to  recompute the time evolution of the sea surface heigth and the vertical scale factor and depth, and thus the time evolution of the vertical transport velocity. 
     797   %------------------------------------------namtrc_sms---------------------------------------------------- 
     798   \nlst{namdta_dyn_nolinssh} 
     799   %----------------------------------------------------------------------------------------------------------- 
    720800\end{itemize} 
    721801 
    722 %- 
    723 %- 
    724 %- 
    725 %-  Describes here the specifities of oflline : At least the dynamical variables needed - u/v/w transport T/S for isopycnal MLD for biogeo models etc ... 
    726 %-  the specfities of vvl - ssh + runoffs and how to 
    727 %- 
     802Additionally, temperature, salinity, and mixed layer depth are needed to compute slopes for isopycnal diffusion. Some ecosystem models like PISCES need sea ice concentration, short-wave radiation at the ocean surface, and wind speed (or at least, wind stress).  
     803 
     804The so-called offline mode is useful since it has lower computational costs for example to perform very longer simulations – about 3000 years - to reach equilibrium of CO$_{2}$ sinks for climate-carbon studies. 
     805 
     806The offline interface is located in the code repository : <repository>/src/OFF/. It is activated by adding the\textit{ key\_offline} CPP key to the CPP keys list.  
     807There are 
     808two specifics routines for the offline code : 
     809\begin{itemize} 
     810   \item dtadyn.F90 : this module reads and computes the dynamical fields at 
     811each model time-step 
     812   \item nemogcm.F90 : a degraded version of the main nemogcm.F90 code of NEMO to 
     813manage the time-stepping 
     814\end{itemize} 
     815 
     816 
    728817\end{document} 

  • NEMO/branches/2021/ticket2669_isf_fluxes/doc/latex/TOP/subfiles/model_setup.tex

    r11591 r14994  
    55\chapter{ Model Setup} 
    66 
     7The usage of TOP is activated i) by including in the configuration definition the component TOP and ii) by adding the macro key\_top in the configuration CPP file (see for more details “Learn more about the model”). 
     8As an example, the user can refer to already available configurations in the code, ORCA2\_ICE\_PISCES being the NEMO biogeochemical demonstrator and GYRE\_BFM to see the required configuration elements to couple with an external biogeochemical model (see also Section 4).\\ 
     9Note that, since version 4.0, TOP interface core functionalities are activated by means of logical keys and all submodules preprocessing macros from previous versions were removed.\\ 
     10 
     11Below is the list of preprocessing keys that apply to the TOP interface (beside key\_top): 
     12\begin{itemize} 
     13   \item key\_xios use XIOS I/O 
     14   \item key\_agrif enables AGRIF coupling 
     15   \item key\_trdtrc and key\_trdmxl\_trc trend computation for tracers 
     16\end{itemize} 
     17 
     18There are only two entry points in the NEMOGCM model for passive tracers : 
     19\begin{itemize} 
     20   \item initialization (trcini) : general initialization of global variables and parameters of BGCM 
     21   \item time-stepping (trcstp) : time-evolution of SMS first, then time evolution of tracers by transport 
     22\end{itemize} 
     23 
    724\section{ Setting up a passive tracer configuration} 
    825%------------------------------------------namtrc_int---------------------------------------------------- 
    … …  
    1027%------------------------------------------------------------------------------------------------------------- 
    1128 
    12 The usage of TOP is activated 
    13  
    14 \begin{itemize} 
    15          \item by including in the configuration definition the component TOP\_SRC 
    16          \item by adding the macro \textit{key\_top} in the configuration cpp file 
    17 \end{itemize} 
    18  
    19 As an example, the user can refer to already available configurations in the code, GYRE\_PISCES being the NEMO biogeochemical demonstrator and GYRE\_BFM to see the required configuration elements to couple with an external biogeochemical model (see also section \S\ref{SMS_models}) . 
    20  
    21 Note that, since version 4.0, TOP interface core functionalities are activated by means of logical keys and all submodules preprocessing macros from previous versions were removed. 
    22  
    23 There are only three specific keys remaining in TOP 
    24  
    25 \begin{itemize} 
    26         \item \textit{key\_top} : to enables passive tracer module 
    27         \item \textit{key\_trdtrc} and \textit{key\_trdmxl\_trc} : trend computation for tracers 
    28 \end{itemize} 
    29  
    30 For a remind, the revisited structure of TOP interface now counts for five different modules handled in namelist\_top : 
     29As a reminder, the revisited structure of TOP interface now counts for five different modules handled in namelist\_top : 
    3130 
    3231\begin{itemize} 
    3332        \item \textbf{PISCES}, default BGC model 
    3433        \item \textbf{MY\_TRC}, template for creation of new modules couplings (maybe run a single passive tracer) 
    35         \item \textbf{CFC}, inert carbon tracers dynamics (CFC11,CFC12,SF6) Updated with OMIP-BGC guidelines (Orr et al, 2016) 
     34        \item \textbf{CFC}, inert tracers dynamics (CFC$_{11}$,CFC$_{12}$,SF$_{6}$) updated based on OMIP-BGC guidelines (Orr et al, 2016) 
    3635        \item \textbf{C14}, radiocarbon passive tracer 
    37         \item \textbf{AGE}, water age tracking revised implementation 
     36        \item \textbf{AGE}, water age tracking 
    3837\end{itemize} 
    3938 
    40 The modular approach was implemented also in the definition of the total number of passive tracers (jptra). This results from to user setting from the namelist \textit{namtrc} 
     39For inert, C14, and Age tracers, all variables settings (\textit{sn\_tracer} definitions) are hard-coded in \textit{trc\_nam\_*} routines. For instance, for Age tracer: 
     40%------------------------------------------namtrc_int---------------------------------------------------- 
     41\nlst{nam_trc_age} 
     42%--------------------------------------------------------------------------------------------------------- 
    4143 
    42 \section{ TOP Tracer Initialisation} 
     44The modular approach was also implemented in the definition of the total number of passive tracers (jptra) which is specified by the user in  \textit{namtrc} 
     45 
     46\section{ TOP Tracer Initialization} 
     47 
     48Two main types of data structure are used within TOP interface to initialize tracer properties and to provide related initial and boundary conditions.  
     49In addition to providing name and metadata for tracers, the use of initial and boundary conditions is also defined here (sn\_tracer). 
     50The data structure is internally initialized by the code with dummy names and all initialization/forcing logical fields are set to \textit{false} . 
     51Below are listed some features/options of the TOP interface accessible through the \textit{namelist\_top\_ref} and modifiable by means of \textit{namelist\_top\_cfg} (as for NEMO physical ones). 
     52 
     53There are three options to initialize TOP tracers in the \textit{namelist\_top } file: (1) initialization to hard-coded constant values when \textit{ln\_trcdta} at \textit{false}, (2) initialization from files when \textit{ln\_trcdta} at \textit{true}, and (3) initialisation from restart files by setting \textit{ln\_rsttr} to \textit{true} in \textit{namelist}. 
     54 
     55In the following, an example of the full structure definition is given for four tracers (DIC, Fe, NO$_{3}$, PHY) with initial conditions and different surface boundary and coastal forcings for DIC, Fe, and NO$_{3}$:  
     56 
     57%------------------------------------------namtrc_int---------------------------------------------------- 
     58\nlst{namtrc_cfg} 
     59%--------------------------------------------------------------------------------------------------------- 
     60 
     61You have to activate which tracers (\textit{sn\_tracer}) you want to initialize by setting them to \texttt{true} in the  column.  
     62 
     63\nlst{namtrc_dta_cfg} 
     64 
     65In \textit{namtrc\_dta}, you prescribe from which files the tracer are initialized (\textit{sn\_trcdta}).  
     66A multiplicative factor can also be set for each tracer (\textit{rn\_trfac}).  
     67 
    4368 
    4469\section{ TOP Boundaries Conditions} 
    4570 
     71\subsection{Surface and lateral boundaries} 
     72 
     73Lateral and surface boundary conditions for passive tracers are prescribed in \textit{namtrc\_bc} as well as whether temporal interpolation of these files is enabled. Here we show the cases of Fe and NO$_{3}$ from dust and rivers with different output frequencies. 
     74  
     75%------------------------------------------namtrc_bc---------------------------------------------------- 
     76\nlst{namtrc_bc_cfg} 
     77%--------------------------------------------------------------------------------------------------------- 
     78 
     79\subsection{Antartic Ice Sheet tracer supply} 
     80 
     81As a reminder, the supply of passive tracers from the AIS is currently implemented only for dissolved Fe. The activation of this Fe source is done by setting \textit{ln\_trcais} to \textit{true} and by adding the Fe tracer (\textit{sn\_tracer(2) = .true.}) in the 'ais' column in \textit{\&namtrc} (see section 2.2). \\ 
     82 
     83As the external source of Fe from the AIS is represented by associating  a sedimentary Fe content (with a solubility fraction) to the freshwater fluxes of icebergs and ice shelves, these fluxes have to be activated in \textit{namelist\_cfg}. The reading of the freshwater flux file from ice shelves is activated in \textit{namisf} with the namelist parameter \textit{ln\_isf} set to \textit{true}. 
     84 
     85You have to choose between two options depending whether the cavities under ice shelves are open or not in your grid configuration: 
     86\begin{itemize} 
     87   \item ln\_isfcav\_mlt = .false. (resolved cavities) 
     88   \item ln\_isfpar\_mlt = .true. (parameterized distribution for unopened cavities) 
     89\end{itemize} 
     90 
     91%------------------------------------------namisf---------------------------------------------------- 
     92\nlst{namisf_cfg_eORCA1} 
     93%----------------------------------------------------------------------------------------------------- 
     94 
     95Runoff from icebergs is activated by setting \textit{ln\_rnf\_icb} to \textit{true} in the \textit{\&namsbc\_rnf} section of \textit{namelist\_cfg}. 
     96 
     97%------------------------------------------namsbc_rnf-------------------------------------------------- 
     98\nlst{namsbc_rnf_cfg_eORCA1} 
     99%--------------------------------------------------------------------------------------------------------- 
     100 
     101The freshwater flux from ice shelves and icebergs is based on observations and modeled climatologies and is available for eORCA1 and eORCA025 grids : 
     102\begin{itemize} 
     103   \item runoff-icb\_DaiTrenberth\_Depoorter\_eORCA1\_JD.nc 
     104   \item runoff-icb\_DaiTrenberth\_Depoorter\_eORCA025\_JD.nc  
     105\end{itemize} 
     106 
     107%------------------------------------------namtrc_ais---------------------------------------------------- 
     108\nlst{namtrc_ais_cfg} 
     109%--------------------------------------------------------------------------------------------------------- 
     110 
     111Two options for tracer concentrations in iceberg and ice shelf can be set with the namelist parameter \textit{nn\_ais\_tr}: 
     112\begin{itemize} 
     113   \item 0 : null concentrations corresponding to dilution of BGC tracers due to freshwater fluxes from icebergs and ice shelves 
     114   \item 1 : prescribed concentrations set with the \textit{rn\_trafac} factor 
     115\end{itemize} 
     116 
     117The depth until which Fe from melting iceberg is delivered can be set with the namelist parameter \textit{rn\_icbdep}. The value of 120 m is the average underwater depth of the different iceberg size classes modeled by the NEMO iceberg module, which was used to produce the freshwater flux climatology of icebergs. 
     118 
     119 
    46120\end{document} 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src

    • Property svn:mergeinfo deleted

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/NST/agrif_oce_interp.F90

    r14433 r14994  
    4444   PUBLIC   interptsn, interpsshn, interpavm 
    4545   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    46    PUBLIC   interpe3t, interpglamt, interpgphit 
     46   PUBLIC   interpglamt, interpgphit 
    4747   PUBLIC   interpht0, interpmbkt, interpe3t0_vremap 
    4848   PUBLIC   agrif_istate_oce, agrif_istate_ssh   ! called by icestate.F90 and domvvl.F90 
    … …  
    216216      IF( lk_west ) THEN 
    217217         ibdy1 = nn_hls + 2                  ! halo + land + 1 
    218          ibdy2 = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox()   ! halo + land + nbghostcells 
     218         ibdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox()   ! halo + land + nbghostcells 
    219219         ! 
    220220         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    … …  
    265265      ! --- East --- ! 
    266266      IF( lk_east) THEN 
    267          ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhox()     
     267         ibdy1 = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()     
    268268         ibdy2 = jpiglo - ( nn_hls + 2 )                  
    269269         ! 
    … …  
    293293         END DO 
    294294         ! 
    295          ibdy1 = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()  
     295         ibdy1 = jpiglo - ( nn_hls + nbghostcells - 1 ) - nn_shift_bar*Agrif_Rhox()  
    296296         ibdy2 = jpiglo - ( nn_hls + 1 )      
    297297         ! 
    … …  
    326326      IF( lk_south ) THEN 
    327327         jbdy1 = nn_hls + 2                  
    328          jbdy2 = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()    
     328         jbdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()    
    329329         ! 
    330330         IF( .NOT.ln_dynspg_ts ) THEN 
    … …  
    375375      ! --- North --- ! 
    376376      IF( lk_north ) THEN 
    377          jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhoy()  
     377         jbdy1 = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()  
    378378         jbdy2 = jpjglo - ( nn_hls + 2 ) 
    379379         ! 
    … …  
    403403         END DO 
    404404         ! 
    405          jbdy1 = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()   
     405         jbdy1 = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()   
    406406         jbdy2 = jpjglo - ( nn_hls + 1 ) 
    407407         ! 
    … …  
    451451      IF( lk_west ) THEN 
    452452         istart = nn_hls + 2                              ! halo + land + 1 
    453          iend   = nn_hls + 1 + nbghostcells  + nn_shift_bar*Agrif_Rhox()              ! halo + land + nbghostcells 
     453         iend   = nn_hls + nbghostcells  + nn_shift_bar*Agrif_Rhox()              ! halo + land + nbghostcells 
    454454         DO ji = mi0(istart), mi1(iend) 
    455455            DO jj=1,jpj 
    … …  
    462462      !--- East ---! 
    463463      IF( lk_east ) THEN 
    464          istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()  
     464         istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()  
    465465         iend   = jpiglo - ( nn_hls + 1 )                 
    466466         DO ji = mi0(istart), mi1(iend) 
    … …  
    470470            END DO 
    471471         END DO 
    472          istart = jpiglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhox()  
     472         istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()  
    473473         iend   = jpiglo - ( nn_hls + 2 )                 
    474474         DO ji = mi0(istart), mi1(iend) 
    … …  
    482482      IF( lk_south ) THEN 
    483483         jstart = nn_hls + 2                               
    484          jend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()            
     484         jend   = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()            
    485485         DO jj = mj0(jstart), mj1(jend) 
    486486 
    … …  
    494494      !--- North ---! 
    495495      IF( lk_north ) THEN 
    496          jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()      
     496         jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()      
    497497         jend   = jpjglo - ( nn_hls + 1 )                 
    498498         DO jj = mj0(jstart), mj1(jend) 
    … …  
    501501            END DO 
    502502         END DO 
    503          jstart = jpjglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhoy()  
     503         jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()  
    504504         jend   = jpjglo - ( nn_hls + 2 )                 
    505505         DO jj = mj0(jstart), mj1(jend) 
    … …  
    529529      IF( lk_west ) THEN 
    530530         istart = nn_hls + 2                               
    531          iend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox()  
     531         iend   = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox()  
    532532         DO ji = mi0(istart), mi1(iend) 
    533533            DO jj=1,jpj 
    … …  
    540540      !--- East ---! 
    541541      IF( lk_east ) THEN 
    542          istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox() 
     542         istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() 
    543543         iend   = jpiglo - ( nn_hls + 1 )                  
    544544         DO ji = mi0(istart), mi1(iend) 
    … …  
    547547            END DO 
    548548         END DO 
    549          istart = jpiglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhox()  
     549         istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()  
    550550         iend   = jpiglo - ( nn_hls + 2 )                  
    551551         DO ji = mi0(istart), mi1(iend) 
    … …  
    559559      IF( lk_south ) THEN 
    560560         jstart = nn_hls + 2                               
    561          jend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()  
     561         jend   = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()  
    562562         DO jj = mj0(jstart), mj1(jend) 
    563563            DO ji=1,jpi 
    … …  
    570570      !--- North ---! 
    571571      IF( lk_north ) THEN 
    572          jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()  
     572         jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()  
    573573         jend   = jpjglo - ( nn_hls + 1 )                 
    574574         DO jj = mj0(jstart), mj1(jend) 
    … …  
    577577            END DO 
    578578         END DO 
    579          jstart = jpjglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhoy()  
     579         jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()  
    580580         jend   = jpjglo - ( nn_hls + 2 )                
    581581         DO jj = mj0(jstart), mj1(jend) 
    … …  
    672672      IF(lk_west) THEN 
    673673         istart = nn_hls + 2                                                          ! halo + land + 1 
    674          iend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox()               ! halo + land + nbghostcells 
     674         iend   = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox()               ! halo + land + nbghostcells 
    675675         DO ji = mi0(istart), mi1(iend) 
    676676            DO jj = 1, jpj 
    … …  
    682682      ! --- East --- ! 
    683683      IF(lk_east) THEN 
    684          istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()       ! halo + land + nbghostcells - 1 
     684         istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()       ! halo + land + nbghostcells - 1 
    685685         iend   = jpiglo - ( nn_hls + 1 )                                              ! halo + land + 1            - 1 
    686686         DO ji = mi0(istart), mi1(iend) 
    … …  
    694694      IF(lk_south) THEN 
    695695         jstart = nn_hls + 2                                                          ! halo + land + 1 
    696          jend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()               ! halo + land + nbghostcells 
     696         jend   = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()               ! halo + land + nbghostcells 
    697697         DO jj = mj0(jstart), mj1(jend) 
    698698            DO ji = 1, jpi 
    … …  
    704704      ! --- North --- ! 
    705705      IF(lk_north) THEN 
    706          jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()     ! halo + land + nbghostcells - 1 
     706         jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()     ! halo + land + nbghostcells - 1 
    707707         jend   = jpjglo - ( nn_hls + 1 )                                            ! halo + land + 1            - 1 
    708708         DO jj = mj0(jstart), mj1(jend) 
    … …  
    731731      IF(lk_west) THEN 
    732732         istart = nn_hls + 2                                                        ! halo + land + 1 
    733          iend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox()             ! halo + land + nbghostcells 
     733         iend   = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox()             ! halo + land + nbghostcells 
    734734         DO ji = mi0(istart), mi1(iend) 
    735735            DO jj = 1, jpj 
    … …  
    741741      ! --- East --- ! 
    742742      IF(lk_east) THEN 
    743          istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()    ! halo + land + nbghostcells - 1 
     743         istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()    ! halo + land + nbghostcells - 1 
    744744         iend   = jpiglo - ( nn_hls + 1 )                                           ! halo + land + 1            - 1 
    745745         DO ji = mi0(istart), mi1(iend) 
    … …  
    753753      IF(lk_south) THEN 
    754754         jstart = nn_hls + 2                                                        ! halo + land + 1 
    755          jend   = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()             ! halo + land + nbghostcells 
     755         jend   = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()             ! halo + land + nbghostcells 
    756756         DO jj = mj0(jstart), mj1(jend) 
    757757            DO ji = 1, jpi 
    … …  
    763763      ! --- North --- ! 
    764764      IF(lk_north) THEN 
    765          jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()    ! halo + land + nbghostcells - 1 
     765         jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()    ! halo + land + nbghostcells - 1 
    766766         jend   = jpjglo - ( nn_hls + 1 )                                           ! halo + land + 1            - 1 
    767767         DO jj = mj0(jstart), mj1(jend) 
    … …  
    14181418            DO jj=j1,j2 
    14191419               IF (utint_stage(ji,jj)==0) THEN  
    1420                   zx = 2._wp*MOD(ABS(mig0(ji)-nbghostcells-1), INT(Agrif_Rhox()))/zrhox - 1._wp   
     1420                  zx = 2._wp*MOD(ABS(mig0(ji)-nbghostcells), INT(Agrif_Rhox()))/zrhox - 1._wp   
    14211421                  ubdy(ji,jj) = ubdy(ji,jj) + 0.25_wp*(1._wp-zx*zx) * ptab(ji,jj) &  
    14221422                              &         / zrhoy *r1_e2u(ji,jj) * umask(ji,jj,1)  
    … …  
    15221522            DO jj=j1,j2 
    15231523               IF (vtint_stage(ji,jj)==0) THEN  
    1524                   zy = 2._wp*MOD(ABS(mjg0(jj)-nbghostcells-1), INT(Agrif_Rhoy()))/zrhoy - 1._wp   
     1524                  zy = 2._wp*MOD(ABS(mjg0(jj)-nbghostcells), INT(Agrif_Rhoy()))/zrhoy - 1._wp   
    15251525                  vbdy(ji,jj) = vbdy(ji,jj) + 0.25_wp*(1._wp-zy*zy) * ptab(ji,jj) &  
    15261526                              &         / zrhox * r1_e1v(ji,jj) * vmask(ji,jj,1)  
    … …  
    15331533      !  
    15341534   END SUBROUTINE vb2b_cor 
    1535  
    1536  
    1537    SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before ) 
    1538       !!---------------------------------------------------------------------- 
    1539       !!                  ***  ROUTINE interpe3t  *** 
    1540       !!----------------------------------------------------------------------   
    1541       INTEGER                              , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
    1542       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1543       LOGICAL                              , INTENT(in   ) :: before 
    1544       ! 
    1545       INTEGER :: ji, jj, jk 
    1546       !!----------------------------------------------------------------------   
    1547       !     
    1548       IF( before ) THEN 
    1549          ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 
    1550       ELSE 
    1551          ! 
    1552          DO jk = k1, k2 
    1553             DO jj = j1, j2 
    1554                DO ji = i1, i2 
    1555                   IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 
    1556                      WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ',  &  
    1557                      &                 ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 
    1558                      &                 mig0(ji), mjg0(jj), jk 
    1559                      kindic_agr = kindic_agr + 1 
    1560                   ENDIF 
    1561                END DO 
    1562             END DO 
    1563          END DO 
    1564          ! 
    1565       ENDIF 
    1566       !  
    1567    END SUBROUTINE interpe3t 
    15681535 
    15691536 
    … …  
    17931760      INTEGER, INTENT(inout) ::   iindic 
    17941761      !! 
    1795       INTEGER :: ji, jj 
     1762      INTEGER :: ji, jj, jk 
    17961763      INTEGER  :: istart, iend, jstart, jend, ispon 
    17971764      !!----------------------------------------------------------------------   
    … …  
    18021769         ispon  = nn_sponge_len * Agrif_irhox() 
    18031770         istart = nn_hls + 2                                  ! halo + land + 1 
    1804          iend   = nn_hls + 1 + nbghostcells + ispon           ! halo + land + nbghostcells + sponge 
    1805          jstart = nn_hls + 2 
     1771         iend   = nn_hls + nbghostcells + ispon           ! halo + land + nbghostcells + sponge 
     1772         jstart = nn_hls + 2  
     1773         jend   = jpjglo - nn_hls - 1  
     1774         DO ji = mi0(istart), mi1(iend) 
     1775            DO jj = mj0(jstart), mj1(jend) 
     1776               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1777               IF ( .NOT.ln_vert_remap) THEN 
     1778                  DO jk = 1, jpkm1 
     1779                     IF ( ABS(e3t0_parent(ji,jj,jk)-e3t_0(ji,jj,jk))*tmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1780                  END DO  
     1781               ENDIF 
     1782            END DO 
     1783            DO jj = mj0(jstart), mj1(jend-1) 
     1784               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1785               IF ( .NOT.ln_vert_remap) THEN 
     1786                  DO jk = 1, jpkm1 
     1787                     IF ( ABS(e3v0_parent(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1788                  END DO  
     1789               ENDIF 
     1790            END DO 
     1791         END DO 
     1792         DO ji = mi0(istart), mi1(iend-1) 
     1793            DO jj = mj0(jstart), mj1(jend) 
     1794               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1795               IF ( .NOT.ln_vert_remap) THEN 
     1796                  DO jk = 1, jpkm1 
     1797                     IF ( ABS(e3u0_parent(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1798                  END DO  
     1799               ENDIF 
     1800            END DO 
     1801         END DO 
     1802      ENDIF 
     1803      ! 
     1804      ! --- East --- ! 
     1805      IF(lk_east) THEN 
     1806         ispon  = nn_sponge_len * Agrif_irhox()  
     1807         istart = jpiglo - ( nn_hls + nbghostcells + ispon -1 )  ! halo + land + nbghostcells + sponge - 1 
     1808         iend   = jpiglo - nn_hls - 1                            ! halo + land + 1                     - 1 
     1809         jstart = nn_hls + 2  
    18061810         jend   = jpjglo - nn_hls - 1 
    18071811         DO ji = mi0(istart), mi1(iend) 
    18081812            DO jj = mj0(jstart), mj1(jend) 
    18091813               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1814               IF ( .NOT.ln_vert_remap) THEN 
     1815                  DO jk = 1, jpkm1 
     1816                     IF ( ABS(e3t0_parent(ji,jj,jk)-e3t_0(ji,jj,jk))*tmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1817                  END DO  
     1818               ENDIF 
    18101819            END DO 
    18111820            DO jj = mj0(jstart), mj1(jend-1) 
    18121821               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1822               IF ( .NOT.ln_vert_remap) THEN 
     1823                  DO jk = 1, jpkm1 
     1824                     IF ( ABS(e3v0_parent(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1825                  END DO  
     1826               ENDIF 
    18131827            END DO 
    18141828         END DO 
    … …  
    18161830            DO jj = mj0(jstart), mj1(jend) 
    18171831               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
    1818             END DO 
    1819          END DO 
    1820       ENDIF 
    1821       ! 
    1822       ! --- East --- ! 
    1823       IF(lk_east) THEN 
    1824          ispon  = nn_sponge_len * Agrif_irhox()  
    1825          istart = jpiglo - ( nn_hls + nbghostcells + ispon )  ! halo + land + nbghostcells + sponge - 1 
    1826          iend   = jpiglo - ( nn_hls + 1 )                     ! halo + land + 1                     - 1 
    1827          jstart = nn_hls + 2 
    1828          jend   = jpjglo - nn_hls - 1  
    1829          DO ji = mi0(istart), mi1(iend) 
    1830             DO jj = mj0(jstart), mj1(jend) 
    1831                IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
    1832             END DO 
    1833             DO jj = mj0(jstart), mj1(jend-1) 
    1834                IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
    1835             END DO 
    1836          END DO 
    1837          DO ji = mi0(istart+1), mi1(iend-1) 
    1838             DO jj = mj0(jstart), mj1(jend) 
    1839                IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1832               IF ( .NOT.ln_vert_remap) THEN 
     1833                  DO jk = 1, jpkm1 
     1834                     IF ( ABS(e3u0_parent(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1835                  END DO  
     1836               ENDIF 
    18401837            END DO 
    18411838         END DO 
    … …  
    18441841      ! --- South --- ! 
    18451842      IF(lk_south) THEN 
    1846          ispon  = nn_sponge_len * Agrif_irhoy()  
     1843         ispon  = nn_sponge_len * Agrif_irhoy()   
    18471844         jstart = nn_hls + 2                                 ! halo + land + 1 
    1848          jend   = nn_hls + 1 + nbghostcells + ispon          ! halo + land + nbghostcells + sponge 
    1849          istart = nn_hls + 2 
    1850          iend   = jpiglo - nn_hls - 1 
     1845         jend   = nn_hls + nbghostcells + ispon          ! halo + land + nbghostcells + sponge 
     1846         istart = nn_hls + 2  
     1847         iend   = jpiglo - nn_hls - 1  
    18511848         DO jj = mj0(jstart), mj1(jend) 
    18521849            DO ji = mi0(istart), mi1(iend) 
    18531850               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1851               IF ( .NOT.ln_vert_remap) THEN 
     1852                  DO jk = 1, jpkm1 
     1853                     IF ( ABS(e3t0_parent(ji,jj,jk)-e3t_0(ji,jj,jk))*tmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1854                  END DO  
     1855               ENDIF 
    18541856            END DO 
    18551857            DO ji = mi0(istart), mi1(iend-1) 
    18561858               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1859               IF ( .NOT.ln_vert_remap) THEN 
     1860                  DO jk = 1, jpkm1 
     1861                     IF ( ABS(e3u0_parent(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1862                  END DO  
     1863               ENDIF 
    18571864            END DO 
    18581865         END DO 
    … …  
    18601867            DO ji = mi0(istart), mi1(iend) 
    18611868               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1869               IF ( .NOT.ln_vert_remap) THEN 
     1870                  DO jk = 1, jpkm1 
     1871                     IF ( ABS(e3v0_parent(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1872                  END DO  
     1873               ENDIF 
    18621874            END DO 
    18631875         END DO 
    … …  
    18671879      IF(lk_north) THEN 
    18681880         ispon  = nn_sponge_len * Agrif_irhoy()  
    1869          jstart = jpjglo - ( nn_hls + nbghostcells + ispon)  ! halo + land + nbghostcells +sponge - 1 
    1870          jend   = jpjglo - ( nn_hls + 1 )                    ! halo + land + 1            - 1 
    1871          istart = nn_hls + 2 
    1872          iend   = jpiglo - nn_hls - 1 
     1881         jstart = jpjglo - ( nn_hls + nbghostcells + ispon - 1)  ! halo + land + nbghostcells +sponge - 1 
     1882         jend   = jpjglo - nn_hls - 1                            ! halo + land + 1            - 1 
     1883         istart = nn_hls + 2  
     1884         iend   = jpiglo - nn_hls - 1  
    18731885         DO jj = mj0(jstart), mj1(jend) 
    18741886            DO ji = mi0(istart), mi1(iend) 
    18751887               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1888               IF ( .NOT.ln_vert_remap) THEN 
     1889                  DO jk = 1, jpkm1 
     1890                     IF ( ABS(e3t0_parent(ji,jj,jk)-e3t_0(ji,jj,jk))*tmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1891                  END DO  
     1892               ENDIF 
    18761893            END DO 
    18771894            DO ji = mi0(istart), mi1(iend-1) 
    18781895               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
    1879             END DO 
    1880          END DO 
    1881          DO jj = mj0(jstart+1), mj1(jend-1) 
     1896               IF ( .NOT.ln_vert_remap) THEN 
     1897                  DO jk = 1, jpkm1 
     1898                     IF ( ABS(e3u0_parent(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1899                  END DO  
     1900               ENDIF 
     1901            END DO 
     1902         END DO 
     1903         DO jj = mj0(jstart), mj1(jend-1) 
    18821904            DO ji = mi0(istart), mi1(iend) 
    18831905               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1906               IF ( .NOT.ln_vert_remap) THEN 
     1907                  DO jk = 1, jpkm1 
     1908                     IF ( ABS(e3v0_parent(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1 
     1909                  END DO  
     1910               ENDIF 
    18841911            END DO 
    18851912         END DO 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/NST/agrif_oce_sponge.F90

    r14433 r14994  
    150150      ztabramp(:,:) = 0._wp 
    151151 
    152       IF( lk_west ) THEN                             ! --- West --- ! 
    153          ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    154          ind2 = nn_hls + 1 + nbghostcells + ispongearea  
     152      IF( lk_west ) THEN                            ! --- West --- ! 
     153         ind1 = nn_hls + nbghostcells               ! halo + nbghostcells 
     154         ind2 = nn_hls + nbghostcells + ispongearea  
    155155         DO ji = mi0(ind1), mi1(ind2)    
    156156            DO jj = 1, jpj                
    … …  
    160160         ! ghost cells: 
    161161         ind1 = 1 
    162          ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     162         ind2 = nn_hls +  nbghostcells              ! halo + nbghostcells 
    163163         DO ji = mi0(ind1), mi1(ind2)    
    164164            DO jj = 1, jpj                
    … …  
    168168      ENDIF 
    169169      IF( lk_east ) THEN                             ! --- East --- ! 
    170          ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea - 1 
    171          ind2 = jpiglo - ( nn_hls + nbghostcells ) - 1    ! halo + land + nbghostcells - 1 
     170         ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - ispongearea - 1 
     171         ind2 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1    ! halo + land + nbghostcells - 1 
    172172         DO ji = mi0(ind1), mi1(ind2) 
    173173            DO jj = 1, jpj 
    … …  
    176176         END DO 
    177177         ! ghost cells: 
    178          ind1 = jpiglo - ( nn_hls + nbghostcells ) - 1    ! halo + land + nbghostcells - 1 
     178         ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1    ! halo + land + nbghostcells - 1 
    179179         ind2 = jpiglo - 1 
    180180         DO ji = mi0(ind1), mi1(ind2) 
    … …  
    185185      ENDIF       
    186186      IF( lk_south ) THEN                            ! --- South --- ! 
    187          ind1 = nn_hls + 1 + nbghostcells                 ! halo + land + nbghostcells 
    188          ind2 = nn_hls + 1 + nbghostcells + jspongearea  
     187         ind1 = nn_hls + nbghostcells                ! halo + nbghostcells 
     188         ind2 = nn_hls + nbghostcells + jspongearea  
    189189         DO jj = mj0(ind1), mj1(ind2)  
    190190            DO ji = 1, jpi 
    … …  
    194194         ! ghost cells: 
    195195         ind1 = 1 
    196          ind2 = nn_hls + 1 + nbghostcells                 ! halo + land + nbghostcells 
     196         ind2 = nn_hls + nbghostcells                ! halo + nbghostcells 
    197197         DO jj = mj0(ind1), mj1(ind2)  
    198198            DO ji = 1, jpi 
    … …  
    202202      ENDIF 
    203203      IF( lk_north ) THEN                            ! --- North --- ! 
    204          ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea - 1 
    205          ind2 = jpjglo - ( nn_hls + nbghostcells ) - 1    ! halo + land + nbghostcells - 1 
     204         ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) - jspongearea - 1 
     205         ind2 = jpjglo - ( nn_hls + nbghostcells -1 ) - 1    ! halo + nbghostcells - 1 
    206206         DO jj = mj0(ind1), mj1(ind2) 
    207207            DO ji = 1, jpi 
    … …  
    210210         END DO 
    211211         ! ghost cells: 
    212          ind1 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     212         ind1 = jpjglo - ( nn_hls + nbghostcells -1 )      ! halo + land + nbghostcells - 1 
    213213         ind2 = jpjglo 
    214214         DO jj = mj0(ind1), mj1(ind2) 
    … …  
    284284 
    285285      IF( lk_west ) THEN                             ! --- West --- ! 
    286          ind1 = nn_hls + 1 + nbghostcells + ishift 
    287          ind2 = nn_hls + 1 + nbghostcells + ishift + ispongearea  
     286         ind1 = nn_hls + nbghostcells + ishift 
     287         ind2 = nn_hls + nbghostcells + ishift + ispongearea  
    288288         DO ji = mi0(ind1), mi1(ind2)    
    289289            DO jj = 1, jpj                
    … …  
    293293         ! ghost cells: 
    294294         ind1 = 1 
    295          ind2 = nn_hls + 1 + nbghostcells + ishift               ! halo + land + nbghostcells 
     295         ind2 = nn_hls + nbghostcells + ishift               ! halo + nbghostcells 
    296296         DO ji = mi0(ind1), mi1(ind2)    
    297297            DO jj = 1, jpj                
    … …  
    301301      ENDIF 
    302302      IF( lk_east ) THEN                             ! --- East --- ! 
    303          ind1 = jpiglo - ( nn_hls + nbghostcells + ishift) - ispongearea - 1 
    304          ind2 = jpiglo - ( nn_hls + nbghostcells + ishift) - 1    ! halo + land + nbghostcells - 1 
     303         ind1 = jpiglo - ( nn_hls + nbghostcells -1  + ishift) - ispongearea - 1 
     304         ind2 = jpiglo - ( nn_hls + nbghostcells -1  + ishift) - 1    ! halo + nbghostcells - 1 
    305305         DO ji = mi0(ind1), mi1(ind2) 
    306306            DO jj = 1, jpj 
    … …  
    309309         END DO 
    310310         ! ghost cells: 
    311          ind1 = jpiglo - ( nn_hls + nbghostcells + ishift) - 1    ! halo + land + nbghostcells - 1 
     311         ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1    ! halo + nbghostcells - 1 
    312312         ind2 = jpiglo - 1 
    313313         DO ji = mi0(ind1), mi1(ind2) 
    … …  
    318318      ENDIF       
    319319      IF( lk_south ) THEN                            ! --- South --- ! 
    320          ind1 = nn_hls + 1 + nbghostcells + jshift                ! halo + land + nbghostcells 
    321          ind2 = nn_hls + 1 + nbghostcells + jshift + jspongearea  
     320         ind1 = nn_hls + nbghostcells + jshift                ! halo + nbghostcells 
     321         ind2 = nn_hls + nbghostcells + jshift + jspongearea  
    322322         DO jj = mj0(ind1), mj1(ind2)  
    323323            DO ji = 1, jpi 
    … …  
    327327         ! ghost cells: 
    328328         ind1 = 1 
    329          ind2 = nn_hls + 1 + nbghostcells + jshift                ! halo + land + nbghostcells 
     329         ind2 = nn_hls + nbghostcells + jshift                ! halo + land + nbghostcells 
    330330         DO jj = mj0(ind1), mj1(ind2)  
    331331            DO ji = 1, jpi 
    … …  
    335335      ENDIF 
    336336      IF( lk_north ) THEN                            ! --- North --- ! 
    337          ind1 = jpjglo - ( nn_hls + nbghostcells + jshift) - jspongearea - 1 
    338          ind2 = jpjglo - ( nn_hls + nbghostcells + jshift) - 1    ! halo + land + nbghostcells - 1 
     337         ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - jspongearea - 1 
     338         ind2 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - 1    ! halo + land + nbghostcells - 1 
    339339         DO jj = mj0(ind1), mj1(ind2) 
    340340            DO ji = 1, jpi 
    … …  
    343343         END DO 
    344344         ! ghost cells: 
    345          ind1 = jpjglo - ( nn_hls + nbghostcells + jshift)      ! halo + land + nbghostcells - 1 
     345         ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift)      ! halo + land + nbghostcells - 1 
    346346         ind2 = jpjglo 
    347347         DO jj = mj0(ind1), mj1(ind2) 
    … …  
    741741 
    742742         jmax = j2-1 
    743          ind1 = jpjglo - ( nn_hls + nbghostcells + 2 )   ! North 
     743         ind1 = jpjglo - ( nn_hls + nbghostcells + 1 )   ! North 
    744744         DO jj = mj0(ind1), mj1(ind1)                  
    745745            jmax = MIN(jmax,jj) 
    … …  
    905905 
    906906         imax = i2 - 1 
    907          ind1 = jpiglo - ( nn_hls + nbghostcells + 2 )   ! East 
     907         ind1 = jpiglo - ( nn_hls + nbghostcells + 1 )   ! East 
    908908         DO ji = mi0(ind1), mi1(ind1)                 
    909909            imax = MIN(imax,ji) 
    … …  
    10051005 
    10061006         jmax = j2-1 
    1007          ind1 = jpjglo - ( nn_hls + nbghostcells + 2 )   ! North 
     1007         ind1 = jpjglo - ( nn_hls + nbghostcells + 1 )   ! North 
    10081008         DO jj = mj0(ind1), mj1(ind1)                  
    10091009            jmax = MIN(jmax,jj) 
    … …  
    10721072 
    10731073         imax = i2 - 1 
    1074          ind1 = jpiglo - ( nn_hls + nbghostcells + 2 )   ! East 
     1074         ind1 = jpiglo - ( nn_hls + nbghostcells + 1 )   ! East 
    10751075         DO ji = mi0(ind1), mi1(ind1)                 
    10761076            imax = MIN(imax,ji) 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/NST/agrif_oce_update.F90

    r14227 r14994  
    12841284      !!---------------------------------------------------------------------- 
    12851285      !  
    1286       IF (( .NOT.ln_agrif_2way ).OR.(.NOT.ln_chk_bathy).OR.(Agrif_Root())) RETURN 
     1286      IF (( .NOT.ln_agrif_2way ).OR.(.NOT.ln_chk_bathy) &  
     1287      & .OR.(.NOT.ln_vert_remap).OR.(Agrif_Root())) RETURN 
    12871288      ! 
    12881289      Agrif_UseSpecialValueInUpdate = .FALSE. 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/NST/agrif_user.F90

    r14433 r14994  
    5757      ! 
    5858      INTEGER :: ind1, ind2, ind3, imaxrho 
     59      INTEGER :: nbghostcellsfine_tot_x, nbghostcellsfine_tot_y 
    5960      INTEGER :: its 
    6061      External :: nemo_mapping 
    … …  
    7879      ! 1. Declaration of the type of variable which have to be interpolated 
    7980      !--------------------------------------------------------------------- 
    80       ind1 =              nbghostcells  
    81       ind2 = nn_hls + 2 + nbghostcells_x 
    82       ind3 = nn_hls + 2 + nbghostcells_y_s 
     81!      ind1 =              nbghostcells  
     82      ind2 = nn_hls + 1 + nbghostcells_x 
     83      ind3 = nn_hls + 1 + nbghostcells_y_s 
     84      nbghostcellsfine_tot_x = nbghostcells_x+1 
     85      nbghostcellsfine_tot_y = MAX(nbghostcells_y_s,nbghostcells_y_n)+1 
     86      ind1 = MAX(nbghostcellsfine_tot_x, nbghostcellsfine_tot_y) 
    8387      imaxrho = MAX(Agrif_irhox(), Agrif_irhoy()) 
    8488 
    … …  
    120124       ! 3. Location of interpolation 
    121125      !----------------------------- 
    122 !      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*imaxrho,ind1-1/) )   
    123 ! JC: check near the boundary only until matching in sponge has been sorted out: 
    124       CALL Agrif_Set_bc(    e3t_id, (/0,ind1-1/) )   
     126      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )   
    125127 
    126128      ! extend the interpolation zone by 1 more point than necessary: 
    127129      ! RB check here 
    128       CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1/) ) 
    129       CALL Agrif_Set_bc(        mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1/) ) 
    130       CALL Agrif_Set_bc(         ht0_id, (/-nn_sponge_len*imaxrho-2,ind1/) ) 
     130      CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 
     131      CALL Agrif_Set_bc(        mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 
     132      CALL Agrif_Set_bc(         ht0_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 
     133 
    131134      CALL Agrif_Set_bc(       tsini_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
    132135      CALL Agrif_Set_bc(        uini_id, (/0,ind1-1/) )  
    … …  
    142145#endif       
    143146 
    144    !   CALL Agrif_Set_ExternalMapping(nemo_mapping) 
     147      CALL Agrif_Set_ExternalMapping(nemo_mapping) 
    145148      ! 
    146149   END SUBROUTINE agrif_declare_var_ini 
    … …  
    222225      ! 
    223226      ! Build "intermediate" parent vertical grid on child domain 
    224       IF ( ln_vert_remap ) THEN 
    225  
    226          jpk_parent = Agrif_parent( jpk ) 
    227          ALLOCATE(e3t0_parent(jpi,jpj,jpk_parent), & 
    228             &     e3u0_parent(jpi,jpj,jpk_parent), & 
    229             &     e3v0_parent(jpi,jpj,jpk_parent), STAT = ierr)  
    230          IF( ierr  > 0 )   CALL ctl_warn('Agrif_Init_Domain: allocation of arrays failed') 
     227      jpk_parent = Agrif_parent( jpk ) 
     228      ALLOCATE(e3t0_parent(jpi,jpj,jpk_parent), & 
     229         &     e3u0_parent(jpi,jpj,jpk_parent), & 
     230         &     e3v0_parent(jpi,jpj,jpk_parent), STAT = ierr)  
     231      IF( ierr  > 0 )   CALL ctl_warn('Agrif_Init_Domain: allocation of arrays failed') 
    231232        
    232          ! Retrieve expected parent scale factors on child grid: 
    233          Agrif_UseSpecialValue = .FALSE. 
    234          e3t0_parent(:,:,:) = 0._wp 
    235          CALL Agrif_Init_Variable(e3t0_interp_id, procname=interpe3t0_vremap) 
    236          ! 
    237          ! Deduce scale factors at U and V points: 
    238          DO_3D( 0, 0, 0, 0, 1, jpk_parent ) 
    239             e3u0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji+1,jj  ,jk)) 
    240             e3v0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji  ,jj+1,jk)) 
    241          END_3D 
    242  
    243          ! Assume a step at the bottom except if (pure) s-coordinates 
    244          IF ( .NOT.Agrif_Parent(ln_sco) ) THEN  
    245             DO_2D( 1, 0, 1, 0 ) 
    246                jk = mbku_parent(ji,jj) 
    247                e3u0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji+1,jj  ,jk)) 
    248                jk = mbkv_parent(ji,jj) 
    249                e3v0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji  ,jj+1,jk)) 
    250             END_2D 
    251          ENDIF 
    252  
    253          CALL lbc_lnk( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp ) 
    254       ENDIF 
     233      ! Retrieve expected parent scale factors on child grid: 
     234      Agrif_UseSpecialValue = .FALSE. 
     235      e3t0_parent(:,:,:) = 0._wp 
     236      CALL Agrif_Init_Variable(e3t0_interp_id, procname=interpe3t0_vremap) 
     237      ! 
     238      ! Deduce scale factors at U and V points: 
     239      DO_3D( 0, 0, 0, 0, 1, jpk_parent ) 
     240         e3u0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji+1,jj  ,jk)) 
     241         e3v0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji  ,jj+1,jk)) 
     242      END_3D 
     243 
     244      ! Assume a step at the bottom except if (pure) s-coordinates 
     245      IF ( .NOT.Agrif_Parent(ln_sco) ) THEN  
     246         DO_2D( 1, 0, 1, 0 ) 
     247            jk = mbku_parent(ji,jj) 
     248            e3u0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji+1,jj  ,jk)) 
     249            jk = mbkv_parent(ji,jj) 
     250            e3v0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji  ,jj+1,jk)) 
     251         END_2D 
     252      ENDIF 
     253 
     254      CALL lbc_lnk( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp ) 
    255255 
    256256      ! check if masks and bathymetries match 
    … …  
    262262         ! 
    263263         kindic_agr = 0 
    264          IF( .NOT. ln_vert_remap ) THEN 
    265             ! 
    266             ! check if tmask and vertical scale factors agree with parent in sponge area: 
    267             CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
    268             ! 
    269          ELSE 
    270             ! 
    271             ! In case of vertical interpolation, check only that total depths agree between child and parent: 
    272                    
    273             CALL Agrif_check_bat( kindic_agr )            
    274          ENDIF 
     264         !          
     265         CALL Agrif_check_bat( kindic_agr )            
    275266         ! 
    276267         CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr ) 
    … …  
    287278      WHERE (ssmask(:,:)  == 0._wp) mbkt_parent(:,:) = 0 
    288279      ! 
     280      IF ( .NOT.ln_vert_remap ) DEALLOCATE(e3t0_parent, e3u0_parent, e3v0_parent) 
     281 
    289282   END SUBROUTINE Agrif_Init_Domain 
    290283 
    … …  
    440433      !--------------------------------------------------------------------- 
    441434      ind1 =              nbghostcells 
    442       ind2 = nn_hls + 2 + nbghostcells_x 
    443       ind3 = nn_hls + 2 + nbghostcells_y_s 
     435      ind2 = nn_hls + 1 + nbghostcells_x 
     436      ind3 = nn_hls + 1 + nbghostcells_y_s 
    444437      imaxrho = MAX(Agrif_irhox(), Agrif_irhoy()) 
    445438 
    … …  
    640633      !------------------------------------------------------------------------------------- 
    641634      ind1 =              nbghostcells 
    642       ind2 = nn_hls + 2 + nbghostcells_x 
    643       ind3 = nn_hls + 2 + nbghostcells_y_s 
     635      ind2 = nn_hls + 1 + nbghostcells_x 
     636      ind3 = nn_hls + 1 + nbghostcells_y_s 
    644637      ipl = jpl*(9+nlay_s+nlay_i) 
    645638      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) 
    … …  
    780773      !--------------------------------------------------------------------- 
    781774      ind1 =              nbghostcells 
    782       ind2 = nn_hls + 2 + nbghostcells_x 
    783       ind3 = nn_hls + 2 + nbghostcells_y_s 
     775      ind2 = nn_hls + 1 + nbghostcells_x 
     776      ind3 = nn_hls + 1 + nbghostcells_y_s 
    784777      imaxrho = MAX(Agrif_irhox(), Agrif_irhoy()) 
    785778 
    … …  
    862855 
    863856! JC => side effects of lines below to be checked: 
    864       lk_west  = .NOT. ( Agrif_Ix() == 1 ) 
    865       lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) -1 ) 
    866       lk_south = .NOT. ( Agrif_Iy() == 1 ) 
    867       lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) -1 ) 
    868       ! 
    869       ! Set the number of ghost cells according to periodicity 
    870       nbghostcells_x   = nbghostcells 
    871       nbghostcells_y_s = nbghostcells 
    872       nbghostcells_y_n = nbghostcells 
    873       ! 
    874       IF(    l_Iperio    )   nbghostcells_x   = 0 
    875       IF( .NOT. lk_south )   nbghostcells_y_s = 0 
    876       IF( .NOT. lk_north )   nbghostcells_y_n = 0 
    877       ! 
    878       ! Some checks 
    879       IF( (.NOT.ln_vert_remap).AND.(jpkglo>Agrif_Parent(jpkglo)) )                    CALL ctl_stop( 'STOP',    & 
    880          &   'agrif_nemo_init: Agrif children must have less or equal number of vertical levels without ln_vert_remap defined' )  
    881       IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x   + nbghostcells_x   )   CALL ctl_stop( 'STOP',    & 
    882          &   'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nn_hls + 2*nbghostcells_x' ) 
    883       IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n )   CALL ctl_stop( 'STOP',    & 
    884          &   'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' ) 
    885       IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
     857      IF (.not.agrif_root()) THEN 
     858         nbghostcells_x   = nbghostcells 
     859         nbghostcells_y_s = nbghostcells 
     860         nbghostcells_y_n = nbghostcells 
     861  
     862 
     863         lk_west  = .TRUE. 
     864         lk_east  = .TRUE. 
     865         lk_south = .TRUE. 
     866         lk_north = .TRUE. 
     867         ! 
     868         ! Correct number of ghost cells according to periodicity 
     869         ! 
     870         IF( l_Iperio         ) THEN ; lk_west  = .FALSE. ; lk_east = .FALSE. ; nbghostcells_x = 0 ; ENDIF 
     871         IF( Agrif_Iy() == 1  ) THEN ; lk_south = .FALSE. ; nbghostcells_y_s = 1 ; ENDIF 
     872         IF( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() ==  Agrif_Parent(Nj0glo) - 1 ) THEN ; lk_north = .FALSE. ; nbghostcells_y_n = 1 ; ENDIF 
     873         ! 
     874         ! Some checks 
     875         IF( (.NOT.ln_vert_remap).AND.(jpkglo>Agrif_Parent(jpkglo)) )                    CALL ctl_stop( 'STOP',    & 
     876           &   'agrif_nemo_init: Agrif children must have less or equal number of vertical levels without ln_vert_remap defined' )  
     877         IF( Ni0glo /= nbcellsx + nbghostcells_x + nbghostcells_x   )   CALL ctl_stop( 'STOP',    & 
     878           &   'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2*nbghostcells_x' ) 
     879         IF( Nj0glo /= nbcellsy + nbghostcells_y_s + nbghostcells_y_n )   CALL ctl_stop( 'STOP',    & 
     880           &   'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + nbghostcells_y_s + nbghostcells_y_n' ) 
     881         IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
     882      ELSE 
     883         ! Root grid 
     884         nbghostcells_x   = 1  
     885         nbghostcells_y_s = 1  
     886         nbghostcells_y_n = 1  
     887         IF ( l_Iperio.OR.l_NFold ) THEN 
     888           nbghostcells_x = 0 
     889         ENDIF 
     890         IF ( l_NFold ) THEN 
     891           nbghostcells_y_n = 0 ! for completeness 
     892         ENDIF 
     893      ENDIF 
    886894      ! 
    887895      ! 
    … …  
    973981      ENDIF 
    974982 
    975       IF( bounds(2,2,2) > jpjglo) THEN 
     983      IF(( bounds(2,2,2) > jpjglo).AND. ( l_NFold )) THEN 
    976984         IF( bounds(2,1,2) <=jpjglo) THEN 
    977985            nb_chunks = 2 
    … …  
    10651073         ENDIF 
    10661074 
    1067       ELSE IF (bounds(1,1,2) < 1) THEN 
     1075      ELSE IF ((bounds(1,1,2) < 1).AND.( l_Iperio )) THEN 
    10681076         IF (bounds(1,2,2) > 0) THEN 
    10691077            nb_chunks = 2 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/LBC/mppini.F90

    r14848 r14994  
    8989      ! 
    9090#if defined key_agrif 
    91     IF (.NOT.agrif_root()) THEN 
    9291      call agrif_nemo_init() 
    93     ENDIF 
    9492#endif 
    9593   END SUBROUTINE mpp_init 
    … …  
    307305 
    308306#if defined key_agrif 
    309       IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
    310307         CALL agrif_nemo_init() 
    311       ENDIF 
    312308#endif 
    313309      ! 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/OBS/diaobs.F90

    r14834 r14994  
    9999   CHARACTER(len=8), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
    100100 
     101#  include "domzgr_substitute.h90" 
    101102   !!---------------------------------------------------------------------- 
    102103   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    623624      INTEGER :: jtype             ! Data loop variable 
    624625      INTEGER :: jvar              ! Variable number 
    625       INTEGER :: ji, jj            ! Loop counters 
     626      INTEGER :: ji, jj, jk        ! Loop counters 
    626627      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    627628         & zprofvar                ! Model values for variables in a prof ob 
    … …  
    634635         & zglam,    &             ! Model longitudes for prof variables 
    635636         & zgphi                   ! Model latitudes for prof variables 
     637      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdept, zdepw 
    636638 
    637639      !----------------------------------------------------------------------- 
    … …  
    650652 
    651653      IF ( nproftypes > 0 ) THEN 
     654 
     655         ALLOCATE( zdept(jpi,jpj,jpk), zdepw(jpi,jpj,jpk) ) 
     656         DO jk = 1, jpk 
     657            zdept(:,:,jk) = gdept(:,:,jk,Kmm) 
     658            zdepw(:,:,jk) = gdepw(:,:,jk,Kmm) 
     659         END DO 
    652660 
    653661         DO jtype = 1, nproftypes 
    … …  
    687695                  &               nit000, idaystp, jvar,                   & 
    688696                  &               zprofvar(:,:,:,jvar),                    & 
    689                   &               gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm),      & 
     697                  &               zdept(:,:,:), zdepw(:,:,:),      & 
    690698                  &               zprofmask(:,:,:,jvar),                   & 
    691699                  &               zglam(:,:,jvar), zgphi(:,:,jvar),        & 
    … …  
    697705 
    698706         END DO 
     707 
     708         DEALLOCATE( zdept, zdepw ) 
    699709 
    700710      ENDIF 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/OBS/obs_prep.F90

    r14275 r14994  
    3333   PUBLIC   calc_month_len   ! Calculate the number of days in the months of a year 
    3434 
     35#  include "domzgr_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    10741075         & gdepw_1d,      & 
    10751076         & gdepw_0,       &                        
    1076          & gdepw,         & 
     1077         & gdepw, r3t,    & 
    10771078         & gdept,         & 
    10781079         & ln_zco,        & 
    … …  
    11281129         & zglam, &           ! Model longitude at grid points 
    11291130         & zgphi              ! Model latitude at grid points 
     1131      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepw 
    11301132      INTEGER, DIMENSION(2,2,kprofno) :: & 
    11311133         & igrdi, &           ! Grid i,j 
    … …  
    11861188      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
    11871189      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
    1188       CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdepw(:,:,:,Kmm), & 
    1189         &                     zgdepw ) 
     1190      DO jk = 1, jpk 
     1191         zdepw(:,:,jk) = gdepw(:,:,jk,Kmm) 
     1192      END DO 
     1193      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, zdepw(:,:,:), zgdepw ) 
    11901194 
    11911195      DO jobs = 1, kprofno 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/SBC/sbcwave.F90

    r14433 r14994  
    2424   USE bdy_oce        ! open boundary condition variables 
    2525   USE domvvl         ! domain: variable volume layers 
     26   USE zdf_oce,  ONLY : ln_zdfswm ! Qiao wave enhanced mixing  
    2627   ! 
    2728   USE iom            ! I/O manager library 
    … …  
    310311            IF( jp_vsd > 0 )   vt0sd(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) * tmask(:,:,1)  ! 2D meridional Stokes Drift at T point 
    311312         ENDIF 
     313 
     314         ! Read also wave number if needed, so that it is available in 
     315         ! coupling routines 
     316         IF( ln_zdfswm .AND. .NOT. cpl_wnum ) THEN     !==wavenumber==! 
     317            CALL fld_read( kt, nn_fsbc, sf_wn )             ! read wave parameters from external forcing 
     318            wnum(:,:) = sf_wn(1)%fnow(:,:,1) * tmask(:,:,1) 
     319         ENDIF 
     320  
    312321         ! 
    313322         IF( jpfld == 4 .OR. ln_wave_test )   & 
    … …  
    506515            ENDIF 
    507516            ! 
    508             ! 3. Wave number (only needed for Qiao parametrisation, ln_zdfqiao=T) 
    509             IF( .NOT. cpl_wnum ) THEN 
     517            ! 3. Wave number (only needed for Qiao parametrisation, ln_zdfswm=T) 
     518            IF( ln_zdfswm .AND. .NOT. cpl_wnum ) THEN 
    510519               ALLOCATE( sf_wn(1), STAT=ierror )           !* allocate and fill sf_wave with sn_wnum 
    511520               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wn structure' ) 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/traadv_qck.F90

    r14834 r14994  
    246246         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions 
    247247 
     248         ! Correct zfd on northfold after lbc_lnk; see #2640 
     249         IF( nn_hls == 1 .AND. l_IdoNFold .AND. ntej == Nje0 ) THEN 
     250            DO jk = 1, jpkm1 
     251               WHERE( tmask_i(ntsi:ntei,ntej:jpj) == 0._wp ) zfd(ntsi:ntei,ntej:jpj,jk) = zfc(ntsi:ntei,ntej:jpj,jk) 
     252            END DO 
     253         ENDIF 
    248254         ! 
    249255         ! Horizontal advective fluxes 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/traadv_qck_lf.F90

    r14834 r14994  
    111111      ! 
    112112      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
    113       CALL tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs ) 
    114       CALL tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs ) 
     113      CALL tra_adv_qck_i_lf( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs ) 
     114      CALL tra_adv_qck_j_lf( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs ) 
    115115 
    116116      !        ! vertical fluxes are computed with the 2nd order centered scheme 
    117       CALL tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs ) 
     117      CALL tra_adv_cen2_k_lf( kt, cdtype, pW, Kmm, pt, kjpt, Krhs ) 
    118118      ! 
    119119   END SUBROUTINE tra_adv_qck_lf 
    120120 
    121121 
    122    SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs ) 
     122   SUBROUTINE tra_adv_qck_i_lf( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs ) 
    123123      !!---------------------------------------------------------------------- 
    124124      !! 
    … …  
    193193      END DO 
    194194      ! 
    195    END SUBROUTINE tra_adv_qck_i 
    196  
    197  
    198    SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs ) 
     195   END SUBROUTINE tra_adv_qck_i_lf 
     196 
     197 
     198   SUBROUTINE tra_adv_qck_j_lf( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs ) 
    199199      !!---------------------------------------------------------------------- 
    200200      !! 
    … …  
    273273      END DO 
    274274      ! 
    275    END SUBROUTINE tra_adv_qck_j 
    276  
    277  
    278    SUBROUTINE tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs ) 
     275   END SUBROUTINE tra_adv_qck_j_lf 
     276 
     277 
     278   SUBROUTINE tra_adv_cen2_k_lf( kt, cdtype, pW, Kmm, pt, kjpt, Krhs ) 
    279279      !!---------------------------------------------------------------------- 
    280280      !! 
    … …  
    323323      END DO 
    324324      ! 
    325    END SUBROUTINE tra_adv_cen2_k 
     325   END SUBROUTINE tra_adv_cen2_k_lf 
    326326 
    327327 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/traadv_ubs.F90

    r14834 r14994  
    161161         END_3D 
    162162         ! 
    163          DO_3D( 1, 1, 1, 1, 1, jpk ) 
     163         DO_3D( 0, 0, 0, 0, 1, jpk ) 
    164164            zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs)      ! store the initial trends before its update 
    165165         END_3D 
    … …  
    175175         END DO 
    176176         ! 
    177          DO_3D( 1, 1, 1, 1, 1, jpk ) 
     177         DO_3D( 0, 0, 0, 0, 1, jpk ) 
    178178            zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltu(ji,jj,jk)  ! Horizontal advective trend used in vertical 2nd order FCT case 
    179179         END_3D                                                     ! and/or in trend diagnostic (l_trd=T) 
    … …  
    203203            ! 
    204204            !                               !*  upstream advection with initial mass fluxes & intermediate update  ==! 
    205             DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     205            DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    206206               zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 
    207207               zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) 
    … …  
    210210            IF( ln_linssh ) THEN                ! top ocean value (only in linear free surface as ztw has been w-masked) 
    211211               IF( ln_isfcav ) THEN                   ! top of the ice-shelf cavities and at the ocean surface 
    212                   DO_2D( 1, 1, 1, 1 ) 
     212                  DO_2D( 0, 0, 0, 0 ) 
    213213                     ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface 
    214214                  END_2D 
    215215               ELSE                                   ! no cavities: only at the ocean surface 
    216                   DO_2D( 1, 1, 1, 1 ) 
     216                  DO_2D( 0, 0, 0, 0 ) 
    217217                     ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 
    218218                  END_2D 
    … …  
    228228            ! 
    229229            !                          !*  anti-diffusive flux : high order minus low order 
    230             DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     230            DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    231231               ztw(ji,jj,jk) = (   0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   & 
    232232                  &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk) 
    … …  
    243243            END_3D 
    244244            IF( ln_linssh ) THEN 
    245                DO_2D( 1, 1, 1, 1 ) 
     245               DO_2D( 0, 0, 0, 0 ) 
    246246                  ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)     !!gm ISF & 4th COMPACT doesn't work 
    247247               END_2D 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/tradmp.F90

    r14718 r14994  
    5353   !! * Substitutions 
    5454#  include "do_loop_substitute.h90" 
     55#  include "domzgr_substitute.h90" 
    5556   !!---------------------------------------------------------------------- 
    5657   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    9697      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    9798      REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts)     ::  zts_dta 
     99      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE ::  zwrk 
    98100      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
    99101      !!---------------------------------------------------------------------- 
    … …  
    102104      ! 
    103105      IF( l_trdtra .OR. iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN   !* Save ta and sa trends 
    104          ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 
    105          ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) 
     106         ALLOCATE( ztrdts(A2D(nn_hls),jpk,jpts) ) 
     107         DO jn = 1, jpts 
     108            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     109               ztrdts(ji,jj,jk,jn) = pts(ji,jj,jk,jn,Krhs) 
     110            END_3D 
     111         END DO 
    106112      ENDIF 
    107113      !                           !==  input T-S data at kt  ==! 
    … …  
    141147      ! 
    142148      ! outputs (clem trunk) 
    143       IF( iom_use('hflx_dmp_cea') )       & 
    144          &   CALL iom_put('hflx_dmp_cea', & 
    145          &   SUM( ( pts(:,:,:,jp_tem,Krhs) - ztrdts(:,:,:,jp_tem) ) * e3t(:,:,:,Kmm), dim=3 ) * rcp * rho0 ) ! W/m2 
    146       IF( iom_use('sflx_dmp_cea') )       & 
    147          &   CALL iom_put('sflx_dmp_cea', & 
    148          &   SUM( ( pts(:,:,:,jp_sal,Krhs) - ztrdts(:,:,:,jp_sal) ) * e3t(:,:,:,Kmm), dim=3 ) * rho0 )       ! g/m2/s 
     149      IF( iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN 
     150         ALLOCATE( zwrk(A2D(nn_hls),jpk) )          ! Needed to handle expressions containing e3t when using key_qco or key_linssh 
     151         zwrk(:,:,:) = 0._wp 
     152 
     153         IF( iom_use('hflx_dmp_cea') ) THEN 
     154            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     155               zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_tem,Krhs) - ztrdts(ji,jj,jk,jp_tem) ) * e3t(ji,jj,jk,Kmm) 
     156            END_3D 
     157            CALL iom_put('hflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rcp * rho0 ) ! W/m2 
     158         ENDIF 
     159         IF( iom_use('sflx_dmp_cea') ) THEN 
     160            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     161               zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_sal,Krhs) - ztrdts(ji,jj,jk,jp_sal) ) * e3t(ji,jj,jk,Kmm) 
     162            END_3D 
     163            CALL iom_put('sflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rho0 )       ! g/m2/s 
     164         ENDIF 
     165 
     166         DEALLOCATE( zwrk ) 
     167      ENDIF 
    149168      ! 
    150169      IF( l_trdtra )   THEN       ! trend diagnostic 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/tramle.F90

    r14834 r14994  
    366366         r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  ) 
    367367         ! 
    368          ! Specifically, dbdx_mle, dbdy_mle and mld_prof need to be defined for nn_hls = 2 
    369          IF( nn_hls == 2 .AND. ln_osm_mle .AND. ln_zdfosm ) THEN 
    370             CALL ctl_stop('nn_hls = 2 cannot be used with ln_mle = ln_osm_mle = ln_zdfosm = T (zdfosm not updated for nn_hls = 2)') 
    371          ENDIF 
    372368      ENDIF 
    373369      ! 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/ZDF/zdfgls.F90

    r14834 r14994  
    2626   USE zdfmxl         ! mixed layer 
    2727   USE sbcwave , ONLY : hsw   ! significant wave height 
     28#if defined key_si3 
     29   USE ice, ONLY: hm_i, h_i 
     30#endif 
     31#if defined key_cice 
     32   USE sbc_ice, ONLY: h_i 
     33#endif 
    2834   ! 
    2935   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    … …  
    5157   LOGICAL  ::   ln_length_lim     ! use limit on the dissipation rate under stable stratification (Galperin et al. 1988) 
    5258   LOGICAL  ::   ln_sigpsi         ! Activate Burchard (2003) modification for k-eps closure & wave breaking mixing 
     59   INTEGER  ::   nn_mxlice         ! type of scaling under sea-ice (=0/1/2/3) 
    5360   INTEGER  ::   nn_bc_surf        ! surface boundary condition (=0/1) 
    5461   INTEGER  ::   nn_bc_bot         ! bottom boundary condition (=0/1) 
    … …  
    208215         zhsro(:,:) = rn_hsro 
    209216      CASE ( 1 )             ! Standard Charnock formula 
    210          zhsro(:,:) = MAX( rsbc_zs1 * ustar2_surf(A2D(nn_hls)) , rn_hsro ) 
     217         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     218            zhsro(ji,jj) = MAX( rsbc_zs1 * ustar2_surf(ji,jj) , rn_hsro ) 
     219         END_2D 
    211220      CASE ( 2 )             ! Roughness formulae according to Rascle et al., Ocean Modelling (2008) 
    212221!!gm faster coding : the 2 comment lines should be used 
    … …  
    222231      ! 
    223232      ! adapt roughness where there is sea ice 
    224       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    225          zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * rn_hsri )*tmask(ji,jj,1)  + & 
    226             &           (1._wp - tmask(ji,jj,1))*rn_hsro 
    227       END_2D 
     233      SELECT CASE( nn_mxlice )       ! Type of scaling under sea-ice 
     234      ! 
     235      CASE( 1 )                      ! scaling with constant sea-ice roughness 
     236         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     237            zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * rn_hsri )*tmask(ji,jj,1)  + (1._wp - tmask(ji,jj,1))*rn_hsro 
     238         END_2D 
     239         ! 
     240      CASE( 2 )                      ! scaling with mean sea-ice thickness 
     241#if defined key_si3 
     242         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     243            zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * hm_i(ji,jj) )*tmask(ji,jj,1)  + (1._wp - tmask(ji,jj,1))*rn_hsro 
     244         END_2D 
     245#endif 
     246         ! 
     247      CASE( 3 )                      ! scaling with max sea-ice thickness 
     248#if defined key_si3 || defined key_cice 
     249         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     250            zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * MAXVAL(h_i(ji,jj,:)) )*tmask(ji,jj,1)  + (1._wp - tmask(ji,jj,1))*rn_hsro 
     251         END_2D 
     252#endif 
     253         ! 
     254      END SELECT 
    228255      ! 
    229256      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  !==  Compute dissipation rate  ==! 
    … …  
    327354         END_2D 
    328355         ! 
     356         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
     357            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     358               IF( mikt(ji,jj) > 1 )THEN 
     359                  itop   = mikt(ji,jj)       ! k   top w-point 
     360                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
     361                  !                                                ! mask at the 
     362                  !                                                ocean surface 
     363                  !                                                points 
     364                  z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 
     365                  ! 
     366                  ! Dirichlet condition applied at: 
     367                  !     top level (itop)         &      Just below it (itopp1) 
     368                  zd_lw(ji,jj,itop) = 0._wp   ;   zd_lw(ji,jj,itopp1) = 0._wp 
     369                  zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp 
     370                  zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = 1._wp 
     371                  en   (ji,jj,itop) = z_en    ;   en   (ji,jj,itopp1) = z_en 
     372               ENDIF 
     373            END_2D 
     374         ENDIF 
    329375         ! 
    330376      CASE ( 1 )             ! Neumann boundary condition (set d(e)/dz) 
    … …  
    350396         END_2D 
    351397         ! 
     398         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
     399            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     400               IF( mikt(ji,jj) > 1 )THEN 
     401                  itop   = mikt(ji,jj)       ! k   top w-point 
     402                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
     403                  !                                                ! mask at the 
     404                  !                                                ocean surface 
     405                  !                                                points 
     406                  z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 
     407                  ! 
     408                  ! Bottom level Dirichlet condition: 
     409                  !     Bottom level (ibot)      &      Just above it (ibotm1) 
     410                  !         Dirichlet            !         Neumann 
     411                  zd_lw(ji,jj,itop) = 0._wp   !   ! Remove zd_up from zdiag 
     412                  zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1) 
     413                  zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp 
     414                  en   (ji,jj,itop) = z_en 
     415               ENDIF 
     416            END_2D 
     417         ENDIF 
    352418         ! 
    353419      END SELECT 
    … …  
    605671         END_2D 
    606672         ! 
     673         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
     674            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     675               IF ( mikt(ji,jj) > 1 ) THEN 
     676                  itop   = mikt(ji,jj)       ! k   top w-point 
     677                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
     678                  ! 
     679                  zdep(ji,jj) = vkarmn * r_z0_top 
     680                  psi (ji,jj,itop) = rc0**rpp * en(ji,jj,itop)**rmm *zdep(ji,jj)**rnn 
     681                  zd_lw(ji,jj,itop) = 0._wp 
     682                  zd_up(ji,jj,itop) = 0._wp 
     683                  zdiag(ji,jj,itop) = 1._wp 
     684                  ! 
     685                  ! Just above last level, Dirichlet condition again (GOTM like) 
     686                  zdep(ji,jj) = vkarmn * ( r_z0_top + e3t(ji,jj,itopp1,Kmm) ) 
     687                  psi (ji,jj,itopp1) = rc0**rpp * en(ji,jj,itop  )**rmm *zdep(ji,jj)**rnn 
     688                  zd_lw(ji,jj,itopp1) = 0._wp 
     689                  zd_up(ji,jj,itopp1) = 0._wp 
     690                  zdiag(ji,jj,itopp1) = 1._wp 
     691               END IF 
     692            END_2D 
     693         END IF 
     694         ! 
    607695      CASE ( 1 )             ! Neumman boundary condition 
    608696         ! 
    … …  
    629717            psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w(ji,jj,ibotm1,Kmm) 
    630718         END_2D 
     719         ! 
     720         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
     721            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     722               IF ( mikt(ji,jj) > 1 ) THEN 
     723                  itop   = mikt(ji,jj)       ! k   top w-point 
     724                  itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
     725                  ! 
     726                  ! Bottom level Dirichlet condition: 
     727                  zdep(ji,jj) = vkarmn * r_z0_top 
     728                  psi (ji,jj,itop) = rc0**rpp * en(ji,jj,itop)**rmm *zdep(ji,jj)**rnn 
     729                  ! 
     730                  zd_lw(ji,jj,itop) = 0._wp 
     731                  zd_up(ji,jj,itop) = 0._wp 
     732                  zdiag(ji,jj,itop) = 1._wp 
     733                  ! 
     734                  ! Just below cavity level: Neumann condition with flux 
     735                  ! injection 
     736                  zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1) ! Remove zd_up from zdiag 
     737                  zd_up(ji,jj,itopp1) = 0._wp 
     738                  ! 
     739                  ! Set psi vertical flux below cavity: 
     740                  zdep(ji,jj) = r_z0_top + 0.5_wp*e3t(ji,jj,itopp1,Kmm) 
     741                  zflxb = rsbc_psi2 * ( p_avm(ji,jj,itop) + p_avm(ji,jj,itopp1))   & 
     742                     &  * (0.5_wp*(en(ji,jj,itop)+en(ji,jj,itopp1)))**rmm * zdep(ji,jj)**(rnn-1._wp) 
     743                  psi(ji,jj,itopp1) = psi(ji,jj,itopp1) + zflxb / e3w(ji,jj,itopp1,Kmm) 
     744               END IF 
     745            END_2D 
     746         END IF 
     747 
    631748         ! 
    632749      END SELECT 
    … …  
    797914      NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim,       & 
    798915         &            rn_clim_galp, ln_sigpsi, rn_hsro, rn_hsri,   & 
    799          &            rn_crban, rn_charn, rn_frac_hs,              & 
     916         &            nn_mxlice, rn_crban, rn_charn, rn_frac_hs,   & 
    800917         &            nn_bc_surf, nn_bc_bot, nn_z0_met, nn_z0_ice, & 
    801918         &            nn_stab_func, nn_clos 
    … …  
    837954         WRITE(numout,*) '      Type of closure                               nn_clos        = ', nn_clos 
    838955         WRITE(numout,*) '      Surface roughness (m)                         rn_hsro        = ', rn_hsro 
    839          WRITE(numout,*) '      Ice-ocean roughness (used if nn_z0_ice/=0)    rn_hsri        = ', rn_hsri 
     956         WRITE(numout,*) '      type of scaling under sea-ice                 nn_mxlice      = ', nn_mxlice 
     957         IF( nn_mxlice == 1 ) & 
     958            WRITE(numout,*) '      Ice-ocean roughness (used if nn_z0_ice/=0) rn_hsri        = ', rn_hsri 
     959         SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
     960            CASE( 0 )   ;   WRITE(numout,*) '   ==>>>   No scaling under sea-ice' 
     961            CASE( 1 )   ;   WRITE(numout,*) '   ==>>>   scaling with constant sea-ice thickness' 
     962            CASE( 2 )   ;   WRITE(numout,*) '   ==>>>   scaling with mean     sea-ice thickness' 
     963            CASE( 3 )   ;   WRITE(numout,*) '   ==>>>   scaling with max      sea-ice thickness' 
     964            CASE DEFAULT 
     965               CALL ctl_stop( 'zdf_tke_init: wrong value for nn_mxlice, should be 0,1,2,3 ') 
     966         END SELECT 
    840967         WRITE(numout,*) 
    841968      ENDIF 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/ZDF/zdfosm.F90

    r14433 r14994  
    3434   !! 16/05/2019 (19) Fox-Kemper parametrization of restratification through mixed layer eddies added to revised code. 
    3535   !! 23/05/19   (20) Old code where key_osmldpth1` is *not* set removed, together with the key key_osmldpth1 
     36   !!             4.2  !  2021-05  (S. Mueller)  Efficiency improvements, source-code clarity enhancements, and adaptation to tiling 
    3637   !!---------------------------------------------------------------------- 
    3738 
    3839   !!---------------------------------------------------------------------- 
    39    !!   'ln_zdfosm'                                             OSMOSIS scheme 
     40   !!   'ln_zdfosm'                                          OSMOSIS scheme 
    4041   !!---------------------------------------------------------------------- 
    41    !!   zdf_osm       : update momentum and tracer Kz from osm scheme 
    42    !!   zdf_osm_init  : initialization, namelist read, and parameters control 
    43    !!   osm_rst       : read (or initialize) and write osmosis restart fields 
    44    !!   tra_osm       : compute and add to the T & S trend the non-local flux 
    45    !!   trc_osm       : compute and add to the passive tracer trend the non-local flux (TBD) 
    46    !!   dyn_osm       : compute and add to u & v trensd the non-local flux 
    47    !! 
    48    !! Subroutines in revised code. 
     42   !!   zdf_osm        : update momentum and tracer Kz from osm scheme 
     43   !!      zdf_osm_vertical_average             : compute vertical averages over boundary layers 
     44   !!      zdf_osm_velocity_rotation            : rotate velocity components 
     45   !!         zdf_osm_velocity_rotation_2d      :    rotation of 2d fields 
     46   !!         zdf_osm_velocity_rotation_3d      :    rotation of 3d fields 
     47   !!      zdf_osm_osbl_state                   : determine the state of the OSBL 
     48   !!      zdf_osm_external_gradients           : calculate gradients below the OSBL 
     49   !!      zdf_osm_calculate_dhdt               : calculate rate of change of hbl 
     50   !!      zdf_osm_timestep_hbl                 : hbl timestep 
     51   !!      zdf_osm_pycnocline_thickness         : calculate thickness of pycnocline 
     52   !!      zdf_osm_diffusivity_viscosity        : compute eddy diffusivity and viscosity profiles 
     53   !!      zdf_osm_fgr_terms                    : compute flux-gradient relationship terms 
     54   !!         zdf_osm_pycnocline_buoyancy_profiles : calculate pycnocline buoyancy profiles 
     55   !!      zdf_osm_zmld_horizontal_gradients    : calculate horizontal buoyancy gradients for use with Fox-Kemper parametrization 
     56   !!      zdf_osm_osbl_state_fk                : determine state of OSBL and MLE layers 
     57   !!      zdf_osm_mle_parameters               : timestep MLE depth and calculate MLE fluxes 
     58   !!   zdf_osm_init   : initialization, namelist read, and parameters control 
     59   !!      zdf_osm_alloc                        : memory allocation 
     60   !!   osm_rst        : read (or initialize) and write osmosis restart fields 
     61   !!   tra_osm        : compute and add to the T & S trend the non-local flux 
     62   !!   trc_osm        : compute and add to the passive tracer trend the non-local flux (TBD) 
     63   !!   dyn_osm        : compute and add to u & v trensd the non-local flux 
     64   !!   zdf_osm_iomput : iom_put wrapper that accepts arrays without halo 
     65   !!      zdf_osm_iomput_2d                    : iom_put wrapper for 2D fields 
     66   !!      zdf_osm_iomput_3d                    : iom_put wrapper for 3D fields 
    4967   !!---------------------------------------------------------------------- 
    50    USE oce            ! ocean dynamics and active tracers 
    51                       ! uses ww from previous time step (which is now wb) to calculate hbl 
    52    USE dom_oce        ! ocean space and time domain 
    53    USE zdf_oce        ! ocean vertical physics 
    54    USE sbc_oce        ! surface boundary condition: ocean 
    55    USE sbcwave        ! surface wave parameters 
    56    USE phycst         ! physical constants 
    57    USE eosbn2         ! equation of state 
    58    USE traqsr         ! details of solar radiation absorption 
    59    USE zdfddm         ! double diffusion mixing (avs array) 
    60    USE iom            ! I/O library 
    61    USE lib_mpp        ! MPP library 
    62    USE trd_oce        ! ocean trends definition 
    63    USE trdtra         ! tracers trends 
    64    ! 
    65    USE in_out_manager ! I/O manager 
    66    USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    67    USE prtctl         ! Print control 
    68    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     68   USE oce                       ! Ocean dynamics and active tracers 
     69   !                             ! Uses ww from previous time step (which is now wb) to calculate hbl 
     70   USE dom_oce                   ! Ocean space and time domain 
     71   USE zdf_oce                   ! Ocean vertical physics 
     72   USE sbc_oce                   ! Surface boundary condition: ocean 
     73   USE sbcwave                   ! Surface wave parameters 
     74   USE phycst                    ! Physical constants 
     75   USE eosbn2                    ! Equation of state 
     76   USE traqsr                    ! Details of solar radiation absorption 
     77   USE zdfdrg, ONLY : rCdU_bot   ! Bottom friction velocity 
     78   USE zdfddm                    ! Double diffusion mixing (avs array) 
     79   USE iom                       ! I/O library 
     80   USE lib_mpp                   ! MPP library 
     81   USE trd_oce                   ! Ocean trends definition 
     82   USE trdtra                    ! Tracers trends 
     83   USE in_out_manager            ! I/O manager 
     84   USE lbclnk                    ! Ocean lateral boundary conditions (or mpp link) 
     85   USE prtctl                    ! Print control 
     86   USE lib_fortran               ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    6987 
    7088   IMPLICIT NONE 
    7189   PRIVATE 
    7290 
    73    PUBLIC   zdf_osm       ! routine called by step.F90 
    74    PUBLIC   zdf_osm_init  ! routine called by nemogcm.F90 
    75    PUBLIC   osm_rst       ! routine called by step.F90 
    76    PUBLIC   tra_osm       ! routine called by step.F90 
    77    PUBLIC   trc_osm       ! routine called by trcstp.F90 
    78    PUBLIC   dyn_osm       ! routine called by step.F90 
    79  
    80    PUBLIC   ln_osm_mle    ! logical needed by tra_mle_init in tramle.F90 
    81  
    82    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamu    !: non-local u-momentum flux 
    83    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamv    !: non-local v-momentum flux 
    84    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamt    !: non-local temperature flux (gamma/<ws>o) 
    85    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghams    !: non-local salinity flux (gamma/<ws>o) 
    86    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean   !: averaging operator for avt 
    87    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hbl      !: boundary layer depth 
    88    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dh       ! depth of pycnocline 
    89    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hml      ! ML depth 
    90    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dstokes  !: penetration depth of the Stokes drift. 
    91  
    92    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)           ::   r1_ft    ! inverse of the modified Coriolis parameter at t-pts 
    93    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hmle     ! Depth of layer affexted by mixed layer eddies in Fox-Kemper parametrization 
    94    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dbdx_mle ! zonal buoyancy gradient in ML 
    95    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dbdy_mle ! meridional buoyancy gradient in ML 
    96    INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   mld_prof ! level of base of MLE layer. 
    97  
    98    !                      !!** Namelist  namzdf_osm  ** 
    99    LOGICAL  ::   ln_use_osm_la      ! Use namelist  rn_osm_la 
    100  
    101    LOGICAL  ::   ln_osm_mle           !: flag to activate the Mixed Layer Eddy (MLE) parameterisation 
    102  
    103    REAL(wp) ::   rn_osm_la          ! Turbulent Langmuir number 
    104    REAL(wp) ::   rn_osm_dstokes     ! Depth scale of Stokes drift 
    105    REAL(wp) ::   rn_zdfosm_adjust_sd = 1.0 ! factor to reduce Stokes drift by 
    106    REAL(wp) ::   rn_osm_hblfrac = 0.1! for nn_osm_wave = 3/4 specify fraction in top of hbl 
    107    LOGICAL  ::   ln_zdfosm_ice_shelter      ! flag to activate ice sheltering 
    108    REAL(wp) ::   rn_osm_hbl0 = 10._wp       ! Initial value of hbl for 1D runs 
    109    INTEGER  ::   nn_ave             ! = 0/1 flag for horizontal average on avt 
    110    INTEGER  ::   nn_osm_wave = 0    ! = 0/1/2 flag for getting stokes drift from La# / PM wind-waves/Inputs into sbcwave 
    111    INTEGER  ::   nn_osm_SD_reduce   ! = 0/1/2 flag for getting effective stokes drift from surface value 
    112    LOGICAL  ::   ln_dia_osm         ! Use namelist  rn_osm_la 
    113  
    114  
    115    LOGICAL  ::   ln_kpprimix  = .true.  ! Shear instability mixing 
    116    REAL(wp) ::   rn_riinfty   = 0.7     ! local Richardson Number limit for shear instability 
    117    REAL(wp) ::   rn_difri    =  0.005   ! maximum shear mixing at Rig = 0    (m2/s) 
    118    LOGICAL  ::   ln_convmix  = .true.   ! Convective instability mixing 
    119    REAL(wp) ::   rn_difconv = 1._wp     ! diffusivity when unstable below BL  (m2/s) 
    120  
    121 ! OSMOSIS mixed layer eddy parametrization constants 
    122    INTEGER  ::   nn_osm_mle             ! = 0/1 flag for horizontal average on avt 
    123    REAL(wp) ::   rn_osm_mle_ce           ! MLE coefficient 
    124    !                                        ! parameters used in nn_osm_mle = 0 case 
    125    REAL(wp) ::   rn_osm_mle_lf               ! typical scale of mixed layer front 
    126    REAL(wp) ::   rn_osm_mle_time             ! time scale for mixing momentum across the mixed layer 
    127    !                                        ! parameters used in nn_osm_mle = 1 case 
    128    REAL(wp) ::   rn_osm_mle_lat              ! reference latitude for a 5 km scale of ML front 
    129    LOGICAL  ::   ln_osm_hmle_limit           ! If true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 
    130    REAL(wp) ::   rn_osm_hmle_limit           ! If ln_osm_hmle_limit true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 
    131    REAL(wp) ::   rn_osm_mle_rho_c        ! Density criterion for definition of MLD used by FK 
    132    REAL(wp) ::   r5_21 = 5.e0 / 21.e0   ! factor used in mle streamfunction computation 
    133    REAL(wp) ::   rb_c                   ! ML buoyancy criteria = g rho_c /rho0 where rho_c is defined in zdfmld 
    134    REAL(wp) ::   rc_f                   ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_osm_mle=1 case 
    135    REAL(wp) ::   rn_osm_mle_thresh          ! Threshold buoyancy for deepening of MLE layer below OSBL base. 
    136    REAL(wp) ::   rn_osm_bl_thresh          ! Threshold buoyancy for deepening of OSBL base. 
    137    REAL(wp) ::   rn_osm_mle_tau             ! Adjustment timescale for MLE. 
    138  
    139  
    140    !                                    !!! ** General constants  ** 
    141    REAL(wp) ::   epsln   = 1.0e-20_wp   ! a small positive number to ensure no div by zero 
    142    REAL(wp) ::   depth_tol = 1.0e-6_wp  ! a small-ish positive number to give a hbl slightly shallower than gdepw 
    143    REAL(wp) ::   pthird  = 1._wp/3._wp  ! 1/3 
    144    REAL(wp) ::   p2third = 2._wp/3._wp  ! 2/3 
    145  
    146    INTEGER :: idebug = 236 
    147    INTEGER :: jdebug = 228 
     91   ! Public subroutines 
     92   PUBLIC zdf_osm        ! Routine called by step.F90 
     93   PUBLIC zdf_osm_init   ! Routine called by nemogcm.F90 
     94   PUBLIC osm_rst        ! Routine called by step.F90 
     95   PUBLIC tra_osm        ! Routine called by step.F90 
     96   PUBLIC trc_osm        ! Routine called by trcstp.F90 
     97   PUBLIC dyn_osm        ! Routine called by step.F90 
     98 
     99   ! Public variables 
     100   LOGICAL,  PUBLIC                                      ::   ln_osm_mle   !: Flag to activate the Mixed Layer Eddy (MLE) 
     101   !                                                                       !     parameterisation, needed by tra_mle_init in 
     102   !                                                                       !     tramle.F90 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamu        !: Non-local u-momentum flux 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamv        !: Non-local v-momentum flux 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamt        !: Non-local temperature flux (gamma/<ws>o) 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghams        !: Non-local salinity flux (gamma/<ws>o) 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hbl          !: Boundary layer depth 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hml          !: ML depth 
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hmle         !: Depth of layer affexted by mixed layer eddies in Fox-Kemper parametrization 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dbdx_mle     !: Zonal buoyancy gradient in ML 
     111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dbdy_mle     !: Meridional buoyancy gradient in ML 
     112   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   mld_prof     !: Level of base of MLE layer 
     113 
     114   INTERFACE zdf_osm_velocity_rotation 
     115      !!--------------------------------------------------------------------- 
     116      !!              ***  INTERFACE zdf_velocity_rotation  *** 
     117      !!--------------------------------------------------------------------- 
     118      MODULE PROCEDURE zdf_osm_velocity_rotation_2d 
     119      MODULE PROCEDURE zdf_osm_velocity_rotation_3d 
     120   END INTERFACE 
     121   ! 
     122   INTERFACE zdf_osm_iomput 
     123      !!--------------------------------------------------------------------- 
     124      !!                 ***  INTERFACE zdf_osm_iomput  *** 
     125      !!--------------------------------------------------------------------- 
     126      MODULE PROCEDURE zdf_osm_iomput_2d 
     127      MODULE PROCEDURE zdf_osm_iomput_3d 
     128   END INTERFACE 
     129 
     130   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean      ! Averaging operator for avt 
     131   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dh          ! Depth of pycnocline 
     132   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   r1_ft       ! Inverse of the modified Coriolis parameter at t-pts 
     133   ! Layer indices 
     134   INTEGER,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nbld        ! Level of boundary layer base 
     135   INTEGER,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nmld        ! Level of mixed-layer depth (pycnocline top) 
     136   ! Layer type 
     137   INTEGER,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   n_ddh       ! Type of shear layer 
     138   !                                                              !    n_ddh=0: active shear layer 
     139   !                                                              !    n_ddh=1: shear layer not active 
     140   !                                                              !    n_ddh=2: shear production low 
     141   ! Layer flags 
     142   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_conv      ! Unstable/stable bl 
     143   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_shear     ! Shear layers 
     144   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_coup      ! Coupling to bottom 
     145   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_pyc       ! OSBL pycnocline present 
     146   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_flux      ! Surface flux extends below OSBL into MLE layer 
     147   LOGICAL,  ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   l_mle       ! MLE layer increases in hickness. 
     148   ! Scales 
     149   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swth0       ! Surface heat flux (Kinematic) 
     150   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sws0        ! Surface freshwater flux 
     151   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swb0        ! Surface buoyancy flux 
     152   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   suw0        ! Surface u-momentum flux 
     153   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sustar      ! Friction velocity 
     154   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   scos_wind   ! Cos angle of surface stress 
     155   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ssin_wind   ! Sin angle of surface stress 
     156   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swthav      ! Heat flux - bl average 
     157   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swsav       ! Freshwater flux - bl average 
     158   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swbav       ! Buoyancy flux - bl average 
     159   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sustke      ! Surface Stokes drift 
     160   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dstokes     ! Penetration depth of the Stokes drift 
     161   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swstrl      ! Langmuir velocity scale 
     162   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   swstrc      ! Convective velocity scale 
     163   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sla         ! Trubulent Langmuir number 
     164   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   svstr       ! Velocity scale that tends to sustar for large Langmuir number 
     165   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   shol        ! Stability parameter for boundary layer 
     166   ! Layer averages: BL 
     167   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_t_bl     ! Temperature average 
     168   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_s_bl     ! Salinity average 
     169   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_u_bl     ! Velocity average (u) 
     170   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_v_bl     ! Velocity average (v) 
     171   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_b_bl     ! Buoyancy average 
     172   ! Difference between layer average and parameter at the base of the layer: BL 
     173   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_dt_bl    ! Temperature difference 
     174   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_ds_bl    ! Salinity difference 
     175   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_du_bl    ! Velocity difference (u) 
     176   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_dv_bl    ! Velocity difference (v) 
     177   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_db_bl    ! Buoyancy difference 
     178   ! Layer averages: ML 
     179   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_t_ml     ! Temperature average 
     180   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_s_ml     ! Salinity average 
     181   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_u_ml     ! Velocity average (u) 
     182   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_v_ml     ! Velocity average (v) 
     183   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_b_ml     ! Buoyancy average 
     184   ! Difference between layer average and parameter at the base of the layer: ML 
     185   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_dt_ml    ! Temperature difference 
     186   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_ds_ml    ! Salinity difference 
     187   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_du_ml    ! Velocity difference (u) 
     188   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_dv_ml    ! Velocity difference (v) 
     189   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_db_ml    ! Buoyancy difference 
     190   ! Layer averages: MLE 
     191   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_t_mle    ! Temperature average 
     192   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_s_mle    ! Salinity average 
     193   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_u_mle    ! Velocity average (u) 
     194   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_v_mle    ! Velocity average (v) 
     195   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   av_b_mle    ! Buoyancy average 
     196   ! Diagnostic output 
     197   REAL(WP), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   osmdia2d    ! Auxiliary array for diagnostic output 
     198   REAL(WP), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   osmdia3d    ! Auxiliary array for diagnostic output 
     199   LOGICAL  ::   ln_dia_pyc_scl = .FALSE.                         ! Output of pycnocline scalar-gradient profiles 
     200   LOGICAL  ::   ln_dia_pyc_shr = .FALSE.                         ! Output of pycnocline velocity-shear  profiles 
     201 
     202   !                                               !!* namelist namzdf_osm * 
     203   LOGICAL  ::   ln_use_osm_la                      ! Use namelist rn_osm_la 
     204   REAL(wp) ::   rn_osm_la                          ! Turbulent Langmuir number 
     205   REAL(wp) ::   rn_osm_dstokes                     ! Depth scale of Stokes drift 
     206   REAL(wp) ::   rn_zdfosm_adjust_sd   = 1.0_wp     ! Factor to reduce Stokes drift by 
     207   REAL(wp) ::   rn_osm_hblfrac        = 0.1_wp     ! For nn_osm_wave = 3/4 specify fraction in top of hbl 
     208   LOGICAL  ::   ln_zdfosm_ice_shelter              ! Flag to activate ice sheltering 
     209   REAL(wp) ::   rn_osm_hbl0           = 10.0_wp    ! Initial value of hbl for 1D runs 
     210   INTEGER  ::   nn_ave                             ! = 0/1 flag for horizontal average on avt 
     211   INTEGER  ::   nn_osm_wave = 0                    ! = 0/1/2 flag for getting stokes drift from La# / PM wind-waves/Inputs into 
     212   !                                                !    sbcwave 
     213   INTEGER  ::   nn_osm_SD_reduce                   ! = 0/1/2 flag for getting effective stokes drift from surface value 
     214   LOGICAL  ::   ln_dia_osm                         ! Use namelist  rn_osm_la 
     215   LOGICAL  ::   ln_kpprimix           = .TRUE.     ! Shear instability mixing 
     216   REAL(wp) ::   rn_riinfty            = 0.7_wp     ! Local Richardson Number limit for shear instability 
     217   REAL(wp) ::   rn_difri              = 0.005_wp   ! Maximum shear mixing at Rig = 0    (m2/s) 
     218   LOGICAL  ::   ln_convmix            = .TRUE.     ! Convective instability mixing 
     219   REAL(wp) ::   rn_difconv            = 1.0_wp     ! Diffusivity when unstable below BL  (m2/s) 
     220   ! OSMOSIS mixed layer eddy parametrization constants 
     221   INTEGER  ::   nn_osm_mle                         ! = 0/1 flag for horizontal average on avt 
     222   REAL(wp) ::   rn_osm_mle_ce                      ! MLE coefficient 
     223   !    Parameters used in nn_osm_mle = 0 case 
     224   REAL(wp) ::   rn_osm_mle_lf                      ! Typical scale of mixed layer front 
     225   REAL(wp) ::   rn_osm_mle_time                    ! Time scale for mixing momentum across the mixed layer 
     226   !    Parameters used in nn_osm_mle = 1 case 
     227   REAL(wp) ::   rn_osm_mle_lat                     ! Reference latitude for a 5 km scale of ML front 
     228   LOGICAL  ::   ln_osm_hmle_limit                  ! If true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 
     229   REAL(wp) ::   rn_osm_hmle_limit                  ! If ln_osm_hmle_limit true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 
     230   REAL(wp) ::   rn_osm_mle_rho_c                   ! Density criterion for definition of MLD used by FK 
     231   REAL(wp) ::   rb_c                               ! ML buoyancy criteria = g rho_c /rho0 where rho_c is defined in zdfmld 
     232   REAL(wp) ::   rc_f                               ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_osm_mle=1 case 
     233   REAL(wp) ::   rn_osm_mle_thresh                  ! Threshold buoyancy for deepening of MLE layer below OSBL base 
     234   REAL(wp) ::   rn_osm_bl_thresh                   ! Threshold buoyancy for deepening of OSBL base 
     235   REAL(wp) ::   rn_osm_mle_tau                     ! Adjustment timescale for MLE 
     236 
     237   ! General constants 
     238   REAL(wp) ::   epsln     = 1.0e-20_wp      ! A small positive number to ensure no div by zero 
     239   REAL(wp) ::   depth_tol = 1.0e-6_wp       ! A small-ish positive number to give a hbl slightly shallower than gdepw 
     240   REAL(wp) ::   pthird    = 1.0_wp/3.0_wp   ! 1/3 
     241   REAL(wp) ::   p2third   = 2.0_wp/3.0_wp   ! 2/3 
    148242 
    149243   !! * Substitutions 
    … …  
    161255      !!                 ***  FUNCTION zdf_osm_alloc  *** 
    162256      !!---------------------------------------------------------------------- 
    163      ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), & 
    164           &       hbl(jpi,jpj), dh(jpi,jpj), hml(jpi,jpj), dstokes(jpi, jpj), & 
    165           &       etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 
    166  
    167      ALLOCATE(  hmle(jpi,jpj), r1_ft(jpi,jpj), dbdx_mle(jpi,jpj), dbdy_mle(jpi,jpj), & 
    168           &       mld_prof(jpi,jpj), STAT= zdf_osm_alloc ) 
    169  
    170      CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 
    171      IF( zdf_osm_alloc /= 0 )   CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 
    172  
     257      INTEGER ::   ierr 
     258      !!---------------------------------------------------------------------- 
     259      ! 
     260      zdf_osm_alloc = 0 
     261      ! 
     262      ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk), ghams(jpi,jpj,jpk), hbl(jpi,jpj), hml(jpi,jpj),   & 
     263         &      hmle(jpi,jpj),      dbdx_mle(jpi,jpj),  dbdy_mle(jpi,jpj),  mld_prof(jpi,jpj),  STAT=ierr ) 
     264      zdf_osm_alloc = zdf_osm_alloc + ierr 
     265      ! 
     266      ALLOCATE( etmean(A2D(nn_hls-1),jpk), dh(jpi,jpj), r1_ft(A2D(nn_hls-1)), STAT=ierr ) 
     267      zdf_osm_alloc = zdf_osm_alloc + ierr 
     268      ! 
     269      ALLOCATE( nbld(jpi,jpj), nmld(A2D(nn_hls-1)), STAT=ierr ) 
     270      zdf_osm_alloc = zdf_osm_alloc + ierr 
     271      ! 
     272      ALLOCATE( n_ddh(A2D(nn_hls-1)), STAT=ierr ) 
     273      zdf_osm_alloc = zdf_osm_alloc + ierr 
     274      ! 
     275      ALLOCATE( l_conv(A2D(nn_hls-1)), l_shear(A2D(nn_hls-1)), l_coup(A2D(nn_hls-1)), l_pyc(A2D(nn_hls-1)),   & 
     276         &      l_flux(A2D(nn_hls-1)), l_mle(A2D(nn_hls-1)),   STAT=ierr ) 
     277      zdf_osm_alloc = zdf_osm_alloc + ierr 
     278      ! 
     279      ALLOCATE( swth0(A2D(nn_hls-1)),  sws0(A2D(nn_hls-1)),      swb0(A2D(nn_hls-1)),      suw0(A2D(nn_hls-1)),      & 
     280         &      sustar(A2D(nn_hls-1)), scos_wind(A2D(nn_hls-1)), ssin_wind(A2D(nn_hls-1)), swthav(A2D(nn_hls-1)),    & 
     281         &      swsav(A2D(nn_hls-1)),  swbav(A2D(nn_hls-1)),     sustke(A2D(nn_hls-1)),    dstokes(A2D(nn_hls-1)),   & 
     282         &      swstrl(A2D(nn_hls-1)), swstrc(A2D(nn_hls-1)),    sla(A2D(nn_hls-1)),       svstr(A2D(nn_hls-1)),     & 
     283         &      shol(A2D(nn_hls-1)),   STAT=ierr ) 
     284      zdf_osm_alloc = zdf_osm_alloc + ierr 
     285      ! 
     286      ALLOCATE( av_t_bl(jpi,jpj), av_s_bl(jpi,jpj), av_u_bl(jpi,jpj), av_v_bl(jpi,jpj),   & 
     287         &      av_b_bl(jpi,jpj), STAT=ierr) 
     288      zdf_osm_alloc = zdf_osm_alloc + ierr 
     289      ! 
     290      ALLOCATE( av_dt_bl(jpi,jpj), av_ds_bl(jpi,jpj), av_du_bl(jpi,jpj), av_dv_bl(jpi,jpj),   & 
     291         &      av_db_bl(jpi,jpj), STAT=ierr) 
     292      zdf_osm_alloc = zdf_osm_alloc + ierr 
     293      ! 
     294      ALLOCATE( av_t_ml(jpi,jpj), av_s_ml(jpi,jpj), av_u_ml(jpi,jpj), av_v_ml(jpi,jpj),   & 
     295         &      av_b_ml(jpi,jpj), STAT=ierr) 
     296      zdf_osm_alloc = zdf_osm_alloc + ierr 
     297      ! 
     298      ALLOCATE( av_dt_ml(jpi,jpj), av_ds_ml(jpi,jpj), av_du_ml(jpi,jpj), av_dv_ml(jpi,jpj),   & 
     299         &      av_db_ml(jpi,jpj), STAT=ierr) 
     300      zdf_osm_alloc = zdf_osm_alloc + ierr 
     301      ! 
     302      ALLOCATE( av_t_mle(jpi,jpj), av_s_mle(jpi,jpj), av_u_mle(jpi,jpj), av_v_mle(jpi,jpj),   & 
     303         &      av_b_mle(jpi,jpj), STAT=ierr) 
     304      zdf_osm_alloc = zdf_osm_alloc + ierr 
     305      ! 
     306      IF ( ln_dia_osm ) THEN 
     307         ALLOCATE( osmdia2d(jpi,jpj), osmdia3d(jpi,jpj,jpk), STAT=ierr ) 
     308         zdf_osm_alloc = zdf_osm_alloc + ierr 
     309      END IF 
     310      ! 
     311      CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 
     312      IF( zdf_osm_alloc /= 0 ) CALL ctl_warn( 'zdf_osm_alloc: failed to allocate zdf_osm arrays' ) 
     313      ! 
    173314   END FUNCTION zdf_osm_alloc 
    174315 
    175  
    176    SUBROUTINE zdf_osm( kt, Kbb, Kmm, Krhs, p_avm, p_avt ) 
     316   SUBROUTINE zdf_osm( kt, Kbb, Kmm, Krhs, p_avm,   & 
     317      &                p_avt ) 
    177318      !!---------------------------------------------------------------------- 
    178319      !!                   ***  ROUTINE zdf_osm  *** 
    … …  
    209350      !!         the equation number. (LMD94, here after) 
    210351      !!---------------------------------------------------------------------- 
    211       INTEGER                   , INTENT(in   ) ::  kt             ! ocean time step 
    212       INTEGER                   , INTENT(in   ) ::  Kbb, Kmm, Krhs ! ocean time level indices 
    213       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::  p_avm, p_avt   ! momentum and tracer Kz (w-points) 
    214       !! 
    215       INTEGER ::   ji, jj, jk                   ! dummy loop indices 
    216  
    217       INTEGER ::   jl                   ! dummy loop indices 
    218  
    219       INTEGER ::   ikbot, jkmax, jkm1, jkp2     ! 
    220  
    221       REAL(wp) ::   ztx, zty, zflageos, zstabl, zbuofdep,zucube      ! 
    222       REAL(wp) ::   zbeta, zthermal                                  ! 
    223       REAL(wp) ::   zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm ! Velocity scales 
    224       REAL(wp) ::   zwsun, zwmun, zcons, zconm, zwcons, zwconm       ! 
    225       REAL(wp) ::   zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed   ! In situ density 
    226       INTEGER  ::   jm                          ! dummy loop indices 
    227       REAL(wp) ::   zr1, zr2, zr3, zr4, zrhop   ! Compression terms 
    228       REAL(wp) ::   zflag, zrn2, zdep21, zdep32, zdep43 
    229       REAL(wp) ::   zesh2, zri, zfri            ! Interior richardson mixing 
    230       REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 
    231       REAL(wp) :: zt,zs,zu,zv,zrh               ! variables used in constructing averages 
    232 ! Scales 
    233       REAL(wp), DIMENSION(jpi,jpj) :: zrad0     ! Surface solar temperature flux (deg m/s) 
    234       REAL(wp), DIMENSION(jpi,jpj) :: zradh     ! Radiative flux at bl base (Buoyancy units) 
    235       REAL(wp), DIMENSION(jpi,jpj) :: zradav    ! Radiative flux, bl average (Buoyancy Units) 
    236       REAL(wp), DIMENSION(jpi,jpj) :: zustar    ! friction velocity 
    237       REAL(wp), DIMENSION(jpi,jpj) :: zwstrl    ! Langmuir velocity scale 
    238       REAL(wp), DIMENSION(jpi,jpj) :: zvstr     ! Velocity scale that ends to zustar for large Langmuir number. 
    239       REAL(wp), DIMENSION(jpi,jpj) :: zwstrc    ! Convective velocity scale 
    240       REAL(wp), DIMENSION(jpi,jpj) :: zuw0      ! Surface u-momentum flux 
    241       REAL(wp), DIMENSION(jpi,jpj) :: zvw0      ! Surface v-momentum flux 
    242       REAL(wp), DIMENSION(jpi,jpj) :: zwth0     ! Surface heat flux (Kinematic) 
    243       REAL(wp), DIMENSION(jpi,jpj) :: zws0      ! Surface freshwater flux 
    244       REAL(wp), DIMENSION(jpi,jpj) :: zwb0      ! Surface buoyancy flux 
    245       REAL(wp), DIMENSION(jpi,jpj) :: zwthav    ! Heat flux - bl average 
    246       REAL(wp), DIMENSION(jpi,jpj) :: zwsav     ! freshwater flux - bl average 
    247       REAL(wp), DIMENSION(jpi,jpj) :: zwbav     ! Buoyancy flux - bl average 
    248       REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent   ! Buoyancy entrainment flux 
    249       REAL(wp), DIMENSION(jpi,jpj) :: zwb_min 
    250  
    251  
    252       REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk_b  ! MLE buoyancy flux averaged over OSBL 
    253       REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk    ! max MLE buoyancy flux 
    254       REAL(wp), DIMENSION(jpi,jpj) :: zdiff_mle ! extra MLE vertical diff 
    255       REAL(wp), DIMENSION(jpi,jpj) :: zvel_mle  ! velocity scale for dhdt with stable ML and FK 
    256  
    257       REAL(wp), DIMENSION(jpi,jpj) :: zustke    ! Surface Stokes drift 
    258       REAL(wp), DIMENSION(jpi,jpj) :: zla       ! Trubulent Langmuir number 
    259       REAL(wp), DIMENSION(jpi,jpj) :: zcos_wind ! Cos angle of surface stress 
    260       REAL(wp), DIMENSION(jpi,jpj) :: zsin_wind ! Sin angle of surface stress 
    261       REAL(wp), DIMENSION(jpi,jpj) :: zhol      ! Stability parameter for boundary layer 
    262       LOGICAL, DIMENSION(jpi,jpj)  :: lconv     ! unstable/stable bl 
    263       LOGICAL, DIMENSION(jpi,jpj)  :: lshear    ! Shear layers 
    264       LOGICAL, DIMENSION(jpi,jpj)  :: lpyc      ! OSBL pycnocline present 
    265       LOGICAL, DIMENSION(jpi,jpj)  :: lflux     ! surface flux extends below OSBL into MLE layer. 
    266       LOGICAL, DIMENSION(jpi,jpj)  :: lmle      ! MLE layer increases in hickness. 
    267  
    268       ! mixed-layer variables 
    269  
    270       INTEGER, DIMENSION(jpi,jpj) :: ibld ! level of boundary layer base 
    271       INTEGER, DIMENSION(jpi,jpj) :: imld ! level of mixed-layer depth (pycnocline top) 
    272       INTEGER, DIMENSION(jpi,jpj) :: jp_ext, jp_ext_mle ! offset for external level 
    273       INTEGER, DIMENSION(jpi, jpj) :: j_ddh ! Type of shear layer 
    274  
    275       REAL(wp) :: ztgrad,zsgrad,zbgrad ! Temporary variables used to calculate pycnocline gradients 
    276       REAL(wp) :: zugrad,zvgrad        ! temporary variables for calculating pycnocline shear 
    277  
    278       REAL(wp), DIMENSION(jpi,jpj) :: zhbl  ! bl depth - grid 
    279       REAL(wp), DIMENSION(jpi,jpj) :: zhml  ! ml depth - grid 
    280  
    281       REAL(wp), DIMENSION(jpi,jpj) :: zhmle ! MLE depth - grid 
    282       REAL(wp), DIMENSION(jpi,jpj) :: zmld  ! ML depth on grid 
    283  
    284       REAL(wp), DIMENSION(jpi,jpj) :: zdh   ! pycnocline depth - grid 
    285       REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! BL depth tendency 
    286       REAL(wp), DIMENSION(jpi,jpj) :: zddhdt                                    ! correction to dhdt due to internal structure. 
    287       REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_bl_ext,zdsdz_bl_ext,zdbdz_bl_ext              ! external temperature/salinity and buoyancy gradients 
    288       REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_mle_ext,zdsdz_mle_ext,zdbdz_mle_ext              ! external temperature/salinity and buoyancy gradients 
    289       REAL(wp), DIMENSION(jpi,jpj) :: zdtdx, zdtdy, zdsdx, zdsdy      ! horizontal gradients for Fox-Kemper parametrization. 
    290  
    291       REAL(wp), DIMENSION(jpi,jpj) :: zt_bl,zs_bl,zu_bl,zv_bl,zb_bl  ! averages over the depth of the blayer 
    292       REAL(wp), DIMENSION(jpi,jpj) :: zt_ml,zs_ml,zu_ml,zv_ml,zb_ml  ! averages over the depth of the mixed layer 
    293       REAL(wp), DIMENSION(jpi,jpj) :: zt_mle,zs_mle,zu_mle,zv_mle,zb_mle  ! averages over the depth of the MLE layer 
    294       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 
    295       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 
    296       REAL(wp), DIMENSION(jpi,jpj) :: zdt_mle,zds_mle,zdu_mle,zdv_mle,zdb_mle ! difference between MLE 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 
    298       REAL(wp) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 
    299       REAL(wp) :: zuw_bse,zvw_bse  ! momentum fluxes at the top of the pycnocline 
    300       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz_pyc    ! parametrized gradient of temperature in pycnocline 
    301       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdsdz_pyc    ! parametrised gradient of salinity in pycnocline 
    302       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdbdz_pyc    ! parametrised gradient of buoyancy in the pycnocline 
    303       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz_pyc    ! u-shear across the pycnocline 
    304       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdvdz_pyc    ! v-shear across the pycnocline 
    305       REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle    ! Magnitude of horizontal buoyancy gradient. 
    306       ! Flux-gradient relationship variables 
    307       REAL(wp), DIMENSION(jpi, jpj) :: zshear, zri_i ! Shear production and interfacial richardon number. 
    308  
    309       REAL(wp) :: zl_c,zl_l,zl_eps  ! Used to calculate turbulence length scale. 
    310  
    311       REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! coefficients in cubic polynomial specifying diffusivity in pycnocline. 
    312       REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_1,zsc_ws_1 ! Temporary scales used to calculate scalar non-gradient terms. 
    313       REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_pyc, zsc_ws_pyc ! Scales for pycnocline transport term/ 
    314       REAL(wp), DIMENSION(jpi,jpj) :: zsc_uw_1,zsc_uw_2,zsc_vw_1,zsc_vw_2 ! Temporary scales for non-gradient momentum flux terms. 
    315       REAL(wp), DIMENSION(jpi,jpj) :: zhbl_t ! holds boundary layer depth updated by full timestep 
    316  
    317       ! For calculating Ri#-dependent mixing 
    318       REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3du   ! u-shear^2 
    319       REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3dv   ! v-shear^2 
    320       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrimix ! spatial form of ri#-induced diffusion 
    321  
    322       ! Temporary variables 
    323       INTEGER :: inhml 
    324       REAL(wp) :: znd,znd_d,zznd_ml,zznd_pyc,zznd_d ! temporary non-dimensional depths used in various routines 
    325       REAL(wp) :: ztemp, zari, zpert, zzdhdt, zdb   ! temporary variables 
    326       REAL(wp) :: zthick, zz0, zz1 ! temporary variables 
    327       REAL(wp) :: zvel_max, zhbl_s ! temporary variables 
    328       REAL(wp) :: zfac, ztmp       ! temporary variable 
    329       REAL(wp) :: zus_x, zus_y     ! temporary Stokes drift 
    330       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zviscos ! viscosity 
    331       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdiffut ! t-diffusivity 
    332       REAL(wp), DIMENSION(jpi,jpj) :: zalpha_pyc 
    333       REAL(wp), DIMENSION(jpi,jpj) :: ztau_sc_u ! dissipation timescale at baes of WML. 
    334       REAL(wp) :: zdelta_pyc, zwt_pyc_sc_1, zws_pyc_sc_1, zzeta_pyc 
    335       REAL(wp) :: zbuoy_pyc_sc, zomega, zvw_max 
    336       INTEGER :: ibld_ext=0                          ! does not have to be zero for modified scheme 
    337       REAL(wp) :: zgamma_b_nd, zgamma_b, zdhoh, ztau 
    338       REAL(wp) :: zzeta_s = 0._wp 
    339       REAL(wp) :: zzeta_v = 0.46 
    340       REAL(wp) :: zabsstke 
    341       REAL(wp) :: zsqrtpi, z_two_thirds, zproportion, ztransp, zthickness 
    342       REAL(wp) :: z2k_times_thickness, zsqrt_depth, zexp_depth, zdstokes0, zf, zexperfc 
    343  
    344       ! For debugging 
    345       INTEGER :: ikt 
    346       !!-------------------------------------------------------------------- 
    347       ! 
    348       ibld(:,:)   = 0     ; imld(:,:)  = 0 
    349       zrad0(:,:)  = 0._wp ; zradh(:,:) = 0._wp ; zradav(:,:)    = 0._wp ; zustar(:,:)    = 0._wp 
    350       zwstrl(:,:) = 0._wp ; zvstr(:,:) = 0._wp ; zwstrc(:,:)    = 0._wp ; zuw0(:,:)      = 0._wp 
    351       zvw0(:,:)   = 0._wp ; zwth0(:,:) = 0._wp ; zws0(:,:)      = 0._wp ; zwb0(:,:)      = 0._wp 
    352       zwthav(:,:) = 0._wp ; zwsav(:,:) = 0._wp ; zwbav(:,:)     = 0._wp ; zwb_ent(:,:)   = 0._wp 
    353       zustke(:,:) = 0._wp ; zla(:,:)   = 0._wp ; zcos_wind(:,:) = 0._wp ; zsin_wind(:,:) = 0._wp 
    354       zhol(:,:)   = 0._wp 
    355       lconv(:,:)  = .FALSE.; lpyc(:,:) = .FALSE. ; lflux(:,:) = .FALSE. ;  lmle(:,:) = .FALSE. 
    356       ! mixed layer 
    357       ! no initialization of zhbl or zhml (or zdh?) 
    358       zhbl(:,:)    = 1._wp ; zhml(:,:)    = 1._wp ; zdh(:,:)      = 1._wp ; zdhdt(:,:)   = 0._wp 
    359       zt_bl(:,:)   = 0._wp ; zs_bl(:,:)   = 0._wp ; zu_bl(:,:)    = 0._wp 
    360       zv_bl(:,:)   = 0._wp ; zb_bl(:,:)  = 0._wp 
    361       zt_ml(:,:)   = 0._wp ; zs_ml(:,:)    = 0._wp ; zu_ml(:,:)   = 0._wp 
    362       zt_mle(:,:)   = 0._wp ; zs_mle(:,:)    = 0._wp ; zu_mle(:,:)   = 0._wp 
    363       zb_mle(:,:) = 0._wp 
    364       zv_ml(:,:)   = 0._wp ; zdt_bl(:,:)   = 0._wp ; zds_bl(:,:)  = 0._wp 
    365       zdu_bl(:,:)  = 0._wp ; zdv_bl(:,:)  = 0._wp ; zdb_bl(:,:)  = 0._wp 
    366       zdt_ml(:,:)  = 0._wp ; zds_ml(:,:)  = 0._wp ; zdu_ml(:,:)   = 0._wp ; zdv_ml(:,:)  = 0._wp 
    367       zdb_ml(:,:)  = 0._wp 
    368       zdt_mle(:,:)  = 0._wp ; zds_mle(:,:)  = 0._wp ; zdu_mle(:,:)   = 0._wp 
    369       zdv_mle(:,:)  = 0._wp ; zdb_mle(:,:)  = 0._wp 
    370       zwth_ent = 0._wp ; zws_ent = 0._wp 
    371       ! 
    372       zdtdz_pyc(:,:,:) = 0._wp ; zdsdz_pyc(:,:,:) = 0._wp ; zdbdz_pyc(:,:,:) = 0._wp 
    373       zdudz_pyc(:,:,:) = 0._wp ; zdvdz_pyc(:,:,:) = 0._wp 
    374       ! 
    375       zdtdz_bl_ext(:,:) = 0._wp ; zdsdz_bl_ext(:,:) = 0._wp ; zdbdz_bl_ext(:,:) = 0._wp 
    376  
    377       IF ( ln_osm_mle ) THEN  ! only initialise arrays if needed 
    378          zdtdx(:,:) = 0._wp ; zdtdy(:,:) = 0._wp ; zdsdx(:,:) = 0._wp 
    379          zdsdy(:,:) = 0._wp ; dbdx_mle(:,:) = 0._wp ; dbdy_mle(:,:) = 0._wp 
    380          zwb_fk(:,:) = 0._wp ; zvel_mle(:,:) = 0._wp; zdiff_mle(:,:) = 0._wp 
    381          zhmle(:,:) = 0._wp  ; zmld(:,:) = 0._wp 
     352      INTEGER                   , INTENT(in   ) ::  kt               ! Ocean time step 
     353      INTEGER                   , INTENT(in   ) ::  Kbb, Kmm, Krhs   ! Ocean time level indices 
     354      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::  p_avm, p_avt     ! Momentum and tracer Kz (w-points) 
     355      !! 
     356      INTEGER ::   ji, jj, jk, jl, jm, jkflt   ! Dummy loop indices 
     357      !! 
     358      REAL(wp) ::   zthermal, zbeta 
     359      REAL(wp) ::   zesh2, zri, zfri   ! Interior Richardson mixing 
     360      !! Scales 
     361      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zrad0       ! Surface solar temperature flux (deg m/s) 
     362      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zradh       ! Radiative flux at bl base (Buoyancy units) 
     363      REAL(wp)                           ::   zradav      ! Radiative flux, bl average (Buoyancy Units) 
     364      REAL(wp)                           ::   zvw0        ! Surface v-momentum flux 
     365      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb0tot     ! Total surface buoyancy flux including insolation 
     366      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb_ent     ! Buoyancy entrainment flux 
     367      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb_min 
     368      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb_fk_b    ! MLE buoyancy flux averaged over OSBL 
     369      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwb_fk      ! Max MLE buoyancy flux 
     370      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdiff_mle   ! Extra MLE vertical diff 
     371      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zvel_mle    ! Velocity scale for dhdt with stable ML and FK 
     372      !! Mixed-layer variables 
     373      INTEGER,  DIMENSION(A2D(nn_hls-1)) ::   jk_nlev  ! Number of levels 
     374      INTEGER,  DIMENSION(A2D(nn_hls-1)) ::   jk_ext   ! Offset for external level 
     375      !! 
     376      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zhbl   ! BL depth - grid 
     377      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zhml   ! ML depth - grid 
     378      !! 
     379      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zhmle   ! MLE depth - grid 
     380      REAL(wp), DIMENSION(A2D(nn_hls))   ::   zmld    ! ML depth on grid 
     381      !! 
     382      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdh                          ! Pycnocline depth - grid 
     383      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdhdt                        ! BL depth tendency 
     384      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdtdz_bl_ext, zdsdz_bl_ext   ! External temperature/salinity gradients 
     385      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdbdz_bl_ext                 ! External buoyancy gradients 
     386      REAL(wp), DIMENSION(A2D(nn_hls))   ::   zdtdx, zdtdy, zdsdx, zdsdy   ! Horizontal gradients for Fox-Kemper parametrization 
     387      !! 
     388      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdbds_mle   ! Magnitude of horizontal buoyancy gradient 
     389      !! Flux-gradient relationship variables 
     390      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zshear   ! Shear production 
     391      !! 
     392      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zhbl_t   ! Holds boundary layer depth updated by full timestep 
     393      !! For calculating Ri#-dependent mixing 
     394      REAL(wp), DIMENSION(A2D(nn_hls)) ::   z2du     ! u-shear^2 
     395      REAL(wp), DIMENSION(A2D(nn_hls)) ::   z2dv     ! v-shear^2 
     396      REAL(wp)                         ::   zrimix   ! Spatial form of ri#-induced diffusion 
     397      !! Temporary variables 
     398      REAL(wp)                                 ::   znd              ! Temporary non-dimensional depth 
     399      REAL(wp)                                 ::   zz0, zz1, zfac 
     400      REAL(wp)                                 ::   zus_x, zus_y     ! Temporary Stokes drift 
     401      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk)   ::   zviscos          ! Viscosity 
     402      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk)   ::   zdiffut          ! t-diffusivity 
     403      REAL(wp)                                 ::   zabsstke 
     404      REAL(wp)                                 ::   zsqrtpi, z_two_thirds, zthickness 
     405      REAL(wp)                                 ::   z2k_times_thickness, zsqrt_depth, zexp_depth, zf, zexperfc 
     406      !! For debugging 
     407      REAL(wp), PARAMETER ::   pp_large = -1e10_wp 
     408      !!---------------------------------------------------------------------- 
     409      ! 
     410      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     411         nmld(ji,jj)   = 0 
     412         sustke(ji,jj) = pp_large 
     413         l_pyc(ji,jj)  = .FALSE. 
     414         l_flux(ji,jj) = .FALSE. 
     415         l_mle(ji,jj)  = .FALSE. 
     416      END_2D 
     417      ! Mixed layer 
     418      ! No initialization of zhbl or zhml (or zdh?) 
     419      zhbl(:,:) = pp_large 
     420      zhml(:,:) = pp_large 
     421      zdh(:,:)  = pp_large 
     422      ! 
     423      IF ( ln_osm_mle ) THEN   ! Only initialise arrays if needed 
     424         zdtdx(:,:)  = pp_large ; zdtdy(:,:)    = pp_large ; zdsdx(:,:)     = pp_large 
     425         zdsdy(:,:)  = pp_large 
     426         zwb_fk(:,:) = pp_large ; zvel_mle(:,:) = pp_large 
     427         zhmle(:,:)  = pp_large ; zmld(:,:)     = pp_large 
     428         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     429            dbdx_mle(ji,jj) = pp_large 
     430            dbdy_mle(ji,jj) = pp_large 
     431         END_2D 
    382432      ENDIF 
    383       zwb_fk_b(:,:) = 0._wp   ! must be initialised even with ln_osm_mle=F as used in zdf_osm_calculate_dhdt 
    384  
    385       ! Flux-Gradient arrays. 
    386       zsc_wth_1(:,:)  = 0._wp ; zsc_ws_1(:,:)   = 0._wp ; zsc_uw_1(:,:)   = 0._wp 
    387       zsc_uw_2(:,:)   = 0._wp ; zsc_vw_1(:,:)   = 0._wp ; zsc_vw_2(:,:)   = 0._wp 
    388       zhbl_t(:,:)     = 0._wp ; zdhdt(:,:)      = 0._wp 
    389  
    390       zdiffut(:,:,:) = 0._wp ; zviscos(:,:,:) = 0._wp ; ghamt(:,:,:) = 0._wp 
    391       ghams(:,:,:)   = 0._wp ; ghamu(:,:,:)   = 0._wp ; ghamv(:,:,:) = 0._wp 
    392  
    393       zddhdt(:,:) = 0._wp 
    394       ! hbl = MAX(hbl,epsln) 
     433      zhbl_t(:,:)   = pp_large 
     434      ! 
     435      zdiffut(:,:,:) = 0.0_wp 
     436      zviscos(:,:,:) = 0.0_wp 
     437      ! 
     438      DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     439         ghamt(ji,jj,jk) = pp_large 
     440         ghams(ji,jj,jk) = pp_large 
     441         ghamu(ji,jj,jk) = pp_large 
     442         ghamv(ji,jj,jk) = pp_large 
     443      END_3D 
     444      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     445         ghamt(ji,jj,jk) = 0.0_wp 
     446         ghams(ji,jj,jk) = 0.0_wp 
     447         ghamu(ji,jj,jk) = 0.0_wp 
     448         ghamv(ji,jj,jk) = 0.0_wp 
     449      END_3D 
     450      ! 
     451      zdiff_mle(:,:) = 0.0_wp 
     452      ! 
     453      ! Ensure only positive hbl values are accessed when using extended halo 
     454      ! (nn_hls==2) 
     455      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     456         hbl(ji,jj) = MAX( hbl(ji,jj), epsln ) 
     457      END_2D 
     458      ! 
    395459      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    396460      ! Calculate boundary layer scales 
    397461      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    398  
    399       ! Assume two-band radiation model for depth of OSBL 
    400      zz0 =       rn_abs       ! surface equi-partition in 2-bands 
    401      zz1 =  1. - rn_abs 
    402      DO_2D( 0, 0, 0, 0 ) 
    403         ! Surface downward irradiance (so always +ve) 
    404         zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp 
    405         ! Downwards irradiance at base of boundary layer 
    406         zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) 
    407         ! Downwards irradiance averaged over depth of the OSBL 
    408         zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 & 
    409               &                         + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj) 
    410      END_2D 
    411      ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 
    412      DO_2D( 0, 0, 0, 0 ) 
    413         zthermal = rab_n(ji,jj,1,jp_tem) 
    414         zbeta    = rab_n(ji,jj,1,jp_sal) 
    415         ! Upwards surface Temperature flux for non-local term 
    416         zwth0(ji,jj) = - qns(ji,jj) * r1_rho0_rcp * tmask(ji,jj,1) 
    417         ! Upwards surface salinity flux for non-local term 
    418         zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * ts(ji,jj,1,jp_sal,Kmm)  + sfx(ji,jj) ) * r1_rho0 * tmask(ji,jj,1) 
    419         ! Non radiative upwards surface buoyancy flux 
    420         zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) -  grav * zbeta * zws0(ji,jj) 
    421         ! turbulent heat flux averaged over depth of OSBL 
    422         zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) ) 
    423         ! turbulent salinity flux averaged over depth of the OBSL 
    424         zwsav(ji,jj) = 0.5 * zws0(ji,jj) 
    425         ! turbulent buoyancy flux averaged over the depth of the OBSBL 
    426         zwbav(ji,jj) = grav  * zthermal * zwthav(ji,jj) - grav  * zbeta * zwsav(ji,jj) 
    427         ! Surface upward velocity fluxes 
    428         zuw0(ji,jj) = - 0.5 * (utau(ji-1,jj) + utau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) 
    429         zvw0(ji,jj) = - 0.5 * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) 
    430         ! Friction velocity (zustar), at T-point : LMD94 eq. 2 
    431         zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) 
    432         zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 
    433         zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 
    434      END_2D 
    435      ! Calculate Stokes drift in direction of wind (zustke) and Stokes penetration depth (dstokes) 
    436      SELECT CASE (nn_osm_wave) 
    437      ! Assume constant La#=0.3 
    438      CASE(0) 
    439         DO_2D( 0, 0, 0, 0 ) 
    440            zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
    441            zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
    442            ! Linearly 
    443            zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 
    444            dstokes(ji,jj) = rn_osm_dstokes 
    445         END_2D 
    446      ! Assume Pierson-Moskovitz wind-wave spectrum 
    447      CASE(1) 
    448         DO_2D( 0, 0, 0, 0 ) 
    449            ! Use wind speed wndm included in sbc_oce module 
    450            zustke(ji,jj) =  MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 
    451            dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 
    452         END_2D 
    453      ! Use ECMWF wave fields as output from SBCWAVE 
    454      CASE(2) 
    455         zfac =  2.0_wp * rpi / 16.0_wp 
    456  
    457         DO_2D( 0, 0, 0, 0 ) 
    458            IF (hsw(ji,jj) > 1.e-4) THEN 
    459               ! Use  wave fields 
    460               zabsstke = SQRT(ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2) 
    461               zustke(ji,jj) = MAX ( ( zcos_wind(ji,jj) * ut0sd(ji,jj) + zsin_wind(ji,jj)  * vt0sd(ji,jj) ), 1.0e-8) 
    462               dstokes(ji,jj) = MAX (zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zabsstke * wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) 
    463            ELSE 
    464               ! Assume masking issue (e.g. ice in ECMWF reanalysis but not in model run) 
    465               ! .. so default to Pierson-Moskowitz 
    466               zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 
    467               dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 
    468            END IF 
    469         END_2D 
    470      END SELECT 
    471  
    472      IF (ln_zdfosm_ice_shelter) THEN 
    473         ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 
    474         DO_2D( 0, 0, 0, 0 ) 
    475            zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj)) 
    476            dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj)) 
    477         END_2D 
    478      END IF 
    479  
    480      SELECT CASE (nn_osm_SD_reduce) 
    481      ! Reduce surface Stokes drift by a constant factor or following Breivik (2016) + van  Roekel (2012) or Grant (2020). 
    482      CASE(0) 
    483         ! The Langmur number from the ECMWF model (or from PM)  appears to give La<0.3 for wind-driven seas. 
    484         !    The coefficient rn_zdfosm_adjust_sd = 0.8 gives La=0.3  in this situation. 
    485         ! It could represent the effects of the spread of wave directions 
    486         ! around the mean wind. The effect of this adjustment needs to be tested. 
    487         IF(nn_osm_wave > 0) THEN 
    488            zustke(2:jpim1,2:jpjm1) = rn_zdfosm_adjust_sd * zustke(2:jpim1,2:jpjm1) 
    489         END IF 
    490      CASE(1) 
    491         ! van  Roekel (2012): consider average SD over top 10% of boundary layer 
    492         ! assumes approximate depth profile of SD from Breivik (2016) 
    493         zsqrtpi = SQRT(rpi) 
    494         z_two_thirds = 2.0_wp / 3.0_wp 
    495  
    496         DO_2D( 0, 0, 0, 0 ) 
    497            zthickness = rn_osm_hblfrac*hbl(ji,jj) 
    498            z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 
    499            zsqrt_depth = SQRT(z2k_times_thickness) 
    500            zexp_depth  = EXP(-z2k_times_thickness) 
    501            zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - zexp_depth  & 
    502                 &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*z2k_times_thickness * ERFC(zsqrt_depth) & 
    503                 &              + 1.0_wp - (1.0_wp + z2k_times_thickness)*zexp_depth ) ) / z2k_times_thickness 
    504  
    505         END_2D 
    506      CASE(2) 
    507         ! Grant (2020): Match to exponential with same SD and d/dz(Sd) at depth 10% of boundary layer 
    508         ! assumes approximate depth profile of SD from Breivik (2016) 
    509         zsqrtpi = SQRT(rpi) 
    510  
    511         DO_2D( 0, 0, 0, 0 ) 
    512            zthickness = rn_osm_hblfrac*hbl(ji,jj) 
    513            z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 
    514  
    515            IF(z2k_times_thickness < 50._wp) THEN 
    516               zsqrt_depth = SQRT(z2k_times_thickness) 
    517               zexperfc = zsqrtpi * zsqrt_depth * ERFC(zsqrt_depth) * EXP(z2k_times_thickness) 
    518            ELSE 
    519               ! asymptotic expansion of sqrt(pi)*zsqrt_depth*EXP(z2k_times_thickness)*ERFC(zsqrt_depth) for large z2k_times_thickness 
    520               ! See Abramowitz and Stegun, Eq. 7.1.23 
    521               ! zexperfc = 1._wp - (1/2)/(z2k_times_thickness)  + (3/4)/(z2k_times_thickness**2) - (15/8)/(z2k_times_thickness**3) 
    522               zexperfc = ((- 1.875_wp/z2k_times_thickness + 0.75_wp)/z2k_times_thickness - 0.5_wp)/z2k_times_thickness + 1.0_wp 
    523            END IF 
    524            zf = z2k_times_thickness*(1.0_wp/zexperfc - 1.0_wp) 
    525            dstokes(ji,jj) = 5.97 * zf * dstokes(ji,jj) 
    526            zustke(ji,jj) = zustke(ji,jj) * EXP(z2k_times_thickness * ( 1.0_wp / (2. * zf) - 1.0_wp )) * ( 1.0_wp - zexperfc) 
    527         END_2D 
    528      END SELECT 
    529  
    530      ! Langmuir velocity scale (zwstrl), La # (zla) 
    531      ! mixed scale (zvstr), convective velocity scale (zwstrc) 
    532      DO_2D( 0, 0, 0, 0 ) 
    533         ! Langmuir velocity scale (zwstrl), at T-point 
    534         zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 
    535         zla(ji,jj) = MAX(MIN(SQRT ( zustar(ji,jj) / ( zwstrl(ji,jj) + epsln ) )**3, 4.0), 0.2) 
    536         IF(zla(ji,jj) > 0.45) dstokes(ji,jj) = MIN(dstokes(ji,jj), 0.5_wp*hbl(ji,jj)) 
    537         ! Velocity scale that tends to zustar for large Langmuir numbers 
    538         zvstr(ji,jj) = ( zwstrl(ji,jj)**3  + & 
    539              & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird 
    540  
    541         ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 
    542         ! Note zustke and zwstrl are not amended. 
    543         ! 
    544         ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 
    545         IF ( zwbav(ji,jj) > 0.0) THEN 
    546            zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 
    547            zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 
     462      ! 
     463      ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 
     464      zz0 =           rn_abs   ! Assume two-band radiation model for depth of OSBL - surface equi-partition in 2-bands 
     465      zz1 =  1.0_wp - rn_abs 
     466      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     467         zrad0(ji,jj)  = qsr(ji,jj) * r1_rho0_rcp   ! Surface downward irradiance (so always +ve) 
     468         zradh(ji,jj)  = zrad0(ji,jj) *                                &   ! Downwards irradiance at base of boundary layer 
     469            &            ( zz0 * EXP( -1.0_wp * hbl(ji,jj) / rn_si0 ) + zz1 * EXP( -1.0_wp * hbl(ji,jj) / rn_si1 ) ) 
     470         zradav        = zrad0(ji,jj) *                                              &            ! Downwards irradiance averaged 
     471            &            ( zz0 * ( 1.0_wp - EXP( -hbl(ji,jj)/rn_si0 ) ) * rn_si0 +   &            !    over depth of the OSBL 
     472            &              zz1 * ( 1.0_wp - EXP( -hbl(ji,jj)/rn_si1 ) ) * rn_si1 ) / hbl(ji,jj) 
     473         swth0(ji,jj)  = - qns(ji,jj) * r1_rho0_rcp * tmask(ji,jj,1)   ! Upwards surface Temperature flux for non-local term 
     474         swthav(ji,jj) = 0.5_wp * swth0(ji,jj) - ( 0.5_wp * ( zrad0(ji,jj) + zradh(ji,jj) ) -   &   ! Turbulent heat flux averaged 
     475            &                                                 zradav )                              !    over depth of OSBL 
     476      END_2D 
     477      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     478         sws0(ji,jj)    = -1.0_wp * ( ( emp(ji,jj) - rnf(ji,jj) ) * ts(ji,jj,1,jp_sal,Kmm) +   &   ! Upwards surface salinity flux 
     479            &                         sfx(ji,jj) ) * r1_rho0 * tmask(ji,jj,1)                      !    for non-local term 
     480         zthermal       = rab_n(ji,jj,1,jp_tem) 
     481         zbeta          = rab_n(ji,jj,1,jp_sal) 
     482         swb0(ji,jj)    = grav * zthermal * swth0(ji,jj) - grav * zbeta * sws0(ji,jj)   ! Non radiative upwards surface buoyancy flux 
     483         zwb0tot(ji,jj) = swb0(ji,jj) - grav * zthermal * ( zrad0(ji,jj) - zradh(ji,jj) )   ! Total upwards surface buoyancy flux 
     484         swsav(ji,jj)   = 0.5_wp * sws0(ji,jj)                              ! Turbulent salinity flux averaged over depth of the OBSL 
     485         swbav(ji,jj)   = grav  * zthermal * swthav(ji,jj) -            &   ! Turbulent buoyancy flux averaged over the depth of the 
     486            &             grav  * zbeta * swsav(ji,jj)                      ! OBSBL 
     487      END_2D 
     488      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     489         suw0(ji,jj)    = -0.5_wp * (utau(ji-1,jj) + utau(ji,jj)) * r1_rho0 * tmask(ji,jj,1)   ! Surface upward velocity fluxes 
     490         zvw0           = -0.5_wp * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) 
     491         sustar(ji,jj)  = MAX( SQRT( SQRT( suw0(ji,jj) * suw0(ji,jj) + zvw0 * zvw0 ) ),   &   ! Friction velocity (sustar), at 
     492            &                  1e-8_wp )                                                      !    T-point : LMD94 eq. 2 
     493         scos_wind(ji,jj) = -1.0_wp * suw0(ji,jj) / ( sustar(ji,jj) * sustar(ji,jj) ) 
     494         ssin_wind(ji,jj) = -1.0_wp * zvw0        / ( sustar(ji,jj) * sustar(ji,jj) ) 
     495      END_2D 
     496      ! Calculate Stokes drift in direction of wind (sustke) and Stokes penetration depth (dstokes) 
     497      SELECT CASE (nn_osm_wave) 
     498         ! Assume constant La#=0.3 
     499      CASE(0) 
     500         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     501            zus_x = scos_wind(ji,jj) * sustar(ji,jj) / 0.3_wp**2 
     502            zus_y = ssin_wind(ji,jj) * sustar(ji,jj) / 0.3_wp**2 
     503            ! Linearly 
     504            sustke(ji,jj)  = MAX( SQRT( zus_x * zus_x + zus_y * zus_y ), 1e-8_wp ) 
     505            dstokes(ji,jj) = rn_osm_dstokes 
     506         END_2D 
     507         ! Assume Pierson-Moskovitz wind-wave spectrum 
     508      CASE(1) 
     509         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     510            ! Use wind speed wndm included in sbc_oce module 
     511            sustke(ji,jj)  = MAX ( 0.016_wp * wndm(ji,jj), 1e-8_wp ) 
     512            dstokes(ji,jj) = MAX ( 0.12_wp * wndm(ji,jj)**2 / grav, 5e-1_wp ) 
     513         END_2D 
     514         ! Use ECMWF wave fields as output from SBCWAVE 
     515      CASE(2) 
     516         zfac =  2.0_wp * rpi / 16.0_wp 
     517         ! 
     518         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     519            IF ( hsw(ji,jj) > 1e-4_wp ) THEN 
     520               ! Use  wave fields 
     521               zabsstke       = SQRT( ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2 ) 
     522               sustke(ji,jj)  = MAX( ( scos_wind(ji,jj) * ut0sd(ji,jj) + ssin_wind(ji,jj)  * vt0sd(ji,jj) ), 1e-8_wp ) 
     523               dstokes(ji,jj) = MAX( zfac * hsw(ji,jj) * hsw(ji,jj) / ( MAX( zabsstke * wmp(ji,jj), 1e-7 ) ), 5e-1_wp ) 
     524            ELSE 
     525               ! Assume masking issue (e.g. ice in ECMWF reanalysis but not in model run) 
     526               ! .. so default to Pierson-Moskowitz 
     527               sustke(ji,jj)  = MAX( 0.016_wp * wndm(ji,jj), 1e-8_wp ) 
     528               dstokes(ji,jj) = MAX( 0.12_wp * wndm(ji,jj)**2 / grav, 5e-1_wp ) 
     529            END IF 
     530         END_2D 
     531      END SELECT 
     532      ! 
     533      IF (ln_zdfosm_ice_shelter) THEN 
     534         ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 
     535         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     536            sustke(ji,jj)  = sustke(ji,jj)  * ( 1.0_wp - fr_i(ji,jj) ) 
     537            dstokes(ji,jj) = dstokes(ji,jj) * ( 1.0_wp - fr_i(ji,jj) ) 
     538         END_2D 
     539      END IF 
     540      ! 
     541      SELECT CASE (nn_osm_SD_reduce) 
     542         ! Reduce surface Stokes drift by a constant factor or following Breivik (2016) + van Roekel (2012) or Grant (2020). 
     543      CASE(0) 
     544         ! The Langmur number from the ECMWF model (or from PM) appears to give La<0.3 for wind-driven seas. 
     545         ! The coefficient rn_zdfosm_adjust_sd = 0.8 gives La=0.3 in this situation. 
     546         ! It could represent the effects of the spread of wave directions around the mean wind. The effect of this adjustment needs to be tested. 
     547         IF(nn_osm_wave > 0) THEN 
     548            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     549               sustke(ji,jj) = rn_zdfosm_adjust_sd * sustke(ji,jj) 
     550            END_2D 
     551         END IF 
     552      CASE(1) 
     553         ! Van Roekel (2012): consider average SD over top 10% of boundary layer 
     554         ! Assumes approximate depth profile of SD from Breivik (2016) 
     555         zsqrtpi = SQRT(rpi) 
     556         z_two_thirds = 2.0_wp / 3.0_wp 
     557         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     558            zthickness = rn_osm_hblfrac*hbl(ji,jj) 
     559            z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 1e-7_wp ) 
     560            zsqrt_depth = SQRT( z2k_times_thickness ) 
     561            zexp_depth  = EXP( -1.0_wp * z2k_times_thickness ) 
     562            sustke(ji,jj) = sustke(ji,jj) * ( 1.0_wp - zexp_depth -   & 
     563               &                              z_two_thirds * ( zsqrtpi * zsqrt_depth * z2k_times_thickness * ERFC(zsqrt_depth) +   & 
     564               &                                               1.0_wp - ( 1.0_wp + z2k_times_thickness ) * zexp_depth ) ) /        & 
     565               &            z2k_times_thickness 
     566         END_2D 
     567      CASE(2) 
     568         ! Grant (2020): Match to exponential with same SD and d/dz(Sd) at depth 10% of boundary layer 
     569         ! Assumes approximate depth profile of SD from Breivik (2016) 
     570         zsqrtpi = SQRT(rpi) 
     571         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     572            zthickness = rn_osm_hblfrac*hbl(ji,jj) 
     573            z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 1e-7_wp ) 
     574            IF( z2k_times_thickness < 50.0_wp ) THEN 
     575               zsqrt_depth = SQRT( z2k_times_thickness ) 
     576               zexperfc    = zsqrtpi * zsqrt_depth * ERFC(zsqrt_depth) * EXP( z2k_times_thickness ) 
     577            ELSE 
     578               ! Asymptotic expansion of sqrt(pi)*zsqrt_depth*EXP(z2k_times_thickness)*ERFC(zsqrt_depth) for large 
     579               !    z2k_times_thickness 
     580               ! See Abramowitz and Stegun, Eq. 7.1.23 
     581               ! zexperfc = 1._wp - (1/2)/(z2k_times_thickness) + (3/4)/(z2k_times_thickness**2) - (15/8)/(z2k_times_thickness**3) 
     582               zexperfc = ( ( -1.875_wp / z2k_times_thickness + 0.75_wp ) / z2k_times_thickness - 0.5_wp ) /   & 
     583                  &       z2k_times_thickness + 1.0_wp 
     584            END IF 
     585            zf = z2k_times_thickness * ( 1.0_wp / zexperfc - 1.0_wp ) 
     586            dstokes(ji,jj) = 5.97_wp * zf * dstokes(ji,jj) 
     587            sustke(ji,jj)  = sustke(ji,jj) * EXP( z2k_times_thickness * ( 1.0_wp / ( 2.0_wp * zf ) - 1.0_wp ) ) *   & 
     588               &             ( 1.0_wp - zexperfc ) 
     589         END_2D 
     590      END SELECT 
     591      ! 
     592      ! Langmuir velocity scale (swstrl), La # (sla) 
     593      ! Mixed scale (svstr), convective velocity scale (swstrc) 
     594      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     595         ! Langmuir velocity scale (swstrl), at T-point 
     596         swstrl(ji,jj) = ( sustar(ji,jj) * sustar(ji,jj) * sustke(ji,jj) )**pthird 
     597         sla(ji,jj)    = MAX( MIN( SQRT( sustar(ji,jj) / ( swstrl(ji,jj) + epsln ) )**3, 4.0_wp ), 0.2_wp ) 
     598         IF ( sla(ji,jj) > 0.45_wp ) dstokes(ji,jj) = MIN( dstokes(ji,jj), 0.5_wp * hbl(ji,jj) ) 
     599         ! Velocity scale that tends to sustar for large Langmuir numbers 
     600         svstr(ji,jj)  = ( swstrl(ji,jj)**3 + ( 1.0_wp - EXP( -0.5_wp * sla(ji,jj)**2 ) ) * sustar(ji,jj) * sustar(ji,jj) *   & 
     601            &                                 sustar(ji,jj) )**pthird 
     602         ! 
     603         ! Limit maximum value of Langmuir number as approximate treatment for shear turbulence 
     604         ! Note sustke and swstrl are not amended 
     605         ! 
     606         ! Get convective velocity (swstrc), stabilty scale (shol) and logical conection flag l_conv 
     607         IF ( swbav(ji,jj) > 0.0_wp ) THEN 
     608            swstrc(ji,jj) = ( 2.0_wp * swbav(ji,jj) * 0.9_wp * hbl(ji,jj) )**pthird 
     609            shol(ji,jj)   = -0.9_wp * hbl(ji,jj) * 2.0_wp * swbav(ji,jj) / ( svstr(ji,jj)**3 + epsln ) 
    548610         ELSE 
    549            zhol(ji,jj) = -hbl(ji,jj) *  2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3  + epsln ) 
    550         ENDIF 
    551      END_2D 
    552  
    553      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    554      ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth 
    555      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    556      ! BL must be always 4 levels deep. 
    557      ! For calculation of lateral buoyancy gradients for FK in 
    558      ! zdf_osm_zmld_horizontal_gradients need halo values for ibld, so must 
    559      ! previously exist for hbl also. 
    560  
    561      ! agn 23/6/20: not clear all this is needed, as hbl checked after it is re-calculated anyway 
    562      ! ########################################################################## 
    563       hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,4,Kmm) ) 
    564       ibld(:,:) = 4 
    565       DO_3D( 1, 1, 1, 1, 5, jpkm1 ) 
    566          IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 
    567             ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 
     611            swstrc(ji,jj) = 0.0_wp 
     612            shol(ji,jj)   = -1.0_wp * hbl(ji,jj) * 2.0_wp * swbav(ji,jj) / ( svstr(ji,jj)**3  + epsln ) 
     613         ENDIF 
     614      END_2D 
     615      ! 
     616      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     617      ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth 
     618      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     619      ! BL must be always 4 levels deep. 
     620      ! For calculation of lateral buoyancy gradients for FK in 
     621      ! zdf_osm_zmld_horizontal_gradients need halo values for nbld 
     622      ! 
     623      ! agn 23/6/20: not clear all this is needed, as hbl checked after it is re-calculated anyway 
     624      ! ########################################################################## 
     625      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     626         hbl(ji,jj) = MAX(hbl(ji,jj), gdepw(ji,jj,4,Kmm) ) 
     627      END_2D 
     628      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     629         nbld(ji,jj) = 4 
     630      END_2D 
     631      DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 5, jpkm1 ) 
     632         IF ( MAX( hbl(ji,jj), gdepw(ji,jj,4,Kmm) ) >= gdepw(ji,jj,jk,Kmm) ) THEN 
     633            nbld(ji,jj) = MIN(mbkt(ji,jj)-2, jk) 
    568634         ENDIF 
    569635      END_3D 
    570      ! ########################################################################## 
    571  
    572       DO_2D( 0, 0, 0, 0 ) 
    573          zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 
    574          imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t(ji, jj, ibld(ji,jj), Kmm )) , 1 )) 
    575          zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
     636      ! ########################################################################## 
     637      ! 
     638      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     639         zhbl(ji,jj) = gdepw(ji,jj,nbld(ji,jj),Kmm) 
     640         nmld(ji,jj) = MAX( 3, nbld(ji,jj) - MAX( INT( dh(ji,jj) / e3t(ji,jj,nbld(ji,jj)-1,Kmm) ), 1 ) ) 
     641         zhml(ji,jj) = gdepw(ji,jj,nmld(ji,jj),Kmm) 
    576642         zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    577643      END_2D 
    578       ! Averages over well-mixed and boundary layer 
    579       jp_ext(:,:) = 2 
    580       CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl) 
    581 !      jp_ext(:,:) = ibld(:,:) - imld(:,:) + 1 
    582       CALL zdf_osm_vertical_average(ibld, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml) 
    583 ! Velocity components in frame aligned with surface stress. 
    584       CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 
    585       CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 
    586 ! Determine the state of the OSBL, stable/unstable, shear/no shear 
    587       CALL zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear, zri_i ) 
    588  
     644      ! 
     645      ! Averages over well-mixed and boundary layer, note BL averages use jk_ext=2 everywhere 
     646      jk_nlev(:,:) = nbld(A2D(nn_hls-1)) 
     647      jk_ext(:,:) = 1   ! ag 19/03 
     648      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_bl,  av_s_bl,    & 
     649         &                           av_b_bl,  av_u_bl,  av_v_bl,  jk_ext,   av_dt_bl,   & 
     650         &                           av_ds_bl, av_db_bl, av_du_bl, av_dv_bl ) 
     651      jk_nlev(:,:) = nmld(A2D(nn_hls-1)) - 1 
     652      jk_ext(:,:) = nbld(A2D(nn_hls-1)) - nmld(A2D(nn_hls-1)) + jk_ext(:,:) + 1   ! ag 19/03 
     653      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_ml,  av_s_ml,    & 
     654         &                           av_b_ml,  av_u_ml,  av_v_ml,  jk_ext,   av_dt_ml,   & 
     655         &                           av_ds_ml, av_db_ml, av_du_ml, av_dv_ml ) 
     656      ! Velocity components in frame aligned with surface stress 
     657      CALL zdf_osm_velocity_rotation( av_u_ml,  av_v_ml  ) 
     658      CALL zdf_osm_velocity_rotation( av_du_ml, av_dv_ml ) 
     659      CALL zdf_osm_velocity_rotation( av_u_bl,  av_v_bl  ) 
     660      CALL zdf_osm_velocity_rotation( av_du_bl, av_dv_bl ) 
     661      ! 
     662      ! Determine the state of the OSBL, stable/unstable, shear/no shear 
     663      CALL zdf_osm_osbl_state( Kmm, zwb_ent, zwb_min, zshear, zhbl,     & 
     664         &                     zhml, zdh ) 
     665      ! 
    589666      IF ( ln_osm_mle ) THEN 
    590 ! Fox-Kemper Scheme 
    591          mld_prof = 4 
    592          DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 
    593          IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 
     667         ! Fox-Kemper Scheme 
     668         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     669            mld_prof(ji,jj) = 4 
     670         END_2D 
     671         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 ) 
     672            IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN( mbkt(ji,jj), jk) 
    594673         END_3D 
    595          jp_ext_mle(:,:) = 2 
    596         CALL zdf_osm_vertical_average(mld_prof, jp_ext_mle, zt_mle, zs_mle, zb_mle, zu_mle, zv_mle, zdt_mle, zds_mle, zdb_mle, zdu_mle, zdv_mle) 
    597  
    598          DO_2D( 0, 0, 0, 0 ) 
    599            zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 
     674         jk_nlev(:,:) = mld_prof(A2D(nn_hls-1)) 
     675         CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_mle, av_s_mle,   & 
     676            &                           av_b_mle, av_u_mle, av_v_mle ) 
     677         ! 
     678         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     679            zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 
    600680         END_2D 
    601  
    602 !! External gradient 
    603          CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 
    604          CALL zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 
    605          CALL zdf_osm_external_gradients( mld_prof, zdtdz_mle_ext, zdsdz_mle_ext, zdbdz_mle_ext ) 
    606          CALL zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk ) 
    607          CALL zdf_osm_mle_parameters( mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 
     681         ! 
     682         ! Calculate fairly-well-mixed depth zmld & its index mld_prof + lateral zmld-averaged gradients 
     683         CALL zdf_osm_zmld_horizontal_gradients( Kmm, zmld, zdtdx, zdtdy, zdsdx,   & 
     684            &                                    zdsdy, zdbds_mle ) 
     685         ! Calculate max vertical FK flux zwb_fk & set logical descriptors 
     686         CALL zdf_osm_osbl_state_fk( Kmm, zwb_fk, zhbl, zhmle, zwb_ent,   & 
     687            &                        zdbds_mle ) 
     688         ! Recalculate hmle, zmle, zvel_mle, zdiff_mle & redefine mld_proc to be index for new hmle 
     689         CALL zdf_osm_mle_parameters( Kmm, zmld, zhmle, zvel_mle, zdiff_mle,   & 
     690            &                         zdbds_mle, zhbl, zwb0tot ) 
    608691      ELSE    ! ln_osm_mle 
    609 ! FK not selected, Boundary Layer only. 
    610          lpyc(:,:) = .TRUE. 
    611          lflux(:,:) = .FALSE. 
    612          lmle(:,:) = .FALSE. 
    613          DO_2D( 0, 0, 0, 0 ) 
    614           IF ( lconv(ji,jj) .AND. zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 
     692         ! FK not selected, Boundary Layer only. 
     693         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     694            l_pyc(ji,jj)  = .TRUE. 
     695            l_flux(ji,jj) = .FALSE. 
     696            l_mle(ji,jj)  = .FALSE. 
     697            IF ( l_conv(ji,jj) .AND. av_db_bl(ji,jj) < rn_osm_bl_thresh ) l_pyc(ji,jj) = .FALSE. 
    615698         END_2D 
    616699      ENDIF   ! ln_osm_mle 
    617  
    618 ! Test if pycnocline well resolved 
    619       DO_2D( 0, 0, 0, 0 ) 
    620        IF (lconv(ji,jj) ) THEN 
    621           ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,ibld(ji,jj),Kmm) 
    622           IF ( ztmp > 6 ) THEN 
    623    ! pycnocline well resolved 
    624             jp_ext(ji,jj) = 1 
    625           ELSE 
    626    ! pycnocline poorly resolved 
    627             jp_ext(ji,jj) = 0 
    628           ENDIF 
    629        ELSE 
    630    ! Stable conditions 
    631          jp_ext(ji,jj) = 0 
    632        ENDIF 
    633       END_2D 
    634  
    635       CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 
    636 !      jp_ext = ibld-imld+1 
    637       CALL zdf_osm_vertical_average(imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml) 
    638 ! Rate of change of hbl 
    639       CALL zdf_osm_calculate_dhdt( zdhdt, zddhdt ) 
    640       DO_2D( 0, 0, 0, 0 ) 
    641        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 
    642             ! adjustment to represent limiting by ocean bottom 
    643        IF ( zhbl_t(ji,jj) >= gdepw(ji, jj, mbkt(ji,jj) + 1, Kmm ) ) THEN 
    644           zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw(ji,jj, mbkt(ji,jj) + 1, Kmm) - depth_tol)! ht(:,:)) 
    645           lpyc(ji,jj) = .FALSE. 
    646        ENDIF 
    647       END_2D 
    648  
    649       imld(:,:) = ibld(:,:)           ! use imld to hold previous blayer index 
    650       ibld(:,:) = 4 
    651  
    652       DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 
     700      ! 
     701      !! External gradient below BL needed both with and w/o FK 
     702      jk_ext(:,:) = nbld(A2D(nn_hls-1)) + 1 
     703      CALL zdf_osm_external_gradients( Kmm, jk_ext, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext )   ! ag 19/03 
     704      ! 
     705      ! Test if pycnocline well resolved 
     706      !      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                                         Removed with ag 19/03 changes. A change in eddy diffusivity/viscosity 
     707      !         IF (l_conv(ji,jj) ) THEN                                  should account for this. 
     708      !            ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,nbld(ji,jj),Kmm) 
     709      !            IF ( ztmp > 6 ) THEN 
     710      !               ! pycnocline well resolved 
     711      !               jk_ext(ji,jj) = 1 
     712      !            ELSE 
     713      !               ! pycnocline poorly resolved 
     714      !               jk_ext(ji,jj) = 0 
     715      !            ENDIF 
     716      !         ELSE 
     717      !            ! Stable conditions 
     718      !            jk_ext(ji,jj) = 0 
     719      !         ENDIF 
     720      !      END_2D 
     721      ! 
     722      ! Recalculate bl averages using jk_ext & ml averages .... note no rotation of u & v here.. 
     723      jk_nlev(:,:) = nbld(A2D(nn_hls-1)) 
     724      jk_ext(:,:) = 1   ! ag 19/03 
     725      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_bl,  av_s_bl,    & 
     726         &                           av_b_bl,  av_u_bl,  av_v_bl,  jk_ext,   av_dt_bl,   & 
     727         &                           av_ds_bl, av_db_bl, av_du_bl, av_dv_bl ) 
     728      jk_nlev(:,:) = nmld(A2D(nn_hls-1)) - 1 
     729      jk_ext(:,:) = nbld(A2D(nn_hls-1)) - nmld(A2D(nn_hls-1)) + jk_ext(:,:) + 1   ! ag 19/03 
     730      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_ml,  av_s_ml,    & 
     731         &                           av_b_ml,  av_u_ml,  av_v_ml,  jk_ext,   av_dt_ml,   & 
     732         &                           av_ds_ml, av_db_ml, av_du_ml, av_dv_ml )   ! ag 19/03 
     733      ! 
     734      ! Rate of change of hbl 
     735      CALL zdf_osm_calculate_dhdt( zdhdt, zhbl, zdh, zwb_ent, zwb_min,   & 
     736         &                         zdbdz_bl_ext, zwb_fk_b, zwb_fk, zvel_mle ) 
     737      ! Test if surface boundary layer coupled to bottom 
     738      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     739         l_coup(ji,jj) = .FALSE.   ! ag 19/03 
     740         zhbl_t(ji,jj) = hbl(ji,jj) + ( zdhdt(ji,jj) - ww(ji,jj,nbld(ji,jj)) ) * rn_Dt   ! Certainly need ww here, so subtract it 
     741         ! Adjustment to represent limiting by ocean bottom 
     742         IF ( mbkt(ji,jj) > 2 ) THEN   ! To ensure mbkt(ji,jj) - 2 > 0 so no incorrect array access 
     743            IF ( zhbl_t(ji,jj) > gdepw(ji, jj,mbkt(ji,jj)-2,Kmm) ) THEN 
     744               zhbl_t(ji,jj) = MIN( zhbl_t(ji,jj), gdepw(ji,jj,mbkt(ji,jj)-2,Kmm) )   ! ht(:,:)) 
     745               l_pyc(ji,jj)  = .FALSE. 
     746               l_coup(ji,jj) = .TRUE.   ! ag 19/03 
     747            END IF 
     748         END IF 
     749      END_2D 
     750      ! 
     751      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     752         nmld(ji,jj) = nbld(ji,jj)           ! use nmld to hold previous blayer index 
     753         nbld(ji,jj) = 4 
     754      END_2D 
     755      ! 
     756      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 4, jpkm1 ) 
    653757         IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 
    654             ibld(ji,jj) = jk 
     758            nbld(ji,jj) = jk 
     759         END IF 
     760      END_3D 
     761      ! 
     762      ! 
     763      ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 
     764      ! 
     765      CALL zdf_osm_timestep_hbl( Kmm, zdhdt, zhbl, zhbl_t, zwb_ent,   & 
     766         &                       zwb_fk_b ) 
     767      ! Is external level in bounds? 
     768      ! 
     769      ! Recalculate BL averages and differences using new BL depth 
     770      jk_nlev(:,:) = nbld(A2D(nn_hls-1)) 
     771      jk_ext(:,:) = 1   ! ag 19/03 
     772      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_bl,  av_s_bl,    & 
     773         &                           av_b_bl,  av_u_bl,  av_v_bl,  jk_ext,   av_dt_bl,   & 
     774         &                           av_ds_bl, av_db_bl, av_du_bl, av_dv_bl ) 
     775      ! 
     776      CALL zdf_osm_pycnocline_thickness( Kmm, zdh, zhml, zdhdt, zhbl,   & 
     777         &                               zwb_ent, zdbdz_bl_ext, zwb_fk_b ) 
     778      ! 
     779      ! Reset l_pyc before calculating terms in the flux-gradient relationship 
     780      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     781         IF ( av_db_bl(ji,jj) < rn_osm_bl_thresh .OR. nbld(ji,jj) >= mbkt(ji,jj) - 2 .OR.   & 
     782            & nbld(ji,jj) - nmld(ji,jj) == 1   .OR. zdhdt(ji,jj) < 0.0_wp ) THEN   ! ag 19/03 
     783            l_pyc(ji,jj) = .FALSE.   ! ag 19/03 
     784            IF ( nbld(ji,jj) >= mbkt(ji,jj) -2 ) THEN 
     785               nmld(ji,jj) = nbld(ji,jj) - 1                                               ! ag 19/03 
     786               zdh(ji,jj)  = gdepw(ji,jj,nbld(ji,jj),Kmm) - gdepw(ji,jj,nmld(ji,jj),Kmm)   ! ag 19/03 
     787               zhml(ji,jj) = gdepw(ji,jj,nmld(ji,jj),Kmm)                                  ! ag 19/03 
     788               dh(ji,jj)   = zdh(ji,jj)                                                    ! ag 19/03   
     789               hml(ji,jj)  = hbl(ji,jj) - dh(ji,jj)                                        ! ag 19/03 
     790            ENDIF 
     791         ENDIF                                              ! ag 19/03 
     792      END_2D 
     793      ! 
     794      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )               ! Limit delta for shallow boundary layers for calculating 
     795         dstokes(ji,jj) = MIN ( dstokes(ji,jj), hbl(ji,jj) / 3.0_wp )   !    flux-gradient terms 
     796      END_2D 
     797      !                                                        
     798      ! 
     799      ! Average over the depth of the mixed layer in the convective boundary layer 
     800      !      jk_ext = nbld - nmld + 1 
     801      ! Recalculate ML averages and differences using new ML depth 
     802      jk_nlev(:,:) = nmld(A2D(nn_hls-1)) - 1 
     803      jk_ext(:,:) = nbld(A2D(nn_hls-1)) - nmld(A2D(nn_hls-1)) + jk_ext(:,:) + 1   ! ag 19/03 
     804      CALL zdf_osm_vertical_average( Kbb,      Kmm,      jk_nlev,  av_t_ml,  av_s_ml,    & 
     805         &                           av_b_ml,  av_u_ml,  av_v_ml,  jk_ext,   av_dt_ml,   & 
     806         &                           av_ds_ml, av_db_ml, av_du_ml, av_dv_ml ) 
     807      ! 
     808      jk_ext(:,:) = nbld(A2D(nn_hls-1)) + 1 
     809      CALL zdf_osm_external_gradients( Kmm, jk_ext, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 
     810      ! Rotate mean currents and changes onto wind aligned co-ordinates 
     811      CALL zdf_osm_velocity_rotation( av_u_ml,  av_v_ml  ) 
     812      CALL zdf_osm_velocity_rotation( av_du_ml, av_dv_ml ) 
     813      CALL zdf_osm_velocity_rotation( av_u_bl,  av_v_bl  ) 
     814      CALL zdf_osm_velocity_rotation( av_du_bl, av_dv_bl ) 
     815      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     816      ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship 
     817      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     818      CALL zdf_osm_diffusivity_viscosity( Kbb, Kmm, zdiffut, zviscos, zhbl,    & 
     819         &                                zhml, zdh, zdhdt, zshear, zwb_ent,   & 
     820         &                                zwb_min ) 
     821      ! 
     822      ! Calculate non-gradient components of the flux-gradient relationships 
     823      ! -------------------------------------------------------------------- 
     824      jk_ext(:,:) = 1   ! ag 19/03 
     825      CALL zdf_osm_fgr_terms( Kmm, jk_ext, zhbl, zhml, zdh,                              & 
     826         &                    zdhdt, zshear, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext,   & 
     827         &                    zdiffut, zviscos ) 
     828      ! 
     829      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     830      ! Need to put in code for contributions that are applied explicitly to 
     831      ! the prognostic variables 
     832      !  1. Entrainment flux 
     833      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     834      ! 
     835      ! Rotate non-gradient velocity terms back to model reference frame 
     836      jk_nlev(:,:) = nbld(A2D(nn_hls-1)) 
     837      CALL zdf_osm_velocity_rotation( ghamu, ghamv, .FALSE.,  2, jk_nlev ) 
     838      ! 
     839      ! KPP-style Ri# mixing 
     840      IF ( ln_kpprimix ) THEN 
     841         jkflt = jpk 
     842         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     843            IF ( nbld(ji,jj) < jkflt ) jkflt = nbld(ji,jj) 
     844         END_2D 
     845         DO jk = jkflt+1, jpkm1 
     846            ! Shear production at uw- and vw-points (energy conserving form) 
     847            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     848               z2du(ji,jj) = 0.5_wp * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) * ( uu(ji,jj,jk-1,Kbb) - uu(ji,jj,jk,Kbb) ) *   & 
     849                  &          wumask(ji,jj,jk) / ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) 
     850               z2dv(ji,jj) = 0.5_wp * ( vv(ji,jj,jk-1,Kmm) - vv(ji,jj,jk,Kmm) ) * ( vv(ji,jj,jk-1,Kbb) - vv(ji,jj,jk,Kbb) ) *   & 
     851                  &          wvmask(ji,jj,jk) / ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) 
     852            END_2D 
     853            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     854               IF ( jk > nbld(ji,jj) ) THEN 
     855                  ! Shear prod. at w-point weightened by mask 
     856                  zesh2 = ( z2du(ji-1,jj) + z2du(ji,jj) ) / MAX( 1.0_wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) +   & 
     857                     &    ( z2dv(ji,jj-1) + z2dv(ji,jj) ) / MAX( 1.0_wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 
     858                  ! Local Richardson number 
     859                  zri     = MAX( rn2b(ji,jj,jk), 0.0_wp ) / MAX( zesh2, epsln ) 
     860                  zfri    = MIN( zri / rn_riinfty, 1.0_wp ) 
     861                  zfri    = ( 1.0_wp - zfri * zfri ) 
     862                  zrimix  =  zfri * zfri  * zfri * wmask(ji, jj, jk) 
     863                  zdiffut(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), zrimix*rn_difri ) 
     864                  zviscos(ji,jj,jk) = MAX( zviscos(ji,jj,jk), zrimix*rn_difri ) 
     865               END IF 
     866            END_2D 
     867         END DO 
     868      END IF   ! ln_kpprimix = .true. 
     869      ! 
     870      ! KPP-style set diffusivity large if unstable below BL 
     871      IF ( ln_convmix) THEN 
     872         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     873            DO jk = nbld(ji,jj) + 1, jpkm1 
     874               IF ( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1e-12_wp ) zdiffut(ji,jj,jk) = MAX( rn_difconv, zdiffut(ji,jj,jk) ) 
     875            END DO 
     876         END_2D 
     877      END IF   ! ln_convmix = .true. 
     878      ! 
     879      IF ( ln_osm_mle ) THEN   ! Set up diffusivity and non-gradient mixing 
     880         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     881            IF ( l_flux(ji,jj) ) THEN   ! MLE mixing extends below boundary layer 
     882               ! Calculate MLE flux contribution from surface fluxes 
     883               DO jk = 1, nbld(ji,jj) 
     884                  znd = gdepw(ji,jj,jk,Kmm) / MAX( zhbl(ji,jj), epsln ) 
     885                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - ( swth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0_wp - znd ) 
     886                  ghams(ji,jj,jk) = ghams(ji,jj,jk) - sws0(ji,jj) * ( 1.0_wp - znd ) 
     887               END DO 
     888               DO jk = 1, mld_prof(ji,jj) 
     889                  znd = gdepw(ji,jj,jk,Kmm) / MAX( zhmle(ji,jj), epsln ) 
     890                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + ( swth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0_wp - znd ) 
     891                  ghams(ji,jj,jk) = ghams(ji,jj,jk) + sws0(ji,jj) * ( 1.0_wp -znd ) 
     892               END DO 
     893               ! Viscosity for MLEs 
     894               DO jk = 1, mld_prof(ji,jj) 
     895                  znd = -1.0_wp * gdepw(ji,jj,jk,Kmm) / MAX( zhmle(ji,jj), epsln ) 
     896                  zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0_wp - ( 2.0_wp * znd + 1.0_wp )**2 ) *   & 
     897                     &                                    ( 1.0_wp + 5.0_wp / 21.0_wp * ( 2.0_wp * znd + 1.0_wp )**2 ) 
     898               END DO 
     899            ELSE   ! Surface transports limited to OSBL 
     900               ! Viscosity for MLEs 
     901               DO jk = 1, mld_prof(ji,jj) 
     902                  znd = -1.0_wp * gdepw(ji,jj,jk,Kmm) / MAX( zhmle(ji,jj), epsln ) 
     903                  zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0_wp - ( 2.0_wp * znd + 1.0_wp )**2 ) *   & 
     904                     &                                    ( 1.0_wp + 5.0_wp / 21.0_wp * ( 2.0_wp * znd + 1.0_wp )**2 ) 
     905               END DO 
     906            END IF 
     907         END_2D 
     908      ENDIF 
     909      ! 
     910      ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 
     911      ! CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp ) 
     912      ! GN 25/8: need to change tmask --> wmask 
     913      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     914         p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 
     915         p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 
     916      END_3D 
     917      ! 
     918      IF ( ln_dia_osm ) THEN 
     919         SELECT CASE (nn_osm_wave) 
     920            ! Stokes drift set by assumimg onstant La#=0.3 (=0) or Pierson-Moskovitz spectrum (=1) 
     921         CASE(0:1) 
     922            CALL zdf_osm_iomput( "us_x", tmask(A2D(0),1) * sustke(A2D(0)) * scos_wind(A2D(0)) )   ! x surface Stokes drift 
     923            CALL zdf_osm_iomput( "us_y", tmask(A2D(0),1) * sustke(A2D(0)) * scos_wind(A2D(0)) )   ! y surface Stokes drift 
     924            CALL zdf_osm_iomput( "wind_wave_abs_power", 1000.0_wp * rho0 * tmask(A2D(0),1) * sustar(A2D(0))**2 * sustke(A2D(0)) ) 
     925            ! Stokes drift read in from sbcwave  (=2). 
     926         CASE(2:3) 
     927            CALL zdf_osm_iomput( "us_x",   ut0sd(A2D(0)) * umask(A2D(0),1) )                         ! x surface Stokes drift 
     928            CALL zdf_osm_iomput( "us_y",   vt0sd(A2D(0)) * vmask(A2D(0),1) )                         ! y surface Stokes drift 
     929            CALL zdf_osm_iomput( "wmp",    wmp(A2D(0)) * tmask(A2D(0),1) )                           ! Wave mean period 
     930            CALL zdf_osm_iomput( "hsw",    hsw(A2D(0)) * tmask(A2D(0),1) )                           ! Significant wave height 
     931            CALL zdf_osm_iomput( "wmp_NP", ( 2.0_wp * rpi * 1.026_wp / ( 0.877_wp * grav ) ) *   &   ! Wave mean period from NP 
     932               &                           wndm(A2D(0)) * tmask(A2D(0),1) )                          !    spectrum 
     933            CALL zdf_osm_iomput( "hsw_NP", ( 0.22_wp / grav ) * wndm(A2D(0))**2 * tmask(A2D(0),1) )  ! Significant wave height from 
     934            !                                                                                        !    NP spectrum 
     935            CALL zdf_osm_iomput( "wndm",   wndm(A2D(0)) * tmask(A2D(0),1) )                          ! U_10 
     936            CALL zdf_osm_iomput( "wind_wave_abs_power", 1000.0_wp * rho0 * tmask(A2D(0),1) * sustar(A2D(0))**2 *   & 
     937               &                                        SQRT( ut0sd(A2D(0))**2 + vt0sd(A2D(0))**2 ) ) 
     938         END SELECT 
     939         CALL zdf_osm_iomput( "zwth0",           tmask(A2D(0),1) * swth0(A2D(0))     )      ! <Tw_0> 
     940         CALL zdf_osm_iomput( "zws0",            tmask(A2D(0),1) * sws0(A2D(0))      )      ! <Sw_0> 
     941         CALL zdf_osm_iomput( "zwb0",            tmask(A2D(0),1) * swb0(A2D(0))      )      ! <Sw_0> 
     942         CALL zdf_osm_iomput( "zwbav",           tmask(A2D(0),1) * swth0(A2D(0))     )      ! Upward BL-avged turb buoyancy flux 
     943         CALL zdf_osm_iomput( "ibld",            tmask(A2D(0),1) * nbld(A2D(0))      )      ! Boundary-layer max k 
     944         CALL zdf_osm_iomput( "zdt_bl",          tmask(A2D(0),1) * av_dt_bl(A2D(0))  )      ! dt at ml base 
     945         CALL zdf_osm_iomput( "zds_bl",          tmask(A2D(0),1) * av_ds_bl(A2D(0))  )      ! ds at ml base 
     946         CALL zdf_osm_iomput( "zdb_bl",          tmask(A2D(0),1) * av_db_bl(A2D(0))  )      ! db at ml base 
     947         CALL zdf_osm_iomput( "zdu_bl",          tmask(A2D(0),1) * av_du_bl(A2D(0))  )      ! du at ml base 
     948         CALL zdf_osm_iomput( "zdv_bl",          tmask(A2D(0),1) * av_dv_bl(A2D(0))  )      ! dv at ml base 
     949         CALL zdf_osm_iomput( "dh",              tmask(A2D(0),1) * dh(A2D(0))        )      ! Initial boundary-layer depth 
     950         CALL zdf_osm_iomput( "hml",             tmask(A2D(0),1) * hml(A2D(0))       )      ! Initial boundary-layer depth 
     951         CALL zdf_osm_iomput( "zdt_ml",          tmask(A2D(0),1) * av_dt_ml(A2D(0))  )      ! dt at ml base 
     952         CALL zdf_osm_iomput( "zds_ml",          tmask(A2D(0),1) * av_ds_ml(A2D(0))  )      ! ds at ml base 
     953         CALL zdf_osm_iomput( "zdb_ml",          tmask(A2D(0),1) * av_db_ml(A2D(0))  )      ! db at ml base 
     954         CALL zdf_osm_iomput( "dstokes",         tmask(A2D(0),1) * dstokes(A2D(0))   )      ! Stokes drift penetration depth 
     955         CALL zdf_osm_iomput( "zustke",          tmask(A2D(0),1) * sustke(A2D(0))    )      ! Stokes drift magnitude at T-points 
     956         CALL zdf_osm_iomput( "zwstrc",          tmask(A2D(0),1) * swstrc(A2D(0))    )      ! Convective velocity scale 
     957         CALL zdf_osm_iomput( "zwstrl",          tmask(A2D(0),1) * swstrl(A2D(0))    )      ! Langmuir velocity scale 
     958         CALL zdf_osm_iomput( "zustar",          tmask(A2D(0),1) * sustar(A2D(0))    )      ! Friction velocity scale 
     959         CALL zdf_osm_iomput( "zvstr",           tmask(A2D(0),1) * svstr(A2D(0))     )      ! Mixed velocity scale 
     960         CALL zdf_osm_iomput( "zla",             tmask(A2D(0),1) * sla(A2D(0))       )      ! Langmuir # 
     961         CALL zdf_osm_iomput( "wind_power",      1000.0_wp * rho0 * tmask(A2D(0),1) *   &   ! BL depth internal to zdf_osm routine 
     962            &                                    sustar(A2D(0))**3 ) 
     963         CALL zdf_osm_iomput( "wind_wave_power", 1000.0_wp * rho0 * tmask(A2D(0),1) *   & 
     964            &                                    sustar(A2D(0))**2 * sustke(A2D(0))  ) 
     965         CALL zdf_osm_iomput( "zhbl",            tmask(A2D(0),1) * zhbl(A2D(0))      )      ! BL depth internal to zdf_osm routine 
     966         CALL zdf_osm_iomput( "zhml",            tmask(A2D(0),1) * zhml(A2D(0))      )      ! ML depth internal to zdf_osm routine 
     967         CALL zdf_osm_iomput( "imld",            tmask(A2D(0),1) * nmld(A2D(0))      )      ! Index for ML depth internal to zdf_osm 
     968         !                                                                                  !    routine 
     969         CALL zdf_osm_iomput( "jp_ext",          tmask(A2D(0),1) * jk_ext(A2D(0))    )      ! =1 if pycnocline resolved internal to 
     970         !                                                                                  !    zdf_osm routine 
     971         CALL zdf_osm_iomput( "j_ddh",           tmask(A2D(0),1) * n_ddh(A2D(0))     )      ! Index forpyc thicknessh internal to 
     972         !                                                                                  !    zdf_osm routine 
     973         CALL zdf_osm_iomput( "zshear",          tmask(A2D(0),1) * zshear(A2D(0))    )      ! Shear production of TKE internal to 
     974         !                                                                                  !    zdf_osm routine 
     975         CALL zdf_osm_iomput( "zdh",             tmask(A2D(0),1) * zdh(A2D(0))       )      ! Pyc thicknessh internal to zdf_osm 
     976         !                                                                                  !    routine 
     977         CALL zdf_osm_iomput( "zhol",            tmask(A2D(0),1) * shol(A2D(0))      )      ! ML depth internal to zdf_osm routine 
     978         CALL zdf_osm_iomput( "zwb_ent",         tmask(A2D(0),1) * zwb_ent(A2D(0))   )      ! Upward turb buoyancy entrainment flux 
     979         CALL zdf_osm_iomput( "zt_ml",           tmask(A2D(0),1) * av_t_ml(A2D(0))   )      ! Average T in ML 
     980         CALL zdf_osm_iomput( "zmld",            tmask(A2D(0),1) * zmld(A2D(0))      )      ! FK target layer depth 
     981         CALL zdf_osm_iomput( "zwb_fk",          tmask(A2D(0),1) * zwb_fk(A2D(0))    )      ! FK b flux 
     982         CALL zdf_osm_iomput( "zwb_fk_b",        tmask(A2D(0),1) * zwb_fk_b(A2D(0))  )      ! FK b flux averaged over ML 
     983         CALL zdf_osm_iomput( "mld_prof",        tmask(A2D(0),1) * mld_prof(A2D(0))  )      ! FK layer max k 
     984         CALL zdf_osm_iomput( "zdtdx",           umask(A2D(0),1) * zdtdx(A2D(0))     )      ! FK dtdx at u-pt 
     985         CALL zdf_osm_iomput( "zdtdy",           vmask(A2D(0),1) * zdtdy(A2D(0))     )      ! FK dtdy at v-pt 
     986         CALL zdf_osm_iomput( "zdsdx",           umask(A2D(0),1) * zdsdx(A2D(0))     )      ! FK dtdx at u-pt 
     987         CALL zdf_osm_iomput( "zdsdy",           vmask(A2D(0),1) * zdsdy(A2D(0))     )      ! FK dsdy at v-pt 
     988         CALL zdf_osm_iomput( "dbdx_mle",        umask(A2D(0),1) * dbdx_mle(A2D(0))  )      ! FK dbdx at u-pt 
     989         CALL zdf_osm_iomput( "dbdy_mle",        vmask(A2D(0),1) * dbdy_mle(A2D(0))  )      ! FK dbdy at v-pt 
     990         CALL zdf_osm_iomput( "zdiff_mle",       tmask(A2D(0),1) * zdiff_mle(A2D(0)) )      ! FK diff in MLE at t-pt 
     991         CALL zdf_osm_iomput( "zvel_mle",        tmask(A2D(0),1) * zdiff_mle(A2D(0)) )      ! FK diff in MLE at t-pt 
     992      END IF 
     993      ! 
     994      ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid (sign unchanged), needed to caclulate gham[uv] on u and 
     995      !    v grids 
     996      IF ( .NOT. l_istiled .OR. ntile == nijtile ) THEN   ! Finalise ghamu, ghamv, hbl, and hmle only after full domain has been 
     997         !                                                !    processed 
     998         IF ( nn_hls == 1 ) CALL lbc_lnk( 'zdfosm', ghamu, 'W', 1.0_wp,   & 
     999            &                                       ghamv, 'W', 1.0_wp ) 
     1000         DO jk = 2, jpkm1 
     1001            DO jj = Njs0, Nje0 
     1002               DO ji = Nis0, Nie0 
     1003                  ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) /   & 
     1004                     &              MAX( 1.0_wp, tmask(ji,jj,jk) + tmask (ji+1,jj,jk) ) * umask(ji,jj,jk) 
     1005                  ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) /   & 
     1006                     &              MAX( 1.0_wp, tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 
     1007                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) * tmask(ji,jj,jk) 
     1008                  ghams(ji,jj,jk) = ghams(ji,jj,jk) * tmask(ji,jj,jk) 
     1009               END DO 
     1010            END DO 
     1011         END DO 
     1012         ! Lateral boundary conditions on final outputs for hbl, on T-grid (sign unchanged) 
     1013         CALL lbc_lnk( 'zdfosm', hbl,  'T', 1.0_wp,   & 
     1014            &                    hmle, 'T', 1.0_wp ) 
     1015         ! 
     1016         CALL zdf_osm_iomput( "ghamt", tmask * ghamt       )   ! <Tw_NL> 
     1017         CALL zdf_osm_iomput( "ghams", tmask * ghams       )   ! <Sw_NL> 
     1018         CALL zdf_osm_iomput( "ghamu", umask * ghamu       )   ! <uw_NL> 
     1019         CALL zdf_osm_iomput( "ghamv", vmask * ghamv       )   ! <vw_NL> 
     1020         CALL zdf_osm_iomput( "hbl",   tmask(:,:,1) * hbl  )   ! Boundary-layer depth 
     1021         CALL zdf_osm_iomput( "hmle",  tmask(:,:,1) * hmle )   ! FK layer depth 
     1022      END IF 
     1023      ! 
     1024   END SUBROUTINE zdf_osm 
     1025 
     1026   SUBROUTINE zdf_osm_vertical_average( Kbb, Kmm, knlev, pt, ps,   & 
     1027      &                                 pb, pu, pv, kp_ext, pdt,   & 
     1028      &                                 pds, pdb, pdu, pdv ) 
     1029      !!--------------------------------------------------------------------- 
     1030      !!                ***  ROUTINE zdf_vertical_average  *** 
     1031      !! 
     1032      !! ** Purpose : Determines vertical averages from surface to knlev, 
     1033      !!              and optionally the differences between these vertical 
     1034      !!              averages and values at an external level 
     1035      !! 
     1036      !! ** Method  : Averages are calculated from the surface to knlev. 
     1037      !!              The external level used to calculate differences is 
     1038      !!              knlev+kp_ext 
     1039      !!---------------------------------------------------------------------- 
     1040      INTEGER,                            INTENT(in   )           ::   Kbb, Kmm   ! Ocean time-level indices 
     1041      INTEGER,  DIMENSION(A2D(nn_hls-1)), INTENT(in   )           ::   knlev      ! Number of levels to average over. 
     1042      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out)           ::   pt, ps     ! Average temperature and salinity 
     1043      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out)           ::   pb         ! Average buoyancy 
     1044      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out)           ::   pu, pv     ! Average current components 
     1045      INTEGER,  DIMENSION(A2D(nn_hls-1)), INTENT(in   ), OPTIONAL ::   kp_ext     ! External-level offsets 
     1046      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out), OPTIONAL ::   pdt        ! Difference between average temperature, 
     1047      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out), OPTIONAL ::   pds        !    salinity, 
     1048      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out), OPTIONAL ::   pdb        !    buoyancy, and 
     1049      REAL(wp), DIMENSION(jpi,jpj),       INTENT(  out), OPTIONAL ::   pdu, pdv   !    velocity components and the OSBL 
     1050      !! 
     1051      INTEGER                              ::   jk, jkflt, jkmax, ji, jj   ! Loop indices 
     1052      INTEGER                              ::   ibld_ext                   ! External-layer index 
     1053      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zthick                     ! Layer thickness 
     1054      REAL(wp)                             ::   zthermal                   ! Thermal expansion coefficient 
     1055      REAL(wp)                             ::   zbeta                      ! Haline contraction coefficient 
     1056      !!---------------------------------------------------------------------- 
     1057      ! 
     1058      ! Averages over depth of boundary layer 
     1059      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1060         pt(ji,jj) = 0.0_wp 
     1061         ps(ji,jj) = 0.0_wp 
     1062         pu(ji,jj) = 0.0_wp 
     1063         pv(ji,jj) = 0.0_wp 
     1064      END_2D 
     1065      zthick(:,:) = epsln 
     1066      jkflt = jpk 
     1067      jkmax = 0 
     1068      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1069         IF ( knlev(ji,jj) < jkflt ) jkflt = knlev(ji,jj) 
     1070         IF ( knlev(ji,jj) > jkmax ) jkmax = knlev(ji,jj) 
     1071      END_2D 
     1072      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkflt )   ! Upper, flat part of layer 
     1073         zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm) 
     1074         pt(ji,jj)     = pt(ji,jj)     + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 
     1075         ps(ji,jj)     = ps(ji,jj)     + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 
     1076         pu(ji,jj)     = pu(ji,jj)     + e3t(ji,jj,jk,Kmm) *                                        & 
     1077            &                               ( uu(ji,jj,jk,Kbb) + uu(ji - 1,jj,jk,Kbb) ) /           & 
     1078            &                               MAX( 1.0_wp , umask(ji,jj,jk) + umask(ji - 1,jj,jk) ) 
     1079         pv(ji,jj)     = pv(ji,jj)     + e3t(ji,jj,jk,Kmm) *                                        & 
     1080            &                               ( vv(ji,jj,jk,Kbb) + vv(ji,jj - 1,jk,Kbb) ) /           & 
     1081            &                               MAX( 1.0_wp , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) )          
     1082      END_3D 
     1083      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jkflt+1, jkmax )   ! Lower, non-flat part of layer 
     1084         IF ( knlev(ji,jj) >= jk ) THEN 
     1085            zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm) 
     1086            pt(ji,jj)     = pt(ji,jj)     + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 
     1087            ps(ji,jj)     = ps(ji,jj)     + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 
     1088            pu(ji,jj)     = pu(ji,jj)     + e3t(ji,jj,jk,Kmm) *                                        & 
     1089               &                               ( uu(ji,jj,jk,Kbb) + uu(ji - 1,jj,jk,Kbb) ) /           & 
     1090               &                               MAX( 1.0_wp , umask(ji,jj,jk) + umask(ji - 1,jj,jk) ) 
     1091            pv(ji,jj)     = pv(ji,jj)     + e3t(ji,jj,jk,Kmm) *                                        & 
     1092               &                               ( vv(ji,jj,jk,Kbb) + vv(ji,jj - 1,jk,Kbb) ) /           & 
     1093               &                               MAX( 1.0_wp , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) ) 
     1094         END IF 
     1095      END_3D 
     1096      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1097         pt(ji,jj) = pt(ji,jj) / zthick(ji,jj) 
     1098         ps(ji,jj) = ps(ji,jj) / zthick(ji,jj) 
     1099         pu(ji,jj) = pu(ji,jj) / zthick(ji,jj) 
     1100         pv(ji,jj) = pv(ji,jj) / zthick(ji,jj) 
     1101         zthermal  = rab_n(ji,jj,1,jp_tem)   ! ideally use nbld not 1?? 
     1102         zbeta     = rab_n(ji,jj,1,jp_sal) 
     1103         pb(ji,jj) = grav * zthermal * pt(ji,jj) - grav * zbeta * ps(ji,jj) 
     1104      END_2D 
     1105      ! 
     1106      ! Differences between vertical averages and values at an external layer 
     1107      IF ( PRESENT( kp_ext ) ) THEN 
     1108         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1109            ibld_ext = knlev(ji,jj) + kp_ext(ji,jj) 
     1110            IF ( ibld_ext <= mbkt(ji,jj)-1 ) THEN   ! ag 09/03 
     1111               ! Two external levels are available 
     1112               pdt(ji,jj) = pt(ji,jj) - ts(ji,jj,ibld_ext,jp_tem,Kmm) 
     1113               pds(ji,jj) = ps(ji,jj) - ts(ji,jj,ibld_ext,jp_sal,Kmm) 
     1114               pdu(ji,jj) = pu(ji,jj) - ( uu(ji,jj,ibld_ext,Kbb) + uu(ji-1,jj,ibld_ext,Kbb ) ) /              & 
     1115                  &                        MAX(1.0_wp , umask(ji,jj,ibld_ext ) + umask(ji-1,jj,ibld_ext ) ) 
     1116               pdv(ji,jj) = pv(ji,jj) - ( vv(ji,jj,ibld_ext,Kbb) + vv(ji,jj-1,ibld_ext,Kbb ) ) /              & 
     1117                  &                        MAX(1.0_wp , vmask(ji,jj,ibld_ext ) + vmask(ji,jj-1,ibld_ext ) ) 
     1118               zthermal   = rab_n(ji,jj,1,jp_tem)   ! ideally use nbld not 1?? 
     1119               zbeta      = rab_n(ji,jj,1,jp_sal) 
     1120               pdb(ji,jj) = grav * zthermal * pdt(ji,jj) - grav * zbeta * pds(ji,jj) 
     1121            ELSE 
     1122               pdt(ji,jj) = 0.0_wp 
     1123               pds(ji,jj) = 0.0_wp 
     1124               pdu(ji,jj) = 0.0_wp 
     1125               pdv(ji,jj) = 0.0_wp 
     1126               pdb(ji,jj) = 0.0_wp 
     1127            ENDIF 
     1128         END_2D 
     1129      END IF 
     1130      ! 
     1131   END SUBROUTINE zdf_osm_vertical_average 
     1132 
     1133   SUBROUTINE zdf_osm_velocity_rotation_2d( pu, pv, fwd ) 
     1134      !!--------------------------------------------------------------------- 
     1135      !!            ***  ROUTINE zdf_velocity_rotation_2d  *** 
     1136      !! 
     1137      !! ** Purpose : Rotates frame of reference of velocity components pu and 
     1138      !!              pv (2d) 
     1139      !! 
     1140      !! ** Method : The velocity components are rotated into (fwd=.TRUE.) or 
     1141      !!             from (fwd=.FALSE.) the frame specified by scos_wind and 
     1142      !!             ssin_wind 
     1143      !! 
     1144      !!----------------------------------------------------------------------       
     1145      REAL(wp),           INTENT(inout), DIMENSION(jpi,jpj) ::   pu, pv   ! Components of current 
     1146      LOGICAL,  OPTIONAL, INTENT(in   )                     ::   fwd      ! Forward (default) or reverse rotation 
     1147      !! 
     1148      INTEGER  ::   ji, jj       ! Loop indices 
     1149      REAL(wp) ::   ztmp, zfwd   ! Auxiliary variables 
     1150      !!----------------------------------------------------------------------       
     1151      ! 
     1152      zfwd = 1.0_wp 
     1153      IF( PRESENT(fwd) .AND. ( .NOT. fwd ) ) zfwd = -1.0_wp 
     1154      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1155         ztmp      = pu(ji,jj) 
     1156         pu(ji,jj) = pu(ji,jj) * scos_wind(ji,jj) + zfwd * pv(ji,jj) * ssin_wind(ji,jj) 
     1157         pv(ji,jj) = pv(ji,jj) * scos_wind(ji,jj) - zfwd * ztmp      * ssin_wind(ji,jj) 
     1158      END_2D 
     1159      ! 
     1160   END SUBROUTINE zdf_osm_velocity_rotation_2d 
     1161 
     1162   SUBROUTINE zdf_osm_velocity_rotation_3d( pu, pv, fwd, ktop, knlev ) 
     1163      !!--------------------------------------------------------------------- 
     1164      !!            ***  ROUTINE zdf_velocity_rotation_3d  *** 
     1165      !! 
     1166      !! ** Purpose : Rotates frame of reference of velocity components pu and 
     1167      !!              pv (3d) 
     1168      !! 
     1169      !! ** Method : The velocity components are rotated into (fwd=.TRUE.) or 
     1170      !!             from (fwd=.FALSE.) the frame specified by scos_wind and 
     1171      !!             ssin_wind; optionally, the rotation can be restricted at 
     1172      !!             each water column to span from the a minimum index ktop to 
     1173      !!             the depth index specified in array knlev 
     1174      !! 
     1175      !!----------------------------------------------------------------------       
     1176      REAL(wp),           INTENT(inout), DIMENSION(jpi,jpj,jpk)   ::   pu, pv   ! Components of current 
     1177      LOGICAL,  OPTIONAL, INTENT(in   )                           ::   fwd      ! Forward (default) or reverse rotation 
     1178      INTEGER,  OPTIONAL, INTENT(in   )                           ::   ktop     ! Minimum depth index 
     1179      INTEGER,  OPTIONAL, INTENT(in   ), DIMENSION(A2D(nn_hls-1)) ::   knlev    ! Array of maximum depth indices 
     1180      !! 
     1181      INTEGER  ::   ji, jj, jk, jktop, jkmax   ! Loop indices 
     1182      REAL(wp) ::   ztmp, zfwd                 ! Auxiliary variables 
     1183      LOGICAL  ::   llkbot                     ! Auxiliary variable 
     1184      !!----------------------------------------------------------------------       
     1185      ! 
     1186      zfwd = 1.0_wp 
     1187      IF( PRESENT(fwd) .AND. ( .NOT. fwd ) ) zfwd = -1.0_wp 
     1188      jktop = 1 
     1189      IF( PRESENT(ktop) ) jktop = ktop 
     1190      IF( PRESENT(knlev) ) THEN 
     1191         jkmax = 0 
     1192         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1193            IF ( knlev(ji,jj) > jkmax ) jkmax = knlev(ji,jj) 
     1194         END_2D 
     1195         llkbot = .FALSE. 
     1196      ELSE 
     1197         jkmax = jpk 
     1198         llkbot = .TRUE. 
     1199      END IF 
     1200      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jktop, jkmax ) 
     1201         IF ( llkbot .OR. knlev(ji,jj) >= jk ) THEN 
     1202            ztmp         = pu(ji,jj,jk) 
     1203            pu(ji,jj,jk) = pu(ji,jj,jk) * scos_wind(ji,jj) + zfwd * pv(ji,jj,jk) * ssin_wind(ji,jj) 
     1204            pv(ji,jj,jk) = pv(ji,jj,jk) * scos_wind(ji,jj) - zfwd * ztmp         * ssin_wind(ji,jj) 
     1205         END IF 
     1206      END_3D 
     1207      ! 
     1208   END SUBROUTINE zdf_osm_velocity_rotation_3d 
     1209 
     1210   SUBROUTINE zdf_osm_osbl_state( Kmm, pwb_ent, pwb_min, pshear, phbl,   & 
     1211      &                           phml, pdh ) 
     1212      !!--------------------------------------------------------------------- 
     1213      !!                 ***  ROUTINE zdf_osm_osbl_state  *** 
     1214      !! 
     1215      !! ** Purpose : Determines the state of the OSBL, stable/unstable, 
     1216      !!              shear/ noshear. Also determines shear production, 
     1217      !!              entrainment buoyancy flux and interfacial Richardson 
     1218      !!              number 
     1219      !! 
     1220      !! ** Method  : 
     1221      !! 
     1222      !!---------------------------------------------------------------------- 
     1223      INTEGER,                            INTENT(in   ) ::   Kmm       ! Ocean time-level index 
     1224      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pwb_ent   ! Buoyancy fluxes at base 
     1225      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pwb_min   !    of well-mixed layer 
     1226      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pshear    ! Production of TKE due to shear across the pycnocline 
     1227      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl      ! BL depth 
     1228      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phml      ! ML depth 
     1229      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdh       ! Pycnocline depth 
     1230      !! 
     1231      INTEGER :: jj, ji   ! Loop indices 
     1232      !! 
     1233      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zekman 
     1234      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zri_p, zri_b   ! Richardson numbers 
     1235      REAL(wp)                           ::   zshear_u, zshear_v, zwb_shr 
     1236      REAL(wp)                           ::   zwcor, zrf_conv, zrf_shear, zrf_langmuir, zr_stokes 
     1237      !! 
     1238      REAL(wp), PARAMETER ::   pp_a_shr         = 0.4_wp,  pp_b_shr    = 6.5_wp,  pp_a_wb_s = 0.8_wp 
     1239      REAL(wp), PARAMETER ::   pp_alpha_c       = 0.2_wp,  pp_alpha_lc = 0.03_wp 
     1240      REAL(wp), PARAMETER ::   pp_alpha_ls      = 0.06_wp, pp_alpha_s  = 0.15_wp 
     1241      REAL(wp), PARAMETER ::   pp_ri_p_thresh   = 27.0_wp 
     1242      REAL(wp), PARAMETER ::   pp_ri_c          = 0.25_wp 
     1243      REAL(wp), PARAMETER ::   pp_ek            = 4.0_wp 
     1244      REAL(wp), PARAMETER ::   pp_large         = -1e10_wp 
     1245      !!---------------------------------------------------------------------- 
     1246      ! 
     1247      ! Initialise arrays 
     1248      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1249         l_conv(ji,jj)  = .FALSE. 
     1250         l_shear(ji,jj) = .FALSE. 
     1251         n_ddh(ji,jj)   = 1 
     1252      END_2D 
     1253      ! Initialise INTENT(  out) arrays 
     1254      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1255         pwb_ent(ji,jj) = pp_large 
     1256         pwb_min(ji,jj) = pp_large 
     1257      END_2D 
     1258      ! 
     1259      ! Determins stability and set flag l_conv 
     1260      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1261         IF ( shol(ji,jj) < 0.0_wp ) THEN 
     1262            l_conv(ji,jj) = .TRUE. 
     1263         ELSE 
     1264            l_conv(ji,jj) = .FALSE. 
    6551265         ENDIF 
    656       END_3D 
    657  
    658 ! 
    659 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 
    660 ! 
    661       CALL zdf_osm_timestep_hbl( zdhdt ) 
    662 ! is external level in bounds? 
    663  
    664       CALL zdf_osm_vertical_average( ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 
    665 ! 
    666 ! 
    667 ! Check to see if lpyc needs to be changed 
    668  
    669       CALL zdf_osm_pycnocline_thickness( dh, zdh ) 
    670  
    671       DO_2D( 0, 0, 0, 0 ) 
    672        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. 
    673       END_2D 
    674  
    675       dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. )  !  Limit delta for shallow boundary layers for calculating flux-gradient terms. 
    676 ! 
    677     ! Average over the depth of the mixed layer in the convective boundary layer 
    678 !      jp_ext = ibld - imld +1 
    679       CALL zdf_osm_vertical_average( imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml ) 
    680     ! rotate mean currents and changes onto wind align co-ordinates 
    681     ! 
    682      CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 
    683      CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 
    684       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    685       !  Pycnocline gradients for scalars and velocity 
    686       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    687  
    688       CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 
    689       CALL zdf_osm_pycnocline_scalar_profiles( zdtdz_pyc, zdsdz_pyc, zdbdz_pyc, zalpha_pyc ) 
    690       CALL zdf_osm_pycnocline_shear_profiles( zdudz_pyc, zdvdz_pyc ) 
    691        !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    692        ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship 
    693        !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    694        CALL zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 
    695  
    696        ! 
    697        ! calculate non-gradient components of the flux-gradient relationships 
    698        ! 
    699 ! Stokes term in scalar flux, flux-gradient relationship 
    700        WHERE ( lconv ) 
    701           zsc_wth_1 = zwstrl**3 * zwth0 / ( zvstr**3 + 0.5 * zwstrc**3 + epsln) 
    702           ! 
    703           zsc_ws_1 = zwstrl**3 * zws0 / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 
    704        ELSEWHERE 
    705           zsc_wth_1 = 2.0 * zwthav 
    706           ! 
    707           zsc_ws_1 = 2.0 * zwsav 
    708        ENDWHERE 
    709  
    710  
    711        DO_2D( 0, 0, 0, 0 ) 
    712          IF ( lconv(ji,jj) ) THEN 
    713            DO jk = 2, imld(ji,jj) 
    714               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
    715               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 
    716               ! 
    717               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) *  zsc_ws_1(ji,jj) 
    718            END DO ! end jk loop 
    719          ELSE     ! else for if (lconv) 
    720  ! Stable conditions 
    721             DO jk = 2, ibld(ji,jj) 
    722                zznd_d=gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
    723                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 
    724                     &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 
    725                ! 
    726                ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 
    727                     &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) *  zsc_ws_1(ji,jj) 
    728             END DO 
    729          ENDIF               ! endif for check on lconv 
    730  
    731        END_2D 
    732  
    733 ! Stokes term in flux-gradient relationship (note in zsc_uw_n don't use zvstr since term needs to go to zero as zwstrl goes to zero) 
    734        WHERE ( lconv ) 
    735           zsc_uw_1 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MAX( ( 1.0 - 1.0 * 6.5 * zla**(8.0/3.0) ), 0.2 ) 
    736           zsc_uw_2 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MIN( zla**(8.0/3.0) + epsln, 0.12 ) 
    737           zsc_vw_1 = ff_t * zhml * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / ( ( zvstr**3 + 0.5 * zwstrc**3 )**(2.0/3.0) + epsln ) 
    738        ELSEWHERE 
    739           zsc_uw_1 = zustar**2 
    740           zsc_vw_1 = ff_t * zhbl * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / (zvstr**2 + epsln) 
    741        ENDWHERE 
    742        IF(ln_dia_osm) THEN 
    743           IF ( iom_use("ghamu_00") ) CALL iom_put( "ghamu_00", wmask*ghamu ) 
    744           IF ( iom_use("ghamv_00") ) CALL iom_put( "ghamv_00", wmask*ghamv ) 
    745        END IF 
    746        DO_2D( 0, 0, 0, 0 ) 
    747           IF ( lconv(ji,jj) ) THEN 
    748              DO jk = 2, imld(ji,jj) 
    749                 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
    750                 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) +      ( -0.05 * EXP ( -0.4 * zznd_d )   * zsc_uw_1(ji,jj)   & 
    751                      &          +                        0.00125 * EXP (      - zznd_d )   * zsc_uw_2(ji,jj) ) & 
    752                      &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) ) 
    753 ! 
    754                 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65 *  0.15 * EXP (      - zznd_d )                       & 
    755                      &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_vw_1(ji,jj) 
    756              END DO   ! end jk loop 
    757           ELSE 
    758 ! Stable conditions 
    759              DO jk = 2, ibld(ji,jj) ! corrected to ibld 
    760                 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
    761                 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 *   1.3 * EXP ( -0.5 * zznd_d )                       & 
    762                      &                                   * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj) 
    763                 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp 
    764              END DO   ! end jk loop 
    765           ENDIF 
    766        END_2D 
    767  
    768 ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio (X0.3) and pressure (X0.5)] 
    769  
    770        WHERE ( lconv ) 
    771           zsc_wth_1 = zwbav * zwth0 * ( 1.0 + EXP ( 0.2 * zhol ) ) / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 
    772           zsc_ws_1  = zwbav * zws0  * ( 1.0 + EXP ( 0.2 * zhol ) ) / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 
    773        ELSEWHERE 
    774           zsc_wth_1 = 0._wp 
    775           zsc_ws_1 = 0._wp 
    776        ENDWHERE 
    777  
    778        DO_2D( 0, 0, 0, 0 ) 
    779           IF (lconv(ji,jj) ) THEN 
    780              DO jk = 2, imld(ji,jj) 
    781                 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
    782                 ! calculate turbulent length scale 
    783                 zl_c = 0.9 * ( 1.0 - EXP ( - 7.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           & 
    784                      &     * ( 1.0 - EXP ( -15.0 * (     1.1 - zznd_ml          ) ) ) 
    785                 zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           & 
    786                      &     * ( 1.0 - EXP ( - 5.0 * (     1.0 - zznd_ml          ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) ) 
    787                 zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( -3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0 / 2.0) 
    788                 ! non-gradient buoyancy terms 
    789                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.5 * zsc_wth_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 
    790                 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 *  zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 
    791              END DO 
    792  
    793              IF ( lpyc(ji,jj) ) THEN 
    794                ztau_sc_u(ji,jj) = zhml(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 
    795                ztau_sc_u(ji,jj) = ztau_sc_u(ji,jj) * ( 1.4 -0.4 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )**1.5 ) 
    796                zwth_ent =  -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zdt_ml(ji,jj) 
    797                zws_ent =  -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zds_ml(ji,jj) 
    798 ! Cubic profile used for buoyancy term 
    799                za_cubic = 0.755 * ztau_sc_u(ji,jj) 
    800                zb_cubic = 0.25 * ztau_sc_u(ji,jj) 
    801                DO jk = 2, ibld(ji,jj) 
    802                  zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 
    803                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - 0.045 * ( ( zwth_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 ) 
    804  
    805                  ghams(ji,jj,jk) = ghams(ji,jj,jk) - 0.045 * ( ( zws_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 ) 
    806                END DO 
    807 ! 
    808                zbuoy_pyc_sc = zalpha_pyc(ji,jj) * zdb_ml(ji,jj) / zdh(ji,jj) + zdbdz_bl_ext(ji,jj) 
    809                zdelta_pyc = ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird / SQRT( MAX( zbuoy_pyc_sc, ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / zdh(ji,jj)**2 ) ) 
    810 ! 
    811                zwt_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zdt_ml(ji,jj) / zdh(ji,jj) + zdtdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj) 
    812 ! 
    813                zws_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zds_ml(ji,jj) / zdh(ji,jj) + zdsdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj) 
    814 ! 
    815                zzeta_pyc = 0.15 - 0.175 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) ) 
    816                DO jk = 2, ibld(ji,jj) 
    817                  zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 
    818                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.05 * zwt_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 
    819 ! 
    820                  ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.05 * zws_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 
    821                END DO 
    822             ENDIF ! End of pycnocline 
    823           ELSE ! lconv test - stable conditions 
    824              DO jk = 2, ibld(ji,jj) 
    825                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) 
    826                 ghams(ji,jj,jk) = ghams(ji,jj,jk) +  zsc_ws_1(ji,jj) 
    827              END DO 
    828           ENDIF 
    829        END_2D 
    830  
    831        WHERE ( lconv ) 
    832           zsc_uw_1 = -zwb0 * zustar**2 * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 
    833           zsc_uw_2 =  zwb0 * zustke    * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln )**(2.0/3.0) 
    834           zsc_vw_1 = 0._wp 
    835        ELSEWHERE 
    836          zsc_uw_1 = 0._wp 
    837          zsc_vw_1 = 0._wp 
    838        ENDWHERE 
    839  
    840        DO_2D( 0, 0, 0, 0 ) 
    841           IF ( lconv(ji,jj) ) THEN 
    842              DO jk = 2 , imld(ji,jj) 
    843                 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
    844                 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) +   0.125 * EXP( -0.5 * zznd_d )     & 
    845                      &                                                            * (   1.0 - EXP( -0.5 * zznd_d ) )   & 
    846                      &                                          * zsc_uw_2(ji,jj)                                    ) 
    847                 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 
    848              END DO  ! jk loop 
    849           ELSE 
    850           ! stable conditions 
    851              DO jk = 2, ibld(ji,jj) 
    852                 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) 
    853                 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 
    854              END DO 
    855           ENDIF 
    856        END_2D 
    857  
    858        DO_2D( 0, 0, 0, 0 ) 
    859         IF ( lpyc(ji,jj) ) THEN 
    860           IF ( j_ddh(ji,jj) == 0 ) THEN 
    861 ! Place holding code. Parametrization needs checking for these conditions. 
    862             zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) )**pthird )**pthird 
    863             zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj) 
    864             zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj) 
    865           ELSE 
    866             zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) )**pthird )**pthird 
    867             zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj) 
    868             zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj) 
    869           ENDIF 
    870           zd_cubic = zdh(ji,jj) / zhbl(ji,jj) * zuw0(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zuw_bse 
    871           zc_cubic = zuw_bse - zd_cubic 
    872 ! need ztau_sc_u to be available. Change to array. 
    873           DO jk = imld(ji,jj), ibld(ji,jj) 
    874              zznd_pyc = - ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 
    875              ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.045 * ztau_sc_u(ji,jj)**2 * ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 
    876           END DO 
    877           zvw_max = 0.7 * ff_t(ji,jj) * ( zustke(ji,jj) * dstokes(ji,jj) + 0.75 * zustar(ji,jj) * zhml(ji,jj) ) 
    878           zd_cubic = zvw_max * zdh(ji,jj) / zhml(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zvw_bse 
    879           zc_cubic = zvw_bse - zd_cubic 
    880           DO jk = imld(ji,jj), ibld(ji,jj) 
    881             zznd_pyc = -( gdepw(ji,jj,jk,Kmm) -zhbl(ji,jj) ) / zdh(ji,jj) 
    882             ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.045 * ztau_sc_u(ji,jj)**2 * ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 
    883           END DO 
    884         ENDIF  ! lpyc 
    885        END_2D 
    886  
    887        IF(ln_dia_osm) THEN 
    888           IF ( iom_use("ghamu_0") ) CALL iom_put( "ghamu_0", wmask*ghamu ) 
    889           IF ( iom_use("zsc_uw_1_0") ) CALL iom_put( "zsc_uw_1_0", tmask(:,:,1)*zsc_uw_1 ) 
    890        END IF 
    891 ! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 
    892  
    893        DO_2D( 1, 0, 1, 0 ) 
    894  
    895          IF ( lconv(ji,jj) ) THEN 
    896            zsc_wth_1(ji,jj) = zwth0(ji,jj) / ( 1.0 - 0.56 * EXP( zhol(ji,jj) ) ) 
    897            zsc_ws_1(ji,jj) = zws0(ji,jj) / (1.0 - 0.56 *EXP( zhol(ji,jj) ) ) 
    898            IF ( lpyc(ji,jj) ) THEN 
    899 ! Pycnocline scales 
    900               zsc_wth_pyc(ji,jj) = -0.2 * zwb0(ji,jj) * zdt_bl(ji,jj) / zdb_bl(ji,jj) 
    901               zsc_ws_pyc(ji,jj) = -0.2 * zwb0(ji,jj) * zds_bl(ji,jj) / zdb_bl(ji,jj) 
    902             ENDIF 
    903          ELSE 
    904            zsc_wth_1(ji,jj) = 2.0 * zwthav(ji,jj) 
    905            zsc_ws_1(ji,jj) = zws0(ji,jj) 
    906          ENDIF 
    907        END_2D 
    908  
    909        DO_2D( 0, 0, 0, 0 ) 
    910          IF ( lconv(ji,jj) ) THEN 
    911             DO jk = 2, imld(ji,jj) 
    912                zznd_ml=gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
    913                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj)                & 
    914                     &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      & 
    915                     &                               - EXP(     - 6.0 * zznd_ml    ) ) )  & 
    916                     &          * ( 1.0 - EXP( - 15.0 * (         1.0 - zznd_ml    ) ) ) 
    917                ! 
    918                ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj)  & 
    919                     &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      & 
    920                     &                               - EXP(     - 6.0 * zznd_ml    ) ) )  & 
    921                     &          * ( 1.0 - EXP ( -15.0 * (         1.0 - zznd_ml    ) ) ) 
    922             END DO 
    923 ! 
    924             IF ( lpyc(ji,jj) ) THEN 
    925 ! pycnocline 
    926               DO jk = imld(ji,jj), ibld(ji,jj) 
    927                 zznd_pyc = - ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 
    928                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 4.0 * zsc_wth_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) ) 
    929                 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 4.0 * zsc_ws_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) ) 
    930               END DO 
    931            ENDIF 
    932          ELSE 
    933             IF( zdhdt(ji,jj) > 0. ) THEN 
    934               DO jk = 2, ibld(ji,jj) 
    935                  zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
    936                  znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    937                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 
    938               &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 
    939                  ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 
    940                &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 
    941               END DO 
     1266      END_2D 
     1267      ! 
     1268      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1269         pshear(ji,jj) = 0.0_wp 
     1270      END_2D 
     1271      zekman(:,:) = EXP( -1.0_wp * pp_ek * ABS( ff_t(A2D(nn_hls-1)) ) * phbl(A2D(nn_hls-1)) /   & 
     1272         &               MAX( sustar(A2D(nn_hls-1)), 1.e-8 ) ) 
     1273      ! 
     1274      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1275         IF ( l_conv(ji,jj) ) THEN 
     1276            IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN 
     1277               zri_p(ji,jj) = MAX (  SQRT( av_db_bl(ji,jj) * pdh(ji,jj) / MAX( av_du_bl(ji,jj)**2 + av_dv_bl(ji,jj)**2,     & 
     1278                  &                                                          1e-8_wp ) ) * ( phbl(ji,jj) / pdh(ji,jj) ) *   & 
     1279                  &                  ( svstr(ji,jj) / MAX( sustar(ji,jj), 1e-6_wp ) )**2 /                                  & 
     1280                  &                  MAX( zekman(ji,jj), 1.0e-6_wp ), 5.0_wp ) 
     1281               IF ( ff_t(ji,jj) >= 0.0_wp ) THEN   ! Northern hemisphere 
     1282                  zri_b(ji,jj) = av_db_ml(ji,jj) * pdh(ji,jj) / ( MAX( av_du_ml(ji,jj), 1e-5_wp )**2 +   & 
     1283                     &                                          MAX( -1.0_wp * av_dv_ml(ji,jj), 1e-5_wp)**2 ) 
     1284               ELSE                                ! Southern hemisphere 
     1285                  zri_b(ji,jj) = av_db_ml(ji,jj) * pdh(ji,jj) / ( MAX( av_du_ml(ji,jj), 1e-5_wp )**2 +   & 
     1286                     &                                          MAX(           av_dv_ml(ji,jj), 1e-5_wp)**2 ) 
     1287               END IF 
     1288               pshear(ji,jj) = pp_a_shr * zekman(ji,jj) *                                                   & 
     1289                  &            ( MAX( sustar(ji,jj)**2 * av_du_ml(ji,jj) / phbl(ji,jj), 0.0_wp ) +          & 
     1290                  &              pp_b_shr * MAX( -1.0_wp * ff_t(ji,jj) * sustke(ji,jj) * dstokes(ji,jj) *   & 
     1291                  &                            av_dv_ml(ji,jj) / phbl(ji,jj), 0.0_wp ) ) 
     1292               ! Stability dependence 
     1293               pshear(ji,jj) = pshear(ji,jj) * EXP( -0.75_wp * MAX( 0.0_wp, ( zri_b(ji,jj) - pp_ri_c ) / pp_ri_c ) ) 
     1294               !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     1295               ! Test ensures n_ddh=0 is not selected. Change to zri_p<27 when  ! 
     1296               ! full code available                                          ! 
     1297               !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     1298               IF ( pshear(ji,jj) > 1e-10 ) THEN 
     1299                  IF ( zri_p(ji,jj) < pp_ri_p_thresh .AND.   & 
     1300                     & MIN( hu(ji,jj,Kmm), hu(ji-1,jj,Kmm), hv(ji,jj,Kmm), hv(ji,jj-1,Kmm) ) > 100.0_wp ) THEN 
     1301                     ! Growing shear layer 
     1302                     n_ddh(ji,jj) = 0 
     1303                     l_shear(ji,jj) = .TRUE. 
     1304                  ELSE 
     1305                     n_ddh(ji,jj) = 1 
     1306                     !             IF ( zri_b <= 1.5 .and. pshear(ji,jj) > 0._wp ) THEN 
     1307                     ! Shear production large enough to determine layer charcteristics, but can't maintain a shear layer 
     1308                     l_shear(ji,jj) = .TRUE. 
     1309                     !             ELSE 
     1310                  END IF 
     1311               ELSE 
     1312                  n_ddh(ji,jj) = 2 
     1313                  l_shear(ji,jj) = .FALSE. 
     1314               END IF 
     1315               ! Shear production may not be zero, but is small and doesn't determine characteristics of pycnocline 
     1316               !               pshear(ji,jj) = 0.5 * pshear(ji,jj) 
     1317               !               l_shear(ji,jj) = .FALSE. 
     1318               !            ENDIF 
     1319            ELSE   ! av_db_bl test, note pshear set to zero 
     1320               n_ddh(ji,jj) = 2 
     1321               l_shear(ji,jj) = .FALSE. 
    9421322            ENDIF 
    9431323         ENDIF 
    944        END_2D 
    945  
    946        WHERE ( lconv ) 
    947           zsc_uw_1 = zustar**2 
    948           zsc_vw_1 = ff_t * zustke * zhml 
    949        ELSEWHERE 
    950           zsc_uw_1 = zustar**2 
    951           zsc_uw_2 = (2.25 - 3.0 * ( 1.0 - EXP( -1.25 * 2.0 ) ) ) * ( 1.0 - EXP( -4.0 * 2.0 ) ) * zsc_uw_1 
    952           zsc_vw_1 = ff_t * zustke * zhbl 
    953           zsc_vw_2 = -0.11 * SIN( 3.14159 * ( 2.0 + 0.4 ) ) * EXP(-( 1.5 + 2.0 )**2 ) * zsc_vw_1 
    954        ENDWHERE 
    955  
    956        DO_2D( 0, 0, 0, 0 ) 
    957           IF ( lconv(ji,jj) ) THEN 
    958             DO jk = 2, imld(ji,jj) 
    959                zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
    960                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
    961                ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 
    962                     & + 0.3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj) 
     1324      END_2D 
     1325      ! 
     1326      ! Calculate entrainment buoyancy flux due to surface fluxes. 
     1327      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1328         IF ( l_conv(ji,jj) ) THEN 
     1329            zwcor        = ABS( ff_t(ji,jj) ) * phbl(ji,jj) + epsln 
     1330            zrf_conv     = TANH( ( swstrc(ji,jj) / zwcor )**0.69_wp ) 
     1331            zrf_shear    = TANH( ( sustar(ji,jj) / zwcor )**0.69_wp ) 
     1332            zrf_langmuir = TANH( ( swstrl(ji,jj) / zwcor )**0.69_wp ) 
     1333            IF ( nn_osm_SD_reduce > 0 ) THEN 
     1334               ! Effective Stokes drift already reduced from surface value 
     1335               zr_stokes = 1.0_wp 
     1336            ELSE 
     1337               ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd, 
     1338               ! requires further reduction where BL is deep 
     1339               zr_stokes = 1.0 - EXP( -25.0_wp * dstokes(ji,jj) / hbl(ji,jj) * ( 1.0_wp + 4.0_wp * dstokes(ji,jj) / hbl(ji,jj) ) ) 
     1340            END IF 
     1341            pwb_ent(ji,jj) = -2.0_wp * pp_alpha_c * zrf_conv * swbav(ji,jj) -                                          & 
     1342               &             pp_alpha_s * zrf_shear * sustar(ji,jj)**3 / phml(ji,jj) +                                 & 
     1343               &             zr_stokes * ( pp_alpha_s * EXP( -1.5_wp * sla(ji,jj) ) * zrf_shear * sustar(ji,jj)**3 -   & 
     1344               &                           zrf_langmuir * pp_alpha_lc * swstrl(ji,jj)**3 ) / phml(ji,jj) 
     1345         ENDIF 
     1346      END_2D 
     1347      ! 
     1348      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1349         IF ( l_shear(ji,jj) ) THEN 
     1350            IF ( l_conv(ji,jj) ) THEN 
     1351               ! Unstable OSBL 
     1352               zwb_shr = -1.0_wp * pp_a_wb_s * zri_b(ji,jj) * pshear(ji,jj) 
     1353               IF ( n_ddh(ji,jj) == 0 ) THEN 
     1354                  ! Developing shear layer, additional shear production possible. 
     1355 
     1356                  !    pshear_u = MAX( zustar(ji,jj)**2 * MAX( av_du_ml(ji,jj), 0._wp ) /  phbl(ji,jj), 0._wp ) 
     1357                  !    pshear(ji,jj) = pshear(ji,jj) + pshear_u * ( 1.0 - MIN( zri_p(ji,jj) / pp_ri_p_thresh, 1.d0 )**2 ) 
     1358                  !    pshear(ji,jj) = MIN( pshear(ji,jj), pshear_u ) 
     1359 
     1360                  !    zwb_shr = zwb_shr - 0.25 * MAX ( pshear_u, 0._wp) * ( 1.0 - MIN( zri_p(ji,jj) / pp_ri_p_thresh, 1._wp )**2 ) 
     1361                  !    zwb_shr = MAX( zwb_shr, -0.25 * pshear_u ) 
     1362               ENDIF 
     1363               pwb_ent(ji,jj) = pwb_ent(ji,jj) + zwb_shr 
     1364               !           pwb_min(ji,jj) = pwb_ent(ji,jj) + pdh(ji,jj) / phbl(ji,jj) * zwb0(ji,jj) 
     1365            ELSE   ! IF ( l_conv ) THEN - ENDIF 
     1366               ! Stable OSBL  - shear production not coded for first attempt. 
     1367            ENDIF   ! l_conv 
     1368         END IF   ! l_shear 
     1369         IF ( l_conv(ji,jj) ) THEN 
     1370            ! Unstable OSBL 
     1371            pwb_min(ji,jj) = pwb_ent(ji,jj) + pdh(ji,jj) / phbl(ji,jj) * 2.0_wp * swbav(ji,jj) 
     1372         END IF  ! l_conv 
     1373      END_2D 
     1374      ! 
     1375   END SUBROUTINE zdf_osm_osbl_state 
     1376 
     1377   SUBROUTINE zdf_osm_external_gradients( Kmm, kbase, pdtdz, pdsdz, pdbdz ) 
     1378      !!--------------------------------------------------------------------- 
     1379      !!                   ***  ROUTINE zdf_osm_external_gradients  *** 
     1380      !! 
     1381      !! ** Purpose : Calculates the gradients below the OSBL 
     1382      !! 
     1383      !! ** Method  : Uses nbld and ibld_ext to determine levels to calculate the gradient. 
     1384      !! 
     1385      !!----------------------------------------------------------------------    
     1386      INTEGER,                            INTENT(in   ) ::   Kmm            ! Ocean time-level index 
     1387      INTEGER,  DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   kbase          ! OSBL base layer index 
     1388      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pdtdz, pdsdz   ! External gradients of temperature, salinity 
     1389      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pdbdz          !    and buoyancy 
     1390      !! 
     1391      INTEGER  ::   ji, jj, jkb, jkb1 
     1392      REAL(wp) ::   zthermal, zbeta 
     1393      !! 
     1394      REAL(wp), PARAMETER ::   pp_large = -1e10_wp 
     1395      !!----------------------------------------------------------------------    
     1396      ! 
     1397      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1398         pdtdz(ji,jj) = pp_large 
     1399         pdsdz(ji,jj) = pp_large 
     1400         pdbdz(ji,jj) = pp_large 
     1401      END_2D 
     1402      ! 
     1403      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1404         IF ( kbase(ji,jj)+1 < mbkt(ji,jj) ) THEN 
     1405            zthermal = rab_n(ji,jj,1,jp_tem)   ! Ideally use nbld not 1?? 
     1406            zbeta    = rab_n(ji,jj,1,jp_sal) 
     1407            jkb = kbase(ji,jj) 
     1408            jkb1 = MIN( jkb + 1, mbkt(ji,jj) ) 
     1409            pdtdz(ji,jj) = -1.0_wp * ( ts(ji,jj,jkb1,jp_tem,Kmm) - ts(ji,jj,jkb,jp_tem,Kmm ) ) / e3w(ji,jj,jkb1,Kmm) 
     1410            pdsdz(ji,jj) = -1.0_wp * ( ts(ji,jj,jkb1,jp_sal,Kmm) - ts(ji,jj,jkb,jp_sal,Kmm ) ) / e3w(ji,jj,jkb1,Kmm) 
     1411            pdbdz(ji,jj) = grav * zthermal * pdtdz(ji,jj) - grav * zbeta * pdsdz(ji,jj) 
     1412         ELSE 
     1413            pdtdz(ji,jj) = 0.0_wp 
     1414            pdsdz(ji,jj) = 0.0_wp 
     1415            pdbdz(ji,jj) = 0.0_wp 
     1416         END IF 
     1417      END_2D 
     1418      ! 
     1419   END SUBROUTINE zdf_osm_external_gradients 
     1420 
     1421   SUBROUTINE zdf_osm_calculate_dhdt( pdhdt, phbl, pdh, pwb_ent, pwb_min,   & 
     1422      &                               pdbdz_bl_ext, pwb_fk_b, pwb_fk, pvel_mle ) 
     1423      !!--------------------------------------------------------------------- 
     1424      !!                   ***  ROUTINE zdf_osm_calculate_dhdt  *** 
     1425      !! 
     1426      !! ** Purpose : Calculates the rate at which hbl changes. 
     1427      !! 
     1428      !! ** Method  : 
     1429      !! 
     1430      !!---------------------------------------------------------------------- 
     1431      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pdhdt          ! Rate of change of hbl 
     1432      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl           ! BL depth 
     1433      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdh            ! Pycnocline depth 
     1434      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_ent        ! Buoyancy entrainment flux 
     1435      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_min 
     1436      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdbdz_bl_ext   ! External buoyancy gradients 
     1437      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(  out) ::   pwb_fk_b       ! MLE buoyancy flux averaged over OSBL 
     1438      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_fk         ! Max MLE buoyancy flux 
     1439      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pvel_mle       ! Vvelocity scale for dhdt with stable ML and FK 
     1440      !! 
     1441      INTEGER  ::   jj, ji 
     1442      REAL(wp) ::   zgamma_b_nd, zgamma_dh_nd, zpert, zpsi, zari 
     1443      REAL(wp) ::   zvel_max, zddhdt 
     1444      !! 
     1445      REAL(wp), PARAMETER ::   pp_alpha_b = 0.3_wp 
     1446      REAL(wp), PARAMETER ::   pp_ddh     = 2.5_wp, pp_ddh_2 = 3.5_wp   ! Also in pycnocline_depth 
     1447      REAL(wp), PARAMETER ::   pp_large   = -1e10_wp 
     1448      !!---------------------------------------------------------------------- 
     1449      ! 
     1450      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1451         pdhdt(ji,jj)    = pp_large 
     1452         pwb_fk_b(ji,jj) = pp_large 
     1453      END_2D 
     1454      ! 
     1455      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1456         ! 
     1457         IF ( l_shear(ji,jj) ) THEN 
     1458            ! 
     1459            IF ( l_conv(ji,jj) ) THEN   ! Convective 
    9631460               ! 
    964                ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 
    965                     & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj) 
    966             END DO 
    967           ELSE 
    968             DO jk = 2, ibld(ji,jj) 
    969                znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    970                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
    971                IF ( zznd_d <= 2.0 ) THEN 
    972                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 & 
    973                        &*  ( 2.25 - 3.0  * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj) 
     1461               IF ( ln_osm_mle ) THEN 
     1462                  IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN   ! Fox-Kemper buoyancy flux average over OSBL 
     1463                     pwb_fk_b(ji,jj) = pwb_fk(ji,jj) * ( 1.0_wp + hmle(ji,jj) / ( 6.0_wp * hbl(ji,jj) ) *   & 
     1464                        &                                         ( -1.0_wp + ( 1.0_wp - 2.0_wp * hbl(ji,jj) / hmle(ji,jj) )**3 ) ) 
     1465                  ELSE 
     1466                     pwb_fk_b(ji,jj) = 0.5_wp * pwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 
     1467                  ENDIF 
     1468                  zvel_max = ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 
     1469                  IF ( ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) < 0.0_wp ) THEN   ! OSBL is deepening, 
     1470                     !                                                                 !    entrainment > restratification 
     1471                     IF ( av_db_bl(ji,jj) > 1e-15_wp ) THEN 
     1472                        zgamma_b_nd = MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) * pdh(ji,jj) /   & 
     1473                           &          ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 
     1474                        zpsi = ( 1.0_wp - 0.5_wp * pdh(ji,jj) / phbl(ji,jj) ) *                                                & 
     1475                           &   ( swb0(ji,jj) - MIN( ( pwb_min(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ), 0.0_wp ) ) * pdh(ji,jj) /   & 
     1476                           &   phbl(ji,jj) 
     1477                        zpsi = zpsi + 1.75_wp * ( 1.0_wp - 0.5_wp * pdh(ji,jj) / phbl(ji,jj) ) *   & 
     1478                           &          ( pdh(ji,jj) / phbl(ji,jj) + zgamma_b_nd ) *   & 
     1479                           &          MIN( ( pwb_min(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ), 0.0_wp ) 
     1480                        zpsi = pp_alpha_b * MAX( zpsi, 0.0_wp ) 
     1481                        pdhdt(ji,jj) = -1.0_wp * ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) /      & 
     1482                           &                      ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) +   & 
     1483                           &            zpsi / ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 
     1484                        IF ( n_ddh(ji,jj) == 1 ) THEN 
     1485                           IF ( ( swstrc(ji,jj) / svstr(ji,jj) )**3 <= 0.5_wp ) THEN 
     1486                              zari = MIN( 1.5_wp * av_db_bl(ji,jj) /                                                   & 
     1487                                 &        ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +                       & 
     1488                                 &                               av_db_bl(ji,jj)**2 / MAX( 4.5_wp * svstr(ji,jj)**2,   & 
     1489                                 &                                                       1e-12_wp ) ) ), 0.2_wp ) 
     1490                           ELSE 
     1491                              zari = MIN( 1.5_wp * av_db_bl(ji,jj) /                                                    & 
     1492                                 &        ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +                        & 
     1493                                 &                               av_db_bl(ji,jj)**2 / MAX( 4.5_wp * swstrc(ji,jj)**2,   & 
     1494                                 &                                                       1e-12_wp ) ) ), 0.2_wp ) 
     1495                           ENDIF 
     1496                           ! Relaxation to dh_ref = zari * hbl 
     1497                           zddhdt = -1.0_wp * pp_ddh_2 * ( 1.0_wp - pdh(ji,jj) / ( zari * phbl(ji,jj) ) ) * pwb_ent(ji,jj) /   & 
     1498                              &     ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 
     1499                        ELSE IF ( n_ddh(ji,jj) == 0 ) THEN   ! Growing shear layer 
     1500                           zddhdt = -1.0_wp * pp_ddh * ( 1.0_wp - 1.6_wp * pdh(ji,jj) / phbl(ji,jj) ) * pwb_ent(ji,jj) /   & 
     1501                              &     ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 
     1502                           zddhdt = EXP( -4.0_wp * ABS( ff_t(ji,jj) ) * phbl(ji,jj) / MAX( sustar(ji,jj), 1e-8_wp ) ) * zddhdt 
     1503                        ELSE 
     1504                           zddhdt = 0.0_wp 
     1505                        ENDIF   ! n_ddh 
     1506                        pdhdt(ji,jj) = pdhdt(ji,jj) + pp_alpha_b * ( 1.0_wp - 0.5_wp * pdh(ji,jj) / phbl(ji,jj) ) *   & 
     1507                           &                            av_db_ml(ji,jj) * MAX( zddhdt, 0.0_wp ) /   & 
     1508                           &                            ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 
     1509                     ELSE   ! av_db_bl >0 
     1510                        pdhdt(ji,jj) = -1.0_wp * ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) /  MAX( zvel_max, 1e-15_wp ) 
     1511                     ENDIF 
     1512                  ELSE   ! pwb_min + 2*pwb_fk_b < 0 
     1513                     ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 
     1514                     pdhdt(ji,jj) = -1.0_wp * MIN( pvel_mle(ji,jj), hbl(ji,jj) / 10800.0_wp ) 
     1515                  ENDIF 
     1516               ELSE   ! Fox-Kemper not used. 
     1517                  zvel_max = -1.0_wp * ( 1.0_wp + 1.0_wp * ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird *     & 
     1518                     &                                                         rn_Dt / hbl(ji,jj) ) * pwb_ent(ji,jj) /   & 
     1519                     &       MAX( ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird, epsln ) 
     1520                  pdhdt(ji,jj) = -1.0_wp * pwb_ent(ji,jj) / ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 
     1521                  ! added ajgn 23 July as temporay fix 
     1522               ENDIF   ! ln_osm_mle 
     1523               ! 
     1524            ELSE   ! l_conv - Stable 
     1525               ! 
     1526               pdhdt(ji,jj) = ( 0.06_wp + 0.52_wp * shol(ji,jj) / 2.0_wp ) * svstr(ji,jj)**3 / hbl(ji,jj) + swbav(ji,jj) 
     1527               IF ( pdhdt(ji,jj) < 0.0_wp ) THEN   ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 
     1528                  zpert = 2.0_wp * ( 1.0_wp + 0.0_wp * 2.0_wp * svstr(ji,jj) * rn_Dt / hbl(ji,jj) ) * svstr(ji,jj)**2 / hbl(ji,jj) 
     1529               ELSE 
     1530                  zpert = MAX( svstr(ji,jj)**2 / hbl(ji,jj), av_db_bl(ji,jj) ) 
     1531               ENDIF 
     1532               pdhdt(ji,jj) = 2.0_wp * pdhdt(ji,jj) / MAX( zpert, epsln ) 
     1533               pdhdt(ji,jj) = MAX( pdhdt(ji,jj), -1.0_wp * hbl(ji,jj) / 5400.0_wp ) 
     1534               ! 
     1535            ENDIF   ! l_conv 
     1536            ! 
     1537         ELSE   ! l_shear 
     1538            ! 
     1539            IF ( l_conv(ji,jj) ) THEN   ! Convective 
     1540               ! 
     1541               IF ( ln_osm_mle ) THEN 
     1542                  IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN   ! Fox-Kemper buoyancy flux average over OSBL 
     1543                     pwb_fk_b(ji,jj) = pwb_fk(ji,jj) *                       & 
     1544                        ( 1.0_wp + hmle(ji,jj) / ( 6.0_wp * hbl(ji,jj) ) *   & 
     1545                        &          ( -1.0_wp + ( 1.0_wp - 2.0_wp * hbl(ji,jj) / hmle(ji,jj))**3) ) 
     1546                  ELSE 
     1547                     pwb_fk_b(ji,jj) = 0.5_wp * pwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 
     1548                  ENDIF 
     1549                  zvel_max = ( swstrl(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 
     1550                  IF ( ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) < 0.0_wp ) THEN   ! OSBL is deepening, 
     1551                     !                                                                 !    entrainment > restratification 
     1552                     IF ( av_db_bl(ji,jj) > 0.0_wp .AND. pdbdz_bl_ext(ji,jj) > 0.0_wp ) THEN 
     1553                        pdhdt(ji,jj) = -1.0_wp * ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) /   & 
     1554                           &            ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 
     1555                     ELSE 
     1556                        pdhdt(ji,jj) = -1.0_wp * ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) / MAX( zvel_max, 1e-15_wp ) 
     1557                     ENDIF 
     1558                  ELSE   ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 
     1559                     pdhdt(ji,jj) = -1.0_wp * MIN( pvel_mle(ji,jj), hbl(ji,jj) / 10800.0_wp ) 
     1560                  ENDIF 
     1561               ELSE   ! Fox-Kemper not used 
     1562                  zvel_max = -1.0_wp * pwb_ent(ji,jj) / MAX( ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird, epsln ) 
     1563                  pdhdt(ji,jj) = -1.0_wp * pwb_ent(ji,jj) / ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 
     1564                  ! added ajgn 23 July as temporay fix 
     1565               ENDIF  ! ln_osm_mle 
     1566               ! 
     1567            ELSE                        ! Stable 
     1568               ! 
     1569               pdhdt(ji,jj) = ( 0.06_wp + 0.52_wp * shol(ji,jj) / 2.0_wp ) * svstr(ji,jj)**3 / hbl(ji,jj) + swbav(ji,jj) 
     1570               IF ( pdhdt(ji,jj) < 0.0_wp ) THEN 
     1571                  ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 
     1572                  zpert = 2.0_wp * svstr(ji,jj)**2 / hbl(ji,jj) 
     1573               ELSE 
     1574                  zpert = MAX( svstr(ji,jj)**2 / hbl(ji,jj), av_db_bl(ji,jj) ) 
     1575               ENDIF 
     1576               pdhdt(ji,jj) = 2.0_wp * pdhdt(ji,jj) / MAX(zpert, epsln) 
     1577               pdhdt(ji,jj) = MAX( pdhdt(ji,jj), -1.0_wp * hbl(ji,jj) / 5400.0_wp ) 
     1578               ! 
     1579            ENDIF  ! l_conv 
     1580            ! 
     1581         ENDIF ! l_shear 
     1582         ! 
     1583      END_2D 
     1584      ! 
     1585   END SUBROUTINE zdf_osm_calculate_dhdt 
     1586 
     1587   SUBROUTINE zdf_osm_timestep_hbl( Kmm, pdhdt, phbl, phbl_t, pwb_ent,   & 
     1588      &                             pwb_fk_b ) 
     1589      !!--------------------------------------------------------------------- 
     1590      !!                ***  ROUTINE zdf_osm_timestep_hbl  *** 
     1591      !! 
     1592      !! ** Purpose : Increments hbl. 
     1593      !! 
     1594      !! ** Method  : If the change in hbl exceeds one model level the change is 
     1595      !!              is calculated by moving down the grid, changing the 
     1596      !!              buoyancy jump. This is to ensure that the change in hbl 
     1597      !!              does not overshoot a stable layer. 
     1598      !! 
     1599      !!---------------------------------------------------------------------- 
     1600      INTEGER,                            INTENT(in   ) ::   Kmm        ! Ocean time-level index 
     1601      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pdhdt      ! Rates of change of hbl 
     1602      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   phbl       ! BL depth 
     1603      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl_t     ! BL depth 
     1604      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_ent    ! Buoyancy entrainment flux 
     1605      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_fk_b   ! MLE buoyancy flux averaged over OSBL 
     1606      !! 
     1607      INTEGER  ::   jk, jj, ji, jm 
     1608      REAL(wp) ::   zhbl_s, zvel_max, zdb 
     1609      REAL(wp) ::   zthermal, zbeta 
     1610      !!---------------------------------------------------------------------- 
     1611      ! 
     1612      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1613         IF ( nbld(ji,jj) - nmld(ji,jj) > 1 ) THEN 
     1614            ! 
     1615            ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 
     1616            ! 
     1617            zhbl_s   = hbl(ji,jj) 
     1618            jm       = nmld(ji,jj) 
     1619            zthermal = rab_n(ji,jj,1,jp_tem) 
     1620            zbeta    = rab_n(ji,jj,1,jp_sal) 
     1621            ! 
     1622            IF ( l_conv(ji,jj) ) THEN   ! Unstable 
     1623               ! 
     1624               IF( ln_osm_mle ) THEN 
     1625                  zvel_max = ( swstrl(ji,jj)**3 + swstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 
     1626               ELSE 
     1627                  zvel_max = -1.0_wp * ( 1.0_wp + 1.0_wp * ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird * rn_Dt /   & 
     1628                     &                                     hbl(ji,jj) ) * pwb_ent(ji,jj) /                                     & 
     1629                     &       ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird 
     1630               ENDIF 
     1631               DO jk = nmld(ji,jj), nbld(ji,jj) 
     1632                  zdb = MAX( grav * ( zthermal * ( av_t_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) -   & 
     1633                     &                zbeta    * ( av_s_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0_wp ) + zvel_max 
    9741634                  ! 
    975                ELSE 
    976                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 
    977                        & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj) 
     1635                  IF ( ln_osm_mle ) THEN 
     1636                     zhbl_s = zhbl_s + MIN( rn_Dt * ( ( -1.0_wp * pwb_ent(ji,jj) - 2.0_wp * pwb_fk_b(ji,jj) ) / zdb ) /   & 
     1637                        &                   REAL( nbld(ji,jj) - nmld(ji,jj), KIND=wp ), e3w(ji,jj,jm,Kmm) ) 
     1638                  ELSE 
     1639                     zhbl_s = zhbl_s + MIN( rn_Dt * ( -1.0_wp * pwb_ent(ji,jj) / zdb ) /   & 
     1640                        &                   REAL( nbld(ji,jj) - nmld(ji,jj), KIND=wp ), e3w(ji,jj,jm,Kmm) ) 
     1641                  ENDIF 
     1642                  !                    zhbl_s = MIN(zhbl_s,  gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 
     1643                  IF ( zhbl_s >= gdepw(ji,jj,mbkt(ji,jj) + 1,Kmm) ) THEN 
     1644                     zhbl_s = MIN( zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1, Kmm ) - depth_tol ) 
     1645                     l_pyc(ji,jj) = .FALSE. 
     1646                  ENDIF 
     1647                  IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 
     1648               END DO 
     1649               hbl(ji,jj)  = zhbl_s 
     1650               nbld(ji,jj) = jm 
     1651            ELSE   ! Stable 
     1652               DO jk = nmld(ji,jj), nbld(ji,jj) 
     1653                  zdb = MAX(  grav * ( zthermal * ( av_t_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) -               & 
     1654                     &                 zbeta    * ( av_s_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0_wp ) +   & 
     1655                     &  2.0_wp * svstr(ji,jj)**2 / zhbl_s 
    9781656                  ! 
    979                ENDIF 
    980  
    981                ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 
    982                     & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj) 
    983                ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 
    984                     & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj) 
    985             END DO 
    986           ENDIF 
    987        END_2D 
    988  
    989        IF(ln_dia_osm) THEN 
    990           IF ( iom_use("ghamu_f") ) CALL iom_put( "ghamu_f", wmask*ghamu ) 
    991           IF ( iom_use("ghamv_f") ) CALL iom_put( "ghamv_f", wmask*ghamv ) 
    992           IF ( iom_use("zsc_uw_1_f") ) CALL iom_put( "zsc_uw_1_f", tmask(:,:,1)*zsc_uw_1 ) 
    993           IF ( iom_use("zsc_vw_1_f") ) CALL iom_put( "zsc_vw_1_f", tmask(:,:,1)*zsc_vw_1 ) 
    994           IF ( iom_use("zsc_uw_2_f") ) CALL iom_put( "zsc_uw_2_f", tmask(:,:,1)*zsc_uw_2 ) 
    995           IF ( iom_use("zsc_vw_2_f") ) CALL iom_put( "zsc_vw_2_f", tmask(:,:,1)*zsc_vw_2 ) 
    996        END IF 
    997 ! 
    998 ! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer. 
    999  
    1000  
    1001  ! Make surface forced velocity non-gradient terms go to zero at the base of the boundary layer. 
    1002  
    1003       DO_2D( 0, 0, 0, 0 ) 
    1004          IF ( .not. lconv(ji,jj) ) THEN 
    1005             DO jk = 2, ibld(ji,jj) 
    1006                znd = ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zhbl(ji,jj) !ALMG to think about 
    1007                IF ( znd >= 0.0 ) THEN 
    1008                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 
    1009                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 
    1010                ELSE 
    1011                   ghamu(ji,jj,jk) = 0._wp 
    1012                   ghamv(ji,jj,jk) = 0._wp 
    1013                ENDIF 
    1014             END DO 
     1657                  ! Alan is thuis right? I have simply changed hbli to hbl 
     1658                  shol(ji,jj)  = -1.0_wp * zhbl_s / ( ( svstr(ji,jj)**3 + epsln ) / swbav(ji,jj) ) 
     1659                  pdhdt(ji,jj) = -1.0_wp * ( swbav(ji,jj) - 0.04_wp / 2.0_wp * swstrl(ji,jj)**3 / zhbl_s -   & 
     1660                     &                       0.15_wp / 2.0_wp * ( 1.0_wp - EXP( -1.5_wp * sla(ji,jj) ) ) *   & 
     1661                     &                                 sustar(ji,jj)**3 / zhbl_s ) *                         & 
     1662                     &           ( 0.725_wp + 0.225_wp * EXP( -7.5_wp * shol(ji,jj) ) ) 
     1663                  pdhdt(ji,jj) = pdhdt(ji,jj) + swbav(ji,jj) 
     1664                  zhbl_s = zhbl_s + MIN( pdhdt(ji,jj) / zdb * rn_Dt / REAL( nbld(ji,jj) - nmld(ji,jj), KIND=wp ),   & 
     1665                     &                   e3w(ji,jj,jm,Kmm) ) 
     1666                   
     1667                  !                    zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 
     1668                  IF ( zhbl_s >= mbkt(ji,jj) + 1 ) THEN 
     1669                     zhbl_s      = MIN( zhbl_s,  gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - depth_tol ) 
     1670                     l_pyc(ji,jj) = .FALSE. 
     1671                  ENDIF 
     1672                  IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 
     1673               END DO 
     1674            ENDIF   ! IF ( l_conv ) 
     1675            hbl(ji,jj)  = MAX( zhbl_s, gdepw(ji,jj,4,Kmm) ) 
     1676            nbld(ji,jj) = MAX( jm, 4 ) 
     1677         ELSE 
     1678            ! change zero or one model level. 
     1679            hbl(ji,jj) = MAX( phbl_t(ji,jj), gdepw(ji,jj,4,Kmm) ) 
    10151680         ENDIF 
    1016       END_2D 
    1017  
    1018       ! pynocline contributions 
    1019        DO_2D( 0, 0, 0, 0 ) 
    1020          IF ( .not. lconv(ji,jj) ) THEN 
    1021           IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 
    1022              DO jk= 2, ibld(ji,jj) 
    1023                 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    1024                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk) 
    1025                 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk) 
    1026                 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk) 
    1027                 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk) 
    1028              END DO 
    1029           END IF 
    1030          END IF 
    1031        END_2D 
    1032       IF(ln_dia_osm) THEN 
    1033           IF ( iom_use("ghamu_b") ) CALL iom_put( "ghamu_b", wmask*ghamu ) 
    1034           IF ( iom_use("ghamv_b") ) CALL iom_put( "ghamv_b", wmask*ghamv ) 
    1035        END IF 
    1036  
    1037        DO_2D( 0, 0, 0, 0 ) 
    1038           ghamt(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 
    1039           ghams(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 
    1040           ghamu(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 
    1041           ghamv(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 
    1042        END_2D 
    1043  
    1044        IF(ln_dia_osm) THEN 
    1045           IF ( iom_use("ghamu_1") ) CALL iom_put( "ghamu_1", wmask*ghamu ) 
    1046           IF ( iom_use("ghamv_1") ) CALL iom_put( "ghamv_1", wmask*ghamv ) 
    1047           IF ( iom_use("zdudz_pyc") ) CALL iom_put( "zdudz_pyc", wmask*zdudz_pyc ) 
    1048           IF ( iom_use("zdvdz_pyc") ) CALL iom_put( "zdvdz_pyc", wmask*zdvdz_pyc ) 
    1049           IF ( iom_use("zviscos") ) CALL iom_put( "zviscos", wmask*zviscos ) 
    1050        END IF 
    1051        !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    1052        ! Need to put in code for contributions that are applied explicitly to 
    1053        ! the prognostic variables 
    1054        !  1. Entrainment flux 
    1055        ! 
    1056        !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    1057  
    1058  
    1059  
    1060        ! rotate non-gradient velocity terms back to model reference frame 
    1061  
    1062        DO_2D( 0, 0, 0, 0 ) 
    1063           DO jk = 2, ibld(ji,jj) 
    1064              ztemp = ghamu(ji,jj,jk) 
    1065              ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj) 
    1066              ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj) 
    1067           END DO 
    1068        END_2D 
    1069  
    1070        IF(ln_dia_osm) THEN 
    1071           IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc ) 
    1072           IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc ) 
    1073           IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc ) 
    1074        END IF 
    1075  
    1076 ! KPP-style Ri# mixing 
    1077        IF( ln_kpprimix) THEN 
    1078           DO_3D( 1, 0, 1, 0, 2, jpkm1 )      !* Shear production at uw- and vw-points (energy conserving form) 
    1079              z3du(ji,jj,jk) = 0.5 * (  uu(ji,jj,jk-1,Kmm) -  uu(ji  ,jj,jk,Kmm) )   & 
    1080                   &                 * (  uu(ji,jj,jk-1,Kbb) -  uu(ji  ,jj,jk,Kbb) ) * wumask(ji,jj,jk) & 
    1081                   &                 / (  e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) 
    1082              z3dv(ji,jj,jk) = 0.5 * (  vv(ji,jj,jk-1,Kmm) -  vv(ji,jj  ,jk,Kmm) )   & 
    1083                   &                 * (  vv(ji,jj,jk-1,Kbb) -  vv(ji,jj  ,jk,Kbb) ) * wvmask(ji,jj,jk) & 
    1084                   &                 / (  e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) 
    1085           END_3D 
    1086       ! 
    1087          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    1088             !                                          ! shear prod. at w-point weightened by mask 
    1089             zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
    1090                &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 
    1091             !                                          ! local Richardson number 
    1092             zri   = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln) 
    1093             zfri =  MIN( zri / rn_riinfty , 1.0_wp ) 
    1094             zfri  = ( 1.0_wp - zfri * zfri ) 
    1095             zrimix(ji,jj,jk)  =  zfri * zfri  * zfri * wmask(ji, jj, jk) 
    1096          END_3D 
    1097  
    1098           DO_2D( 0, 0, 0, 0 ) 
    1099              DO jk = ibld(ji,jj) + 1, jpkm1 
    1100                 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
    1101                 zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
    1102              END DO 
    1103           END_2D 
    1104  
    1105        END IF ! ln_kpprimix = .true. 
    1106  
    1107 ! KPP-style set diffusivity large if unstable below BL 
    1108        IF( ln_convmix) THEN 
    1109           DO_2D( 0, 0, 0, 0 ) 
    1110              DO jk = ibld(ji,jj) + 1, jpkm1 
    1111                IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv 
    1112              END DO 
    1113           END_2D 
    1114        END IF ! ln_convmix = .true. 
    1115  
    1116  
    1117  
    1118        IF ( ln_osm_mle ) THEN  ! set up diffusivity and non-gradient mixing 
    1119           DO_2D( 0, 0, 0, 0 ) 
    1120               IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer 
    1121              ! Calculate MLE flux contribution from surface fluxes 
    1122                 DO jk = 1, ibld(ji,jj) 
    1123                   znd = gdepw(ji,jj,jk,Kmm) / MAX(zhbl(ji,jj),epsln) 
    1124                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - zwth0(ji,jj) * ( 1.0 - znd ) 
    1125                   ghams(ji,jj,jk) = ghams(ji,jj,jk) - zws0(ji,jj) * ( 1.0 - znd ) 
    1126                  END DO 
    1127                  DO jk = 1, mld_prof(ji,jj) 
    1128                    znd = gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 
    1129                    ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth0(ji,jj) * ( 1.0 - znd ) 
    1130                    ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws0(ji,jj) * ( 1.0 -znd ) 
    1131                  END DO 
    1132          ! Viscosity for MLEs 
    1133                  DO jk = 1, mld_prof(ji,jj) 
    1134                    znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 
    1135                    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 ) 
    1136                  END DO 
    1137               ELSE 
    1138 ! Surface transports limited to OSBL. 
    1139          ! Viscosity for MLEs 
    1140                  DO jk = 1, mld_prof(ji,jj) 
    1141                    znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 
    1142                    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 ) 
    1143                  END DO 
    1144               ENDIF 
    1145           END_2D 
    1146        ENDIF 
    1147  
    1148        IF(ln_dia_osm) THEN 
    1149           IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc ) 
    1150           IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc ) 
    1151           IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc ) 
    1152        END IF 
    1153  
    1154  
    1155        ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 
    1156        !CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp ) 
    1157  
    1158        ! GN 25/8: need to change tmask --> wmask 
    1159  
    1160      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    1161           p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 
    1162           p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 
    1163      END_3D 
    1164       ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid  (sign unchanged), needed to caclulate gham[uv] on u and v grids 
    1165      CALL lbc_lnk( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp,   & 
    1166         &                    ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 
    1167        DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    1168             ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 
    1169                &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) 
    1170  
    1171             ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) & 
    1172                 &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 
    1173  
    1174             ghamt(ji,jj,jk) =  ghamt(ji,jj,jk) * tmask(ji,jj,jk) 
    1175             ghams(ji,jj,jk) =  ghams(ji,jj,jk) * tmask(ji,jj,jk) 
    1176        END_3D 
    1177         ! Lateral boundary conditions on final outputs for hbl,  on T-grid (sign unchanged) 
    1178         CALL lbc_lnk( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 
    1179         ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged) 
    1180         ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign changed) 
    1181         CALL lbc_lnk( 'zdfosm', ghamt, 'W',  1.0_wp , ghams, 'W',  1.0_wp,   & 
    1182            &                    ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 
    1183  
    1184       IF(ln_dia_osm) THEN 
    1185          SELECT CASE (nn_osm_wave) 
    1186          ! Stokes drift set by assumimg onstant La#=0.3(=0)  or Pierson-Moskovitz spectrum (=1). 
    1187          CASE(0:1) 
    1188             IF ( iom_use("us_x") ) CALL iom_put( "us_x", tmask(:,:,1)*zustke*zcos_wind )   ! x surface Stokes drift 
    1189             IF ( iom_use("us_y") ) CALL iom_put( "us_y", tmask(:,:,1)*zustke*zsin_wind )  ! y surface Stokes drift 
    1190             IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 
    1191          ! Stokes drift read in from sbcwave  (=2). 
    1192          CASE(2:3) 
    1193             IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd*umask(:,:,1) )               ! x surface Stokes drift 
    1194             IF ( iom_use("us_y") ) CALL iom_put( "us_y", vt0sd*vmask(:,:,1) )               ! y surface Stokes drift 
    1195             IF ( iom_use("wmp") ) CALL iom_put( "wmp", wmp*tmask(:,:,1) )                   ! wave mean period 
    1196             IF ( iom_use("hsw") ) CALL iom_put( "hsw", hsw*tmask(:,:,1) )                   ! significant wave height 
    1197             IF ( iom_use("wmp_NP") ) CALL iom_put( "wmp_NP", (2.*rpi*1.026/(0.877*grav) )*wndm*tmask(:,:,1) )                  ! wave mean period from NP spectrum 
    1198             IF ( iom_use("hsw_NP") ) CALL iom_put( "hsw_NP", (0.22/grav)*wndm**2*tmask(:,:,1) )                   ! significant wave height from NP spectrum 
    1199             IF ( iom_use("wndm") ) CALL iom_put( "wndm", wndm*tmask(:,:,1) )                   ! U_10 
    1200             IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2* & 
    1201                  & SQRT(ut0sd**2 + vt0sd**2 ) ) 
    1202          END SELECT 
    1203          IF ( iom_use("ghamt") ) CALL iom_put( "ghamt", tmask*ghamt )            ! <Tw_NL> 
    1204          IF ( iom_use("ghams") ) CALL iom_put( "ghams", tmask*ghams )            ! <Sw_NL> 
    1205          IF ( iom_use("ghamu") ) CALL iom_put( "ghamu", umask*ghamu )            ! <uw_NL> 
    1206          IF ( iom_use("ghamv") ) CALL iom_put( "ghamv", vmask*ghamv )            ! <vw_NL> 
    1207          IF ( iom_use("zwth0") ) CALL iom_put( "zwth0", tmask(:,:,1)*zwth0 )            ! <Tw_0> 
    1208          IF ( iom_use("zws0") ) CALL iom_put( "zws0", tmask(:,:,1)*zws0 )                ! <Sw_0> 
    1209          IF ( iom_use("hbl") ) CALL iom_put( "hbl", tmask(:,:,1)*hbl )                  ! boundary-layer depth 
    1210          IF ( iom_use("ibld") ) CALL iom_put( "ibld", tmask(:,:,1)*ibld )               ! boundary-layer max k 
    1211          IF ( iom_use("zdt_bl") ) CALL iom_put( "zdt_bl", tmask(:,:,1)*zdt_bl )           ! dt at ml base 
    1212          IF ( iom_use("zds_bl") ) CALL iom_put( "zds_bl", tmask(:,:,1)*zds_bl )           ! ds at ml base 
    1213          IF ( iom_use("zdb_bl") ) CALL iom_put( "zdb_bl", tmask(:,:,1)*zdb_bl )           ! db at ml base 
    1214          IF ( iom_use("zdu_bl") ) CALL iom_put( "zdu_bl", tmask(:,:,1)*zdu_bl )           ! du at ml base 
    1215          IF ( iom_use("zdv_bl") ) CALL iom_put( "zdv_bl", tmask(:,:,1)*zdv_bl )           ! dv at ml base 
    1216          IF ( iom_use("dh") ) CALL iom_put( "dh", tmask(:,:,1)*dh )               ! Initial boundary-layer depth 
    1217          IF ( iom_use("hml") ) CALL iom_put( "hml", tmask(:,:,1)*hml )               ! Initial boundary-layer depth 
    1218          IF ( iom_use("dstokes") ) CALL iom_put( "dstokes", tmask(:,:,1)*dstokes )      ! Stokes drift penetration depth 
    1219          IF ( iom_use("zustke") ) CALL iom_put( "zustke", tmask(:,:,1)*zustke )            ! Stokes drift magnitude at T-points 
    1220          IF ( iom_use("zwstrc") ) CALL iom_put( "zwstrc", tmask(:,:,1)*zwstrc )         ! convective velocity scale 
    1221          IF ( iom_use("zwstrl") ) CALL iom_put( "zwstrl", tmask(:,:,1)*zwstrl )         ! Langmuir velocity scale 
    1222          IF ( iom_use("zustar") ) CALL iom_put( "zustar", tmask(:,:,1)*zustar )         ! friction velocity scale 
    1223          IF ( iom_use("zvstr") ) CALL iom_put( "zvstr", tmask(:,:,1)*zvstr )         ! mixed velocity scale 
    1224          IF ( iom_use("zla") ) CALL iom_put( "zla", tmask(:,:,1)*zla )         ! langmuir # 
    1225          IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rho0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine 
    1226          IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 
    1227          IF ( iom_use("zhbl") ) CALL iom_put( "zhbl", tmask(:,:,1)*zhbl )               ! BL depth internal to zdf_osm routine 
    1228          IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml )               ! ML depth internal to zdf_osm routine 
    1229          IF ( iom_use("imld") ) CALL iom_put( "imld", tmask(:,:,1)*imld )               ! index for ML depth internal to zdf_osm routine 
    1230          IF ( iom_use("zdh") ) CALL iom_put( "zdh", tmask(:,:,1)*zdh )                  ! pyc thicknessh internal to zdf_osm routine 
    1231          IF ( iom_use("zhol") ) CALL iom_put( "zhol", tmask(:,:,1)*zhol )               ! ML depth internal to zdf_osm routine 
    1232          IF ( iom_use("zwthav") ) CALL iom_put( "zwthav", tmask(:,:,1)*zwthav )         ! upward BL-avged turb temp flux 
    1233          IF ( iom_use("zwth_ent") ) CALL iom_put( "zwth_ent", tmask(:,:,1)*zwth_ent )   ! upward turb temp entrainment flux 
    1234          IF ( iom_use("zwb_ent") ) CALL iom_put( "zwb_ent", tmask(:,:,1)*zwb_ent )      ! upward turb buoyancy entrainment flux 
    1235          IF ( iom_use("zws_ent") ) CALL iom_put( "zws_ent", tmask(:,:,1)*zws_ent )      ! upward turb salinity entrainment flux 
    1236          IF ( iom_use("zt_ml") ) CALL iom_put( "zt_ml", tmask(:,:,1)*zt_ml )            ! average T in ML 
    1237  
    1238          IF ( iom_use("hmle") ) CALL iom_put( "hmle", tmask(:,:,1)*hmle )               ! FK layer depth 
    1239          IF ( iom_use("zmld") ) CALL iom_put( "zmld", tmask(:,:,1)*zmld )               ! FK target layer depth 
    1240          IF ( iom_use("zwb_fk") ) CALL iom_put( "zwb_fk", tmask(:,:,1)*zwb_fk )         ! FK b flux 
    1241          IF ( iom_use("zwb_fk_b") ) CALL iom_put( "zwb_fk_b", tmask(:,:,1)*zwb_fk_b )   ! FK b flux averaged over ML 
    1242          IF ( iom_use("mld_prof") ) CALL iom_put( "mld_prof", tmask(:,:,1)*mld_prof )! FK layer max k 
    1243          IF ( iom_use("zdtdx") ) CALL iom_put( "zdtdx", umask(:,:,1)*zdtdx )            ! FK dtdx at u-pt 
    1244          IF ( iom_use("zdtdy") ) CALL iom_put( "zdtdy", vmask(:,:,1)*zdtdy )            ! FK dtdy at v-pt 
    1245          IF ( iom_use("zdsdx") ) CALL iom_put( "zdsdx", umask(:,:,1)*zdsdx )            ! FK dtdx at u-pt 
    1246          IF ( iom_use("zdsdy") ) CALL iom_put( "zdsdy", vmask(:,:,1)*zdsdy )            ! FK dsdy at v-pt 
    1247          IF ( iom_use("dbdx_mle") ) CALL iom_put( "dbdx_mle", umask(:,:,1)*dbdx_mle )            ! FK dbdx at u-pt 
    1248          IF ( iom_use("dbdy_mle") ) CALL iom_put( "dbdy_mle", vmask(:,:,1)*dbdy_mle )            ! FK dbdy at v-pt 
    1249          IF ( iom_use("zdiff_mle") ) CALL iom_put( "zdiff_mle", tmask(:,:,1)*zdiff_mle )! FK diff in MLE at t-pt 
    1250          IF ( iom_use("zvel_mle") ) CALL iom_put( "zvel_mle", tmask(:,:,1)*zdiff_mle )! FK diff in MLE at t-pt 
    1251  
    1252       END IF 
    1253  
    1254 CONTAINS 
    1255 ! subroutine code changed, needs syntax checking. 
    1256   SUBROUTINE zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 
    1257  
    1258 !!--------------------------------------------------------------------- 
    1259      !!                   ***  ROUTINE zdf_osm_diffusivity_viscosity  *** 
    1260      !! 
    1261      !! ** Purpose : Determines the eddy diffusivity and eddy viscosity profiles in the mixed layer and the pycnocline. 
    1262      !! 
    1263      !! ** Method  : 
    1264      !! 
    1265      !! !!---------------------------------------------------------------------- 
    1266      REAL(wp), DIMENSION(:,:,:) :: zdiffut 
    1267      REAL(wp), DIMENSION(:,:,:) :: zviscos 
    1268 ! local 
    1269  
    1270 ! Scales used to calculate eddy diffusivity and viscosity profiles 
    1271       REAL(wp), DIMENSION(jpi,jpj) :: zdifml_sc, zvisml_sc 
    1272       REAL(wp), DIMENSION(jpi,jpj) :: zdifpyc_n_sc, zdifpyc_s_sc, zdifpyc_shr 
    1273       REAL(wp), DIMENSION(jpi,jpj) :: zvispyc_n_sc, zvispyc_s_sc,zvispyc_shr 
    1274       REAL(wp), DIMENSION(jpi,jpj) :: zbeta_d_sc, zbeta_v_sc 
    1275 ! 
    1276       REAL(wp) :: zvel_sc_pyc, zvel_sc_ml, zstab_fac 
    1277  
    1278       REAL(wp), PARAMETER :: rn_dif_ml = 0.8, rn_vis_ml = 0.375 
    1279       REAL(wp), PARAMETER :: rn_dif_pyc = 0.15, rn_vis_pyc = 0.142 
    1280       REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 
    1281  
    1282       DO_2D( 0, 0, 0, 0 ) 
    1283           IF ( lconv(ji,jj) ) THEN 
    1284  
    1285             zvel_sc_pyc = ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.25 * zshear(ji,jj) * zhbl(ji,jj) )**pthird 
    1286             zvel_sc_ml = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    1287             zstab_fac = ( zhml(ji,jj) / zvel_sc_ml * ( 1.4 - 0.4 / ( 1.0 + EXP(-3.5 * LOG10(-zhol(ji,jj) ) ) )**1.25 ) )**2 
    1288  
    1289             zdifml_sc(ji,jj) = rn_dif_ml * zhml(ji,jj) * zvel_sc_ml 
    1290             zvisml_sc(ji,jj) = rn_vis_ml * zdifml_sc(ji,jj) 
    1291  
    1292             IF ( lpyc(ji,jj) ) THEN 
    1293               zdifpyc_n_sc(ji,jj) =  rn_dif_pyc * zvel_sc_ml * zdh(ji,jj) 
    1294  
    1295               IF ( lshear(ji,jj) .and. j_ddh(ji,jj) == 1 ) THEN 
    1296                 zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj) )**pthird * zhbl(ji,jj) 
    1297               ENDIF 
    1298  
    1299               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) ) 
    1300               zdifpyc_s_sc(ji,jj) = 0.09 * zdifpyc_s_sc(ji,jj) * zstab_fac 
    1301               zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5 * zdifpyc_n_sc(ji,jj) ) 
    1302  
    1303               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) 
    1304               zvispyc_n_sc(ji,jj) = rn_vis_pyc * zvel_sc_ml * zdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac 
    1305               IF ( lshear(ji,jj) .and. j_ddh(ji,jj) == 1 ) THEN 
    1306                 zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj ) )**pthird * zhbl(ji,jj) 
    1307               ENDIF 
    1308  
    1309               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) ) ) 
    1310               zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac 
    1311               zvispyc_s_sc(ji,jj) = MAX( zvispyc_s_sc(ji,jj), -0.5 * zvispyc_s_sc(ji,jj) ) 
    1312  
    1313               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 
    1314               zbeta_v_sc(ji,jj) = 1.0 -  2.0 * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) / ( zvisml_sc(ji,jj) + epsln ) 
    1315             ELSE 
    1316               zbeta_d_sc(ji,jj) = 1.0 
    1317               zbeta_v_sc(ji,jj) = 1.0 
    1318             ENDIF 
    1319           ELSE 
    1320             zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 
    1321             zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 
    1322           END IF 
    1323       END_2D 
    1324 ! 
    1325        DO_2D( 0, 0, 0, 0 ) 
    1326           IF ( lconv(ji,jj) ) THEN 
    1327              DO jk = 2, imld(ji,jj)   ! mixed layer diffusivity 
    1328                  zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
    1329                  ! 
    1330                  zdiffut(ji,jj,jk) = zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5 
    1331                  ! 
    1332                  zviscos(ji,jj,jk) = zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) & 
    1333    &            *                                      ( 1.0 - 0.5 * zznd_ml**2 ) 
    1334              END DO 
    1335 ! pycnocline 
    1336              IF ( lpyc(ji,jj) ) THEN 
    1337 ! Diffusivity profile in the pycnocline given by cubic polynomial. 
    1338                 za_cubic = 0.5 
    1339                 zb_cubic = -1.75 * zdifpyc_s_sc(ji,jj) / zdifpyc_n_sc(ji,jj) 
    1340                 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 ) & 
    1341                      & - 0.85 * zdifpyc_s_sc(ji,jj) ) / MAX(zdifpyc_n_sc(ji,jj), 1.e-8) 
    1342                 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic  - zb_cubic ) 
    1343                 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 
    1344                 DO jk = imld(ji,jj) , ibld(ji,jj) 
    1345                   zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 
    1346                       ! 
    1347                   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 ) 
    1348  
    1349                   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 ) 
    1350                 END DO 
    1351  ! viscosity profiles. 
    1352                 za_cubic = 0.5 
    1353                 zb_cubic = -1.75 * zvispyc_s_sc(ji,jj) / zvispyc_n_sc(ji,jj) 
    1354                 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) 
    1355                 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zd_cubic ) 
    1356                 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 
    1357                 DO jk = imld(ji,jj) , ibld(ji,jj) 
    1358                    zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 
    1359                     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 ) 
    1360                     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 ) 
    1361                 END DO 
    1362                 IF ( zdhdt(ji,jj) > 0._wp ) THEN 
    1363                  zdiffut(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 ) 
    1364                  zviscos(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 ) 
    1365                 ELSE 
    1366                   zdiffut(ji,jj,ibld(ji,jj)) = 0._wp 
    1367                   zviscos(ji,jj,ibld(ji,jj)) = 0._wp 
    1368                 ENDIF 
    1369              ENDIF 
    1370           ELSE 
    1371           ! stable conditions 
    1372              DO jk = 2, ibld(ji,jj) 
    1373                 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    1374                 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 
    1375                 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 
    1376              END DO 
    1377  
    1378              IF ( zdhdt(ji,jj) > 0._wp ) THEN 
    1379                 zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm) 
    1380                 zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm) 
    1381              ENDIF 
    1382           ENDIF   ! end if ( lconv ) 
    1383           ! 
    1384        END_2D 
    1385  
    1386   END SUBROUTINE zdf_osm_diffusivity_viscosity 
    1387  
    1388   SUBROUTINE zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear, zri_i ) 
    1389  
    1390 !!--------------------------------------------------------------------- 
    1391      !!                   ***  ROUTINE zdf_osm_osbl_state  *** 
    1392      !! 
    1393      !! ** Purpose : Determines the state of the OSBL, stable/unstable, shear/ noshear. Also determines shear production, entrainment buoyancy flux and interfacial Richardson number 
    1394      !! 
    1395      !! ** Method  : 
    1396      !! 
    1397      !! !!---------------------------------------------------------------------- 
    1398  
    1399      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. 
    1400  
    1401      LOGICAL, DIMENSION(jpi,jpj) :: lconv, lshear 
    1402  
    1403      REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent, zwb_min ! Buoyancy fluxes at base of well-mixed layer. 
    1404      REAL(wp), DIMENSION(jpi,jpj) :: zshear  ! production of TKE due to shear across the pycnocline 
    1405      REAL(wp), DIMENSION(jpi,jpj) :: zri_i  ! Interfacial Richardson Number 
    1406  
    1407 ! Local Variables 
    1408  
    1409      INTEGER :: jj, ji 
    1410  
    1411      REAL(wp), DIMENSION(jpi,jpj) :: zekman 
    1412      REAL(wp) :: zri_p, zri_b   ! Richardson numbers 
    1413      REAL(wp) :: zshear_u, zshear_v, zwb_shr 
    1414      REAL(wp) :: zwcor, zrf_conv, zrf_shear, zrf_langmuir, zr_stokes 
    1415  
    1416      REAL, PARAMETER :: za_shr = 0.4, zb_shr = 6.5, za_wb_s = 0.1 
    1417      REAL, PARAMETER :: rn_ri_thres_a = 0.5, rn_ri_thresh_b = 0.59 
    1418      REAL, PARAMETER :: zalpha_c = 0.2, zalpha_lc = 0.04 
    1419      REAL, PARAMETER :: zalpha_ls = 0.06, zalpha_s = 0.15 
    1420      REAL, PARAMETER :: rn_ri_p_thresh = 27.0 
    1421      REAL, PARAMETER :: zrot=0._wp  ! dummy rotation rate of surface stress. 
    1422  
    1423 ! Determins stability and set flag lconv 
    1424      DO_2D( 0, 0, 0, 0 ) 
    1425       IF ( zhol(ji,jj) < 0._wp ) THEN 
    1426          lconv(ji,jj) = .TRUE. 
    1427        ELSE 
    1428           lconv(ji,jj) = .FALSE. 
    1429        ENDIF 
    1430      END_2D 
    1431  
    1432      zekman(:,:) = EXP( - 4.0 * ABS( ff_t(:,:) ) * zhbl(:,:) / MAX(zustar(:,:), 1.e-8 ) ) 
    1433  
    1434      WHERE ( lconv ) 
    1435        zri_i = zdb_ml * zhml**2 / MAX( ( zvstr**3 + 0.5 * zwstrc**3 )**p2third * zdh, 1.e-12 ) 
    1436      END WHERE 
    1437  
    1438      zshear(:,:) = 0._wp 
    1439      j_ddh(:,:) = 1 
    1440  
    1441      DO_2D( 0, 0, 0, 0 ) 
    1442       IF ( lconv(ji,jj) ) THEN 
    1443          IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    1444            zri_p = 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 & 
    1445                 & / MAX( zekman(ji,jj), 1.e-6 )  , 5._wp ) 
    1446  
    1447            zri_b = zdb_ml(ji,jj) * zdh(ji,jj) / MAX( zdu_ml(ji,jj)**2 + zdv_ml(ji,jj)**2, 1.e-8 ) 
    1448  
    1449            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 ) ) 
    1450 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    1451 ! Test ensures j_ddh=0 is not selected. Change to zri_p<27 when  ! 
    1452 ! full code available                                          ! 
    1453 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    1454            IF ( zri_p < -rn_ri_p_thresh .and. zshear(ji,jj) > 0._wp ) THEN 
    1455 ! Growing shear layer 
    1456              j_ddh(ji,jj) = 0 
    1457              lshear(ji,jj) = .TRUE. 
    1458            ELSE 
    1459              j_ddh(ji,jj) = 1 
    1460              IF ( zri_b <= 1.5 .and. zshear(ji,jj) > 0._wp ) THEN 
    1461 ! shear production large enough to determine layer charcteristics, but can't maintain a shear layer. 
    1462                lshear(ji,jj) = .TRUE. 
    1463              ELSE 
    1464 ! Shear production may not be zero, but is small and doesn't determine characteristics of pycnocline. 
    1465                zshear(ji,jj) = 0.5 * zshear(ji,jj) 
    1466                lshear(ji,jj) = .FALSE. 
    1467              ENDIF 
    1468            ENDIF 
    1469          ELSE                ! zdb_bl test, note zshear set to zero 
    1470            j_ddh(ji,jj) = 2 
    1471            lshear(ji,jj) = .FALSE. 
    1472          ENDIF 
    1473        ENDIF 
    1474      END_2D 
    1475  
    1476 ! Calculate entrainment buoyancy flux due to surface fluxes. 
    1477  
    1478      DO_2D( 0, 0, 0, 0 ) 
    1479       IF ( lconv(ji,jj) ) THEN 
    1480         zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln 
    1481         zrf_conv = TANH( ( zwstrc(ji,jj) / zwcor )**0.69 ) 
    1482         zrf_shear = TANH( ( zustar(ji,jj) / zwcor )**0.69 ) 
    1483         zrf_langmuir = TANH( ( zwstrl(ji,jj) / zwcor )**0.69 ) 
    1484         IF (nn_osm_SD_reduce > 0 ) THEN 
    1485         ! Effective Stokes drift already reduced from surface value 
    1486            zr_stokes = 1.0_wp 
    1487         ELSE 
    1488          ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd, 
    1489           ! requires further reduction where BL is deep 
    1490            zr_stokes = 1.0 - EXP( -25.0 * dstokes(ji,jj) / hbl(ji,jj) & 
    1491          &                  * ( 1.0 + 4.0 * dstokes(ji,jj) / hbl(ji,jj) ) ) 
    1492         END IF 
    1493         zwb_ent(ji,jj) = - 2.0 * 0.2 * zrf_conv * zwbav(ji,jj) & 
    1494                &                  - 0.15 * zrf_shear * zustar(ji,jj)**3 /zhml(ji,jj) & 
    1495                &         + zr_stokes * ( 0.15 * EXP( -1.5 * zla(ji,jj) ) * zrf_shear * zustar(ji,jj)**3 & 
    1496                &                                         - zrf_langmuir * 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj) 
    1497           ! 
    1498       ENDIF 
    1499      END_2D 
    1500  
    1501      zwb_min(:,:) = 0._wp 
    1502  
    1503      DO_2D( 0, 0, 0, 0 ) 
    1504       IF ( lshear(ji,jj) ) THEN 
    1505         IF ( lconv(ji,jj) ) THEN 
    1506 ! Unstable OSBL 
    1507            zwb_shr = -za_wb_s * zshear(ji,jj) 
    1508            IF ( j_ddh(ji,jj) == 0 ) THEN 
    1509  
    1510 ! Developing shear layer, additional shear production possible. 
    1511  
    1512              zshear_u = MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) /  zhbl(ji,jj), 0._wp ) 
    1513              zshear(ji,jj) = zshear(ji,jj) + zshear_u * ( 1.0 - MIN( zri_p / rn_ri_p_thresh, 1.d0 ) ) 
    1514              zshear(ji,jj) = MIN( zshear(ji,jj), zshear_u ) 
    1515  
    1516              zwb_shr = -za_wb_s * zshear(ji,jj) 
    1517  
    1518            ENDIF 
    1519            zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr 
    1520            zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj) 
    1521         ELSE    ! IF ( lconv ) THEN - ENDIF 
    1522 ! Stable OSBL  - shear production not coded for first attempt. 
    1523         ENDIF  ! lconv 
    1524       ELSE  ! lshear 
    1525         IF ( lconv(ji,jj) ) THEN 
    1526 ! Unstable OSBL 
    1527            zwb_shr = -za_wb_s * zshear(ji,jj) 
    1528            zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr 
    1529            zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj) 
    1530         ENDIF  ! lconv 
    1531       ENDIF    ! lshear 
    1532      END_2D 
    1533    END SUBROUTINE zdf_osm_osbl_state 
    1534  
    1535  
    1536    SUBROUTINE zdf_osm_vertical_average( jnlev_av, jp_ext, zt, zs, zb, zu, zv, zdt, zds, zdb, zdu, zdv ) 
    1537      !!--------------------------------------------------------------------- 
    1538      !!                   ***  ROUTINE zdf_vertical_average  *** 
    1539      !! 
    1540      !! ** Purpose : Determines vertical averages from surface to jnlev. 
    1541      !! 
    1542      !! ** Method  : Averages are calculated from the surface to jnlev. 
    1543      !!              The external level used to calculate differences is ibld+ibld_ext 
    1544      !! 
    1545      !!---------------------------------------------------------------------- 
    1546  
    1547         INTEGER, DIMENSION(jpi,jpj) :: jnlev_av  ! Number of levels to average over. 
    1548         INTEGER, DIMENSION(jpi,jpj) :: jp_ext 
    1549  
    1550         ! Alan: do we need zb? 
    1551         REAL(wp), DIMENSION(jpi,jpj) :: zt, zs, zb        ! Average temperature and salinity 
    1552         REAL(wp), DIMENSION(jpi,jpj) :: zu,zv         ! Average current components 
    1553         REAL(wp), DIMENSION(jpi,jpj) :: zdt, zds, zdb ! Difference between average and value at base of OSBL 
    1554         REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv      ! Difference for velocity components. 
    1555  
    1556         INTEGER :: jk, ji, jj, ibld_ext 
    1557         REAL(wp) :: zthick, zthermal, zbeta 
    1558  
    1559  
    1560         zt   = 0._wp 
    1561         zs   = 0._wp 
    1562         zu   = 0._wp 
    1563         zv   = 0._wp 
    1564         DO_2D( 0, 0, 0, 0 ) 
    1565          zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    1566          zbeta    = rab_n(ji,jj,1,jp_sal) 
    1567             ! average over depth of boundary layer 
    1568          zthick = epsln 
    1569          DO jk = 2, jnlev_av(ji,jj) 
    1570             zthick = zthick + e3t(ji,jj,jk,Kmm) 
    1571             zt(ji,jj)   = zt(ji,jj)  + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 
    1572             zs(ji,jj)   = zs(ji,jj)  + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 
    1573             zu(ji,jj)   = zu(ji,jj)  + e3t(ji,jj,jk,Kmm) & 
    1574                   &            * ( uu(ji,jj,jk,Kbb) + uu(ji - 1,jj,jk,Kbb) ) & 
    1575                   &            / MAX( 1. , umask(ji,jj,jk) + umask(ji - 1,jj,jk) ) 
    1576             zv(ji,jj)   = zv(ji,jj)  + e3t(ji,jj,jk,Kmm) & 
    1577                   &            * ( vv(ji,jj,jk,Kbb) + vv(ji,jj - 1,jk,Kbb) ) & 
    1578                   &            / MAX( 1. , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) ) 
    1579          END DO 
    1580          zt(ji,jj) = zt(ji,jj) / zthick 
    1581          zs(ji,jj) = zs(ji,jj) / zthick 
    1582          zu(ji,jj) = zu(ji,jj) / zthick 
    1583          zv(ji,jj) = zv(ji,jj) / zthick 
    1584          zb(ji,jj) = grav * zthermal * zt(ji,jj) - grav * zbeta * zs(ji,jj) 
    1585          ibld_ext = jnlev_av(ji,jj) + jp_ext(ji,jj) 
    1586          IF ( ibld_ext < mbkt(ji,jj) ) THEN 
    1587            zdt(ji,jj) = zt(ji,jj) - ts(ji,jj,ibld_ext,jp_tem,Kmm) 
    1588            zds(ji,jj) = zs(ji,jj) - ts(ji,jj,ibld_ext,jp_sal,Kmm) 
    1589            zdu(ji,jj) = zu(ji,jj) - ( uu(ji,jj,ibld_ext,Kbb) + uu(ji-1,jj,ibld_ext,Kbb ) ) & 
    1590                   &    / MAX(1. , umask(ji,jj,ibld_ext ) + umask(ji-1,jj,ibld_ext ) ) 
    1591            zdv(ji,jj) = zv(ji,jj) - ( vv(ji,jj,ibld_ext,Kbb) + vv(ji,jj-1,ibld_ext,Kbb ) ) & 
    1592                   &   / MAX(1. , vmask(ji,jj,ibld_ext ) + vmask(ji,jj-1,ibld_ext ) ) 
    1593            zdb(ji,jj) = grav * zthermal * zdt(ji,jj) - grav * zbeta * zds(ji,jj) 
    1594          ELSE 
    1595            zdt(ji,jj) = 0._wp 
    1596            zds(ji,jj) = 0._wp 
    1597            zdu(ji,jj) = 0._wp 
    1598            zdv(ji,jj) = 0._wp 
    1599            zdb(ji,jj) = 0._wp 
    1600          ENDIF 
    1601         END_2D 
    1602    END SUBROUTINE zdf_osm_vertical_average 
    1603  
    1604    SUBROUTINE zdf_osm_velocity_rotation( zcos_w, zsin_w, zu, zv, zdu, zdv ) 
    1605      !!--------------------------------------------------------------------- 
    1606      !!                   ***  ROUTINE zdf_velocity_rotation  *** 
    1607      !! 
    1608      !! ** Purpose : Rotates frame of reference of averaged velocity components. 
    1609      !! 
    1610      !! ** Method  : The velocity components are rotated into frame specified by zcos_w and zsin_w 
    1611      !! 
    1612      !!---------------------------------------------------------------------- 
    1613  
    1614         REAL(wp), DIMENSION(jpi,jpj) :: zcos_w, zsin_w       ! Cos and Sin of rotation angle 
    1615         REAL(wp), DIMENSION(jpi,jpj) :: zu, zv               ! Components of current 
    1616         REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv             ! Change in velocity components across pycnocline 
    1617  
    1618         INTEGER :: ji, jj 
    1619         REAL(wp) :: ztemp 
    1620  
    1621         DO_2D( 0, 0, 0, 0 ) 
    1622            ztemp = zu(ji,jj) 
    1623            zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj) 
    1624            zv(ji,jj) = zv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj) 
    1625            ztemp = zdu(ji,jj) 
    1626            zdu(ji,jj) = zdu(ji,jj) * zcos_w(ji,jj) + zdv(ji,jj) * zsin_w(ji,jj) 
    1627            zdv(ji,jj) = zdv(ji,jj) * zsin_w(ji,jj) - ztemp * zsin_w(ji,jj) 
    1628         END_2D 
    1629     END SUBROUTINE zdf_osm_velocity_rotation 
    1630  
    1631     SUBROUTINE zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk ) 
    1632      !!--------------------------------------------------------------------- 
    1633      !!                   ***  ROUTINE zdf_osm_osbl_state_fk  *** 
    1634      !! 
    1635      !! ** 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. 
    1636      !!  lpyc :: determines whether pycnocline flux-grad relationship needs to be determined 
    1637      !!  lflux :: determines whether effects of surface flux extend below the base of the OSBL 
    1638      !!  lmle  :: determines whether the layer with MLE is increasing with time or if base is relaxing towards hbl. 
    1639      !! 
    1640      !! ** Method  : 
    1641      !! 
    1642      !! 
    1643      !!---------------------------------------------------------------------- 
    1644  
    1645 ! Outputs 
    1646       LOGICAL,  DIMENSION(jpi,jpj)  :: lpyc, lflux, lmle 
    1647       REAL(wp), DIMENSION(jpi,jpj)  :: zwb_fk 
    1648 ! 
    1649       REAL(wp), DIMENSION(jpi,jpj)  :: znd_param 
    1650       REAL(wp)                      :: zbuoy, ztmp, zpe_mle_layer 
    1651       REAL(wp)                      :: zpe_mle_ref, zwb_ent, zdbdz_mle_int 
    1652  
    1653       znd_param(:,:) = 0._wp 
    1654  
    1655         DO_2D( 0, 0, 0, 0 ) 
    1656           ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 
    1657           zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * zdbds_mle(ji,jj) * zdbds_mle(ji,jj) 
    1658         END_2D 
    1659         DO_2D( 0, 0, 0, 0 ) 
    1660                  ! 
    1661          IF ( lconv(ji,jj) ) THEN 
    1662            IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 
    1663              zt_mle(ji,jj) = ( zt_mle(ji,jj) * zhmle(ji,jj) - zt_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 
    1664              zs_mle(ji,jj) = ( zs_mle(ji,jj) * zhmle(ji,jj) - zs_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 
    1665              zb_mle(ji,jj) = ( zb_mle(ji,jj) * zhmle(ji,jj) - zb_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 
    1666              zdbdz_mle_int = ( zb_bl(ji,jj) - ( 2.0 * zb_mle(ji,jj) -zb_bl(ji,jj) ) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 
    1667 ! Calculate potential energies of actual profile and reference profile. 
    1668              zpe_mle_layer = 0._wp 
    1669              zpe_mle_ref = 0._wp 
    1670              DO jk = ibld(ji,jj), mld_prof(ji,jj) 
    1671                zbuoy = grav * ( zthermal * ts(ji,jj,jk,jp_tem,Kmm) - zbeta * ts(ji,jj,jk,jp_sal,Kmm) ) 
    1672                zpe_mle_layer = zpe_mle_layer + zbuoy * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    1673                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) 
    1674              END DO 
    1675 ! Non-dimensional parameter to diagnose the presence of thermocline 
    1676  
    1677              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) ) 
    1678            ENDIF 
    1679          ENDIF 
    1680         END_2D 
    1681  
    1682 ! Diagnosis 
    1683         DO_2D( 0, 0, 0, 0 ) 
    1684           IF ( lconv(ji,jj) ) THEN 
    1685             zwb_ent = - 2.0 * 0.2 * zwbav(ji,jj) & 
    1686                &                  - 0.15 * zustar(ji,jj)**3 /zhml(ji,jj) & 
    1687                &         + ( 0.15 * EXP( -1.5 * zla(ji,jj) ) * zustar(ji,jj)**3 & 
    1688                &         - 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj) 
    1689             IF ( -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5 ) THEN 
    1690               IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 
    1691 ! MLE layer growing 
    1692                 IF ( znd_param (ji,jj) > 100. ) THEN 
    1693 ! Thermocline present 
    1694                   lflux(ji,jj) = .FALSE. 
    1695                   lmle(ji,jj) =.FALSE. 
    1696                 ELSE 
    1697 ! Thermocline not present 
    1698                   lflux(ji,jj) = .TRUE. 
    1699                   lmle(ji,jj) = .TRUE. 
    1700                 ENDIF  ! znd_param > 100 
    1701 ! 
    1702                 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 
    1703                   lpyc(ji,jj) = .FALSE. 
    1704                 ELSE 
    1705                    lpyc = .TRUE. 
    1706                 ENDIF 
    1707               ELSE 
    1708 ! MLE layer restricted to OSBL or just below. 
    1709                 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 
    1710 ! Weak stratification MLE layer can grow. 
    1711                   lpyc(ji,jj) = .FALSE. 
    1712                   lflux(ji,jj) = .TRUE. 
    1713                   lmle(ji,jj) = .TRUE. 
    1714                 ELSE 
    1715 ! Strong stratification 
    1716                   lpyc(ji,jj) = .TRUE. 
    1717                   lflux(ji,jj) = .FALSE. 
    1718                   lmle(ji,jj) = .FALSE. 
    1719                 ENDIF ! zdb_bl < rn_mle_thresh_bl and 
    1720               ENDIF  ! zhmle > 1.2 zhbl 
    1721             ELSE 
    1722               lpyc(ji,jj) = .TRUE. 
    1723               lflux(ji,jj) = .FALSE. 
    1724               lmle(ji,jj) = .FALSE. 
    1725               IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 
    1726             ENDIF !  -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5 
    1727           ELSE 
    1728 ! Stable Boundary Layer 
    1729             lpyc(ji,jj) = .FALSE. 
    1730             lflux(ji,jj) = .FALSE. 
    1731             lmle(ji,jj) = .FALSE. 
    1732           ENDIF  ! lconv 
    1733         END_2D 
    1734     END SUBROUTINE zdf_osm_osbl_state_fk 
    1735  
    1736     SUBROUTINE zdf_osm_external_gradients(jbase, zdtdz, zdsdz, zdbdz ) 
    1737      !!--------------------------------------------------------------------- 
    1738      !!                   ***  ROUTINE zdf_osm_external_gradients  *** 
    1739      !! 
    1740      !! ** Purpose : Calculates the gradients below the OSBL 
    1741      !! 
    1742      !! ** Method  : Uses ibld and ibld_ext to determine levels to calculate the gradient. 
    1743      !! 
    1744      !!---------------------------------------------------------------------- 
    1745  
    1746      INTEGER, DIMENSION(jpi,jpj)  :: jbase 
    1747      REAL(wp), DIMENSION(jpi,jpj) :: zdtdz, zdsdz, zdbdz   ! External gradients of temperature, salinity and buoyancy. 
    1748  
    1749      INTEGER :: jj, ji, jkb, jkb1 
    1750      REAL(wp) :: zthermal, zbeta 
    1751  
    1752  
    1753      DO_2D( 0, 0, 0, 0 ) 
    1754         IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN 
    1755            zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    1756            zbeta    = rab_n(ji,jj,1,jp_sal) 
    1757            jkb = jbase(ji,jj) 
    1758            jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 
    1759            zdtdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_tem,Kmm) - ts(ji,jj,jkb,jp_tem,Kmm ) ) & 
    1760                 &   / e3t(ji,jj,ibld(ji,jj),Kmm) 
    1761            zdsdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_sal,Kmm) - ts(ji,jj,jkb,jp_sal,Kmm ) ) & 
    1762                 &   / e3t(ji,jj,ibld(ji,jj),Kmm) 
    1763            zdbdz(ji,jj) = grav * zthermal * zdtdz(ji,jj) - grav * zbeta * zdsdz(ji,jj) 
    1764         ELSE 
    1765            zdtdz(ji,jj) = 0._wp 
    1766            zdsdz(ji,jj) = 0._wp 
    1767            zdbdz(ji,jj) = 0._wp 
    1768         END IF 
    1769      END_2D 
    1770     END SUBROUTINE zdf_osm_external_gradients 
    1771  
    1772     SUBROUTINE zdf_osm_pycnocline_scalar_profiles( zdtdz, zdsdz, zdbdz, zalpha ) 
    1773  
    1774      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz, zdsdz, zdbdz      ! gradients in the pycnocline 
    1775      REAL(wp), DIMENSION(jpi,jpj) :: zalpha 
    1776  
    1777      INTEGER :: jk, jj, ji 
    1778      REAL(wp) :: ztgrad, zsgrad, zbgrad 
    1779      REAL(wp) :: zgamma_b_nd, znd 
    1780      REAL(wp) :: zzeta_m, zzeta_en, zbuoy_pyc_sc 
    1781      REAL(wp), PARAMETER :: zgamma_b = 2.25, zzeta_sh = 0.15 
    1782  
    1783      DO_2D( 0, 0, 0, 0 ) 
    1784         IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 
    1785            IF ( lconv(ji,jj) ) THEN  ! convective conditions 
    1786              IF ( lpyc(ji,jj) ) THEN 
    1787                 zzeta_m = 0.1 + 0.3 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) ) 
    1788                 zalpha(ji,jj) = 2.0 * ( 1.0 - ( 0.80 * zzeta_m + 0.5 * SQRT( 3.14159 / zgamma_b ) ) * zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / zdb_ml(ji,jj) ) / ( 0.723 + SQRT( 3.14159 / zgamma_b ) ) 
    1789                 zalpha(ji,jj) = MAX( zalpha(ji,jj), 0._wp ) 
    1790  
    1791                 ztmp = 1._wp/MAX(zdh(ji,jj), epsln) 
    1792 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    1793 ! Commented lines in this section are not needed in new code, once tested ! 
    1794 ! can be removed                                                          ! 
    1795 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    1796 !                   ztgrad = zalpha * zdt_ml(ji,jj) * ztmp + zdtdz_bl_ext(ji,jj) 
    1797 !                   zsgrad = zalpha * zds_ml(ji,jj) * ztmp + zdsdz_bl_ext(ji,jj) 
    1798                 zbgrad = zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp + zdbdz_bl_ext(ji,jj) 
    1799                 zgamma_b_nd = zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / MAX(zdb_ml(ji,jj), epsln) 
    1800                 DO jk = 2, ibld(ji,jj)+ibld_ext 
    1801                   znd = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) * ztmp 
    1802                   IF ( znd <= zzeta_m ) THEN 
    1803 !                        zdtdz(ji,jj,jk) = zdtdz_bl_ext(ji,jj) + zalpha * zdt_ml(ji,jj) * ztmp * & 
    1804 !                &        EXP( -6.0 * ( znd -zzeta_m )**2 ) 
    1805 !                        zdsdz(ji,jj,jk) = zdsdz_bl_ext(ji,jj) + zalpha * zds_ml(ji,jj) * ztmp * & 
    1806 !                                  & EXP( -6.0 * ( znd -zzeta_m )**2 ) 
    1807                      zdbdz(ji,jj,jk) = zdbdz_bl_ext(ji,jj) + zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp * & 
    1808                                & EXP( -6.0 * ( znd -zzeta_m )**2 ) 
    1809                   ELSE 
    1810 !                         zdtdz(ji,jj,jk) =  ztgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 
    1811 !                         zdsdz(ji,jj,jk) =  zsgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 
    1812                       zdbdz(ji,jj,jk) =  zbgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 
    1813                   ENDIF 
    1814                END DO 
    1815             ENDIF ! if no pycnocline pycnocline gradients set to zero 
    1816            ELSE 
    1817               ! stable conditions 
    1818               ! if pycnocline profile only defined when depth steady of increasing. 
    1819               IF ( zdhdt(ji,jj) > 0.0 ) THEN        ! Depth increasing, or steady. 
    1820                  IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    1821                     IF ( zhol(ji,jj) >= 0.5 ) THEN      ! Very stable - 'thick' pycnocline 
    1822                        ztmp = 1._wp/MAX(zhbl(ji,jj), epsln) 
    1823                        ztgrad = zdt_bl(ji,jj) * ztmp 
    1824                        zsgrad = zds_bl(ji,jj) * ztmp 
    1825                        zbgrad = zdb_bl(ji,jj) * ztmp 
    1826                        DO jk = 2, ibld(ji,jj) 
    1827                           znd = gdepw(ji,jj,jk,Kmm) * ztmp 
    1828                           zdtdz(ji,jj,jk) =  ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
    1829                           zdbdz(ji,jj,jk) =  zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
    1830                           zdsdz(ji,jj,jk) =  zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
    1831                        END DO 
    1832                     ELSE                                   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 
    1833                        ztmp = 1._wp/MAX(zdh(ji,jj), epsln) 
    1834                        ztgrad = zdt_bl(ji,jj) * ztmp 
    1835                        zsgrad = zds_bl(ji,jj) * ztmp 
    1836                        zbgrad = zdb_bl(ji,jj) * ztmp 
    1837                        DO jk = 2, ibld(ji,jj) 
    1838                           znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) * ztmp 
    1839                           zdtdz(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    1840                           zdbdz(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    1841                           zdsdz(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    1842                        END DO 
    1843                     ENDIF ! IF (zhol >=0.5) 
    1844                  ENDIF    ! IF (zdb_bl> 0.) 
    1845               ENDIF       ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero 
    1846            ENDIF          ! IF (lconv) 
    1847         ENDIF      ! IF ( ibld(ji,jj) < mbkt(ji,jj) ) 
    1848      END_2D 
    1849  
    1850     END SUBROUTINE zdf_osm_pycnocline_scalar_profiles 
    1851  
    1852     SUBROUTINE zdf_osm_pycnocline_shear_profiles( zdudz, zdvdz ) 
     1681         phbl(ji,jj) = gdepw(ji,jj,nbld(ji,jj),Kmm) 
     1682      END_2D 
     1683      ! 
     1684   END SUBROUTINE zdf_osm_timestep_hbl 
     1685 
     1686   SUBROUTINE zdf_osm_pycnocline_thickness( Kmm, pdh, phml, pdhdt, phbl,   & 
     1687      &                                     pwb_ent, pdbdz_bl_ext, pwb_fk_b ) 
    18531688      !!--------------------------------------------------------------------- 
    1854       !!                   ***  ROUTINE zdf_osm_pycnocline_shear_profiles  *** 
    1855       !! 
    1856       !! ** Purpose : Calculates velocity shear in the pycnocline 
    1857       !! 
    1858       !! ** Method  : 
    1859       !! 
    1860       !!---------------------------------------------------------------------- 
    1861  
    1862       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz, zdvdz 
    1863  
    1864       INTEGER :: jk, jj, ji 
    1865       REAL(wp) :: zugrad, zvgrad, znd 
    1866       REAL(wp) :: zzeta_v = 0.45 
    1867       ! 
    1868       DO_2D( 0, 0, 0, 0 ) 
    1869          ! 
    1870          IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 
    1871             IF ( lconv (ji,jj) ) THEN 
    1872                ! Unstable conditions. Shouldn;t be needed with no pycnocline code. 
    1873 !                  zugrad = 0.7 * zdu_ml(ji,jj) / zdh(ji,jj) + 0.3 * zustar(ji,jj)*zustar(ji,jj) / & 
    1874 !                       &      ( ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) * & 
    1875 !                      &      MIN(zla(ji,jj)**(8.0/3.0) + epsln, 0.12 )) 
    1876                !Alan is this right? 
    1877 !                  zvgrad = ( 0.7 * zdv_ml(ji,jj) + & 
    1878 !                       &    2.0 * ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) / & 
    1879 !                       &          ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird  + epsln ) & 
    1880 !                       &      )/ (zdh(ji,jj)  + epsln ) 
    1881 !                  DO jk = 2, ibld(ji,jj) - 1 + ibld_ext 
    1882 !                     znd = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / (zdh(ji,jj) + epsln ) - zzeta_v 
    1883 !                     IF ( znd <= 0.0 ) THEN 
    1884 !                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( 3.0 * znd ) 
    1885 !                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( 3.0 * znd ) 
    1886 !                     ELSE 
    1887 !                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( -2.0 * znd ) 
    1888 !                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( -2.0 * znd ) 
    1889 !                     ENDIF 
    1890 !                  END DO 
    1891             ELSE 
    1892                ! stable conditions 
    1893                zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj) 
    1894                zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj) 
    1895                DO jk = 2, ibld(ji,jj) 
    1896                   znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    1897                   IF ( znd < 1.0 ) THEN 
    1898                      zdudz(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 ) 
    1899                   ELSE 
    1900                      zdudz(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 ) 
    1901                   ENDIF 
    1902                   zdvdz(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 ) 
    1903                END DO 
    1904             ENDIF 
    1905             ! 
    1906          END IF      ! IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) 
    1907       END_2D 
    1908     END SUBROUTINE zdf_osm_pycnocline_shear_profiles 
    1909  
    1910    SUBROUTINE zdf_osm_calculate_dhdt( zdhdt, zddhdt ) 
    1911      !!--------------------------------------------------------------------- 
    1912      !!                   ***  ROUTINE zdf_osm_calculate_dhdt  *** 
    1913      !! 
    1914      !! ** Purpose : Calculates the rate at which hbl changes. 
    1915      !! 
    1916      !! ** Method  : 
    1917      !! 
    1918      !!---------------------------------------------------------------------- 
    1919  
    1920     REAL(wp), DIMENSION(jpi,jpj) :: zdhdt, zddhdt        ! Rate of change of hbl 
    1921  
    1922     INTEGER :: jj, ji 
    1923     REAL(wp) :: zgamma_b_nd, zgamma_dh_nd, zpert, zpsi 
    1924     REAL(wp) :: zvel_max!, zwb_min 
    1925     REAL(wp) :: zzeta_m = 0.3 
    1926     REAL(wp) :: zgamma_c = 2.0 
    1927     REAL(wp) :: zdhoh = 0.1 
    1928     REAL(wp) :: alpha_bc = 0.5 
    1929     REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 
    1930  
    1931   DO_2D( 0, 0, 0, 0 ) 
    1932  
    1933     IF ( lshear(ji,jj) ) THEN 
    1934        IF ( lconv(ji,jj) ) THEN    ! Convective 
    1935  
    1936           IF ( ln_osm_mle ) THEN 
    1937  
    1938              IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 
    1939        ! Fox-Kemper buoyancy flux average over OSBL 
    1940                 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) *  & 
    1941                      (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 
    1942              ELSE 
    1943                 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 
    1944              ENDIF 
    1945              zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 
    1946              IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 
    1947                 ! OSBL is deepening, entrainment > restratification 
    1948                 IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN 
    1949 ! *** Used for shear Needs to be changed to work stabily 
    1950 !                zgamma_b_nd = zdbdz_bl_ext * dh / zdb_ml 
    1951 !                zalpha_b = 6.7 * zgamma_b_nd / ( 1.0 + zgamma_b_nd ) 
    1952 !                zgamma_b = zgamma_b_nd / ( 0.12 * ( 1.25 + zgamma_b_nd ) ) 
    1953 !                za_1 = 1.0 / zgamma_b**2 - 0.017 
    1954 !                za_2 = 1.0 / zgamma_b**3 - 0.0025 
    1955 !                zpsi = zalpha_b * ( 1.0 + zgamma_b_nd ) * ( za_1 - 2.0 * za_2 * dh / hbl ) 
    1956                    zpsi = 0._wp 
    1957                    zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 
    1958                    zdhdt(ji,jj) = zdhdt(ji,jj)! - zpsi * ( -1.0 / zhml(ji,jj) + 2.4 * zdbdz_bl_ext(ji,jj) / zdb_ml(ji,jj) ) * zwb_min(ji,jj) * zdh(ji,jj) / zdb_bl(ji,jj) 
    1959                    IF ( j_ddh(ji,jj) == 1 ) THEN 
    1960                      IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 
    1961                         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 ) 
    1962                      ELSE 
    1963                         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 ) 
    1964                      ENDIF 
    1965 ! Relaxation to dh_ref = zari * hbl 
    1966                      zddhdt(ji,jj) = -a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj) 
    1967  
    1968                    ELSE  ! j_ddh == 0 
    1969 ! Growing shear layer 
    1970                      zddhdt(ji,jj) = -a_ddh * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj) 
    1971                    ENDIF ! j_ddh 
    1972                      zdhdt(ji,jj) = zdhdt(ji,jj) ! + zpsi * zddhdt(ji,jj) 
    1973                 ELSE    ! zdb_bl >0 
    1974                    zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) /  MAX( zvel_max, 1.0e-15) 
    1975                 ENDIF 
    1976              ELSE   ! zwb_min + 2*zwb_fk_b < 0 
    1977                 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 
    1978                 zdhdt(ji,jj) = - zvel_mle(ji,jj) 
    1979  
    1980  
    1981              ENDIF 
    1982  
    1983           ELSE 
    1984              ! Fox-Kemper not used. 
    1985  
    1986                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) / & 
    1987                &        MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 
    1988                zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 
    1989              ! added ajgn 23 July as temporay fix 
    1990  
    1991           ENDIF  ! ln_osm_mle 
    1992  
    1993          ELSE    ! lconv - Stable 
    1994              zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 
    1995              IF ( zdhdt(ji,jj) < 0._wp ) THEN 
    1996                 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 
    1997                  zpert = 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_Dt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj) 
    1998              ELSE 
    1999                  zpert = MAX( 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 
    2000              ENDIF 
    2001              zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 
    2002          ENDIF  ! lconv 
    2003     ELSE ! lshear 
    2004       IF ( lconv(ji,jj) ) THEN    ! Convective 
    2005  
    2006           IF ( ln_osm_mle ) THEN 
    2007  
    2008              IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 
    2009        ! Fox-Kemper buoyancy flux average over OSBL 
    2010                 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) *  & 
    2011                      (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 
    2012              ELSE 
    2013                 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 
    2014              ENDIF 
    2015              zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 
    2016              IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 
    2017                 ! OSBL is deepening, entrainment > restratification 
    2018                 IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN 
    2019                    zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 
    2020                 ELSE 
    2021                    zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) /  MAX( zvel_max, 1.0e-15) 
    2022                 ENDIF 
    2023              ELSE 
    2024                 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 
    2025                 zdhdt(ji,jj) = - zvel_mle(ji,jj) 
    2026  
    2027  
    2028              ENDIF 
    2029  
    2030           ELSE 
    2031              ! Fox-Kemper not used. 
    2032  
    2033                zvel_max = -zwb_ent(ji,jj) / & 
    2034                &        MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 
    2035                zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 
    2036              ! added ajgn 23 July as temporay fix 
    2037  
    2038           ENDIF  ! ln_osm_mle 
    2039  
    2040          ELSE                        ! Stable 
    2041              zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 
    2042              IF ( zdhdt(ji,jj) < 0._wp ) THEN 
    2043                 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 
    2044                  zpert = 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj) 
    2045              ELSE 
    2046                  zpert = MAX( 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 
    2047              ENDIF 
    2048              zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 
    2049          ENDIF  ! lconv 
    2050       ENDIF ! lshear 
    2051   END_2D 
    2052     END SUBROUTINE zdf_osm_calculate_dhdt 
    2053  
    2054     SUBROUTINE zdf_osm_timestep_hbl( zdhdt ) 
    2055      !!--------------------------------------------------------------------- 
    2056      !!                   ***  ROUTINE zdf_osm_timestep_hbl  *** 
    2057      !! 
    2058      !! ** Purpose : Increments hbl. 
    2059      !! 
    2060      !! ** Method  : If thechange in hbl exceeds one model level the change is 
    2061      !!              is calculated by moving down the grid, changing the buoyancy 
    2062      !!              jump. This is to ensure that the change in hbl does not 
    2063      !!              overshoot a stable layer. 
    2064      !! 
    2065      !!---------------------------------------------------------------------- 
    2066  
    2067  
    2068     REAL(wp), DIMENSION(jpi,jpj) :: zdhdt   ! rates of change of hbl. 
    2069  
    2070     INTEGER :: jk, jj, ji, jm 
    2071     REAL(wp) :: zhbl_s, zvel_max, zdb 
    2072     REAL(wp) :: zthermal, zbeta 
    2073  
    2074      DO_2D( 0, 0, 0, 0 ) 
    2075         IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 
    2076 ! 
    2077 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 
    2078 ! 
    2079            zhbl_s = hbl(ji,jj) 
    2080            jm = imld(ji,jj) 
    2081            zthermal = rab_n(ji,jj,1,jp_tem) 
    2082            zbeta = rab_n(ji,jj,1,jp_sal) 
    2083  
    2084  
    2085            IF ( lconv(ji,jj) ) THEN 
    2086 !unstable 
    2087  
    2088               IF( ln_osm_mle ) THEN 
    2089                  zvel_max = ( zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 
    2090               ELSE 
    2091  
    2092                  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) / & 
    2093                    &      ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    2094  
    2095               ENDIF 
    2096  
    2097               DO jk = imld(ji,jj), ibld(ji,jj) 
    2098                  zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 
    2099                       & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), & 
    2100                       &  0.0 ) + zvel_max 
    2101  
    2102  
    2103                  IF ( ln_osm_mle ) THEN 
    2104                     zhbl_s = zhbl_s + MIN( & 
    2105                      & rn_Dt * ( ( -zwb_ent(ji,jj) - 2.0 * zwb_fk_b(ji,jj) )/ zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 
    2106                      & e3w(ji,jj,jm,Kmm) ) 
    2107                  ELSE 
    2108                    zhbl_s = zhbl_s + MIN( & 
    2109                      & rn_Dt * (  -zwb_ent(ji,jj) / zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 
    2110                      & e3w(ji,jj,jm,Kmm) ) 
    2111                  ENDIF 
    2112  
    2113 !                    zhbl_s = MIN(zhbl_s,  gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 
    2114                  IF ( zhbl_s >= gdepw(ji,jj,mbkt(ji,jj) + 1,Kmm) ) THEN 
    2115                    zhbl_s = MIN(zhbl_s,  gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 
    2116                    lpyc(ji,jj) = .FALSE. 
    2117                  ENDIF 
    2118                  IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 
    2119               END DO 
    2120               hbl(ji,jj) = zhbl_s 
    2121               ibld(ji,jj) = jm 
    2122           ELSE 
    2123 ! stable 
    2124               DO jk = imld(ji,jj), ibld(ji,jj) 
    2125                  zdb = MAX( & 
    2126                       & grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) )& 
    2127                       &           - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ),& 
    2128                       & 0.0 ) + & 
    2129           &       2.0 * zvstr(ji,jj)**2 / zhbl_s 
    2130  
    2131                  ! Alan is thuis right? I have simply changed hbli to hbl 
    2132                  zhol(ji,jj) = -zhbl_s / ( ( zvstr(ji,jj)**3 + epsln )/ zwbav(ji,jj) ) 
    2133                  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) ) ) * & 
    2134             &                  zustar(ji,jj)**3 / zhbl_s ) * ( 0.725 + 0.225 * EXP( -7.5 * zhol(ji,jj) ) ) 
    2135                  zdhdt(ji,jj) = zdhdt(ji,jj) + zwbav(ji,jj) 
    2136                  zhbl_s = zhbl_s + MIN( zdhdt(ji,jj) / zdb * rn_Dt / FLOAT( ibld(ji,jj) - imld(ji,jj) ), e3w(ji,jj,jm,Kmm) ) 
    2137  
    2138 !                    zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 
    2139                  IF ( zhbl_s >= mbkt(ji,jj) + 1 ) THEN 
    2140                    zhbl_s = MIN(zhbl_s,  gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 
    2141                    lpyc(ji,jj) = .FALSE. 
    2142                  ENDIF 
    2143                  IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 
    2144               END DO 
    2145           ENDIF   ! IF ( lconv ) 
    2146           hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,4,Kmm) ) 
    2147           ibld(ji,jj) = MAX(jm, 4 ) 
    2148         ELSE 
    2149 ! change zero or one model level. 
    2150           hbl(ji,jj) = MAX(zhbl_t(ji,jj), gdepw(ji,jj,4,Kmm) ) 
    2151         ENDIF 
    2152         zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 
    2153      END_2D 
    2154  
    2155     END SUBROUTINE zdf_osm_timestep_hbl 
    2156  
    2157     SUBROUTINE zdf_osm_pycnocline_thickness( dh, zdh ) 
    2158       !!--------------------------------------------------------------------- 
    2159       !!                   ***  ROUTINE zdf_osm_pycnocline_thickness  *** 
     1689      !!            ***  ROUTINE zdf_osm_pycnocline_thickness  *** 
    21601690      !! 
    21611691      !! ** Purpose : Calculates thickness of the pycnocline 
    … …  
    21681698      !! 
    21691699      !!---------------------------------------------------------------------- 
    2170  
    2171       REAL(wp), DIMENSION(jpi,jpj) :: dh, zdh     ! pycnocline thickness. 
    2172        ! 
    2173       INTEGER :: jj, ji 
    2174       INTEGER :: inhml 
    2175       REAL(wp) :: zari, ztau, zdh_ref 
    2176       REAL, PARAMETER :: a_ddh_2 = 3.5 ! also in pycnocline_depth 
    2177  
    2178     DO_2D( 0, 0, 0, 0 ) 
    2179  
    2180       IF ( lshear(ji,jj) ) THEN 
    2181          IF ( lconv(ji,jj) ) THEN 
    2182            IF ( j_ddh(ji,jj) == 0 ) THEN 
    2183 ! ddhdt for pycnocline determined in osm_calculate_dhdt 
    2184              dh(ji,jj) = dh(ji,jj) + zddhdt(ji,jj) * rn_Dt 
    2185            ELSE 
    2186 ! Temporary (probably) Recalculate dh_ref to ensure dh doesn't go negative. Can't do this using zddhdt from calculate_dhdt 
    2187              IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 
    2188                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 ) 
    2189              ELSE 
    2190                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 ) 
    2191              ENDIF 
    2192              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 ) 
    2193              dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zari * zhbl(ji,jj) * ( 1.0 - EXP( -rn_Dt / ztau ) ) 
    2194              IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * zhbl(ji,jj) 
    2195            ENDIF 
    2196  
    2197          ELSE ! lconv 
    2198 ! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL 
    2199  
    2200             ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 
    2201             IF ( zdhdt(ji,jj) >= 0.0 ) THEN    ! probably shouldn't include wm here 
    2202                ! boundary layer deepening 
    2203                IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    2204                   ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 
    2205                   zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 
    2206                        & /  MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01  , 0.2 ) 
    2207                   zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 
     1700      INTEGER,                            INTENT(in   ) ::   Kmm            ! Ocean time-level index 
     1701      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pdh            ! Pycnocline thickness 
     1702      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   phml           ! ML depth 
     1703      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdhdt          ! BL depth tendency 
     1704      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl           ! BL depth 
     1705      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_ent        ! Buoyancy entrainment flux 
     1706      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdbdz_bl_ext   ! External buoyancy gradients 
     1707      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_fk_b       ! MLE buoyancy flux averaged over OSBL 
     1708      !! 
     1709      INTEGER  ::   jj, ji 
     1710      INTEGER  ::   inhml 
     1711      REAL(wp) ::   zari, ztau, zdh_ref, zddhdt, zvel_max 
     1712      REAL(wp) ::   ztmp   ! Auxiliary variable 
     1713      !! 
     1714      REAL, PARAMETER ::   pp_ddh = 2.5_wp, pp_ddh_2 = 3.5_wp   ! Also in pycnocline_depth 
     1715      !!---------------------------------------------------------------------- 
     1716      ! 
     1717      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1718         ! 
     1719         IF ( l_shear(ji,jj) ) THEN 
     1720            ! 
     1721            IF ( l_conv(ji,jj) ) THEN 
     1722               ! 
     1723               IF ( av_db_bl(ji,jj) > 1e-15_wp ) THEN 
     1724                  IF ( n_ddh(ji,jj) == 0 ) THEN 
     1725                     zvel_max = ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 
     1726                     ! ddhdt for pycnocline determined in osm_calculate_dhdt 
     1727                     zddhdt = -1.0_wp * pp_ddh * ( 1.0_wp - 1.6_wp * pdh(ji,jj) / phbl(ji,jj) ) * pwb_ent(ji,jj) /   & 
     1728                        &     ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15 ) ) 
     1729                     zddhdt = EXP( -4.0_wp * ABS( ff_t(ji,jj) ) * phbl(ji,jj) / MAX( sustar(ji,jj), 1e-8 ) ) * zddhdt 
     1730                     ! Maximum limit for how thick the shear layer can grow relative to the thickness of the boundary layer 
     1731                     dh(ji,jj) = MIN( dh(ji,jj) + zddhdt * rn_Dt, 0.625_wp * hbl(ji,jj) ) 
     1732                  ELSE   ! Need to recalculate because hbl has been updated 
     1733                     IF ( ( swstrc(ji,jj) / svstr(ji,jj) )**3 <= 0.5_wp ) THEN 
     1734                        ztmp = svstr(ji,jj) 
     1735                     ELSE 
     1736                        ztmp = swstrc(ji,jj) 
     1737                     END IF 
     1738                     zari = MIN( 1.5_wp * av_db_bl(ji,jj) / ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +        & 
     1739                        &                                                   av_db_bl(ji,jj)**2 / MAX( 4.5_wp * ztmp**2,   & 
     1740                        &                                                                           1e-12_wp ) ) ), 0.2_wp ) 
     1741                     ztau = MAX( av_db_bl(ji,jj) * ( zari * hbl(ji,jj) ) /   & 
     1742                        &        ( pp_ddh_2 * MAX( -1.0_wp * pwb_ent(ji,jj), 1e-12_wp ) ), 2.0_wp * rn_Dt ) 
     1743                     dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) +   & 
     1744                        &        zari * phbl(ji,jj) * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) ) 
     1745                     IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * phbl(ji,jj) 
     1746                  END IF 
    22081747               ELSE 
    2209                   zdh_ref = 0.2 * hbl(ji,jj) 
     1748                  ztau = MAX( MAX( hbl(ji,jj) / ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird, epsln), 2.0_wp * rn_Dt ) 
     1749                  dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) +   & 
     1750                     &        0.2_wp * phbl(ji,jj) * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) ) 
     1751                  IF ( dh(ji,jj) > hbl(ji,jj) ) dh(ji,jj) = 0.2_wp * hbl(ji,jj) 
     1752               END IF 
     1753               ! 
     1754            ELSE   ! l_conv 
     1755               ! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL 
     1756               ztau = hbl(ji,jj) / MAX(svstr(ji,jj), epsln) 
     1757               IF ( pdhdt(ji,jj) >= 0.0_wp ) THEN   ! Probably shouldn't include wm here 
     1758                  ! Boundary layer deepening 
     1759                  IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN 
     1760                     ! Pycnocline thickness set by stratification - use same relationship as for neutral conditions 
     1761                     zari    = MIN( 4.5_wp * ( svstr(ji,jj)**2 ) / MAX( av_db_bl(ji,jj) * phbl(ji,jj), epsln ) + 0.01_wp, 0.2_wp ) 
     1762                     zdh_ref = MIN( zari, 0.2_wp ) * hbl(ji,jj) 
     1763                  ELSE 
     1764                     zdh_ref = 0.2_wp * hbl(ji,jj) 
     1765                  ENDIF 
     1766               ELSE   ! IF(dhdt < 0) 
     1767                  zdh_ref = 0.2_wp * hbl(ji,jj) 
     1768               ENDIF   ! IF (dhdt >= 0) 
     1769               dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) + zdh_ref * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) ) 
     1770               IF ( pdhdt(ji,jj) < 0.0_wp .AND. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref   ! Can be a problem with dh>hbl for 
     1771               !                                                                                !    rapid collapse 
     1772            ENDIF 
     1773            ! 
     1774         ELSE   ! l_shear = .FALSE., calculate ddhdt here 
     1775            ! 
     1776            IF ( l_conv(ji,jj) ) THEN 
     1777               ! 
     1778               IF( ln_osm_mle ) THEN 
     1779                  IF ( ( pwb_ent(ji,jj) + 2.0_wp * pwb_fk_b(ji,jj) ) < 0.0_wp ) THEN   ! OSBL is deepening. Note wb_fk_b is zero if 
     1780                     !                                                                 !    ln_osm_mle=F 
     1781                     IF ( av_db_bl(ji,jj) > 0.0_wp .AND. pdbdz_bl_ext(ji,jj) > 0.0_wp ) THEN 
     1782                        IF ( ( swstrc(ji,jj) / MAX( svstr(ji,jj), epsln) )**3 <= 0.5_wp ) THEN   ! Near neutral stability 
     1783                           ztmp = svstr(ji,jj) 
     1784                        ELSE   ! Unstable 
     1785                           ztmp = swstrc(ji,jj) 
     1786                        END IF 
     1787                        zari = MIN( 1.5_wp * av_db_bl(ji,jj) /                               & 
     1788                           &        ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +   & 
     1789                           &                          av_db_bl(ji,jj)**2 / MAX( 4.5_wp * ztmp**2 , 1e-12_wp ) ) ), 0.2_wp ) 
     1790                     ELSE 
     1791                        zari = 0.2_wp 
     1792                     END IF 
     1793                  ELSE 
     1794                     zari = 0.2_wp 
     1795                  END IF 
     1796                  ztau    = 0.2_wp * hbl(ji,jj) / MAX( epsln, ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird ) 
     1797                  zdh_ref = zari * hbl(ji,jj) 
     1798               ELSE   ! ln_osm_mle 
     1799                  IF ( av_db_bl(ji,jj) > 0.0_wp .AND. pdbdz_bl_ext(ji,jj) > 0.0_wp ) THEN 
     1800                     IF ( ( swstrc(ji,jj) / MAX( svstr(ji,jj), epsln ) )**3 <= 0.5_wp ) THEN   ! Near neutral stability 
     1801                        ztmp = svstr(ji,jj) 
     1802                     ELSE   ! Unstable 
     1803                        ztmp = swstrc(ji,jj) 
     1804                     END IF 
     1805                     zari    = MIN( 1.5_wp * av_db_bl(ji,jj) /                               & 
     1806                        &           ( phbl(ji,jj) * ( MAX( pdbdz_bl_ext(ji,jj), 0.0_wp ) +   & 
     1807                        &                             av_db_bl(ji,jj)**2 / MAX( 4.5_wp * ztmp**2 , 1e-12_wp ) ) ), 0.2_wp ) 
     1808                  ELSE 
     1809                     zari    = 0.2_wp 
     1810                  END IF 
     1811                  ztau    = hbl(ji,jj) / MAX( epsln, ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird ) 
     1812                  zdh_ref = zari * hbl(ji,jj) 
     1813               END IF   ! ln_osm_mle 
     1814               dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) + zdh_ref * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) ) 
     1815               !               IF ( pdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 
     1816               IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 
     1817               ! Alan: this hml is never defined or used 
     1818            ELSE   ! IF (l_conv) 
     1819               ! 
     1820               ztau = hbl(ji,jj) / MAX( svstr(ji,jj), epsln ) 
     1821               IF ( pdhdt(ji,jj) >= 0.0_wp ) THEN   ! Probably shouldn't include wm here 
     1822                  ! Boundary layer deepening 
     1823                  IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN 
     1824                     ! Pycnocline thickness set by stratification - use same relationship as for neutral conditions. 
     1825                     zari    = MIN( 4.5_wp * ( svstr(ji,jj)**2 ) / MAX( av_db_bl(ji,jj) * phbl(ji,jj), epsln ) + 0.01_wp , 0.2_wp ) 
     1826                     zdh_ref = MIN( zari, 0.2_wp ) * hbl(ji,jj) 
     1827                  ELSE 
     1828                     zdh_ref = 0.2_wp * hbl(ji,jj) 
     1829                  END IF 
     1830               ELSE   ! IF(dhdt < 0) 
     1831                  zdh_ref = 0.2_wp * hbl(ji,jj) 
     1832               END IF   ! IF (dhdt >= 0) 
     1833               dh(ji,jj) = dh(ji,jj) * EXP( -1.0_wp * rn_Dt / ztau ) + zdh_ref * ( 1.0_wp - EXP( -1.0_wp * rn_Dt / ztau ) ) 
     1834               IF ( pdhdt(ji,jj) < 0.0_wp .AND. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref   ! Can be a problem with dh>hbl for 
     1835               !                                                                                !    rapid collapse 
     1836            END IF   ! IF (l_conv) 
     1837            ! 
     1838         END IF   ! l_shear 
     1839         ! 
     1840         hml(ji,jj)  = hbl(ji,jj) - dh(ji,jj) 
     1841         inhml       = MAX( INT( dh(ji,jj) / MAX( e3t(ji,jj,nbld(ji,jj)-1,Kmm), 1e-3_wp ) ), 1 ) 
     1842         nmld(ji,jj) = MAX( nbld(ji,jj) - inhml, 3 ) 
     1843         phml(ji,jj) = gdepw(ji,jj,nmld(ji,jj),Kmm) 
     1844         pdh(ji,jj)  = phbl(ji,jj) - phml(ji,jj) 
     1845         ! 
     1846      END_2D 
     1847      ! 
     1848   END SUBROUTINE zdf_osm_pycnocline_thickness 
     1849 
     1850   SUBROUTINE zdf_osm_pycnocline_buoyancy_profiles( Kmm, kp_ext, pdbdz, palpha, pdh,   & 
     1851      &                                             phbl, pdbdz_bl_ext, phml, pdhdt ) 
     1852      !!--------------------------------------------------------------------- 
     1853      !!       ***  ROUTINE zdf_osm_pycnocline_buoyancy_profiles  *** 
     1854      !! 
     1855      !! ** Purpose : calculate pycnocline buoyancy profiles 
     1856      !! 
     1857      !! ** Method  :  
     1858      !! 
     1859      !!---------------------------------------------------------------------- 
     1860      INTEGER,                                 INTENT(in   ) ::   Kmm            ! Ocean time-level index 
     1861      INTEGER,  DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   kp_ext         ! External-level offsets 
     1862      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(  out) ::   pdbdz          ! Gradients in the pycnocline 
     1863      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(  out) ::   palpha 
     1864      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdh            ! Pycnocline thickness 
     1865      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phbl           ! BL depth 
     1866      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdbdz_bl_ext   ! External buoyancy gradients 
     1867      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phml           ! ML depth 
     1868      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdhdt          ! Rates of change of hbl 
     1869      !! 
     1870      INTEGER  ::   jk, jj, ji 
     1871      REAL(wp) ::   zbgrad 
     1872      REAL(wp) ::   zgamma_b_nd, znd 
     1873      REAL(wp) ::   zzeta_m 
     1874      REAL(wp) ::   ztmp   ! Auxiliary variable 
     1875      !! 
     1876      REAL(wp), PARAMETER ::   pp_gamma_b = 2.25_wp 
     1877      REAL(wp), PARAMETER ::   pp_large   = -1e10_wp 
     1878      !!---------------------------------------------------------------------- 
     1879      ! 
     1880      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )       
     1881         pdbdz(ji,jj,:) = pp_large 
     1882         palpha(ji,jj)  = pp_large 
     1883      END_2D 
     1884      ! 
     1885      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1886         ! 
     1887         IF ( nbld(ji,jj) + kp_ext(ji,jj) < mbkt(ji,jj) ) THEN 
     1888            ! 
     1889            IF ( l_conv(ji,jj) ) THEN   ! Convective conditions 
     1890               ! 
     1891               IF ( l_pyc(ji,jj) ) THEN 
     1892                  ! 
     1893                  zzeta_m = 0.1_wp + 0.3_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) ) 
     1894                  palpha(ji,jj) = 2.0_wp * ( 1.0_wp - ( 0.80_wp * zzeta_m + 0.5_wp * SQRT( 3.14159_wp / pp_gamma_b ) ) *   & 
     1895                     &                                pdbdz_bl_ext(ji,jj) * pdh(ji,jj) / av_db_ml(ji,jj) ) /                & 
     1896                     &            ( 0.723_wp + SQRT( 3.14159_wp / pp_gamma_b ) ) 
     1897                  palpha(ji,jj) = MAX( palpha(ji,jj), 0.0_wp ) 
     1898                  ztmp = 1.0_wp / MAX( pdh(ji,jj), epsln ) 
     1899                  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     1900                  ! Commented lines in this section are not needed in new code, once tested ! 
     1901                  ! can be removed                                                          ! 
     1902                  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     1903                  ! ztgrad = zalpha * av_dt_ml(ji,jj) * ztmp + zdtdz_bl_ext(ji,jj) 
     1904                  ! zsgrad = zalpha * av_ds_ml(ji,jj) * ztmp + zdsdz_bl_ext(ji,jj) 
     1905                  zbgrad = palpha(ji,jj) * av_db_ml(ji,jj) * ztmp + pdbdz_bl_ext(ji,jj) 
     1906                  zgamma_b_nd = pdbdz_bl_ext(ji,jj) * pdh(ji,jj) / MAX( av_db_ml(ji,jj), epsln ) 
     1907                  DO jk = 2, nbld(ji,jj) 
     1908                     znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) * ztmp 
     1909                     IF ( znd <= zzeta_m ) THEN 
     1910                        ! zdtdz(ji,jj,jk) = zdtdz_bl_ext(ji,jj) + zalpha * av_dt_ml(ji,jj) * ztmp * & 
     1911                        ! &        EXP( -6.0 * ( znd -zzeta_m )**2 ) 
     1912                        ! zdsdz(ji,jj,jk) = zdsdz_bl_ext(ji,jj) + zalpha * av_ds_ml(ji,jj) * ztmp * & 
     1913                        ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 
     1914                        pdbdz(ji,jj,jk) = pdbdz_bl_ext(ji,jj) + palpha(ji,jj) * av_db_ml(ji,jj) * ztmp * & 
     1915                           & EXP( -6.0_wp * ( znd -zzeta_m )**2 ) 
     1916                     ELSE 
     1917                        ! zdtdz(ji,jj,jk) =  ztgrad * EXP( -pp_gamma_b * ( znd - zzeta_m )**2 ) 
     1918                        ! zdsdz(ji,jj,jk) =  zsgrad * EXP( -pp_gamma_b * ( znd - zzeta_m )**2 ) 
     1919                        pdbdz(ji,jj,jk) =  zbgrad * EXP( -1.0_wp * pp_gamma_b * ( znd - zzeta_m )**2 ) 
     1920                     END IF 
     1921                  END DO 
     1922               END IF   ! If no pycnocline pycnocline gradients set to zero 
     1923               ! 
     1924            ELSE   ! Stable conditions 
     1925               ! If pycnocline profile only defined when depth steady of increasing. 
     1926               IF ( pdhdt(ji,jj) > 0.0_wp ) THEN   ! Depth increasing, or steady. 
     1927                  IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN 
     1928                     IF ( shol(ji,jj) >= 0.5_wp ) THEN   ! Very stable - 'thick' pycnocline 
     1929                        ztmp = 1.0_wp / MAX( phbl(ji,jj), epsln ) 
     1930                        zbgrad = av_db_bl(ji,jj) * ztmp 
     1931                        DO jk = 2, nbld(ji,jj) 
     1932                           znd = gdepw(ji,jj,jk,Kmm) * ztmp 
     1933                           pdbdz(ji,jj,jk) = zbgrad * EXP( -15.0_wp * ( znd - 0.9_wp )**2 ) 
     1934                        END DO 
     1935                     ELSE   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 
     1936                        ztmp = 1.0_wp / MAX( pdh(ji,jj), epsln ) 
     1937                        zbgrad = av_db_bl(ji,jj) * ztmp 
     1938                        DO jk = 2, nbld(ji,jj) 
     1939                           znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phml(ji,jj) ) * ztmp 
     1940                           pdbdz(ji,jj,jk) = zbgrad * EXP( -1.75_wp * ( znd + 0.75_wp )**2 ) 
     1941                        END DO 
     1942                     END IF   ! IF (shol >=0.5) 
     1943                  END IF      ! IF (av_db_bl> 0.) 
     1944               END IF         ! IF (pdhdt >= 0) pdhdt < 0 not considered since pycnocline profile is zero and profile arrays are 
     1945               !              !    intialized to zero 
     1946               ! 
     1947            END IF            ! IF (l_conv) 
     1948            ! 
     1949         END IF   ! IF ( nbld(ji,jj) < mbkt(ji,jj) ) 
     1950         ! 
     1951      END_2D 
     1952      ! 
     1953      IF ( ln_dia_pyc_scl ) THEN   ! Output of pycnocline gradient profiles 
     1954         CALL zdf_osm_iomput( "zdbdz_pyc", wmask(A2D(0),:) * pdbdz(A2D(0),:) ) 
     1955      END IF 
     1956      ! 
     1957   END SUBROUTINE zdf_osm_pycnocline_buoyancy_profiles 
     1958 
     1959   SUBROUTINE zdf_osm_diffusivity_viscosity( Kbb, Kmm, pdiffut, pviscos, phbl,   & 
     1960      &                                      phml, pdh, pdhdt, pshear,           & 
     1961      &                                      pwb_ent, pwb_min ) 
     1962      !!--------------------------------------------------------------------- 
     1963      !!           ***  ROUTINE zdf_osm_diffusivity_viscosity  *** 
     1964      !! 
     1965      !! ** Purpose : Determines the eddy diffusivity and eddy viscosity 
     1966      !!              profiles in the mixed layer and the pycnocline. 
     1967      !! 
     1968      !! ** Method  : 
     1969      !! 
     1970      !!---------------------------------------------------------------------- 
     1971      INTEGER,                                 INTENT(in   ) ::   Kbb, Kmm       ! Ocean time-level indices 
     1972      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(inout) ::   pdiffut        ! t-diffusivity 
     1973      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(inout) ::   pviscos        ! Viscosity 
     1974      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phbl           ! BL depth 
     1975      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phml           ! ML depth 
     1976      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdh            ! Pycnocline depth 
     1977      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdhdt          ! BL depth tendency 
     1978      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pshear         ! Shear production 
     1979      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pwb_ent        ! Buoyancy entrainment flux 
     1980      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pwb_min 
     1981      !! 
     1982      INTEGER ::   ji, jj, jk   ! Loop indices 
     1983      !! Scales used to calculate eddy diffusivity and viscosity profiles 
     1984      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdifml_sc,    zvisml_sc 
     1985      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zdifpyc_n_sc, zdifpyc_s_sc 
     1986      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zvispyc_n_sc, zvispyc_s_sc 
     1987      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zbeta_d_sc,   zbeta_v_sc 
     1988      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zb_coup,      zc_coup_vis,  zc_coup_dif 
     1989      !! 
     1990      REAL(wp) ::   zvel_sc_pyc, zvel_sc_ml, zstab_fac, zz_b 
     1991      REAL(wp) ::   za_cubic, zb_d_cubic, zc_d_cubic, zd_d_cubic,   &   ! Coefficients in cubic polynomial specifying diffusivity 
     1992         &                    zb_v_cubic, zc_v_cubic, zd_v_cubic        ! and viscosity in pycnocline 
     1993      REAL(wp) ::   zznd_ml, zznd_pyc, ztmp 
     1994      REAL(wp) ::   zmsku, zmskv 
     1995      !! 
     1996      REAL(wp), PARAMETER ::   pp_dif_ml     = 0.8_wp,  pp_vis_ml  = 0.375_wp 
     1997      REAL(wp), PARAMETER ::   pp_dif_pyc    = 0.15_wp, pp_vis_pyc = 0.142_wp 
     1998      REAL(wp), PARAMETER ::   pp_vispyc_shr = 0.15_wp 
     1999      !!---------------------------------------------------------------------- 
     2000      ! 
     2001      zb_coup(:,:) = 0.0_wp 
     2002      ! 
     2003      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2004         IF ( l_conv(ji,jj) ) THEN 
     2005            ! 
     2006            zvel_sc_pyc = ( 0.15_wp * svstr(ji,jj)**3 + swstrc(ji,jj)**3 + 4.25_wp * pshear(ji,jj) * phbl(ji,jj) )**pthird 
     2007            zvel_sc_ml  = ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird 
     2008            zstab_fac   = ( phml(ji,jj) / zvel_sc_ml *   & 
     2009               &            ( 1.4_wp - 0.4_wp / ( 1.0_wp + EXP(-3.5_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) )**1.25_wp ) )**2 
     2010            ! 
     2011            zdifml_sc(ji,jj) = pp_dif_ml * phml(ji,jj) * zvel_sc_ml 
     2012            zvisml_sc(ji,jj) = pp_vis_ml * zdifml_sc(ji,jj) 
     2013            ! 
     2014            IF ( l_pyc(ji,jj) ) THEN 
     2015               zdifpyc_n_sc(ji,jj) = pp_dif_pyc * zvel_sc_ml * pdh(ji,jj) 
     2016               zvispyc_n_sc(ji,jj) = 0.09_wp * zvel_sc_pyc * ( 1.0_wp - phbl(ji,jj) / pdh(ji,jj) )**2 *   & 
     2017                  &                  ( 0.005_wp  * ( av_u_ml(ji,jj) - av_u_bl(ji,jj) )**2 +     & 
     2018                  &                    0.0075_wp * ( av_v_ml(ji,jj) - av_v_bl(ji,jj) )**2 ) /   & 
     2019                  &                  pdh(ji,jj) 
     2020               zvispyc_n_sc(ji,jj) = pp_vis_pyc * zvel_sc_ml * pdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac 
     2021               ! 
     2022               IF ( l_shear(ji,jj) .AND. n_ddh(ji,jj) /= 2 ) THEN 
     2023                  ztmp = pp_vispyc_shr * ( pshear(ji,jj) * phbl(ji,jj) )**pthird * phbl(ji,jj) 
     2024                  zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + ztmp 
     2025                  zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + ztmp 
    22102026               ENDIF 
    2211             ELSE     ! IF(dhdt < 0) 
    2212                zdh_ref = 0.2 * hbl(ji,jj) 
    2213             ENDIF    ! IF (dhdt >= 0) 
    2214             dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 
    2215             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 
    2216             ! Alan: this hml is never defined or used -- do we need it? 
     2027               ! 
     2028               zdifpyc_s_sc(ji,jj) = pwb_ent(ji,jj) + 0.0025_wp * zvel_sc_pyc * ( phbl(ji,jj) / pdh(ji,jj) - 1.0_wp ) *   & 
     2029                  &                                   ( av_b_ml(ji,jj) - av_b_bl(ji,jj) ) 
     2030               zvispyc_s_sc(ji,jj) = 0.09_wp * ( pwb_min(ji,jj) + 0.0025_wp * zvel_sc_pyc *                 & 
     2031                  &                                               ( phbl(ji,jj) / pdh(ji,jj) - 1.0_wp ) *   & 
     2032                  &                                               ( av_b_ml(ji,jj) - av_b_bl(ji,jj) ) ) 
     2033               zdifpyc_s_sc(ji,jj) = 0.09_wp * zdifpyc_s_sc(ji,jj) * zstab_fac 
     2034               zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac 
     2035               ! 
     2036               zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5_wp * zdifpyc_n_sc(ji,jj) ) 
     2037               zvispyc_s_sc(ji,jj) = MAX( zvispyc_s_sc(ji,jj), -0.5_wp * zvispyc_n_sc(ji,jj) ) 
     2038                
     2039               zbeta_d_sc(ji,jj) = 1.0_wp - ( ( zdifpyc_n_sc(ji,jj) + 1.4_wp * zdifpyc_s_sc(ji,jj) ) /   & 
     2040                  &                           ( zdifml_sc(ji,jj) + epsln ) )**p2third 
     2041               zbeta_v_sc(ji,jj) = 1.0_wp - 2.0_wp * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) / ( zvisml_sc(ji,jj) + epsln ) 
     2042            ELSE 
     2043               zdifpyc_n_sc(ji,jj) = pp_dif_pyc * zvel_sc_ml * pdh(ji,jj)   ! ag 19/03 
     2044               zdifpyc_s_sc(ji,jj) = 0.0_wp   ! ag 19/03 
     2045               zvispyc_n_sc(ji,jj) = pp_vis_pyc * zvel_sc_ml * pdh(ji,jj)   ! ag 19/03 
     2046               zvispyc_s_sc(ji,jj) = 0.0_wp   ! ag 19/03 
     2047               IF(l_coup(ji,jj) ) THEN   ! ag 19/03 
     2048                  ! code from SUBROUTINE tke_tke zdftke.F90; uses bottom drag velocity rCdU_bot(ji,jj) = -Cd|ub| 
     2049                  !     already calculated at T-points in SUBROUTINE zdf_drg from zdfdrg.F90 
     2050                  !  Gives friction velocity sqrt bottom drag/rho_0 i.e. u* = SQRT(rCdU_bot*ub) 
     2051                  ! wet-cell averaging .. 
     2052                  zmsku = 0.5_wp * ( 2.0_wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
     2053                  zmskv = 0.5_wp * ( 2.0_wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 
     2054                  zb_coup(ji,jj) = 0.4_wp * SQRT(-1.0_wp * rCdU_bot(ji,jj) *   & 
     2055                     &             SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2   & 
     2056                     &                  + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2  ) ) 
     2057                   
     2058                  zz_b = -1.0_wp * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)   ! ag 19/03 
     2059                  zc_coup_vis(ji,jj) = -0.5_wp * ( 0.5_wp * zvisml_sc(ji,jj) / phml(ji,jj) - zb_coup(ji,jj) ) /   & 
     2060                     &                 ( phml(ji,jj) + zz_b )   ! ag 19/03 
     2061                  zz_b = -1.0_wp * phml(ji,jj) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)   ! ag 19/03 
     2062                  zbeta_v_sc(ji,jj) = 1.0_wp - 2.0_wp * ( zb_coup(ji,jj) * zz_b + zc_coup_vis(ji,jj) * zz_b**2 ) /   & 
     2063                     &                                  zvisml_sc(ji,jj)   ! ag 19/03 
     2064                  zbeta_d_sc(ji,jj) = 1.0_wp - ( ( zb_coup(ji,jj) * zz_b + zc_coup_vis(ji,jj) * zz_b**2 ) /   & 
     2065                     &                           zdifml_sc(ji,jj) )**p2third 
     2066                  zc_coup_dif(ji,jj) = 0.5_wp * ( -zdifml_sc(ji,jj) / phml(ji,jj) * ( 1.0_wp - zbeta_d_sc(ji,jj) )**1.5_wp +   & 
     2067                     &                 1.5_wp * ( zdifml_sc(ji,jj) / phml(ji,jj) ) * zbeta_d_sc(ji,jj) *   & 
     2068                     &                          SQRT( 1.0_wp - zbeta_d_sc(ji,jj) ) - zb_coup(ji,jj) ) / zz_b   ! ag 19/03 
     2069               ELSE   ! ag 19/03 
     2070                  zbeta_d_sc(ji,jj) = 1.0_wp - ( ( zdifpyc_n_sc(ji,jj) + 1.4_wp * zdifpyc_s_sc(ji,jj) ) /   & 
     2071                     &                           ( zdifml_sc(ji,jj) + epsln ) )**p2third   ! ag 19/03 
     2072                  zbeta_v_sc(ji,jj) = 1.0_wp - 2.0_wp * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) /   & 
     2073                     &                         ( zvisml_sc(ji,jj) + epsln )   ! ag 19/03 
     2074               ENDIF   ! ag 19/03 
     2075            ENDIF      ! ag 19/03 
     2076         ELSE 
     2077            zdifml_sc(ji,jj) = svstr(ji,jj) * phbl(ji,jj) * MAX( EXP ( -1.0_wp * ( shol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 
     2078            zvisml_sc(ji,jj) = zdifml_sc(ji,jj) 
     2079         END IF 
     2080      END_2D 
     2081      ! 
     2082      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2083         IF ( l_conv(ji,jj) ) THEN 
     2084            DO jk = 2, nmld(ji,jj)   ! Mixed layer diffusivity 
     2085               zznd_ml = gdepw(ji,jj,jk,Kmm) / phml(ji,jj) 
     2086               pdiffut(ji,jj,jk) = zdifml_sc(ji,jj) * zznd_ml * ( 1.0_wp - zbeta_d_sc(ji,jj) * zznd_ml )**1.5 
     2087               pviscos(ji,jj,jk) = zvisml_sc(ji,jj) * zznd_ml * ( 1.0_wp - zbeta_v_sc(ji,jj) * zznd_ml ) *   & 
     2088                  &                ( 1.0_wp - 0.5_wp * zznd_ml**2 ) 
     2089            END DO 
     2090            ! 
     2091            ! Coupling to bottom 
     2092            ! 
     2093            IF ( l_coup(ji,jj) ) THEN                                                         ! ag 19/03 
     2094               DO jk = mbkt(ji,jj), nmld(ji,jj), -1                                           ! ag 19/03 
     2095                  zz_b = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) )   ! ag 19/03 
     2096                  pviscos(ji,jj,jk) = zb_coup(ji,jj) * zz_b + zc_coup_vis(ji,jj) * zz_b**2    ! ag 19/03 
     2097                  pdiffut(ji,jj,jk) = zb_coup(ji,jj) * zz_b + zc_coup_dif(ji,jj) * zz_b**2    ! ag 19/03 
     2098               END DO                                                                         ! ag 19/03 
     2099            ENDIF                                                                             ! ag 19/03 
     2100            ! Pycnocline 
     2101            IF ( l_pyc(ji,jj) ) THEN  
     2102               ! Diffusivity and viscosity profiles in the pycnocline given by 
     2103               ! cubic polynomial. Note, if l_pyc TRUE can't be coupled to seabed. 
     2104               za_cubic = 0.5_wp 
     2105               zb_d_cubic = -1.75_wp * zdifpyc_s_sc(ji,jj) / zdifpyc_n_sc(ji,jj) 
     2106               zd_d_cubic = ( pdh(ji,jj) * zdifml_sc(ji,jj) / phml(ji,jj) * SQRT( 1.0_wp - zbeta_d_sc(ji,jj) ) *   & 
     2107                  &           ( 2.5_wp * zbeta_d_sc(ji,jj) - 1.0_wp ) - 0.85_wp * zdifpyc_s_sc(ji,jj) ) /            & 
     2108                  &           MAX( zdifpyc_n_sc(ji,jj), 1.0e-8_wp ) 
     2109               zd_d_cubic = zd_d_cubic - zb_d_cubic - 2.0_wp * ( 1.0_wp - za_cubic  - zb_d_cubic ) 
     2110               zc_d_cubic = 1.0_wp - za_cubic - zb_d_cubic - zd_d_cubic 
     2111               zb_v_cubic = -1.75_wp * zvispyc_s_sc(ji,jj) / zvispyc_n_sc(ji,jj) 
     2112               zd_v_cubic = ( 0.5_wp * zvisml_sc(ji,jj) * pdh(ji,jj) / phml(ji,jj) - 0.85_wp * zvispyc_s_sc(ji,jj) ) /   & 
     2113                  &           MAX( zvispyc_n_sc(ji,jj), 1.0e-8_wp ) 
     2114               zd_v_cubic = zd_v_cubic - zb_v_cubic - 2.0_wp * ( 1.0_wp - za_cubic - zb_v_cubic ) 
     2115               zc_v_cubic = 1.0_wp - za_cubic - zb_v_cubic - zd_v_cubic 
     2116               DO jk = nmld(ji,jj) , nbld(ji,jj) 
     2117                  zznd_pyc = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / MAX(pdh(ji,jj), 1.0e-6_wp ) 
     2118                  ztmp = ( 1.75_wp * zznd_pyc - 0.15_wp * zznd_pyc**2 - 0.2_wp * zznd_pyc**3 ) 
     2119                  ! 
     2120                  pdiffut(ji,jj,jk) = zdifpyc_n_sc(ji,jj) *   & 
     2121                     &                ( za_cubic + zb_d_cubic * zznd_pyc + zc_d_cubic * zznd_pyc**2 + zd_d_cubic * zznd_pyc**3 ) 
     2122                  ! 
     2123                  pdiffut(ji,jj,jk) = pdiffut(ji,jj,jk) + zdifpyc_s_sc(ji,jj) * ztmp 
     2124                  pviscos(ji,jj,jk) = zvispyc_n_sc(ji,jj) *   & 
     2125                     &                ( za_cubic + zb_v_cubic * zznd_pyc + zc_v_cubic * zznd_pyc**2 + zd_v_cubic * zznd_pyc**3 ) 
     2126                  pviscos(ji,jj,jk) = pviscos(ji,jj,jk) + zvispyc_s_sc(ji,jj) * ztmp 
     2127               END DO 
     2128   !                  IF ( pdhdt(ji,jj) > 0._wp ) THEN 
     2129   !                     zdiffut(ji,jj,nbld(ji,jj)+1) = MAX( 0.5 * pdhdt(ji,jj) * e3w(ji,jj,nbld(ji,jj)+1,Kmm), 1.0e-6 ) 
     2130   !                     zviscos(ji,jj,nbld(ji,jj)+1) = MAX( 0.5 * pdhdt(ji,jj) * e3w(ji,jj,nbld(ji,jj)+1,Kmm), 1.0e-6 ) 
     2131   !                  ELSE 
     2132   !                     zdiffut(ji,jj,nbld(ji,jj)) = 0._wp 
     2133   !                     zviscos(ji,jj,nbld(ji,jj)) = 0._wp 
     2134   !                  ENDIF 
     2135            ENDIF 
     2136         ELSE 
     2137            ! Stable conditions 
     2138            DO jk = 2, nbld(ji,jj) 
     2139               zznd_ml = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj) 
     2140               pdiffut(ji,jj,jk) = 0.75_wp * zdifml_sc(ji,jj) * zznd_ml * ( 1.0_wp - zznd_ml )**1.5_wp 
     2141               pviscos(ji,jj,jk) = 0.375_wp * zvisml_sc(ji,jj) * zznd_ml * ( 1.0_wp - zznd_ml ) * ( 1.0_wp - zznd_ml**2 ) 
     2142            END DO 
     2143            ! 
     2144            IF ( pdhdt(ji,jj) > 0.0_wp ) THEN 
     2145               pdiffut(ji,jj,nbld(ji,jj)) = MAX( pdhdt(ji,jj), 1.0e-6_wp) * e3w(ji, jj, nbld(ji,jj), Kmm) 
     2146               pviscos(ji,jj,nbld(ji,jj)) = pdiffut(ji,jj,nbld(ji,jj)) 
     2147            ENDIF 
     2148         ENDIF   ! End if ( l_conv ) 
     2149         ! 
     2150      END_2D 
     2151      CALL zdf_osm_iomput( "pb_coup", tmask(A2D(0),1) * zb_coup(A2D(0)) )   ! BBL-coupling velocity scale 
     2152      ! 
     2153   END SUBROUTINE zdf_osm_diffusivity_viscosity 
     2154 
     2155   SUBROUTINE zdf_osm_fgr_terms( Kmm, kp_ext, phbl, phml, pdh,                              & 
     2156      &                          pdhdt, pshear, pdtdz_bl_ext, pdsdz_bl_ext, pdbdz_bl_ext,   & 
     2157      &                          pdiffut, pviscos ) 
     2158      !!--------------------------------------------------------------------- 
     2159      !!                 ***  ROUTINE zdf_osm_fgr_terms *** 
     2160      !! 
     2161      !! ** Purpose : Compute non-gradient terms in flux-gradient relationship 
     2162      !! 
     2163      !! ** Method  : 
     2164      !! 
     2165      !!---------------------------------------------------------------------- 
     2166      INTEGER,                                 INTENT(in   ) ::   Kmm            ! Time-level index 
     2167      INTEGER,  DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   kp_ext         ! Offset for external level 
     2168      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phbl           ! BL depth 
     2169      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   phml           ! ML depth 
     2170      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdh            ! Pycnocline depth 
     2171      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdhdt          ! BL depth tendency 
     2172      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pshear         ! Shear production 
     2173      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdtdz_bl_ext   ! External temperature gradients 
     2174      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdsdz_bl_ext   ! External salinity gradients 
     2175      REAL(wp), DIMENSION(A2D(nn_hls-1)),      INTENT(in   ) ::   pdbdz_bl_ext   ! External buoyancy gradients 
     2176      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(in   ) ::   pdiffut        ! t-diffusivity 
     2177      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk),  INTENT(in   ) ::   pviscos        ! Viscosity 
     2178      !! 
     2179      REAL(wp), DIMENSION(A2D(nn_hls-1))     ::   zalpha_pyc   ! 
     2180      REAL(wp), DIMENSION(A2D(nn_hls-1),jpk) ::   zdbdz_pyc    ! Parametrised gradient of buoyancy in the pycnocline 
     2181      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   z3ddz_pyc_1, z3ddz_pyc_2   ! Pycnocline gradient/shear profiles 
     2182      !! 
     2183      INTEGER                            ::   ji, jj, jk, jkm_bld, jkf_mld, jkm_mld   ! Loop indices 
     2184      INTEGER                            ::   istat                                   ! Memory allocation status 
     2185      REAL(wp)                           ::   zznd_d, zznd_ml, zznd_pyc, znd          ! Temporary non-dimensional depths 
     2186      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zsc_wth_1,zsc_ws_1                      ! Temporary scales 
     2187      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zsc_uw_1, zsc_uw_2                      ! Temporary scales 
     2188      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zsc_vw_1, zsc_vw_2                      ! Temporary scales 
     2189      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   ztau_sc_u                               ! Dissipation timescale at base of WML 
     2190      REAL(wp)                           ::   zbuoy_pyc_sc, zdelta_pyc                ! 
     2191      REAL(wp)                           ::   zl_c,zl_l,zl_eps                        ! Used to calculate turbulence length scale 
     2192      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   za_cubic, zb_cubic                      ! Coefficients in cubic polynomial specifying 
     2193      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zc_cubic, zd_cubic                      !    diffusivity in pycnocline 
     2194      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwt_pyc_sc_1, zws_pyc_sc_1              ! 
     2195      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zzeta_pyc                               ! 
     2196      REAL(wp)                           ::   zomega, zvw_max                         ! 
     2197      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zuw_bse,zvw_bse                         ! Momentum, heat, and salinity fluxes 
     2198      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zwth_ent,zws_ent                        !    at the top of the pycnocline 
     2199      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   zsc_wth_pyc, zsc_ws_pyc                 ! Scales for pycnocline transport term 
     2200      REAL(wp)                           ::   ztmp                                    ! 
     2201      REAL(wp)                           ::   ztgrad, zsgrad, zbgrad                  ! Variables used to calculate pycnocline 
     2202      !!                                                                              !    gradients 
     2203      REAL(wp)                           ::   zugrad, zvgrad                          ! Variables for calculating pycnocline shear 
     2204      REAL(wp)                           ::   zdtdz_pyc                               ! Parametrized gradient of temperature in 
     2205      !!                                                                              !    pycnocline 
     2206      REAL(wp)                           ::   zdsdz_pyc                               ! Parametrised gradient of salinity in 
     2207      !!                                                                              !    pycnocline 
     2208      REAL(wp)                           ::   zdudz_pyc                               ! u-shear across the pycnocline 
     2209      REAL(wp)                           ::   zdvdz_pyc                               ! v-shear across the pycnocline 
     2210      !!---------------------------------------------------------------------- 
     2211      ! 
     2212      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     2213      !  Pycnocline gradients for scalars and velocity 
     2214      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     2215      CALL zdf_osm_pycnocline_buoyancy_profiles( Kmm, kp_ext, zdbdz_pyc, zalpha_pyc, pdh,    & 
     2216         &                                       phbl, pdbdz_bl_ext, phml, pdhdt ) 
     2217      ! 
     2218      ! Auxiliary indices 
     2219      ! ----------------- 
     2220      jkm_bld = 0 
     2221      jkf_mld = jpk 
     2222      jkm_mld = 0 
     2223      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2224         IF ( nbld(ji,jj) > jkm_bld ) jkm_bld = nbld(ji,jj) 
     2225         IF ( nmld(ji,jj) < jkf_mld ) jkf_mld = nmld(ji,jj) 
     2226         IF ( nmld(ji,jj) > jkm_mld ) jkm_mld = nmld(ji,jj) 
     2227      END_2D 
     2228      ! 
     2229      ! Stokes term in scalar flux, flux-gradient relationship 
     2230      ! ------------------------------------------------------ 
     2231      WHERE ( l_conv(A2D(nn_hls-1)) ) 
     2232         zsc_wth_1(:,:) = swstrl(A2D(nn_hls-1))**3 * swth0(A2D(nn_hls-1)) /   & 
     2233            &             ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln ) 
     2234         zsc_ws_1(:,:)  = swstrl(A2D(nn_hls-1))**3 * sws0(A2D(nn_hls-1))  /   & 
     2235            &             ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln ) 
     2236      ELSEWHERE 
     2237         zsc_wth_1(:,:) = 2.0_wp * swthav(A2D(nn_hls-1)) 
     2238         zsc_ws_1(:,:)  = 2.0_wp * swsav(A2D(nn_hls-1)) 
     2239      ENDWHERE 
     2240      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) ) 
     2241         IF ( l_conv(ji,jj) ) THEN 
     2242            IF ( jk <= nmld(ji,jj) ) THEN 
     2243               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     2244               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35_wp * EXP( -1.0_wp * zznd_d ) *   & 
     2245                  &                                ( 1.0_wp - EXP( -2.0_wp * zznd_d ) ) * zsc_wth_1(ji,jj) 
     2246               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35_wp * EXP( -1.0_wp * zznd_d ) *   & 
     2247                  &                                ( 1.0_wp - EXP( -2.0_wp * zznd_d ) ) * zsc_ws_1(ji,jj) 
     2248            END IF 
     2249         ELSE   ! Stable conditions 
     2250            IF ( jk <= nbld(ji,jj) ) THEN 
     2251               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     2252               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 2.15_wp * EXP( -0.85_wp * zznd_d ) *   & 
     2253                  &                                ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) * zsc_wth_1(ji,jj) 
     2254               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 2.15_wp * EXP( -0.85_wp * zznd_d ) *   & 
     2255                  &                                ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) * zsc_ws_1(ji,jj) 
     2256            END IF 
     2257         END IF   ! Check on l_conv 
     2258      END_3D 
     2259      ! 
     2260      IF ( ln_dia_osm ) THEN 
     2261         CALL zdf_osm_iomput( "ghamu_00", wmask(A2D(0),:) * ghamu(A2D(0),:) ) 
     2262         CALL zdf_osm_iomput( "ghamv_00", wmask(A2D(0),:) * ghamv(A2D(0),:) ) 
     2263      END IF 
     2264      ! 
     2265      ! Stokes term in flux-gradient relationship (note in zsc_uw_n don't use 
     2266      ! svstr since term needs to go to zero as swstrl goes to zero) 
     2267      ! --------------------------------------------------------------------- 
     2268      WHERE ( l_conv(A2D(nn_hls-1)) ) 
     2269         zsc_uw_1(:,:) = ( swstrl(A2D(nn_hls-1))**3 +                                                & 
     2270            &              0.5_wp * swstrc(A2D(nn_hls-1))**3 )**pthird * sustke(A2D(nn_hls-1)) /   & 
     2271            &              MAX( ( 1.0_wp - 1.0_wp * 6.5_wp * sla(A2D(nn_hls-1))**( 8.0_wp / 3.0_wp ) ), 0.2_wp ) 
     2272         zsc_uw_2(:,:) = ( swstrl(A2D(nn_hls-1))**3 +                                                & 
     2273            &              0.5_wp * swstrc(A2D(nn_hls-1))**3 )**pthird * sustke(A2D(nn_hls-1)) /   & 
     2274            &              MIN( sla(A2D(nn_hls-1))**( 8.0_wp / 3.0_wp ) + epsln, 0.12_wp ) 
     2275         zsc_vw_1(:,:) = ff_t(A2D(nn_hls-1)) * phml(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1))**3 *   & 
     2276            &            MIN( sla(A2D(nn_hls-1))**( 8.0_wp / 3.0_wp ), 0.12_wp ) /                    & 
     2277            &            ( ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 )**( 2.0_wp / 3.0_wp ) + epsln ) 
     2278      ELSEWHERE 
     2279         zsc_uw_1(:,:) = sustar(A2D(nn_hls-1))**2 
     2280         zsc_vw_1(:,:) = ff_t(A2D(nn_hls-1)) * phbl(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1))**3 *   & 
     2281            &            MIN( sla(A2D(nn_hls-1))**( 8.0_wp / 3.0_wp ), 0.12_wp ) / ( svstr(A2D(nn_hls-1))**2 + epsln ) 
     2282      ENDWHERE 
     2283      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) ) 
     2284         IF ( l_conv(ji,jj) ) THEN 
     2285            IF ( jk <= nmld(ji,jj) ) THEN 
     2286               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     2287               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + ( -0.05_wp   * EXP( -0.4_wp * zznd_d ) * zsc_uw_1(ji,jj) +     & 
     2288                  &                                  0.00125_wp * EXP( -1.0_wp * zznd_d ) * zsc_uw_2(ji,jj) ) *   & 
     2289                  &                                ( 1.0_wp - EXP( -2.0_wp * zznd_d ) ) 
     2290               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65_wp *  0.15_wp * EXP( -1.0_wp * zznd_d ) *                 & 
     2291                  &                                ( 1.0_wp - EXP( -2.0_wp * zznd_d ) ) * zsc_vw_1(ji,jj) 
     2292            END IF 
     2293         ELSE   ! Stable conditions 
     2294            IF ( jk <= nbld(ji,jj) ) THEN   ! Corrected to nbld 
     2295               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     2296               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75_wp * 1.3_wp * EXP( -0.5_wp * zznd_d ) *             & 
     2297                  &                                ( 1.0_wp - EXP( -4.0_wp * zznd_d ) ) * zsc_uw_1(ji,jj) 
     2298            END IF 
     2299         END IF 
     2300      END_3D 
     2301      ! 
     2302      ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio 
     2303      ! (X0.3) and pressure (X0.5)] 
     2304      ! ---------------------------------------------------------------------- 
     2305      WHERE ( l_conv(A2D(nn_hls-1)) ) 
     2306         zsc_wth_1(:,:) = swbav(A2D(nn_hls-1)) * swth0(A2D(nn_hls-1)) * ( 1.0_wp + EXP( 0.2_wp * shol(A2D(nn_hls-1)) ) ) *   & 
     2307            &             phml(A2D(nn_hls-1)) / ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln ) 
     2308         zsc_ws_1(:,:)  = swbav(A2D(nn_hls-1)) * sws0(A2D(nn_hls-1))  * ( 1.0_wp + EXP( 0.2_wp * shol(A2D(nn_hls-1)) ) ) *   & 
     2309            &             phml(A2D(nn_hls-1)) / ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln ) 
     2310      ELSEWHERE 
     2311         zsc_wth_1(:,:) = 0.0_wp 
     2312         zsc_ws_1(:,:)  = 0.0_wp 
     2313      ENDWHERE 
     2314      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) ) 
     2315         IF ( l_conv(ji,jj) ) THEN 
     2316            IF ( jk <= nmld(ji,jj) ) THEN 
     2317               zznd_ml = gdepw(ji,jj,jk,Kmm) / phml(ji,jj) 
     2318               ! Calculate turbulent time scale 
     2319               zl_c   = 0.9_wp * ( 1.0_wp - EXP( -5.0_wp * ( zznd_ml + zznd_ml**3 / 3.0_wp ) ) ) *                         & 
     2320                  &     ( 1.0_wp - EXP( -15.0_wp * ( 1.2_wp - zznd_ml ) ) ) 
     2321               zl_l   = 2.0_wp * ( 1.0_wp - EXP( -2.0_wp * ( zznd_ml + zznd_ml**3 / 3.0_wp ) ) ) *                         & 
     2322                  &     ( 1.0_wp - EXP( -8.0_wp  * ( 1.15_wp - zznd_ml ) ) ) * ( 1.0_wp + dstokes(ji,jj) / phml (ji,jj) ) 
     2323               zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0_wp + EXP( -3.0_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) )**( 3.0_wp / 2.0_wp ) 
     2324               ! Non-gradient buoyancy terms 
     2325               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3_wp * 0.4_wp * zsc_wth_1(ji,jj) * zl_eps / ( 0.15_wp + zznd_ml ) 
     2326               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3_wp * 0.4_wp *  zsc_ws_1(ji,jj) * zl_eps / ( 0.15_wp + zznd_ml ) 
     2327            END IF 
     2328         ELSE   ! Stable conditions 
     2329            IF ( jk <= nbld(ji,jj) ) THEN 
     2330               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) 
     2331               ghams(ji,jj,jk) = ghams(ji,jj,jk) +  zsc_ws_1(ji,jj) 
     2332            END IF 
     2333         END IF 
     2334      END_3D 
     2335      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2336         IF ( l_conv(ji,jj) .AND. l_pyc(ji,jj) ) THEN 
     2337            ztau_sc_u(ji,jj)    = phml(ji,jj) / ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird *                             & 
     2338               &                ( 1.4_wp - 0.4_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) )**1.5_wp ) 
     2339            zwth_ent(ji,jj)     = -0.003_wp * ( 0.15_wp * svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird *   & 
     2340               &                ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_dt_ml(ji,jj) 
     2341            zws_ent(ji,jj)      = -0.003_wp * ( 0.15_wp * svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird *   & 
     2342               &                ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_ds_ml(ji,jj) 
     2343            IF ( dh(ji,jj) < 0.2_wp * hbl(ji,jj) ) THEN 
     2344               zbuoy_pyc_sc        = 2.0_wp * MAX( av_db_ml(ji,jj), 0.0_wp ) / pdh(ji,jj) 
     2345               zdelta_pyc          = ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird /   & 
     2346                  &                       SQRT( MAX( zbuoy_pyc_sc, ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**p2third / pdh(ji,jj)**2 ) ) 
     2347               zwt_pyc_sc_1(ji,jj) = 0.325_wp * ( zalpha_pyc(ji,jj) * av_dt_ml(ji,jj) / pdh(ji,jj) + pdtdz_bl_ext(ji,jj) ) *   & 
     2348                  &                     zdelta_pyc**2 / pdh(ji,jj) 
     2349               zws_pyc_sc_1(ji,jj) = 0.325_wp * ( zalpha_pyc(ji,jj) * av_ds_ml(ji,jj) / pdh(ji,jj) + pdsdz_bl_ext(ji,jj) ) *   & 
     2350                  &                     zdelta_pyc**2 / pdh(ji,jj) 
     2351               zzeta_pyc(ji,jj)    = 0.15_wp - 0.175_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) ) 
     2352            END IF 
     2353         END IF 
     2354      END_2D 
     2355      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkm_bld ) 
     2356         IF ( l_conv(ji,jj) .AND. l_pyc(ji,jj) .AND. ( jk <= nbld(ji,jj) ) ) THEN 
     2357            zznd_pyc = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / pdh(ji,jj) 
     2358            ghamt(ji,jj,jk) = ghamt(ji,jj,jk) -                                                                                & 
     2359               &              0.045_wp * ( ( zwth_ent(ji,jj) * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) *                 & 
     2360               &                         MAX( ( 1.75_wp * zznd_pyc -0.15_wp * zznd_pyc**2 - 0.2_wp * zznd_pyc**3 ), 0.0_wp ) 
     2361            ghams(ji,jj,jk) = ghams(ji,jj,jk) -                                                                                & 
     2362               &              0.045_wp * ( ( zws_ent(ji,jj)  * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) *                 & 
     2363               &                         MAX( ( 1.75_wp * zznd_pyc -0.15_wp * zznd_pyc**2 - 0.2_wp * zznd_pyc**3 ), 0.0_wp ) 
     2364            IF ( dh(ji,jj) < 0.2_wp * hbl(ji,jj) .AND. nbld(ji,jj) - nmld(ji,jj) > 3 ) THEN 
     2365               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.05_wp  * zwt_pyc_sc_1(ji,jj) *                              & 
     2366                  &                                EXP( -0.25_wp * ( zznd_pyc / zzeta_pyc(ji,jj) )**2 ) *        & 
     2367                  &                                pdh(ji,jj) / ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird 
     2368               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.05_wp  * zws_pyc_sc_1(ji,jj) *                              & 
     2369                  &                                EXP( -0.25_wp * ( zznd_pyc / zzeta_pyc(ji,jj) )**2 ) *        & 
     2370                  &                                pdh(ji,jj) / ( svstr(ji,jj)**3 + swstrc(ji,jj)**3 )**pthird 
     2371            END IF 
     2372         END IF   ! End of pycnocline 
     2373      END_3D 
     2374      ! 
     2375      IF ( ln_dia_osm ) THEN 
     2376         CALL zdf_osm_iomput( "zwth_ent", tmask(A2D(0),1) * zwth_ent(A2D(0)) )   ! Upward turb. temperature entrainment flux 
     2377         CALL zdf_osm_iomput( "zws_ent",  tmask(A2D(0),1) * zws_ent(A2D(0))  )   ! Upward turb. salinity entrainment flux 
     2378      END IF 
     2379      ! 
     2380      zsc_vw_1(:,:) = 0.0_wp 
     2381      WHERE ( l_conv(A2D(nn_hls-1)) ) 
     2382         zsc_uw_1(:,:) = -1.0_wp * swb0(A2D(nn_hls-1)) * sustar(A2D(nn_hls-1))**2 * phml(A2D(nn_hls-1)) /   & 
     2383            &            ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln ) 
     2384         zsc_uw_2(:,:) =           swb0(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1))    * phml(A2D(nn_hls-1)) /   & 
     2385            &            ( svstr(A2D(nn_hls-1))**3 + 0.5_wp * swstrc(A2D(nn_hls-1))**3 + epsln )**( 2.0_wp / 3.0_wp ) 
     2386      ELSEWHERE 
     2387         zsc_uw_1(:,:) = 0.0_wp 
     2388      ENDWHERE 
     2389      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) ) 
     2390         IF ( l_conv(ji,jj) ) THEN 
     2391            IF ( jk <= nmld(ji,jj) ) THEN 
     2392               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     2393               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3_wp * 0.5_wp *   & 
     2394                  &                                ( zsc_uw_1(ji,jj) + 0.125_wp * EXP( -0.5_wp * zznd_d ) *       & 
     2395                  &                                  (   1.0_wp - EXP( -0.5_wp * zznd_d ) ) * zsc_uw_2(ji,jj) ) 
     2396               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 
     2397            END IF 
     2398         ELSE   ! Stable conditions 
     2399            IF ( jk <= nbld(ji,jj) ) THEN 
     2400               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) 
     2401               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 
     2402            END IF 
    22172403         ENDIF 
    2218  
    2219       ELSE   ! lshear 
    2220 ! for lshear = .FALSE. calculate ddhdt here 
    2221  
    2222           IF ( lconv(ji,jj) ) THEN 
    2223  
    2224             IF( ln_osm_mle ) THEN 
    2225                IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0._wp ) THEN 
    2226                   ! OSBL is deepening. Note wb_fk_b is zero if ln_osm_mle=F 
    2227                   IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 
    2228                      IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN  ! near neutral stability 
    2229                         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 ) 
    2230                      ELSE                                                     ! unstable 
    2231                         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 ) 
    2232                      ENDIF 
    2233                      ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 
    2234                      zdh_ref = zari * hbl(ji,jj) 
     2404      END_3D 
     2405      ! 
     2406      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2407         IF ( l_conv(ji,jj) .AND. l_pyc(ji,jj) ) THEN 
     2408            IF ( n_ddh(ji,jj) == 0 ) THEN 
     2409               ! Place holding code. Parametrization needs checking for these conditions. 
     2410               zomega = ( 0.15_wp * swstrl(ji,jj)**3 + swstrc(ji,jj)**3 + 4.75_wp * ( pshear(ji,jj) * phbl(ji,jj) ) )**pthird 
     2411               zuw_bse(ji,jj) = -0.0035_wp * zomega * ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_du_ml(ji,jj) 
     2412               zvw_bse(ji,jj) = -0.0075_wp * zomega * ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_dv_ml(ji,jj) 
     2413            ELSE 
     2414               zomega = ( 0.15_wp * swstrl(ji,jj)**3 + swstrc(ji,jj)**3 + 4.75_wp * ( pshear(ji,jj) * phbl(ji,jj) ) )**pthird 
     2415               zuw_bse(ji,jj) = -0.0035_wp * zomega * ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_du_ml(ji,jj) 
     2416               zvw_bse(ji,jj) = -0.0075_wp * zomega * ( 1.0_wp - pdh(ji,jj) / phbl(ji,jj) ) * av_dv_ml(ji,jj) 
     2417            ENDIF 
     2418            zb_cubic(ji,jj) = pdh(ji,jj) / phbl(ji,jj) * suw0(ji,jj) - ( 2.0_wp + pdh(ji,jj) / phml(ji,jj) ) * zuw_bse(ji,jj) 
     2419            za_cubic(ji,jj) = zuw_bse(ji,jj) - zb_cubic(ji,jj) 
     2420            zvw_max = 0.7_wp * ff_t(ji,jj) * ( sustke(ji,jj) * dstokes(ji,jj) + 0.7_wp * sustar(ji,jj) * phml(ji,jj) ) 
     2421            zd_cubic(ji,jj) = zvw_max * pdh(ji,jj) / phml(ji,jj) - ( 2.0_wp + pdh(ji,jj) / phml(ji,jj) ) * zvw_bse(ji,jj) 
     2422            zc_cubic(ji,jj) = zvw_bse(ji,jj) - zd_cubic(ji,jj) 
     2423         END IF 
     2424      END_2D 
     2425      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jkf_mld, jkm_bld )   ! Need ztau_sc_u to be available. Change to array. 
     2426         IF ( l_conv(ji,jj) .AND. l_pyc(ji,jj) .AND. ( jk >= nmld(ji,jj) ) .AND. ( jk <= nbld(ji,jj) ) ) THEN 
     2427            zznd_pyc = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / pdh(ji,jj) 
     2428            ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.045_wp * ( ztau_sc_u(ji,jj)**2 ) * zuw_bse(ji,jj) *                 & 
     2429               &                                ( za_cubic(ji,jj) * zznd_pyc**2 + zb_cubic(ji,jj) * zznd_pyc**3 ) *   & 
     2430               &                                ( 0.75_wp + 0.25_wp * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 
     2431            ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.045_wp * ( ztau_sc_u(ji,jj)**2 ) * zvw_bse(ji,jj) *                 & 
     2432               &                                ( zc_cubic(ji,jj) * zznd_pyc**2 + zd_cubic(ji,jj) * zznd_pyc**3 ) *   & 
     2433               &                                ( 0.75_wp + 0.25_wp * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 
     2434         END IF   ! l_conv .AND. l_pyc 
     2435      END_3D 
     2436      ! 
     2437      IF ( ln_dia_osm ) THEN 
     2438         CALL zdf_osm_iomput( "ghamu_0",    wmask(A2D(0),:) * ghamu(A2D(0),:)  ) 
     2439         CALL zdf_osm_iomput( "zsc_uw_1_0", tmask(A2D(0),1) * zsc_uw_1(A2D(0)) ) 
     2440      END IF 
     2441      ! 
     2442      ! Transport term in flux-gradient relationship [note : includes ROI ratio 
     2443      ! (X0.3) ] 
     2444      ! ----------------------------------------------------------------------- 
     2445      WHERE ( l_conv(A2D(nn_hls-1)) ) 
     2446         zsc_wth_1(:,:) = swth0(A2D(nn_hls-1)) / ( 1.0_wp - 0.56_wp * EXP( shol(A2D(nn_hls-1)) ) ) 
     2447         zsc_ws_1(:,:)  = sws0(A2D(nn_hls-1))  / ( 1.0_wp - 0.56_wp * EXP( shol(A2D(nn_hls-1)) ) ) 
     2448         WHERE ( l_pyc(A2D(nn_hls-1)) )   ! Pycnocline scales 
     2449            zsc_wth_pyc(:,:) = -0.003_wp * swstrc(A2D(nn_hls-1)) * ( 1.0_wp - pdh(A2D(nn_hls-1)) / phbl(A2D(nn_hls-1)) ) *   & 
     2450               &               av_dt_ml(A2D(nn_hls-1)) 
     2451            zsc_ws_pyc(:,:)  = -0.003_wp * swstrc(A2D(nn_hls-1)) * ( 1.0_wp - pdh(A2D(nn_hls-1)) / phbl(A2D(nn_hls-1)) ) *   & 
     2452               &               av_ds_ml(A2D(nn_hls-1)) 
     2453         END WHERE 
     2454      ELSEWHERE 
     2455         zsc_wth_1(:,:) = 2.0_wp * swthav(A2D(nn_hls-1)) 
     2456         zsc_ws_1(:,:)  =          sws0(A2D(nn_hls-1)) 
     2457      END WHERE 
     2458      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, MAX( jkm_mld, jkm_bld ) ) 
     2459         IF ( l_conv(ji,jj) ) THEN 
     2460            IF ( ( jk > 1 ) .AND. ( jk <= nmld(ji,jj) ) ) THEN 
     2461               zznd_ml = gdepw(ji,jj,jk,Kmm) / phml(ji,jj) 
     2462               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3_wp * zsc_wth_1(ji,jj) *                                  & 
     2463                  &                                ( -2.0_wp + 2.75_wp * ( ( 1.0_wp + 0.6_wp * zznd_ml**4 ) -   & 
     2464                  &                                                        EXP( -6.0_wp * zznd_ml ) ) ) *       & 
     2465                  &                                ( 1.0_wp - EXP( -15.0_wp * ( 1.0_wp - zznd_ml ) ) ) 
     2466               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3_wp * zsc_ws_1(ji,jj) *                                   & 
     2467                  &                                ( -2.0_wp + 2.75_wp * ( ( 1.0_wp + 0.6_wp * zznd_ml**4 ) -   & 
     2468                  &                                EXP( -6.0_wp * zznd_ml ) ) ) * ( 1.0_wp - EXP( -15.0_wp * ( 1.0_wp - zznd_ml ) ) ) 
     2469            END IF 
     2470            ! 
     2471            ! may need to comment out lpyc block 
     2472            IF ( l_pyc(ji,jj) .AND. ( jk >= nmld(ji,jj) ) .AND. ( jk <= nbld(ji,jj) ) ) THEN   ! Pycnocline 
     2473               zznd_pyc = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / pdh(ji,jj) 
     2474               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 4.0_wp * zsc_wth_pyc(ji,jj) *   & 
     2475                  &                                ( 0.48_wp - EXP( -1.5_wp * ( zznd_pyc - 0.3_wp )**2 ) ) 
     2476               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 4.0_wp * zsc_ws_pyc(ji,jj)  *   & 
     2477                  &                                ( 0.48_wp - EXP( -1.5_wp * ( zznd_pyc - 0.3_wp )**2 ) ) 
     2478            END IF 
     2479         ELSE 
     2480            IF( pdhdt(ji,jj) > 0. ) THEN 
     2481               IF ( ( jk > 1 ) .AND. ( jk <= nbld(ji,jj) ) ) THEN 
     2482                  zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     2483                  znd    = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj) 
     2484                  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 ) ) +   & 
     2485                     7.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_wth_1(ji,jj) 
     2486                  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 ) ) +   & 
     2487                     7.5_wp * EXP ( -10.0_wp * ( 0.95_wp - znd )**2 ) * ( 1.0_wp - znd ) ) * zsc_ws_1(ji,jj) 
     2488               END IF 
     2489            ENDIF 
     2490         ENDIF 
     2491      END_3D 
     2492      ! 
     2493      WHERE ( l_conv(A2D(nn_hls-1)) ) 
     2494         zsc_uw_1(:,:) = sustar(A2D(nn_hls-1))**2 
     2495         zsc_vw_1(:,:) = ff_t(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1)) * phml(A2D(nn_hls-1)) 
     2496      ELSEWHERE 
     2497         zsc_uw_1(:,:) = sustar(A2D(nn_hls-1))**2 
     2498         zsc_uw_2(:,:) = ( 2.25_wp - 3.0_wp * ( 1.0_wp - EXP( -1.25_wp * 2.0_wp ) ) ) * ( 1.0_wp - EXP( -4.0_wp * 2.0_wp ) ) *   & 
     2499            &            zsc_uw_1(:,:) 
     2500         zsc_vw_1(:,:) = ff_t(A2D(nn_hls-1)) * sustke(A2D(nn_hls-1)) * phbl(A2D(nn_hls-1)) 
     2501         zsc_vw_2(:,:) = -0.11_wp * SIN( 3.14159_wp * ( 2.0_wp + 0.4_wp ) ) * EXP( -1.0_wp * ( 1.5_wp + 2.0_wp )**2 ) *   & 
     2502            &            zsc_vw_1(:,:) 
     2503      ENDWHERE 
     2504      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, MAX( jkm_mld, jkm_bld ) ) 
     2505         IF ( l_conv(ji,jj) ) THEN 
     2506            IF ( jk <= nmld(ji,jj) ) THEN 
     2507               zznd_ml = gdepw(ji,jj,jk,Kmm) / phml(ji,jj) 
     2508               zznd_d  = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     2509               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) +   & 
     2510                  &              0.3_wp * ( -2.0_wp + 2.5_wp * ( 1.0_wp + 0.1_wp * zznd_ml**4 ) - EXP( -8.0_wp * zznd_ml ) ) *   & 
     2511                  &              zsc_uw_1(ji,jj) 
     2512               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) +   & 
     2513                  &              0.3_wp * 0.1_wp * ( EXP( -1.0_wp * zznd_d ) + EXP( -5.0_wp * ( 1.0_wp - zznd_ml ) ) ) *   & 
     2514                  &              zsc_vw_1(ji,jj) 
     2515            END IF 
     2516         ELSE 
     2517            IF ( jk <= nbld(ji,jj) ) THEN 
     2518               znd    = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj) 
     2519               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     2520               IF ( zznd_d <= 2.0_wp ) THEN 
     2521                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5_wp * 0.3_wp *                                              & 
     2522                     &                                ( 2.25_wp - 3.0_wp * ( 1.0_wp - EXP( -1.25_wp * zznd_d ) ) *   & 
     2523                     &                                  ( 1.0_wp - EXP( -2.0_wp * zznd_d ) ) ) * zsc_uw_1(ji,jj) 
     2524               ELSE 
     2525                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5_wp * 0.3_wp *   & 
     2526                     &                                ( 1.0_wp - EXP( -5.0_wp * ( 1.0_wp - znd ) ) ) * zsc_uw_2(ji,jj) 
     2527               ENDIF 
     2528               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0.3_wp * 0.15_wp * SIN( 3.14159_wp * ( 0.65_wp * zznd_d ) ) *   & 
     2529                  &                                EXP( -0.25_wp * zznd_d**2 ) * zsc_vw_1(ji,jj) 
     2530               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0.3_wp * 0.15_wp * EXP( -5.0 * ( 1.0 - znd ) ) *   & 
     2531                  &                                ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj) 
     2532            END IF 
     2533         END IF 
     2534      END_3D 
     2535      ! 
     2536      IF ( ln_dia_osm ) THEN 
     2537         CALL zdf_osm_iomput( "ghamu_f",    wmask(A2D(0),:) * ghamu(A2D(0),:)  ) 
     2538         CALL zdf_osm_iomput( "ghamv_f",    wmask(A2D(0),:) * ghamv(A2D(0),:)  ) 
     2539         CALL zdf_osm_iomput( "zsc_uw_1_f", tmask(A2D(0),1) * zsc_uw_1(A2D(0)) ) 
     2540         CALL zdf_osm_iomput( "zsc_vw_1_f", tmask(A2D(0),1) * zsc_vw_1(A2D(0)) ) 
     2541         CALL zdf_osm_iomput( "zsc_uw_2_f", tmask(A2D(0),1) * zsc_uw_2(A2D(0)) ) 
     2542         CALL zdf_osm_iomput( "zsc_vw_2_f", tmask(A2D(0),1) * zsc_vw_2(A2D(0)) ) 
     2543      END IF 
     2544      ! 
     2545      ! Make surface forced velocity non-gradient terms go to zero at the base 
     2546      ! of the mixed layer. 
     2547      ! 
     2548      ! Make surface forced velocity non-gradient terms go to zero at the base 
     2549      ! of the boundary layer. 
     2550      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkm_bld ) 
     2551         IF ( ( .NOT. l_conv(ji,jj) ) .AND. ( jk <= nbld(ji,jj) ) ) THEN 
     2552            znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / phbl(ji,jj)   ! ALMG to think about 
     2553            IF ( znd >= 0.0_wp ) THEN 
     2554               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0_wp - EXP( -10.0_wp * znd**2 ) ) 
     2555               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0_wp - EXP( -10.0_wp * znd**2 ) ) 
     2556            ELSE 
     2557               ghamu(ji,jj,jk) = 0.0_wp 
     2558               ghamv(ji,jj,jk) = 0.0_wp 
     2559            ENDIF 
     2560         END IF 
     2561      END_3D 
     2562      ! 
     2563      ! Pynocline contributions 
     2564      ! 
     2565      IF ( ln_dia_pyc_scl .OR. ln_dia_pyc_shr ) THEN   ! Allocate arrays for output of pycnocline gradient/shear profiles 
     2566         ALLOCATE( z3ddz_pyc_1(A2D(nn_hls),jpk), z3ddz_pyc_2(A2D(nn_hls),jpk), STAT=istat ) 
     2567         IF ( istat /= 0 ) CALL ctl_stop( 'zdf_osm: failed to allocate temporary arrays' ) 
     2568         z3ddz_pyc_1(:,:,:) = 0.0_wp 
     2569         z3ddz_pyc_2(:,:,:) = 0.0_wp 
     2570      END IF 
     2571      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkm_bld ) 
     2572         IF ( l_conv (ji,jj) ) THEN 
     2573            ! Unstable conditions. Shouldn;t be needed with no pycnocline code. 
     2574            !                  zugrad = 0.7 * av_du_ml(ji,jj) / zdh(ji,jj) + 0.3 * zustar(ji,jj)*zustar(ji,jj) / & 
     2575            !                       &      ( ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) * & 
     2576            !                      &      MIN(zla(ji,jj)**(8.0/3.0) + epsln, 0.12 )) 
     2577            !Alan is this right? 
     2578            !                  zvgrad = ( 0.7 * av_dv_ml(ji,jj) + & 
     2579            !                       &    2.0 * ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) / & 
     2580            !                       &          ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird  + epsln ) & 
     2581            !                       &      )/ (zdh(ji,jj)  + epsln ) 
     2582            !                  DO jk = 2, nbld(ji,jj) - 1 + ibld_ext 
     2583            !                     znd = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / (zdh(ji,jj) + epsln ) - zzeta_v 
     2584            !                     IF ( znd <= 0.0 ) THEN 
     2585            !                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( 3.0 * znd ) 
     2586            !                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( 3.0 * znd ) 
     2587            !                     ELSE 
     2588            !                        zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( -2.0 * znd ) 
     2589            !                        zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( -2.0 * znd ) 
     2590            !                     ENDIF 
     2591            !                  END DO 
     2592         ELSE   ! Stable conditions 
     2593            IF ( nbld(ji,jj) + kp_ext(ji,jj) < mbkt(ji,jj) ) THEN 
     2594               ! Pycnocline profile only defined when depth steady of increasing. 
     2595               IF ( pdhdt(ji,jj) > 0.0_wp ) THEN   ! Depth increasing, or steady. 
     2596                  IF ( av_db_bl(ji,jj) > 0.0_wp ) THEN 
     2597                     IF ( shol(ji,jj) >= 0.5_wp ) THEN   ! Very stable - 'thick' pycnocline 
     2598                        ztmp = 1.0_wp / MAX( phbl(ji,jj), epsln ) 
     2599                        ztgrad = av_dt_bl(ji,jj) * ztmp 
     2600                        zsgrad = av_ds_bl(ji,jj) * ztmp 
     2601                        zbgrad = av_db_bl(ji,jj) * ztmp 
     2602                        IF ( jk <= nbld(ji,jj) ) THEN 
     2603                           znd = gdepw(ji,jj,jk,Kmm) * ztmp 
     2604                           zdtdz_pyc =  ztgrad * EXP( -15.0_wp * ( znd - 0.9_wp )**2 ) 
     2605                           zdsdz_pyc =  zsgrad * EXP( -15.0_wp * ( znd - 0.9_wp )**2 ) 
     2606                           ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + pdiffut(ji,jj,jk) * zdtdz_pyc 
     2607                           ghams(ji,jj,jk) = ghams(ji,jj,jk) + pdiffut(ji,jj,jk) * zdsdz_pyc 
     2608                           IF ( ln_dia_pyc_scl ) THEN 
     2609                              z3ddz_pyc_1(ji,jj,jk) = zdtdz_pyc 
     2610                              z3ddz_pyc_2(ji,jj,jk) = zdsdz_pyc 
     2611                           END IF 
     2612                        END IF 
     2613                     ELSE   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 
     2614                        ztmp = 1.0_wp / MAX( pdh(ji,jj), epsln ) 
     2615                        ztgrad = av_dt_bl(ji,jj) * ztmp 
     2616                        zsgrad = av_ds_bl(ji,jj) * ztmp 
     2617                        zbgrad = av_db_bl(ji,jj) * ztmp 
     2618                        IF ( jk <= nbld(ji,jj) ) THEN 
     2619                           znd = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phml(ji,jj) ) * ztmp 
     2620                           zdtdz_pyc =  ztgrad * EXP( -1.75_wp * ( znd + 0.75_wp )**2 ) 
     2621                           zdsdz_pyc =  zsgrad * EXP( -1.75_wp * ( znd + 0.75_wp )**2 ) 
     2622                           ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + pdiffut(ji,jj,jk) * zdtdz_pyc 
     2623                           ghams(ji,jj,jk) = ghams(ji,jj,jk) + pdiffut(ji,jj,jk) * zdsdz_pyc 
     2624                           IF ( ln_dia_pyc_scl ) THEN 
     2625                              z3ddz_pyc_1(ji,jj,jk) = zdtdz_pyc 
     2626                              z3ddz_pyc_2(ji,jj,jk) = zdsdz_pyc 
     2627                           END IF 
     2628                        END IF 
     2629                     ENDIF   ! IF (shol >=0.5) 
     2630                  ENDIF      ! IF (av_db_bl> 0.) 
     2631               ENDIF         ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are 
     2632               !             !    intialized to zero 
     2633            END IF 
     2634         END IF 
     2635      END_3D 
     2636      IF ( ln_dia_pyc_scl ) THEN   ! Output of pycnocline gradient profiles 
     2637         CALL zdf_osm_iomput( "zdtdz_pyc", wmask(A2D(0),:) * z3ddz_pyc_1(A2D(0),:) ) 
     2638         CALL zdf_osm_iomput( "zdsdz_pyc", wmask(A2D(0),:) * z3ddz_pyc_2(A2D(0),:) ) 
     2639      END IF 
     2640      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jkm_bld ) 
     2641         IF ( .NOT. l_conv (ji,jj) ) THEN 
     2642            IF ( nbld(ji,jj) + kp_ext(ji,jj) < mbkt(ji,jj) ) THEN 
     2643               zugrad = 3.25_wp * av_du_bl(ji,jj) / phbl(ji,jj) 
     2644               zvgrad = 2.75_wp * av_dv_bl(ji,jj) / phbl(ji,jj) 
     2645               IF ( jk <= nbld(ji,jj) ) THEN 
     2646                  znd = gdepw(ji,jj,jk,Kmm) / phbl(ji,jj) 
     2647                  IF ( znd < 1.0 ) THEN 
     2648                     zdudz_pyc = zugrad * EXP( -40.0_wp * ( znd - 1.0_wp )**2 ) 
    22352649                  ELSE 
    2236                      ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 
    2237                      zdh_ref = 0.2 * hbl(ji,jj) 
     2650                     zdudz_pyc = zugrad * EXP( -20.0_wp * ( znd - 1.0_wp )**2 ) 
    22382651                  ENDIF 
    2239                ELSE 
    2240                   ztau = 0.2 * hbl(ji,jj) /  MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 
    2241                   zdh_ref = 0.2 * hbl(ji,jj) 
    2242                ENDIF 
    2243             ELSE ! ln_osm_mle 
    2244                IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 
    2245                   IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN  ! near neutral stability 
    2246                      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 ) 
    2247                   ELSE                                                     ! unstable 
    2248                      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 ) 
    2249                   ENDIF 
    2250                   ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 
    2251                   zdh_ref = zari * hbl(ji,jj) 
    2252                ELSE 
    2253                   ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 
    2254                   zdh_ref = 0.2 * hbl(ji,jj) 
    2255                ENDIF 
    2256  
    2257             END IF  ! ln_osm_mle 
    2258  
    2259             dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 
    2260 !               IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 
    2261             IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 
    2262             ! Alan: this hml is never defined or used 
    2263          ELSE   ! IF (lconv) 
    2264             ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 
    2265             IF ( zdhdt(ji,jj) >= 0.0 ) THEN    ! probably shouldn't include wm here 
    2266                ! boundary layer deepening 
    2267                IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    2268                   ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 
    2269                   zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 
    2270                        & /  MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01  , 0.2 ) 
    2271                   zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 
    2272                ELSE 
    2273                   zdh_ref = 0.2 * hbl(ji,jj) 
    2274                ENDIF 
    2275             ELSE     ! IF(dhdt < 0) 
    2276                zdh_ref = 0.2 * hbl(ji,jj) 
    2277             ENDIF    ! IF (dhdt >= 0) 
    2278             dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 
    2279             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 
    2280          ENDIF       ! IF (lconv) 
    2281       ENDIF  ! lshear 
    2282  
    2283       hml(ji,jj) = hbl(ji,jj) - dh(ji,jj) 
    2284       inhml = MAX( INT( dh(ji,jj) / MAX(e3t(ji,jj,ibld(ji,jj),Kmm), 1.e-3) ) , 1 ) 
    2285       imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 3) 
    2286       zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
    2287       zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    2288     END_2D 
    2289  
    2290     END SUBROUTINE zdf_osm_pycnocline_thickness 
    2291  
    2292  
    2293    SUBROUTINE zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 
    2294       !!---------------------------------------------------------------------- 
    2295       !!                  ***  ROUTINE zdf_osm_horizontal_gradients  *** 
    2296       !! 
    2297       !! ** Purpose :   Calculates horizontal gradients of buoyancy for use with Fox-Kemper parametrization. 
     2652                  zdvdz_pyc = zvgrad * EXP( -20.0_wp * ( znd - 0.85_wp )**2 ) 
     2653                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + pviscos(ji,jj,jk) * zdudz_pyc 
     2654                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + pviscos(ji,jj,jk) * zdvdz_pyc 
     2655                  IF ( ln_dia_pyc_shr ) THEN 
     2656                     z3ddz_pyc_1(ji,jj,jk) = zdudz_pyc 
     2657                     z3ddz_pyc_2(ji,jj,jk) = zdvdz_pyc 
     2658                  END IF 
     2659               END IF 
     2660            END IF 
     2661         END IF 
     2662      END_3D 
     2663      IF ( ln_dia_pyc_shr ) THEN   ! Output of pycnocline shear profiles 
     2664         CALL zdf_osm_iomput( "zdudz_pyc", wmask(A2D(0),:) * z3ddz_pyc_1(A2D(0),:) ) 
     2665         CALL zdf_osm_iomput( "zdvdz_pyc", wmask(A2D(0),:) * z3ddz_pyc_2(A2D(0),:) ) 
     2666      END IF 
     2667      IF ( ln_dia_osm ) THEN 
     2668         CALL zdf_osm_iomput( "ghamu_b", wmask(A2D(0),:) * ghamu(A2D(0),:) ) 
     2669         CALL zdf_osm_iomput( "ghamv_b", wmask(A2D(0),:) * ghamv(A2D(0),:) ) 
     2670      END IF 
     2671      IF ( ln_dia_pyc_scl .OR. ln_dia_pyc_shr ) THEN   ! Deallocate arrays used for output of pycnocline gradient/shear profiles 
     2672         DEALLOCATE( z3ddz_pyc_1, z3ddz_pyc_2 ) 
     2673      END IF 
     2674      ! 
     2675      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2676         ghamt(ji,jj,nbld(ji,jj)) = 0.0_wp 
     2677         ghams(ji,jj,nbld(ji,jj)) = 0.0_wp 
     2678         ghamu(ji,jj,nbld(ji,jj)) = 0.0_wp 
     2679         ghamv(ji,jj,nbld(ji,jj)) = 0.0_wp 
     2680      END_2D 
     2681      ! 
     2682      IF ( ln_dia_osm ) THEN 
     2683         CALL zdf_osm_iomput( "ghamu_1", wmask(A2D(0),:) * ghamu(A2D(0),:)   ) 
     2684         CALL zdf_osm_iomput( "ghamv_1", wmask(A2D(0),:) * ghamv(A2D(0),:)   ) 
     2685         CALL zdf_osm_iomput( "zviscos", wmask(A2D(0),:) * pviscos(A2D(0),:) ) 
     2686      END IF 
     2687      ! 
     2688   END SUBROUTINE zdf_osm_fgr_terms 
     2689 
     2690   SUBROUTINE zdf_osm_zmld_horizontal_gradients( Kmm, pmld, pdtdx, pdtdy, pdsdx,   & 
     2691      &                                          pdsdy, pdbds_mle ) 
     2692      !!---------------------------------------------------------------------- 
     2693      !!          ***  ROUTINE zdf_osm_zmld_horizontal_gradients  *** 
     2694      !! 
     2695      !! ** Purpose : Calculates horizontal gradients of buoyancy for use with 
     2696      !!              Fox-Kemper parametrization 
    22982697      !! 
    22992698      !! ** Method  : 
    … …  
    23012700      !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 
    23022701      !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 
    2303  
    2304  
    2305       REAL(wp), DIMENSION(jpi,jpj)     :: dbdx_mle, dbdy_mle ! MLE horiz gradients at u & v points 
    2306       REAL(wp), DIMENSION(jpi,jpj)     :: zdbds_mle ! Magnitude of horizontal buoyancy gradient. 
    2307       REAL(wp), DIMENSION(jpi,jpj)     :: zmld ! ==  estimated FK BLD used for MLE horiz gradients  == ! 
    2308       REAL(wp), DIMENSION(jpi,jpj)     :: zdtdx, zdtdy, zdsdx, zdsdy 
    2309  
    2310       INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    2311       INTEGER  ::   ii, ij, ik, ikmax   ! local integers 
    2312       REAL(wp)                         :: zc 
    2313       REAL(wp)                         :: zN2_c           ! local buoyancy difference from 10m value 
    2314       REAL(wp), DIMENSION(jpi,jpj)     :: ztm, zsm, zLf_NH, zLf_MH 
    2315       REAL(wp), DIMENSION(jpi,jpj,jpts):: ztsm_midu, ztsm_midv, zabu, zabv 
    2316       REAL(wp), DIMENSION(jpi,jpj)     :: zmld_midu, zmld_midv 
    2317 !!---------------------------------------------------------------------- 
    2318       ! 
    2319       !                                      !==  MLD used for MLE  ==! 
    2320  
    2321       mld_prof(:,:)  = nlb10               ! Initialization to the number of w ocean point 
    2322       zmld(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
    2323       zN2_c = grav * rn_osm_mle_rho_c * r1_rho0   ! convert density criteria into N^2 criteria 
    2324       DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 
     2702      !! 
     2703      !!---------------------------------------------------------------------- 
     2704      INTEGER,                            INTENT(in   ) ::   Kmm          ! Time-level index 
     2705      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(  out) ::   pmld         ! == Estimated FK BLD used for MLE horizontal gradients == ! 
     2706      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(inout) ::   pdtdx        ! Horizontal gradient for Fox-Kemper parametrization 
     2707      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(inout) ::   pdtdy        ! Horizontal gradient for Fox-Kemper parametrization 
     2708      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(inout) ::   pdsdx        ! Horizontal gradient for Fox-Kemper parametrization 
     2709      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(inout) ::   pdsdy        ! Horizontal gradient for Fox-Kemper parametrization 
     2710      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pdbds_mle    ! Magnitude of horizontal buoyancy gradient 
     2711      !! 
     2712      INTEGER                               ::   ji, jj, jk   ! Dummy loop indices 
     2713      INTEGER,  DIMENSION(A2D(nn_hls))      ::   jk_mld_prof  ! Base level of MLE layer 
     2714      INTEGER                               ::   ikt, ikmax   ! Local integers       
     2715      REAL(wp)                              ::   zc 
     2716      REAL(wp)                              ::   zN2_c        ! Local buoyancy difference from 10m value 
     2717      REAL(wp), DIMENSION(A2D(nn_hls))      ::   ztm 
     2718      REAL(wp), DIMENSION(A2D(nn_hls))      ::   zsm 
     2719      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::   ztsm_midu 
     2720      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::   ztsm_midv 
     2721      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::   zabu 
     2722      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::   zabv 
     2723      REAL(wp), DIMENSION(A2D(nn_hls))      ::   zmld_midu 
     2724      REAL(wp), DIMENSION(A2D(nn_hls))      ::   zmld_midv 
     2725      !!---------------------------------------------------------------------- 
     2726      ! 
     2727      ! ==  MLD used for MLE  ==! 
     2728      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     2729         jk_mld_prof(ji,jj) = nlb10    ! Initialization to the number of w ocean point 
     2730         pmld(ji,jj)        = 0.0_wp   ! Here hmlp used as a dummy variable, integrating vertically N^2 
     2731      END_2D 
     2732      zN2_c = grav * rn_osm_mle_rho_c * r1_rho0   ! Convert density criteria into N^2 criteria 
     2733      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 ) 
    23252734         ikt = mbkt(ji,jj) 
    2326          zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 
    2327          IF( zmld(ji,jj) < zN2_c )   mld_prof(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
     2735         pmld(ji,jj) = pmld(ji,jj) + MAX( rn2b(ji,jj,jk), 0.0_wp ) * e3w(ji,jj,jk,Kmm) 
     2736         IF( pmld(ji,jj) < zN2_c ) jk_mld_prof(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
    23282737      END_3D 
    2329       DO_2D( 1, 1, 1, 1 ) 
    2330          mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj)) 
    2331          zmld(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 
    2332       END_2D 
    2333       ! ensure mld_prof .ge. ibld 
    2334       ! 
    2335       ikmax = MIN( MAXVAL( mld_prof(:,:) ), jpkm1 )                  ! max level of the computation 
    2336       ! 
    2337       ztm(:,:) = 0._wp 
    2338       zsm(:,:) = 0._wp 
    2339       DO_3D( 1, 1, 1, 1, 1, ikmax ) 
    2340          zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
     2738      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     2739         jk_mld_prof(ji,jj) = MAX( jk_mld_prof(ji,jj), nbld(ji,jj) )   ! Ensure jk_mld_prof .ge. nbld 
     2740         pmld(ji,jj)     = gdepw(ji,jj,jk_mld_prof(ji,jj),Kmm) 
     2741      END_2D 
     2742      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2743         mld_prof(ji,jj) = jk_mld_prof(ji,jj) 
     2744      END_2D 
     2745      ! 
     2746      ikmax = MIN( MAXVAL( jk_mld_prof(A2D(nn_hls)) ), jpkm1 )   ! Max level of the computation 
     2747      ztm(:,:) = 0.0_wp 
     2748      zsm(:,:) = 0.0_wp 
     2749      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax ) 
     2750         zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, jk_mld_prof(ji,jj) - jk ), 1  ), KIND=wp )   ! zc being 0 outside the ML 
     2751         !                                                                                        !    t-points 
    23412752         ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem,Kmm) 
    23422753         zsm(ji,jj) = zsm(ji,jj) + zc * ts(ji,jj,jk,jp_sal,Kmm) 
    23432754      END_3D 
    2344       ! average temperature and salinity. 
    2345       ztm(:,:) = ztm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 
    2346       zsm(:,:) = zsm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 
    2347       ! calculate horizontal gradients at u & v points 
    2348  
    2349       DO_2D( 1, 0, 0, 0 ) 
    2350          zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj) 
    2351          zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj) 
    2352          zmld_midu(ji,jj) = 0.25_wp * (zmld(ji+1,jj) + zmld( ji,jj)) 
    2353          ztsm_midu(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji+1,jj) + ztm( ji,jj) ) 
    2354          ztsm_midu(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji+1,jj) + zsm( ji,jj) ) 
    2355       END_2D 
    2356  
    2357       DO_2D( 0, 0, 1, 0 ) 
    2358          zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 
    2359          zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 
    2360          zmld_midv(ji,jj) = 0.25_wp * (zmld(ji,jj+1) + zmld( ji,jj)) 
    2361          ztsm_midv(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji,jj+1) + ztm( ji,jj) ) 
    2362          ztsm_midv(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji,jj+1) + zsm( ji,jj) ) 
    2363       END_2D 
    2364  
    2365       CALL eos_rab(ztsm_midu, zmld_midu, zabu, Kmm) 
    2366       CALL eos_rab(ztsm_midv, zmld_midv, zabv, Kmm) 
    2367  
    2368       DO_2D( 1, 0, 0, 0 ) 
    2369          dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal)) 
    2370       END_2D 
    2371       DO_2D( 0, 0, 1, 0 ) 
    2372          dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal)) 
    2373       END_2D 
    2374  
    2375       DO_2D( 0, 0, 0, 0 ) 
    2376         ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 
    2377         zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) & 
    2378              & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) ) 
    2379       END_2D 
    2380  
    2381  END SUBROUTINE zdf_osm_zmld_horizontal_gradients 
    2382   SUBROUTINE zdf_osm_mle_parameters( mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 
    2383       !!---------------------------------------------------------------------- 
    2384       !!                  ***  ROUTINE zdf_osm_mle_parameters  *** 
    2385       !! 
    2386       !! ** Purpose :   Timesteps the mixed layer eddy depth, hmle and calculates the mixed layer eddy fluxes for buoyancy, heat and salinity. 
     2755      ! Average temperature and salinity 
     2756      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     2757         ztm(ji,jj) = ztm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), pmld(ji,jj) ) 
     2758         zsm(ji,jj) = zsm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), pmld(ji,jj) ) 
     2759      END_2D 
     2760      ! Calculate horizontal gradients at u & v points 
     2761      zmld_midu(:,:)   =  0.0_wp 
     2762      ztsm_midu(:,:,:) = 10.0_wp 
     2763      DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2764         pdtdx(ji,jj)            = ( ztm(ji+1,jj) - ztm(ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj) 
     2765         pdsdx(ji,jj)            = ( zsm(ji+1,jj) - zsm(ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj) 
     2766         zmld_midu(ji,jj)        = 0.25_wp * ( pmld(ji+1,jj) + pmld(ji,jj)) 
     2767         ztsm_midu(ji,jj,jp_tem) =  0.5_wp * ( ztm( ji+1,jj)  + ztm( ji,jj) ) 
     2768         ztsm_midu(ji,jj,jp_sal) =  0.5_wp * ( zsm( ji+1,jj)  + zsm( ji,jj) ) 
     2769      END_2D 
     2770      zmld_midv(:,:)   =  0.0_wp 
     2771      ztsm_midv(:,:,:) = 10.0_wp 
     2772      DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 
     2773         pdtdy(ji,jj)            = ( ztm(ji,jj+1) - ztm(ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 
     2774         pdsdy(ji,jj)            = ( zsm(ji,jj+1) - zsm(ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 
     2775         zmld_midv(ji,jj)        = 0.25_wp * ( pmld(ji,jj+1) + pmld( ji,jj) ) 
     2776         ztsm_midv(ji,jj,jp_tem) =  0.5_wp * ( ztm( ji,jj+1)  + ztm( ji,jj) ) 
     2777         ztsm_midv(ji,jj,jp_sal) =  0.5_wp * ( zsm( ji,jj+1)  + zsm( ji,jj) ) 
     2778      END_2D 
     2779      CALL eos_rab( ztsm_midu, zmld_midu, zabu, Kmm ) 
     2780      CALL eos_rab( ztsm_midv, zmld_midv, zabv, Kmm ) 
     2781      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2782         dbdx_mle(ji,jj) = grav * ( pdtdx(ji,jj) * zabu(ji,jj,jp_tem) - pdsdx(ji,jj) * zabu(ji,jj,jp_sal) ) 
     2783      END_2D 
     2784      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 
     2785         dbdy_mle(ji,jj) = grav * ( pdtdy(ji,jj) * zabv(ji,jj,jp_tem) - pdsdy(ji,jj) * zabv(ji,jj,jp_sal) ) 
     2786      END_2D 
     2787      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2788         pdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,  jj) * dbdx_mle(ji,  jj) + dbdy_mle(ji,jj  ) * dbdy_mle(ji,jj  ) +   & 
     2789            &                                dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) ) 
     2790      END_2D 
     2791      ! 
     2792   END SUBROUTINE zdf_osm_zmld_horizontal_gradients 
     2793 
     2794   SUBROUTINE zdf_osm_osbl_state_fk( Kmm, pwb_fk, phbl, phmle, pwb_ent,   & 
     2795      &                              pdbds_mle ) 
     2796      !!--------------------------------------------------------------------- 
     2797      !!               ***  ROUTINE zdf_osm_osbl_state_fk  *** 
     2798      !! 
     2799      !! ** Purpose : Determines the state of the OSBL and MLE layer. Info is 
     2800      !!              returned in the logicals l_pyc, l_flux and ldmle. Used 
     2801      !!              with Fox-Kemper scheme. 
     2802      !!                l_pyc  :: determines whether pycnocline flux-grad 
     2803      !!                          relationship needs to be determined 
     2804      !!                l_flux :: determines whether effects of surface flux 
     2805      !!                          extend below the base of the OSBL 
     2806      !!                ldmle  :: determines whether the layer with MLE is 
     2807      !!                          increasing with time or if base is relaxing 
     2808      !!                          towards hbl 
     2809      !! 
     2810      !! ** Method  : 
     2811      !! 
     2812      !!----------------------------------------------------------------------       
     2813      INTEGER,                            INTENT(in   ) ::   Kmm         ! Time-level index 
     2814      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pwb_fk 
     2815      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl        ! BL depth 
     2816      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phmle       ! MLE depth 
     2817      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb_ent     ! Buoyancy entrainment flux 
     2818      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdbds_mle   ! Magnitude of horizontal buoyancy gradient 
     2819      !! 
     2820      INTEGER                            ::   ji, jj, jk        ! Dummy loop indices 
     2821      REAL(wp), DIMENSION(A2D(nn_hls-1)) ::   znd_param 
     2822      REAL(wp)                           ::   zthermal, zbeta 
     2823      REAL(wp)                           ::   zbuoy 
     2824      REAL(wp)                           ::   ztmp 
     2825      REAL(wp)                           ::   zpe_mle_layer 
     2826      REAL(wp)                           ::   zpe_mle_ref 
     2827      REAL(wp)                           ::   zdbdz_mle_int 
     2828      !!----------------------------------------------------------------------       
     2829      ! 
     2830      znd_param(:,:) = 0.0_wp 
     2831      ! 
     2832      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2833         ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 
     2834         pwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * pdbds_mle(ji,jj) * pdbds_mle(ji,jj) 
     2835      END_2D 
     2836      ! 
     2837      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2838         ! 
     2839         IF ( l_conv(ji,jj) ) THEN 
     2840            IF ( phmle(ji,jj) > 1.2_wp * phbl(ji,jj) ) THEN 
     2841               av_t_mle(ji,jj) = ( av_t_mle(ji,jj) * phmle(ji,jj) - av_t_bl(ji,jj) * phbl(ji,jj) ) / ( phmle(ji,jj) - phbl(ji,jj) ) 
     2842               av_s_mle(ji,jj) = ( av_s_mle(ji,jj) * phmle(ji,jj) - av_s_bl(ji,jj) * phbl(ji,jj) ) / ( phmle(ji,jj) - phbl(ji,jj) ) 
     2843               av_b_mle(ji,jj) = ( av_b_mle(ji,jj) * phmle(ji,jj) - av_b_bl(ji,jj) * phbl(ji,jj) ) / ( phmle(ji,jj) - phbl(ji,jj) ) 
     2844               zdbdz_mle_int = ( av_b_bl(ji,jj) - ( 2.0_wp * av_b_mle(ji,jj) - av_b_bl(ji,jj) ) ) / ( phmle(ji,jj) - phbl(ji,jj) ) 
     2845               ! Calculate potential energies of actual profile and reference profile 
     2846               zpe_mle_layer = 0.0_wp 
     2847               zpe_mle_ref   = 0.0_wp 
     2848               zthermal = rab_n(ji,jj,1,jp_tem) 
     2849               zbeta    = rab_n(ji,jj,1,jp_sal) 
     2850               DO jk = nbld(ji,jj), mld_prof(ji,jj) 
     2851                  zbuoy         = grav * ( zthermal * ts(ji,jj,jk,jp_tem,Kmm) - zbeta * ts(ji,jj,jk,jp_sal,Kmm) ) 
     2852                  zpe_mle_layer = zpe_mle_layer + zbuoy * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
     2853                  zpe_mle_ref   = zpe_mle_ref   + ( av_b_bl(ji,jj) - zdbdz_mle_int * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) ) *   & 
     2854                     &                            gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
     2855               END DO 
     2856               ! Non-dimensional parameter to diagnose the presence of thermocline 
     2857               znd_param(ji,jj) = ( zpe_mle_layer - zpe_mle_ref ) * ABS( ff_t(ji,jj) ) /   & 
     2858                  &               ( MAX( pwb_fk(ji,jj), 1e-10 ) * phmle(ji,jj) ) 
     2859            END IF 
     2860         END IF 
     2861         ! 
     2862      END_2D 
     2863      ! 
     2864      ! Diagnosis 
     2865      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2866         ! 
     2867         IF ( l_conv(ji,jj) ) THEN 
     2868            IF ( -2.0_wp * pwb_fk(ji,jj) / pwb_ent(ji,jj) > 0.5_wp ) THEN 
     2869               IF ( phmle(ji,jj) > 1.2_wp * phbl(ji,jj) ) THEN   ! MLE layer growing 
     2870                  IF ( znd_param (ji,jj) > 100.0_wp ) THEN   ! Thermocline present 
     2871                     l_flux(ji,jj) = .FALSE. 
     2872                     l_mle(ji,jj)  = .FALSE. 
     2873                  ELSE   ! Thermocline not present 
     2874                     l_flux(ji,jj) = .TRUE. 
     2875                     l_mle(ji,jj)  = .TRUE. 
     2876                  ENDIF  ! znd_param > 100 
     2877                  ! 
     2878                  IF ( av_db_bl(ji,jj) < rn_osm_bl_thresh ) THEN 
     2879                     l_pyc(ji,jj) = .FALSE. 
     2880                  ELSE 
     2881                     l_pyc(ji,jj) = .TRUE. 
     2882                  ENDIF 
     2883               ELSE   ! MLE layer restricted to OSBL or just below 
     2884                  IF ( av_db_bl(ji,jj) < rn_osm_bl_thresh ) THEN   ! Weak stratification MLE layer can grow 
     2885                     l_pyc(ji,jj)  = .FALSE. 
     2886                     l_flux(ji,jj) = .TRUE. 
     2887                     l_mle(ji,jj)  = .TRUE. 
     2888                  ELSE   ! Strong stratification 
     2889                     l_pyc(ji,jj)  = .TRUE. 
     2890                     l_flux(ji,jj) = .FALSE. 
     2891                     l_mle(ji,jj)  = .FALSE. 
     2892                  END IF   ! av_db_bl < rn_mle_thresh_bl and 
     2893               END IF   ! phmle > 1.2 phbl 
     2894            ELSE 
     2895               l_pyc(ji,jj)  = .TRUE. 
     2896               l_flux(ji,jj) = .FALSE. 
     2897               l_mle(ji,jj)  = .FALSE. 
     2898               IF ( av_db_bl(ji,jj) < rn_osm_bl_thresh ) l_pyc(ji,jj) = .FALSE. 
     2899            END IF   !  -2.0 * pwb_fk(ji,jj) / pwb_ent > 0.5 
     2900         ELSE   ! Stable Boundary Layer 
     2901            l_pyc(ji,jj)  = .FALSE. 
     2902            l_flux(ji,jj) = .FALSE. 
     2903            l_mle(ji,jj)  = .FALSE. 
     2904         END IF   ! l_conv 
     2905         ! 
     2906      END_2D 
     2907      ! 
     2908   END SUBROUTINE zdf_osm_osbl_state_fk 
     2909 
     2910   SUBROUTINE zdf_osm_mle_parameters( Kmm, pmld, phmle, pvel_mle, pdiff_mle,   & 
     2911      &                               pdbds_mle, phbl, pwb0tot ) 
     2912      !!---------------------------------------------------------------------- 
     2913      !!               ***  ROUTINE zdf_osm_mle_parameters  *** 
     2914      !! 
     2915      !! ** Purpose : Timesteps the mixed layer eddy depth, hmle and calculates 
     2916      !!              the mixed layer eddy fluxes for buoyancy, heat and 
     2917      !!              salinity. 
    23872918      !! 
    23882919      !! ** Method  : 
    … …  
    23902921      !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 
    23912922      !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 
    2392  
    2393       INTEGER, DIMENSION(jpi,jpj)      :: mld_prof 
    2394       REAL(wp), DIMENSION(jpi,jpj)     :: hmle, zhmle, zwb_fk, zvel_mle, zdiff_mle 
    2395       INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    2396       INTEGER  ::   ii, ij, ik, jkb, jkb1  ! local integers 
    2397       INTEGER , DIMENSION(jpi,jpj)     :: inml_mle 
    2398       REAL(wp) ::  ztmp, zdbdz, zdtdz, zdsdz, zthermal,zbeta, zbuoy, zdb_mle 
    2399  
    2400    ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE. 
    2401  
    2402       DO_2D( 0, 0, 0, 0 ) 
    2403        IF ( lconv(ji,jj) ) THEN 
    2404           ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 
    2405    ! This velocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt. 
    2406           zvel_mle(ji,jj) = zdbds_mle(ji,jj) * ztmp * hmle(ji,jj) * tmask(ji,jj,1) 
    2407           zdiff_mle(ji,jj) = 5.e-4_wp * rn_osm_mle_ce * ztmp * zdbds_mle(ji,jj) * zhmle(ji,jj)**2 
    2408        ENDIF 
    2409       END_2D 
    2410    ! Timestep mixed layer eddy depth. 
    2411       DO_2D( 0, 0, 0, 0 ) 
    2412         IF ( lmle(ji,jj) ) THEN  ! MLE layer growing. 
    2413 ! Buoyancy gradient at base of MLE layer. 
    2414            zthermal = rab_n(ji,jj,1,jp_tem) 
    2415            zbeta    = rab_n(ji,jj,1,jp_sal) 
    2416            jkb = mld_prof(ji,jj) 
    2417            jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 
    2418 ! 
    2419            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) ) 
    2420            zdb_mle = zb_bl(ji,jj) - zbuoy 
    2421 ! Timestep hmle. 
    2422            hmle(ji,jj) = hmle(ji,jj) + zwb0(ji,jj) * rn_Dt / zdb_mle 
    2423         ELSE 
    2424            IF ( zhmle(ji,jj) > zhbl(ji,jj) ) THEN 
    2425               hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau 
    2426            ELSE 
    2427               hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt /rn_osm_mle_tau 
    2428            ENDIF 
    2429         ENDIF 
    2430         hmle(ji,jj) = MIN(hmle(ji,jj), ht(ji,jj)) 
    2431        IF(ln_osm_hmle_limit) hmle(ji,jj) = MIN(hmle(ji,jj), MAX(rn_osm_hmle_limit,1.2*hbl(ji,jj)) ) 
    2432       END_2D 
    2433  
    2434       mld_prof = 4 
    2435       DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 
    2436       IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 
     2923      !! 
     2924      !!---------------------------------------------------------------------- 
     2925      INTEGER,                            INTENT(in   ) ::   Kmm         ! Time-level index 
     2926      REAL(wp), DIMENSION(A2D(nn_hls)),   INTENT(in   ) ::   pmld        ! == Estimated FK BLD used for MLE horiz gradients == ! 
     2927      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   phmle       ! MLE depth 
     2928      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pvel_mle    ! Velocity scale for dhdt with stable ML and FK 
     2929      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(inout) ::   pdiff_mle   ! Extra MLE vertical diff 
     2930      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pdbds_mle   ! Magnitude of horizontal buoyancy gradient 
     2931      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   phbl        ! BL depth 
     2932      REAL(wp), DIMENSION(A2D(nn_hls-1)), INTENT(in   ) ::   pwb0tot     ! Total surface buoyancy flux including insolation 
     2933      !! 
     2934      INTEGER  ::   ji, jj, jk   ! Dummy loop indices 
     2935      REAL(wp) ::   ztmp 
     2936      REAL(wp) ::   zdbdz 
     2937      REAL(wp) ::   zdtdz 
     2938      REAL(wp) ::   zdsdz 
     2939      REAL(wp) ::   zthermal 
     2940      REAL(wp) ::   zbeta 
     2941      REAL(wp) ::   zbuoy 
     2942      REAL(wp) ::   zdb_mle 
     2943      !!---------------------------------------------------------------------- 
     2944      ! 
     2945      ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE 
     2946      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2947         IF ( l_conv(ji,jj) ) THEN 
     2948            ztmp =  r1_ft(ji,jj) * MIN( 111e3_wp, e1u(ji,jj) ) / rn_osm_mle_lf 
     2949            ! This velocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt 
     2950            pvel_mle(ji,jj)  = pdbds_mle(ji,jj) * ztmp * hmle(ji,jj) * tmask(ji,jj,1) 
     2951            pdiff_mle(ji,jj) = 5e-4_wp * rn_osm_mle_ce * ztmp * pdbds_mle(ji,jj) * phmle(ji,jj)**2 
     2952         END IF 
     2953      END_2D 
     2954      ! Timestep mixed layer eddy depth 
     2955      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2956         IF ( l_mle(ji,jj) ) THEN   ! MLE layer growing 
     2957            ! Buoyancy gradient at base of MLE layer 
     2958            zthermal = rab_n(ji,jj,1,jp_tem) 
     2959            zbeta    = rab_n(ji,jj,1,jp_sal) 
     2960            zbuoy = grav * ( zthermal * ts(ji,jj,mld_prof(ji,jj)+2,jp_tem,Kmm) -   & 
     2961               &             zbeta    * ts(ji,jj,mld_prof(ji,jj)+2,jp_sal,Kmm) ) 
     2962            zdb_mle = av_b_bl(ji,jj) - zbuoy 
     2963            ! Timestep hmle 
     2964            hmle(ji,jj) = hmle(ji,jj) + pwb0tot(ji,jj) * rn_Dt / zdb_mle 
     2965         ELSE 
     2966            IF ( phmle(ji,jj) > phbl(ji,jj) ) THEN 
     2967               hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau 
     2968            ELSE 
     2969               hmle(ji,jj) = hmle(ji,jj) - 10.0_wp * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau 
     2970            END IF 
     2971         END IF 
     2972         hmle(ji,jj) = MAX( MIN( hmle(ji,jj), ht(ji,jj) ), gdepw(ji,jj,4,Kmm) ) 
     2973         IF ( ln_osm_hmle_limit ) hmle(ji,jj) = MIN( hmle(ji,jj), rn_osm_hmle_limit*hbl(ji,jj) ) 
     2974         hmle(ji,jj) = pmld(ji,jj)   ! For now try just set hmle to pmld 
     2975      END_2D 
     2976      ! 
     2977      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 ) 
     2978         IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN( mbkt(ji,jj), jk ) 
    24372979      END_3D 
    2438       DO_2D( 0, 0, 0, 0 ) 
    2439          zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj),Kmm) 
    2440       END_2D 
    2441 END SUBROUTINE zdf_osm_mle_parameters 
    2442  
    2443 END SUBROUTINE zdf_osm 
    2444  
     2980      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2981         phmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 
     2982      END_2D 
     2983      ! 
     2984   END SUBROUTINE zdf_osm_mle_parameters 
    24452985 
    24462986   SUBROUTINE zdf_osm_init( Kmm ) 
    2447      !!---------------------------------------------------------------------- 
    2448      !!                  ***  ROUTINE zdf_osm_init  *** 
    2449      !! 
    2450      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
    2451      !!      viscosity when using a osm turbulent closure scheme 
    2452      !! 
    2453      !! ** Method  :   Read the namosm namelist and check the parameters 
    2454      !!      called at the first timestep (nit000) 
    2455      !! 
    2456      !! ** input   :   Namlist namosm 
    2457      !!---------------------------------------------------------------------- 
    2458      INTEGER, INTENT(in)   ::   Kmm       ! time level 
    2459      INTEGER  ::   ios            ! local integer 
    2460      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    2461      REAL z1_t2 
    2462      !! 
    2463      NAMELIST/namzdf_osm/ ln_use_osm_la, rn_osm_la, rn_osm_dstokes, nn_ave & 
    2464           & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0, rn_zdfosm_adjust_sd & 
    2465           & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv, nn_osm_wave & 
    2466           & ,nn_osm_SD_reduce, ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter 
    2467 ! Namelist for Fox-Kemper parametrization. 
    2468       NAMELIST/namosm_mle/ nn_osm_mle, rn_osm_mle_ce, rn_osm_mle_lf, rn_osm_mle_time, rn_osm_mle_lat,& 
    2469            & rn_osm_mle_rho_c, rn_osm_mle_thresh, rn_osm_mle_tau, ln_osm_hmle_limit, rn_osm_hmle_limit 
    2470  
    2471      !!---------------------------------------------------------------------- 
    2472      ! 
    2473      READ  ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901) 
    2474 901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' ) 
    2475  
    2476      READ  ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 ) 
    2477 902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' ) 
    2478      IF(lwm) WRITE ( numond, namzdf_osm ) 
    2479  
    2480      IF(lwp) THEN                    ! Control print 
    2481         WRITE(numout,*) 
    2482         WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation' 
    2483         WRITE(numout,*) '~~~~~~~~~~~~' 
    2484         WRITE(numout,*) '   Namelist namzdf_osm : set osm mixing parameters' 
    2485         WRITE(numout,*) '     Use  rn_osm_la                                ln_use_osm_la = ', ln_use_osm_la 
    2486         WRITE(numout,*) '     Use  MLE in OBL, i.e. Fox-Kemper param        ln_osm_mle = ', ln_osm_mle 
    2487         WRITE(numout,*) '     Turbulent Langmuir number                     rn_osm_la   = ', rn_osm_la 
    2488         WRITE(numout,*) '     Stokes drift reduction factor                 rn_zdfosm_adjust_sd   = ', rn_zdfosm_adjust_sd 
    2489         WRITE(numout,*) '     Initial hbl for 1D runs                       rn_osm_hbl0   = ', rn_osm_hbl0 
    2490         WRITE(numout,*) '     Depth scale of Stokes drift                   rn_osm_dstokes = ', rn_osm_dstokes 
    2491         WRITE(numout,*) '     horizontal average flag                       nn_ave      = ', nn_ave 
    2492         WRITE(numout,*) '     Stokes drift                                  nn_osm_wave = ', nn_osm_wave 
    2493         SELECT CASE (nn_osm_wave) 
    2494         CASE(0) 
    2495            WRITE(numout,*) '     calculated assuming constant La#=0.3' 
    2496         CASE(1) 
    2497            WRITE(numout,*) '     calculated from Pierson Moskowitz wind-waves' 
    2498         CASE(2) 
    2499            WRITE(numout,*) '     calculated from ECMWF wave fields' 
     2987      !!---------------------------------------------------------------------- 
     2988      !!                  ***  ROUTINE zdf_osm_init  *** 
     2989      !! 
     2990      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
     2991      !!      viscosity when using a osm turbulent closure scheme 
     2992      !! 
     2993      !! ** Method  :   Read the namosm namelist and check the parameters 
     2994      !!      called at the first timestep (nit000) 
     2995      !! 
     2996      !! ** input   :   Namlists namzdf_osm and namosm_mle 
     2997      !! 
     2998      !!---------------------------------------------------------------------- 
     2999      INTEGER, INTENT(in   ) ::   Kmm   ! Time level 
     3000      !! 
     3001      INTEGER  ::   ios            ! Local integer 
     3002      INTEGER  ::   ji, jj, jk     ! Dummy loop indices 
     3003      REAL(wp) ::   z1_t2 
     3004      !! 
     3005      REAL(wp), PARAMETER ::   pp_large = -1e10_wp 
     3006      !! 
     3007      NAMELIST/namzdf_osm/ ln_use_osm_la,    rn_osm_la,      rn_osm_dstokes,      nn_ave,                nn_osm_wave,        & 
     3008         &                 ln_dia_osm,       rn_osm_hbl0,    rn_zdfosm_adjust_sd, ln_kpprimix,           rn_riinfty,         & 
     3009         &                 rn_difri,         ln_convmix,     rn_difconv,          nn_osm_wave,           nn_osm_SD_reduce,   & 
     3010         &                 ln_osm_mle,       rn_osm_hblfrac, rn_osm_bl_thresh,    ln_zdfosm_ice_shelter 
     3011      !! Namelist for Fox-Kemper parametrization 
     3012      NAMELIST/namosm_mle/ nn_osm_mle,       rn_osm_mle_ce,     rn_osm_mle_lf,  rn_osm_mle_time,  rn_osm_mle_lat,   & 
     3013         &                 rn_osm_mle_rho_c, rn_osm_mle_thresh, rn_osm_mle_tau, ln_osm_hmle_limit, rn_osm_hmle_limit 
     3014      !!---------------------------------------------------------------------- 
     3015      ! 
     3016      READ  ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901) 
     3017901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' ) 
     3018 
     3019      READ  ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 ) 
     3020902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' ) 
     3021      IF(lwm) WRITE ( numond, namzdf_osm ) 
     3022 
     3023      IF(lwp) THEN                    ! Control print 
     3024         WRITE(numout,*) 
     3025         WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation' 
     3026         WRITE(numout,*) '~~~~~~~~~~~~' 
     3027         WRITE(numout,*) '   Namelist namzdf_osm : set osm mixing parameters' 
     3028         WRITE(numout,*) '      Use  rn_osm_la                                     ln_use_osm_la         = ', ln_use_osm_la 
     3029         WRITE(numout,*) '      Use  MLE in OBL, i.e. Fox-Kemper param             ln_osm_mle            = ', ln_osm_mle 
     3030         WRITE(numout,*) '      Turbulent Langmuir number                          rn_osm_la             = ', rn_osm_la 
     3031         WRITE(numout,*) '      Stokes drift reduction factor                      rn_zdfosm_adjust_sd   = ', rn_zdfosm_adjust_sd 
     3032         WRITE(numout,*) '      Initial hbl for 1D runs                            rn_osm_hbl0           = ', rn_osm_hbl0 
     3033         WRITE(numout,*) '      Depth scale of Stokes drift                        rn_osm_dstokes        = ', rn_osm_dstokes 
     3034         WRITE(numout,*) '      Horizontal average flag                            nn_ave                = ', nn_ave 
     3035         WRITE(numout,*) '      Stokes drift                                       nn_osm_wave           = ', nn_osm_wave 
     3036         SELECT CASE (nn_osm_wave) 
     3037         CASE(0) 
     3038            WRITE(numout,*) '      Calculated assuming constant La#=0.3' 
     3039         CASE(1) 
     3040            WRITE(numout,*) '      Calculated from Pierson Moskowitz wind-waves' 
     3041         CASE(2) 
     3042            WRITE(numout,*) '      Calculated from ECMWF wave fields' 
    25003043         END SELECT 
    2501         WRITE(numout,*) '     Stokes drift reduction                        nn_osm_SD_reduce', nn_osm_SD_reduce 
    2502         WRITE(numout,*) '     fraction of hbl to average SD over/fit' 
    2503         WRITE(numout,*) '     exponential with nn_osm_SD_reduce = 1 or 2    rn_osm_hblfrac =  ', rn_osm_hblfrac 
    2504         SELECT CASE (nn_osm_SD_reduce) 
    2505         CASE(0) 
    2506            WRITE(numout,*) '     No reduction' 
    2507         CASE(1) 
    2508            WRITE(numout,*) '     Average SD over upper rn_osm_hblfrac of BL' 
    2509         CASE(2) 
    2510            WRITE(numout,*) '     Fit exponential to slope rn_osm_hblfrac of BL' 
    2511         END SELECT 
    2512         WRITE(numout,*) '     reduce surface SD and depth scale under ice   ln_zdfosm_ice_shelter=', ln_zdfosm_ice_shelter 
    2513         WRITE(numout,*) '     Output osm diagnostics                       ln_dia_osm  = ',  ln_dia_osm 
    2514         WRITE(numout,*) '         Threshold used to define BL              rn_osm_bl_thresh  = ', rn_osm_bl_thresh, 'm^2/s' 
    2515         WRITE(numout,*) '     Use KPP-style shear instability mixing       ln_kpprimix = ', ln_kpprimix 
    2516         WRITE(numout,*) '     local Richardson Number limit for shear instability rn_riinfty = ', rn_riinfty 
    2517         WRITE(numout,*) '     maximum shear diffusivity at Rig = 0    (m2/s) rn_difri = ', rn_difri 
    2518         WRITE(numout,*) '     Use large mixing below BL when unstable       ln_convmix = ', ln_convmix 
    2519         WRITE(numout,*) '     diffusivity when unstable below BL     (m2/s) rn_difconv = ', rn_difconv 
    2520      ENDIF 
    2521  
    2522  
    2523      !                              ! Check wave coupling settings ! 
    2524      !                         ! Further work needed - see ticket #2447 ! 
    2525      IF( nn_osm_wave == 2 ) THEN 
    2526         IF (.NOT. ( ln_wave .AND. ln_sdw )) & 
    2527            & CALL ctl_stop( 'zdf_osm_init : ln_zdfosm and nn_osm_wave=2, ln_wave and ln_sdw must be true' ) 
    2528      END IF 
    2529  
    2530      !                              ! allocate zdfosm arrays 
    2531      IF( zdf_osm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 
    2532  
    2533  
    2534      IF( ln_osm_mle ) THEN 
    2535 ! Initialise Fox-Kemper parametrization 
     3044         WRITE(numout,*) '      Stokes drift reduction                             nn_osm_SD_reduce      = ', nn_osm_SD_reduce 
     3045         WRITE(numout,*) '      Fraction of hbl to average SD over/fit' 
     3046         WRITE(numout,*) '      Exponential with nn_osm_SD_reduce = 1 or 2         rn_osm_hblfrac        = ', rn_osm_hblfrac 
     3047         SELECT CASE (nn_osm_SD_reduce) 
     3048         CASE(0) 
     3049            WRITE(numout,*) '     No reduction' 
     3050         CASE(1) 
     3051            WRITE(numout,*) '     Average SD over upper rn_osm_hblfrac of BL' 
     3052         CASE(2) 
     3053            WRITE(numout,*) '     Fit exponential to slope rn_osm_hblfrac of BL' 
     3054         END SELECT 
     3055         WRITE(numout,*) '     Reduce surface SD and depth scale under ice         ln_zdfosm_ice_shelter = ', ln_zdfosm_ice_shelter 
     3056         WRITE(numout,*) '     Output osm diagnostics                              ln_dia_osm            = ', ln_dia_osm 
     3057         WRITE(numout,*) '         Threshold used to define BL                     rn_osm_bl_thresh      = ', rn_osm_bl_thresh,   & 
     3058            &            'm^2/s' 
     3059         WRITE(numout,*) '     Use KPP-style shear instability mixing              ln_kpprimix           = ', ln_kpprimix 
     3060         WRITE(numout,*) '     Local Richardson Number limit for shear instability rn_riinfty            = ', rn_riinfty 
     3061         WRITE(numout,*) '     Maximum shear diffusivity at Rig = 0 (m2/s)         rn_difri              = ', rn_difri 
     3062         WRITE(numout,*) '     Use large mixing below BL when unstable             ln_convmix            = ', ln_convmix 
     3063         WRITE(numout,*) '     Diffusivity when unstable below BL (m2/s)           rn_difconv            = ', rn_difconv 
     3064      ENDIF 
     3065      ! 
     3066      !                              ! Check wave coupling settings ! 
     3067      !                         ! Further work needed - see ticket #2447 ! 
     3068      IF ( nn_osm_wave == 2 ) THEN 
     3069         IF (.NOT. ( ln_wave .AND. ln_sdw )) & 
     3070            & CALL ctl_stop( 'zdf_osm_init : ln_zdfosm and nn_osm_wave=2, ln_wave and ln_sdw must be true' ) 
     3071      END IF 
     3072      ! 
     3073      ! Flags associated with diagnostic output 
     3074      IF ( ln_dia_osm .AND. ( iom_use("zdudz_pyc") .OR. iom_use("zdvdz_pyc") ) )                            ln_dia_pyc_shr = .TRUE. 
     3075      IF ( ln_dia_osm .AND. ( iom_use("zdtdz_pyc") .OR. iom_use("zdsdz_pyc") .OR. iom_use("zdbdz_pyc" ) ) ) ln_dia_pyc_scl = .TRUE. 
     3076      ! 
     3077      ! Allocate zdfosm arrays 
     3078      IF( zdf_osm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 
     3079      ! 
     3080      IF( ln_osm_mle ) THEN   ! Initialise Fox-Kemper parametrization 
    25363081         READ  ( numnam_ref, namosm_mle, IOSTAT = ios, ERR = 903) 
    2537 903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namosm_mle in reference namelist') 
    2538  
     3082903      IF( ios /= 0 ) CALL ctl_nam( ios, 'namosm_mle in reference namelist' ) 
    25393083         READ  ( numnam_cfg, namosm_mle, IOSTAT = ios, ERR = 904 ) 
    2540 904      IF( ios >  0 )   CALL ctl_nam ( ios , 'namosm_mle in configuration namelist') 
     3084904      IF( ios >  0 ) CALL ctl_nam( ios, 'namosm_mle in configuration namelist' ) 
    25413085         IF(lwm) WRITE ( numond, namosm_mle ) 
    2542  
    2543          IF(lwp) THEN                     ! Namelist print 
     3086         ! 
     3087         IF(lwp) THEN   ! Namelist print 
    25443088            WRITE(numout,*) 
    25453089            WRITE(numout,*) 'zdf_osm_init : initialise mixed layer eddy (MLE)' 
    25463090            WRITE(numout,*) '~~~~~~~~~~~~~' 
    25473091            WRITE(numout,*) '   Namelist namosm_mle : ' 
    2548             WRITE(numout,*) '         MLE type: =0 standard Fox-Kemper ; =1 new formulation        nn_osm_mle    = ', nn_osm_mle 
    2549             WRITE(numout,*) '         magnitude of the MLE (typical value: 0.06 to 0.08)           rn_osm_mle_ce    = ', rn_osm_mle_ce 
    2550             WRITE(numout,*) '         scale of ML front (ML radius of deformation) (nn_osm_mle=0)      rn_osm_mle_lf     = ', rn_osm_mle_lf, 'm' 
    2551             WRITE(numout,*) '         maximum time scale of MLE                    (nn_osm_mle=0)      rn_osm_mle_time   = ', rn_osm_mle_time, 's' 
    2552             WRITE(numout,*) '         reference latitude (degrees) of MLE coef.    (nn_osm_mle=1)      rn_osm_mle_lat    = ', rn_osm_mle_lat, 'deg' 
    2553             WRITE(numout,*) '         Density difference used to define ML for FK              rn_osm_mle_rho_c  = ', rn_osm_mle_rho_c 
    2554             WRITE(numout,*) '         Threshold used to define MLE for FK                      rn_osm_mle_thresh  = ', rn_osm_mle_thresh, 'm^2/s' 
    2555             WRITE(numout,*) '         Timescale for OSM-FK                                         rn_osm_mle_tau  = ', rn_osm_mle_tau, 's' 
    2556             WRITE(numout,*) '         switch to limit hmle                                      ln_osm_hmle_limit  = ', ln_osm_hmle_limit 
    2557             WRITE(numout,*) '         fraction of zmld to limit hmle to if ln_osm_hmle_limit =.T.  rn_osm_hmle_limit = ', rn_osm_hmle_limit 
    2558          ENDIF         ! 
    2559      ENDIF 
     3092            WRITE(numout,*) '      MLE type: =0 standard Fox-Kemper ; =1 new formulation   nn_osm_mle        = ', nn_osm_mle 
     3093            WRITE(numout,*) '      Magnitude of the MLE (typical value: 0.06 to 0.08)      rn_osm_mle_ce     = ', rn_osm_mle_ce 
     3094            WRITE(numout,*) '      Scale of ML front (ML radius of deform.) (nn_osm_mle=0) rn_osm_mle_lf     = ', rn_osm_mle_lf,    & 
     3095               &            'm' 
     3096            WRITE(numout,*) '      Maximum time scale of MLE                (nn_osm_mle=0) rn_osm_mle_time   = ',   & 
     3097               &            rn_osm_mle_time, 's' 
     3098            WRITE(numout,*) '      Reference latitude (deg) of MLE coef.    (nn_osm_mle=1) rn_osm_mle_lat    = ', rn_osm_mle_lat,   & 
     3099               &            'deg' 
     3100            WRITE(numout,*) '      Density difference used to define ML for FK             rn_osm_mle_rho_c  = ', rn_osm_mle_rho_c 
     3101            WRITE(numout,*) '      Threshold used to define MLE for FK                     rn_osm_mle_thresh = ',   & 
     3102               &            rn_osm_mle_thresh, 'm^2/s' 
     3103            WRITE(numout,*) '      Timescale for OSM-FK                                    rn_osm_mle_tau    = ', rn_osm_mle_tau, 's' 
     3104            WRITE(numout,*) '      Switch to limit hmle                                    ln_osm_hmle_limit = ', ln_osm_hmle_limit 
     3105            WRITE(numout,*) '      hmle limit (fraction of zmld) (ln_osm_hmle_limit = .T.) rn_osm_hmle_limit = ', rn_osm_hmle_limit 
     3106         END IF 
     3107      END IF 
    25603108      ! 
    25613109      IF(lwp) THEN 
    25623110         WRITE(numout,*) 
    2563          IF( ln_osm_mle ) THEN 
     3111         IF ( ln_osm_mle ) THEN 
    25643112            WRITE(numout,*) '   ==>>>   Mixed Layer Eddy induced transport added to OSMOSIS BL calculation' 
    25653113            IF( nn_osm_mle == 0 )   WRITE(numout,*) '              Fox-Kemper et al 2010 formulation' 
    … …  
    25673115         ELSE 
    25683116            WRITE(numout,*) '   ==>>>   Mixed Layer induced transport NOT added to OSMOSIS BL calculation' 
    2569          ENDIF 
    2570       ENDIF 
    2571       ! 
    2572       IF( ln_osm_mle ) THEN                ! MLE initialisation 
     3117         END IF 
     3118      END IF 
     3119      ! 
     3120      IF( ln_osm_mle ) THEN   ! MLE initialisation 
    25733121         ! 
    2574          rb_c = grav * rn_osm_mle_rho_c /rho0        ! Mixed Layer buoyancy criteria 
     3122         rb_c = grav * rn_osm_mle_rho_c / rho0   ! Mixed Layer buoyancy criteria 
    25753123         IF(lwp) WRITE(numout,*) 
    25763124         IF(lwp) WRITE(numout,*) '      ML buoyancy criteria = ', rb_c, ' m/s2 ' 
    25773125         IF(lwp) WRITE(numout,*) '      associated ML density criteria defined in zdfmxl = ', rn_osm_mle_rho_c, 'kg/m3' 
    25783126         ! 
    2579          IF( nn_osm_mle == 0 ) THEN           ! MLE array allocation & initialisation            ! 
    2580 ! 
    2581          ELSEIF( nn_osm_mle == 1 ) THEN           ! MLE array allocation & initialisation 
    2582             rc_f = rn_osm_mle_ce/ (  5.e3_wp * 2._wp * omega * SIN( rad * rn_osm_mle_lat )  ) 
    2583             ! 
    2584          ENDIF 
    2585          !                                ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case) 
    2586          z1_t2 = 2.e-5 
    2587          DO_2D( 1, 1, 1, 1 ) 
    2588             r1_ft(ji,jj) = MIN(1./( ABS(ff_t(ji,jj)) + epsln ), ABS(ff_t(ji,jj))/z1_t2**2) 
     3127         IF( nn_osm_mle == 1 ) THEN 
     3128            rc_f = rn_osm_mle_ce / ( 5e3_wp * 2.0_wp * omega * SIN( rad * rn_osm_mle_lat ) ) 
     3129         END IF 
     3130         ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case) 
     3131         z1_t2 = 2e-5_wp 
     3132         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     3133            r1_ft(ji,jj) = MIN( 1.0_wp / ( ABS( ff_t(ji,jj)) + epsln ), ABS( ff_t(ji,jj) ) / z1_t2**2 ) 
    25893134         END_2D 
    25903135         ! z1_t2 = 1._wp / ( rn_osm_mle_time * rn_osm_mle_timeji,jj ) 
    25913136         ! r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  ) 
    25923137         ! 
    2593       ENDIF 
    2594  
    2595      call osm_rst( nit000, Kmm,  'READ' ) !* read or initialize hbl, dh, hmle 
    2596  
    2597  
    2598      IF( ln_zdfddm) THEN 
    2599         IF(lwp) THEN 
    2600            WRITE(numout,*) 
    2601            WRITE(numout,*) '    Double diffusion mixing on temperature and salinity ' 
    2602            WRITE(numout,*) '    CAUTION : done in routine zdfosm, not in routine zdfddm ' 
    2603         ENDIF 
    2604      ENDIF 
    2605  
    2606  
    2607      !set constants not in namelist 
    2608      !----------------------------- 
    2609  
    2610      IF(lwp) THEN 
    2611         WRITE(numout,*) 
    2612      ENDIF 
    2613  
    2614      IF (nn_osm_wave == 0) THEN 
    2615         dstokes(:,:) = rn_osm_dstokes 
    2616      END IF 
    2617  
    2618      ! Horizontal average : initialization of weighting arrays 
    2619      ! ------------------- 
    2620  
    2621      SELECT CASE ( nn_ave ) 
    2622  
    2623      CASE ( 0 )                ! no horizontal average 
    2624         IF(lwp) WRITE(numout,*) '          no horizontal average on avt' 
    2625         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !' 
    2626         ! weighting mean arrays etmean 
    2627         !           ( 1  1 ) 
    2628         ! avt = 1/4 ( 1  1 ) 
    2629         ! 
    2630         etmean(:,:,:) = 0.e0 
    2631  
    2632         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    2633            etmean(ji,jj,jk) = tmask(ji,jj,jk)                     & 
    2634                 &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   & 
    2635                 &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  ) 
    2636         END_3D 
    2637  
    2638      CASE ( 1 )                ! horizontal average 
    2639         IF(lwp) WRITE(numout,*) '          horizontal average on avt' 
    2640         ! weighting mean arrays etmean 
    2641         !           ( 1/2  1  1/2 ) 
    2642         ! avt = 1/8 ( 1    2  1   ) 
    2643         !           ( 1/2  1  1/2 ) 
    2644         etmean(:,:,:) = 0.e0 
    2645  
    2646         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    2647            etmean(ji,jj,jk) = tmask(ji, jj,jk)                           & 
    2648                 & / MAX( 1., 2.* tmask(ji,jj,jk)                           & 
    2649                 &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   & 
    2650                 &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) & 
    2651                 &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   & 
    2652                 &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) ) 
    2653         END_3D 
    2654  
    2655      CASE DEFAULT 
    2656         WRITE(ctmp1,*) '          bad flag value for nn_ave = ', nn_ave 
    2657         CALL ctl_stop( ctmp1 ) 
    2658  
    2659      END SELECT 
    2660  
    2661      ! Initialization of vertical eddy coef. to the background value 
    2662      ! ------------------------------------------------------------- 
    2663      DO jk = 1, jpk 
    2664         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk) 
    2665      END DO 
    2666  
    2667      ! zero the surface flux for non local term and osm mixed layer depth 
    2668      ! ------------------------------------------------------------------ 
    2669      ghamt(:,:,:) = 0. 
    2670      ghams(:,:,:) = 0. 
    2671      ghamu(:,:,:) = 0. 
    2672      ghamv(:,:,:) = 0. 
    2673      ! 
     3138      END IF 
     3139      ! 
     3140      CALL osm_rst( nit000, Kmm,  'READ' )   ! Read or initialize hbl, dh, hmle 
     3141      ! 
     3142      IF ( ln_zdfddm ) THEN 
     3143         IF(lwp) THEN 
     3144            WRITE(numout,*) 
     3145            WRITE(numout,*) '    Double diffusion mixing on temperature and salinity ' 
     3146            WRITE(numout,*) '    CAUTION : done in routine zdfosm, not in routine zdfddm ' 
     3147         END IF 
     3148      END IF 
     3149      ! 
     3150      ! Set constants not in namelist 
     3151      ! ----------------------------- 
     3152      IF(lwp) THEN 
     3153         WRITE(numout,*) 
     3154      END IF 
     3155      ! 
     3156      dstokes(:,:) = pp_large 
     3157      IF (nn_osm_wave == 0) THEN 
     3158         dstokes(:,:) = rn_osm_dstokes 
     3159      END IF 
     3160      ! 
     3161      ! Horizontal average : initialization of weighting arrays 
     3162      ! ------------------- 
     3163      SELECT CASE ( nn_ave ) 
     3164      CASE ( 0 )                ! no horizontal average 
     3165         IF(lwp) WRITE(numout,*) '          no horizontal average on avt' 
     3166         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !' 
     3167         ! Weighting mean arrays etmean 
     3168         !           ( 1  1 ) 
     3169         ! avt = 1/4 ( 1  1 ) 
     3170         ! 
     3171         etmean(:,:,:) = 0.0_wp 
     3172         ! 
     3173         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     3174            etmean(ji,jj,jk) = tmask(ji,jj,jk) / MAX( 1.0_wp, umask(ji-1,jj,  jk) + umask(ji,jj,jk) +   & 
     3175               &                                              vmask(ji,  jj-1,jk) + vmask(ji,jj,jk) ) 
     3176         END_3D 
     3177      CASE ( 1 )                ! horizontal average 
     3178         IF(lwp) WRITE(numout,*) '          horizontal average on avt' 
     3179         ! Weighting mean arrays etmean 
     3180         !           ( 1/2  1  1/2 ) 
     3181         ! avt = 1/8 ( 1    2  1   ) 
     3182         !           ( 1/2  1  1/2 ) 
     3183         etmean(:,:,:) = 0.0_wp 
     3184         ! 
     3185         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     3186            etmean(ji,jj,jk) = tmask(ji, jj,jk) / MAX( 1.0_wp, 2.0_wp *   tmask(ji,jj,jk) +                               & 
     3187               &                                               0.5_wp * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk) +     & 
     3188               &                                                          tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) +   & 
     3189               &                                               1.0_wp * ( tmask(ji-1,jj,  jk) + tmask(ji,  jj+1,jk) +     & 
     3190               &                                                          tmask(ji,  jj-1,jk) + tmask(ji+1,jj,  jk) ) ) 
     3191         END_3D 
     3192      CASE DEFAULT 
     3193         WRITE(ctmp1,*) '          bad flag value for nn_ave = ', nn_ave 
     3194         CALL ctl_stop( ctmp1 ) 
     3195      END SELECT 
     3196      ! 
     3197      ! Initialization of vertical eddy coef. to the background value 
     3198      ! ------------------------------------------------------------- 
     3199      DO jk = 1, jpk 
     3200         avt(:,:,jk) = avtb(jk) * tmask(:,:,jk) 
     3201      END DO 
     3202      ! 
     3203      ! Zero the surface flux for non local term and osm mixed layer depth 
     3204      ! ------------------------------------------------------------------ 
     3205      ghamt(:,:,:) = 0.0_wp 
     3206      ghams(:,:,:) = 0.0_wp 
     3207      ghamu(:,:,:) = 0.0_wp 
     3208      ghamv(:,:,:) = 0.0_wp 
     3209      ! 
     3210      IF ( ln_dia_osm ) THEN   ! Initialise auxiliary arrays for diagnostic output 
     3211         osmdia2d(:,:)   = 0.0_wp 
     3212         osmdia3d(:,:,:) = 0.0_wp 
     3213      END IF 
     3214      ! 
    26743215   END SUBROUTINE zdf_osm_init 
    26753216 
    2676  
    26773217   SUBROUTINE osm_rst( kt, Kmm, cdrw ) 
    2678      !!--------------------------------------------------------------------- 
    2679      !!                   ***  ROUTINE osm_rst  *** 
    2680      !! 
    2681      !! ** Purpose :   Read or write BL fields in restart file 
    2682      !! 
    2683      !! ** Method  :   use of IOM library. If the restart does not contain 
    2684      !!                required fields, they are recomputed from stratification 
    2685      !!---------------------------------------------------------------------- 
    2686  
    2687      INTEGER         , INTENT(in) ::   kt     ! ocean time step index 
    2688      INTEGER         , INTENT(in) ::   Kmm    ! ocean time level index (middle) 
    2689      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    2690  
    2691      INTEGER ::   id1, id2, id3   ! iom enquiry index 
    2692      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    2693      INTEGER  ::   iiki, ikt ! local integer 
    2694      REAL(wp) ::   zhbf           ! tempory scalars 
    2695      REAL(wp) ::   zN2_c           ! local scalar 
    2696      REAL(wp) ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth 
    2697      INTEGER, DIMENSION(jpi,jpj) :: imld_rst ! level of mixed-layer depth (pycnocline top) 
    2698      !!---------------------------------------------------------------------- 
    2699      ! 
    2700      !!----------------------------------------------------------------------------- 
    2701      ! If READ/WRITE Flag is 'READ', try to get hbl from restart file. If successful then return 
    2702      !!----------------------------------------------------------------------------- 
    2703      IF( TRIM(cdrw) == 'READ'.AND. ln_rstart) THEN 
    2704         id1 = iom_varid( numror, 'wn'   , ldstop = .FALSE. ) 
    2705         IF( id1 > 0 ) THEN                       ! 'wn' exists; read 
    2706            CALL iom_get( numror, jpdom_auto, 'wn', ww ) 
    2707            WRITE(numout,*) ' ===>>>> :  wn read from restart file' 
    2708         ELSE 
    2709            ww(:,:,:) = 0._wp 
    2710            WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially' 
    2711         END IF 
    2712  
    2713         id1 = iom_varid( numror, 'hbl'   , ldstop = .FALSE. ) 
    2714         id2 = iom_varid( numror, 'dh'   , ldstop = .FALSE. ) 
    2715         IF( id1 > 0 .AND. id2 > 0) THEN                       ! 'hbl' exists; read and return 
    2716            CALL iom_get( numror, jpdom_auto, 'hbl' , hbl  ) 
    2717            CALL iom_get( numror, jpdom_auto, 'dh', dh ) 
    2718            WRITE(numout,*) ' ===>>>> :  hbl & dh read from restart file' 
    2719            IF( ln_osm_mle ) THEN 
    2720               id3 = iom_varid( numror, 'hmle'   , ldstop = .FALSE. ) 
    2721               IF( id3 > 0) THEN 
    2722                  CALL iom_get( numror, jpdom_auto, 'hmle' , hmle ) 
    2723                  WRITE(numout,*) ' ===>>>> :  hmle read from restart file' 
    2724               ELSE 
    2725                  WRITE(numout,*) ' ===>>>> :  hmle not found, set to hbl' 
    2726                  hmle(:,:) = hbl(:,:)            ! Initialise MLE depth. 
    2727               END IF 
    2728            END IF 
    2729            RETURN 
    2730         ELSE                      ! 'hbl' & 'dh' not in restart file, recalculate 
    2731            WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification' 
    2732         END IF 
    2733      END IF 
    2734  
    2735      !!----------------------------------------------------------------------------- 
    2736      ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return 
    2737      !!----------------------------------------------------------------------------- 
    2738      IF( TRIM(cdrw) == 'WRITE') THEN     !* Write hbl into the restart file, then return 
    2739         IF(lwp) WRITE(numout,*) '---- osm-rst ----' 
    2740          CALL iom_rstput( kt, nitrst, numrow, 'wn'     , ww  ) 
    2741          CALL iom_rstput( kt, nitrst, numrow, 'hbl'    , hbl ) 
    2742          CALL iom_rstput( kt, nitrst, numrow, 'dh'     , dh  ) 
    2743          IF( ln_osm_mle ) THEN 
     3218      !!--------------------------------------------------------------------- 
     3219      !!                   ***  ROUTINE osm_rst  *** 
     3220      !! 
     3221      !! ** Purpose :   Read or write BL fields in restart file 
     3222      !! 
     3223      !! ** Method  :   use of IOM library. If the restart does not contain 
     3224      !!                required fields, they are recomputed from stratification 
     3225      !! 
     3226      !!---------------------------------------------------------------------- 
     3227      INTEGER         , INTENT(in   ) ::   kt     ! Ocean time step index 
     3228      INTEGER         , INTENT(in   ) ::   Kmm    ! Ocean time level index (middle) 
     3229      CHARACTER(len=*), INTENT(in   ) ::   cdrw   ! "READ"/"WRITE" flag 
     3230      !! 
     3231      INTEGER  ::   id1, id2, id3                 ! iom enquiry index 
     3232      INTEGER  ::   ji, jj, jk                    ! Dummy loop indices 
     3233      INTEGER  ::   iiki, ikt                     ! Local integer 
     3234      REAL(wp) ::   zhbf                          ! Tempory scalars 
     3235      REAL(wp) ::   zN2_c                         ! Local scalar 
     3236      REAL(wp) ::   rho_c = 0.01_wp               ! Density criterion for mixed layer depth 
     3237      INTEGER, DIMENSION(jpi,jpj) ::   imld_rst   ! Level of mixed-layer depth (pycnocline top) 
     3238      !!---------------------------------------------------------------------- 
     3239      ! 
     3240      !!----------------------------------------------------------------------------- 
     3241      ! If READ/WRITE Flag is 'READ', try to get hbl from restart file. If successful then return 
     3242      !!----------------------------------------------------------------------------- 
     3243      IF( TRIM(cdrw) == 'READ' .AND. ln_rstart) THEN 
     3244         id1 = iom_varid( numror, 'wn', ldstop = .FALSE. ) 
     3245         IF( id1 > 0 ) THEN   ! 'wn' exists; read 
     3246            CALL iom_get( numror, jpdom_auto, 'wn', ww ) 
     3247            WRITE(numout,*) ' ===>>>> :  wn read from restart file' 
     3248         ELSE 
     3249            ww(:,:,:) = 0.0_wp 
     3250            WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially' 
     3251         END IF 
     3252         ! 
     3253         id1 = iom_varid( numror, 'hbl', ldstop = .FALSE. ) 
     3254         id2 = iom_varid( numror, 'dh',  ldstop = .FALSE. ) 
     3255         IF( id1 > 0 .AND. id2 > 0 ) THEN   ! 'hbl' exists; read and return 
     3256            CALL iom_get( numror, jpdom_auto, 'hbl', hbl  ) 
     3257            CALL iom_get( numror, jpdom_auto, 'dh',  dh   ) 
     3258            hml(:,:) = hbl(:,:) - dh(:,:)   ! Initialise ML depth 
     3259            WRITE(numout,*) ' ===>>>> :  hbl & dh read from restart file' 
     3260            IF( ln_osm_mle ) THEN 
     3261               id3 = iom_varid( numror, 'hmle', ldstop = .FALSE. ) 
     3262               IF( id3 > 0 ) THEN 
     3263                  CALL iom_get( numror, jpdom_auto, 'hmle', hmle ) 
     3264                  WRITE(numout,*) ' ===>>>> :  hmle read from restart file' 
     3265               ELSE 
     3266                  WRITE(numout,*) ' ===>>>> :  hmle not found, set to hbl' 
     3267                  hmle(:,:) = hbl(:,:)   ! Initialise MLE depth 
     3268               END IF 
     3269            END IF 
     3270            RETURN 
     3271         ELSE   ! 'hbl' & 'dh' not in restart file, recalculate 
     3272            WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification' 
     3273         END IF 
     3274      END IF 
     3275      ! 
     3276      !!----------------------------------------------------------------------------- 
     3277      ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return 
     3278      !!----------------------------------------------------------------------------- 
     3279      IF ( TRIM(cdrw) == 'WRITE' ) THEN 
     3280         IF(lwp) WRITE(numout,*) '---- osm-rst ----' 
     3281         CALL iom_rstput( kt, nitrst, numrow, 'wn',  ww  ) 
     3282         CALL iom_rstput( kt, nitrst, numrow, 'hbl', hbl ) 
     3283         CALL iom_rstput( kt, nitrst, numrow, 'dh',  dh  ) 
     3284         IF ( ln_osm_mle ) THEN 
    27443285            CALL iom_rstput( kt, nitrst, numrow, 'hmle', hmle ) 
    27453286         END IF 
    2746         RETURN 
    2747      END IF 
    2748  
    2749      !!----------------------------------------------------------------------------- 
    2750      ! Getting hbl, no restart file with hbl, so calculate from surface stratification 
    2751      !!----------------------------------------------------------------------------- 
    2752      IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification' 
    2753      ! w-level of the mixing and mixed layers 
    2754      CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) 
    2755      CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2, Kmm) 
    2756      imld_rst(:,:)  = nlb10         ! Initialization to the number of w ocean point 
    2757      hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
    2758      zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 
    2759      ! 
    2760      hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
    2761      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    2762         ikt = mbkt(ji,jj) 
    2763         hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 
    2764         IF( hbl(ji,jj) < zN2_c )   imld_rst(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
    2765      END_3D 
    2766      ! 
    2767      DO_2D( 1, 1, 1, 1 ) 
    2768         iiki = MAX(4,imld_rst(ji,jj)) 
    2769         hbl (ji,jj) = gdepw(ji,jj,iiki,Kmm  )    ! Turbocline depth 
    2770         dh (ji,jj) = e3t(ji,jj,iiki-1,Kmm  )     ! Turbocline depth 
    2771      END_2D 
    2772  
    2773      WRITE(numout,*) ' ===>>>> : hbl computed from stratification' 
    2774  
    2775      IF( ln_osm_mle ) THEN 
    2776         hmle(:,:) = hbl(:,:)            ! Initialise MLE depth. 
    2777         WRITE(numout,*) ' ===>>>> : hmle set = to hbl' 
    2778      END IF 
    2779  
    2780      ww(:,:,:) = 0._wp 
    2781      WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially' 
     3287         RETURN 
     3288      END IF 
     3289      ! 
     3290      !!----------------------------------------------------------------------------- 
     3291      ! Getting hbl, no restart file with hbl, so calculate from surface stratification 
     3292      !!----------------------------------------------------------------------------- 
     3293      IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification' 
     3294      ! w-level of the mixing and mixed layers 
     3295      CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) 
     3296      CALL bn2( ts(:,:,:,:,Kmm), rab_n, rn2, Kmm ) 
     3297      imld_rst(:,:) = nlb10            ! Initialization to the number of w ocean point 
     3298      hbl(:,:) = 0.0_wp                ! Here hbl used as a dummy variable, integrating vertically N^2 
     3299      zN2_c = grav * rho_c * r1_rho0   ! Convert density criteria into N^2 criteria 
     3300      ! 
     3301      hbl(:,:)  = 0.0_wp   ! Here hbl used as a dummy variable, integrating vertically N^2 
     3302      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
     3303         ikt = mbkt(ji,jj) 
     3304         hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0.0_wp ) * e3w(ji,jj,jk,Kmm) 
     3305         IF ( hbl(ji,jj) < zN2_c ) imld_rst(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
     3306      END_3D 
     3307      ! 
     3308      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     3309         iiki = MAX( 4, imld_rst(ji,jj) ) 
     3310         hbl(ji,jj) = gdepw(ji,jj,iiki,Kmm  )   ! Turbocline depth 
     3311         dh(ji,jj)  = e3t(ji,jj,iiki-1,Kmm  )   ! Turbocline depth 
     3312         hml(ji,jj) = hbl(ji,jj) - dh(ji,jj) 
     3313      END_2D 
     3314      ! 
     3315      WRITE(numout,*) ' ===>>>> : hbl computed from stratification' 
     3316      ! 
     3317      IF( ln_osm_mle ) THEN 
     3318         hmle(:,:) = hbl(:,:)            ! Initialise MLE depth. 
     3319         WRITE(numout,*) ' ===>>>> : hmle set = to hbl' 
     3320      END IF 
     3321      ! 
     3322      ww(:,:,:) = 0.0_wp 
     3323      WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially' 
     3324      ! 
    27823325   END SUBROUTINE osm_rst 
    27833326 
    2784  
    27853327   SUBROUTINE tra_osm( kt, Kmm, pts, Krhs ) 
    27863328      !!---------------------------------------------------------------------- 
    … …  
    27903332      !! 
    27913333      !! ** Method  :   ??? 
    2792       !!---------------------------------------------------------------------- 
     3334      !! 
     3335      !!---------------------------------------------------------------------- 
     3336      INTEGER                                  , INTENT(in   ) ::   kt          ! Time step index 
     3337      INTEGER                                  , INTENT(in   ) ::   Kmm, Krhs   ! Time level indices 
     3338      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts         ! Active tracers and RHS of tracer equation 
     3339      !! 
     3340      INTEGER                                 ::   ji, jj, jk 
    27933341      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace 
    27943342      !!---------------------------------------------------------------------- 
    2795       INTEGER                                  , INTENT(in)    :: kt        ! time step index 
    2796       INTEGER                                  , INTENT(in)    :: Kmm, Krhs ! time level indices 
    2797       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
    2798       ! 
    2799       INTEGER :: ji, jj, jk 
    2800       ! 
    2801       IF( kt == nit000 ) THEN 
    2802          IF( ntile == 0 .OR. ntile == 1 ) THEN                    ! Do only on the first tile 
     3343      ! 
     3344      IF ( kt == nit000 ) THEN 
     3345         IF ( ntile == 0 .OR. ntile == 1 ) THEN   ! Do only on the first tile 
    28033346            IF(lwp) WRITE(numout,*) 
    28043347            IF(lwp) WRITE(numout,*) 'tra_osm : OSM non-local tracer fluxes' 
    28053348            IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    2806          ENDIF 
    2807       ENDIF 
    2808  
    2809       IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    2810          ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
    2811          ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
    2812       ENDIF 
    2813  
     3349         END IF 
     3350      END IF 
     3351      ! 
     3352      IF ( l_trdtra ) THEN   ! Save ta and sa trends 
     3353         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
     3354         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
     3355         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
     3356      END IF 
     3357      ! 
    28143358      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    28153359         pts(ji,jj,jk,jp_tem,Krhs) =  pts(ji,jj,jk,jp_tem,Krhs)                      & 
    … …  
    28203364            &                    - ghams(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
    28213365      END_3D 
    2822  
    2823       ! save the non-local tracer flux trends for diagnostics 
    2824       IF( l_trdtra )   THEN 
     3366      ! 
     3367      IF ( l_trdtra ) THEN   ! Save the non-local tracer flux trends for diagnostics 
    28253368         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    28263369         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    2827  
    28283370         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_osm, ztrdt ) 
    28293371         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_osm, ztrds ) 
    2830          DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
    2831       ENDIF 
    2832  
    2833       IF(sn_cfctl%l_prtctl) THEN 
     3372         DEALLOCATE( ztrdt, ztrds ) 
     3373      END IF 
     3374      ! 
     3375      IF ( sn_cfctl%l_prtctl ) THEN 
    28343376         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' osm  - Ta: ', mask1=tmask,   & 
    2835          &             tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    2836       ENDIF 
     3377            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     3378      END IF 
    28373379      ! 
    28383380   END SUBROUTINE tra_osm 
    28393381 
    2840  
    2841    SUBROUTINE trc_osm( kt )          ! Dummy routine 
     3382   SUBROUTINE trc_osm( kt )   ! Dummy routine 
    28423383      !!---------------------------------------------------------------------- 
    28433384      !!                  ***  ROUTINE trc_osm  *** 
    … …  
    28483389      !! 
    28493390      !! ** Method  :   ??? 
    2850       !!---------------------------------------------------------------------- 
    2851       ! 
     3391      !! 
    28523392      !!---------------------------------------------------------------------- 
    28533393      INTEGER, INTENT(in) :: kt 
     3394      !!---------------------------------------------------------------------- 
     3395      ! 
    28543396      WRITE(*,*) 'trc_osm: Not written yet', kt 
     3397      ! 
    28553398   END SUBROUTINE trc_osm 
    2856  
    28573399 
    28583400   SUBROUTINE dyn_osm( kt, Kmm, puu, pvv, Krhs ) 
    … …  
    28643406      !! 
    28653407      !! ** Method  :   ??? 
    2866       !!---------------------------------------------------------------------- 
    2867       INTEGER                             , INTENT( in )  ::  kt          ! ocean time step index 
    2868       INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
    2869       REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    2870       ! 
     3408      !! 
     3409      !!---------------------------------------------------------------------- 
     3410      INTEGER                             , INTENT(in   ) ::   kt          ! Ocean time step index 
     3411      INTEGER                             , INTENT(in   ) ::   Kmm, Krhs   ! Ocean time level indices 
     3412      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv    ! Ocean velocities and RHS of momentum equation 
     3413      !! 
    28713414      INTEGER :: ji, jj, jk   ! dummy loop indices 
    28723415      !!---------------------------------------------------------------------- 
    28733416      ! 
    2874       IF( kt == nit000 ) THEN 
     3417      IF ( kt == nit000 ) THEN 
    28753418         IF(lwp) WRITE(numout,*) 
    28763419         IF(lwp) WRITE(numout,*) 'dyn_osm : OSM non-local velocity' 
    28773420         IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    2878       ENDIF 
    2879       !code saving tracer trends removed, replace with trdmxl_oce 
    2880  
    2881       DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! add non-local u and v fluxes 
    2882          puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs)                      & 
    2883             &                 - (  ghamu(ji,jj,jk  )  & 
    2884             &                    - ghamu(ji,jj,jk+1) ) / e3u(ji,jj,jk,Kmm) 
    2885          pvv(ji,jj,jk,Krhs) =  pvv(ji,jj,jk,Krhs)                      & 
    2886             &                 - (  ghamv(ji,jj,jk  )  & 
    2887             &                    - ghamv(ji,jj,jk+1) ) / e3v(ji,jj,jk,Kmm) 
     3421      END IF 
     3422      ! 
     3423      ! Code saving tracer trends removed, replace with trdmxl_oce 
     3424      ! 
     3425      DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! Add non-local u and v fluxes 
     3426         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs) - ( ghamu(ji,jj,jk  ) -   & 
     3427            &                                         ghamu(ji,jj,jk+1) ) / e3u(ji,jj,jk,Kmm) 
     3428         pvv(ji,jj,jk,Krhs) =  pvv(ji,jj,jk,Krhs) - ( ghamv(ji,jj,jk  ) -   & 
     3429            &                                         ghamv(ji,jj,jk+1) ) / e3v(ji,jj,jk,Kmm) 
    28883430      END_3D 
    28893431      ! 
    2890       ! code for saving tracer trends removed 
     3432      ! Code for saving tracer trends removed 
    28913433      ! 
    28923434   END SUBROUTINE dyn_osm 
    28933435 
     3436   SUBROUTINE zdf_osm_iomput_2d( cdname, posmdia2d ) 
     3437      !!---------------------------------------------------------------------- 
     3438      !!                ***  ROUTINE zdf_osm_iomput_2d  *** 
     3439      !! 
     3440      !! ** Purpose :   Wrapper for subroutine iom_put that accepts 2D arrays 
     3441      !!                with and without halo 
     3442      !! 
     3443      !!---------------------------------------------------------------------- 
     3444      CHARACTER(LEN=*),         INTENT(in   ) ::   cdname 
     3445      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   posmdia2d 
     3446      !!---------------------------------------------------------------------- 
     3447      ! 
     3448      IF ( ln_dia_osm .AND. iom_use( cdname ) ) THEN 
     3449         IF ( SIZE( posmdia2d, 1 ) == ntei-ntsi+1 .AND. SIZE( posmdia2d, 2 ) == ntej-ntsj+1 ) THEN   ! Halo absent 
     3450            osmdia2d(A2D(0)) = posmdia2d(:,:) 
     3451            CALL iom_put( cdname, osmdia2d(A2D(nn_hls)) ) 
     3452         ELSE   ! Halo present 
     3453            CALL iom_put( cdname, osmdia2d ) 
     3454         END IF 
     3455      END IF 
     3456      ! 
     3457   END SUBROUTINE zdf_osm_iomput_2d 
     3458 
     3459   SUBROUTINE zdf_osm_iomput_3d( cdname, posmdia3d ) 
     3460      !!---------------------------------------------------------------------- 
     3461      !!                ***  ROUTINE zdf_osm_iomput_3d  *** 
     3462      !! 
     3463      !! ** Purpose :   Wrapper for subroutine iom_put that accepts 3D arrays 
     3464      !!                with and without halo 
     3465      !! 
     3466      !!---------------------------------------------------------------------- 
     3467      CHARACTER(LEN=*),           INTENT(in   ) ::   cdname 
     3468      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   posmdia3d 
     3469      !!---------------------------------------------------------------------- 
     3470      ! 
     3471      IF ( ln_dia_osm .AND. iom_use( cdname ) ) THEN 
     3472         IF ( SIZE( posmdia3d, 1 ) == ntei-ntsi+1 .AND. SIZE( posmdia3d, 2 ) == ntej-ntsj+1 ) THEN   ! Halo absent 
     3473            osmdia3d(A2D(0),:) = posmdia3d(:,:,:) 
     3474            CALL iom_put( cdname, osmdia3d(A2D(nn_hls),:) ) 
     3475         ELSE   ! Halo present 
     3476            CALL iom_put( cdname, osmdia3d ) 
     3477         END IF 
     3478      END IF 
     3479      ! 
     3480   END SUBROUTINE zdf_osm_iomput_3d 
     3481 
    28943482   !!====================================================================== 
    28953483 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/ZDF/zdfphy.F90

    r14834 r14994  
    186186      IF( lk_top    .AND. ln_zdfnpc )   CALL ctl_stop( 'zdf_phy_init: npc scheme is not working with key_top' ) 
    187187      IF( lk_top    .AND. ln_zdfosm )   CALL ctl_warn( 'zdf_phy_init: osmosis gives no non-local fluxes for TOP tracers yet' ) 
    188       ! TEMP: [tiling] This change not necessary after finalisation of zdf_osm (not yet tiled) 
    189       IF( ln_tile   .AND. ln_zdfosm )   CALL ctl_warn( 'zdf_phy_init: osmosis does not yet work with tiling' ) 
    190188      IF( lk_top    .AND. ln_zdfmfc )   CALL ctl_stop( 'zdf_phy_init: Mass Flux scheme is not working with key_top' ) 
    191189      IF(lwp) THEN 
    … …  
    215213      IF( ioptio /= 1 )    CALL ctl_stop( 'zdf_phy_init: one and only one vertical diffusion option has to be defined ' ) 
    216214      IF( ln_isfcav ) THEN 
    217       IF( ln_zdfric .OR. ln_zdfgls )    CALL ctl_stop( 'zdf_phy_init: zdfric and zdfgls never tested with ice shelves cavities ' ) 
     215      IF( ln_zdfric )      CALL ctl_stop( 'zdf_phy_init: zdfric never tested with ice shelves cavities ' ) 
    218216      ENDIF 
    219217      !                                ! shear production term flag 
    … …  
    256254      INTEGER ::   ji, jj, jk   ! dummy loop indice 
    257255      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zsh2   ! shear production 
    258       ! TEMP: [tiling] This change not necessary after finalisation of zdf_osm (not yet tiled) 
    259       LOGICAL :: lskip 
    260256      !! --------------------------------------------------------------------- 
    261257      ! 
    262258      IF( ln_timing )   CALL timing_start('zdf_phy') 
    263  
    264       ! TEMP: [tiling] These changes not necessary after finalisation of zdf_osm (not yet tiled) 
    265       lskip = .FALSE. 
    266  
    267       IF( ln_tile .AND. nzdf_phy == np_OSM )  THEN 
    268          IF( ntile == 1 ) THEN 
    269             CALL dom_tile_stop( ldhold=.TRUE. ) 
    270          ELSE 
    271             lskip = .TRUE. 
    272          ENDIF 
    273       ENDIF 
    274259      ! 
    275260      IF( l_zdfdrg ) THEN     !==  update top/bottom drag  ==!   (non-linear cases) 
    … …  
    301286      ! 
    302287      CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level 
    303  
    304       ! TEMP: [tiling] These changes not necessary after finalisation of zdf_osm (not yet tiled) 
    305       IF( .NOT. lskip ) THEN 
    306          !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
    307          ! 
    308          ! NOTE: [tiling] the closure schemes (zdf_tke etc) will update avm_k. With tiling, the calculation of zsh2 on adjacent tiles then uses both updated (next timestep) and non-updated (current timestep) values of avm_k. To preserve results, we save a read-only copy of the "now" avm_k to use in the calculation of zsh2. 
    309          IF( l_zdfsh2 ) THEN        !* shear production at w-points (energy conserving form) 
    310             IF( ln_tile ) THEN 
    311                IF( ntile == 1 ) avm_k_n(:,:,:) = avm_k(:,:,:)     ! Preserve "now" avm_k for calculation of zsh2 
    312                CALL zdf_sh2( Kbb, Kmm, avm_k_n, &     ! <<== in 
    313                   &                     zsh2    )     ! ==>> out : shear production 
    314             ELSE 
    315                CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in 
    316                   &                     zsh2    )     ! ==>> out : shear production 
    317             ENDIF 
    318          ENDIF 
    319          ! 
    320          SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points 
    321          CASE( np_RIC )   ;   CALL zdf_ric( kt,      Kmm, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz 
    322          CASE( np_TKE )   ;   CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz 
    323          CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz 
    324          CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz 
     288      ! 
     289      !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
     290      ! 
     291      ! NOTE: [tiling] the closure schemes (zdf_tke etc) will update avm_k. With tiling, the calculation of zsh2 on adjacent tiles then uses both updated (next timestep) and non-updated (current timestep) values of avm_k. To preserve results, we save a read-only copy of the "now" avm_k to use in the calculation of zsh2. 
     292      IF( l_zdfsh2 ) THEN        !* shear production at w-points (energy conserving form) 
     293         IF( ln_tile ) THEN 
     294            IF( ntile == 1 ) avm_k_n(:,:,:) = avm_k(:,:,:)     ! Preserve "now" avm_k for calculation of zsh2 
     295            CALL zdf_sh2( Kbb, Kmm, avm_k_n, &     ! <<== in 
     296               &                     zsh2    )     ! ==>> out : shear production 
     297         ELSE 
     298            CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in 
     299               &                     zsh2    )     ! ==>> out : shear production 
     300         ENDIF 
     301      ENDIF 
     302      ! 
     303      SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points 
     304      CASE( np_RIC )   ;   CALL zdf_ric( kt,      Kmm, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz 
     305      CASE( np_TKE )   ;   CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz 
     306      CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz 
     307      CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz 
    325308   !     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value) 
    326309   !         ! avt_k and avm_k set one for all at initialisation phase 
    327310!!gm         avt(2:jpim1,2:jpjm1,1:jpkm1) = rn_avt0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
    328311!!gm         avm(2:jpim1,2:jpjm1,1:jpkm1) = rn_avm0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
    329          END SELECT 
    330  
    331          IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE. ) 
    332       ENDIF 
     312      END SELECT 
    333313      ! 
    334314      !                          !==  ocean Kz  ==!   (avt, avs, avm) 
    … …  
    395375      ENDIF 
    396376      ! 
     377      ! diagnostics of energy dissipation 
     378      IF( iom_use('avt_k') .OR. iom_use('avm_k') .OR. iom_use('eshear_k') .OR. iom_use('estrat_k') ) THEN 
     379         IF( l_zdfsh2 ) THEN 
     380            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     381               zsh2(ji,jj,1  ) = 0._wp 
     382               zsh2(ji,jj,jpk) = 0._wp 
     383            END_2D 
     384            CALL iom_put( 'avt_k'   ,   avt_k       * wmask ) 
     385            CALL iom_put( 'avm_k'   ,   avm_k       * wmask ) 
     386            CALL iom_put( 'eshear_k',   zsh2        * wmask ) 
     387            CALL iom_put( 'estrat_k', - avt_k * rn2 * wmask ) 
     388         ENDIF 
     389      ENDIF 
     390      ! 
    397391      IF( ln_timing )   CALL timing_stop('zdf_phy') 
    398392      ! 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/ZDF/zdfric.F90

    r14834 r14994  
    5151   !! * Substitutions 
    5252#  include "do_loop_substitute.h90" 
     53#  include "domzgr_substitute.h90" 
    5354   !!---------------------------------------------------------------------- 
    5455   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/ZDF/zdftke.F90

    r14834 r14994  
    219219      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zice_fra, zhlc, zus3, zWlc2 
    220220      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zpelc, zdiag, zd_up, zd_lw 
     221      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztmp ! for diags 
    221222      !!-------------------------------------------------------------------- 
    222223      ! 
    … …  
    446447         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 
    447448      END_3D 
     449      ! 
     450      ! Kolmogorov energy of dissipation (W/kg) 
     451      !    ediss = Ce*sqrt(en)/L*en 
     452      !    dissl = sqrt(en)/L 
     453      IF( iom_use('ediss_k') ) THEN 
     454         ALLOCATE( ztmp(A2D(nn_hls),jpk) ) 
     455         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     456            ztmp(ji,jj,jk) = zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk) * wmask(ji,jj,jk) 
     457         END_3D 
     458         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     459            ztmp(ji,jj,jpk) = 0._wp 
     460         END_2D 
     461         CALL iom_put( 'ediss_k', ztmp ) 
     462         DEALLOCATE( ztmp ) 
     463      ENDIF 
    448464      ! 
    449465      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/do_loop_substitute.h90

    r14834 r14994  
    6161#define DO_2D(L, R, B, T) DO jj = ntsj-(B), ntej+(T) ; DO ji = ntsi-(L), ntei+(R) 
    6262#define DO_2D_OVR(L, R, B, T) DO_2D(L-(L+R)*nthl, R-(R+L)*nthr, B-(B+T)*nthb, T-(T+B)*ntht) 
    63 #define A1Di(H) ntsi-H:ntei+H 
    64 #define A1Dj(H) ntsj-H:ntej+H 
     63#define A1Di(H) ntsi-(H):ntei+(H) 
     64#define A1Dj(H) ntsj-(H):ntej+(H) 
    6565#define A2D(H) A1Di(H),A1Dj(H) 
    6666#define A1Di_T(T) (ntsi-nn_hls-1)*T+1: 

  • NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/par_oce.F90

    r14834 r14994  
    4747   ! global domain size for AGRIF     !!! * total AGRIF computational domain * 
    4848   INTEGER, PUBLIC            ::   nbug_in_agrif_conv_do_not_remove_or_modify = 1 - 1 
    49    INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 3   !: number of ghost cells: default value 
     49   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 4   !: number of ghost cells: default value 
    5050   INTEGER, PUBLIC            ::   nbghostcells_x     !: number of ghost cells in i-direction 
    5151   INTEGER, PUBLIC            ::   nbghostcells_y_s   !: number of ghost cells in j-direction at south 

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/CANAL/EXPREF/file_def_nemo-oce.xml

    r14224 r14994  
    2626     <field field_ref="utau"  /> 
    2727     <field field_ref="uoce" /> 
    28      <field_group group_ref="trendU"  />   
    2928   </file> 
    3029    
    … …  
    3231     <field field_ref="vtau"  /> 
    3332     <field field_ref="voce" /> 
    34      <field_group group_ref="trendV"  />   
    3533   </file> 
    3634    

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/DOME/EXPREF/AGRIF_FixedGrids.in

    r14216 r14994  
    111 
    2 278 358 88 162 2 2 2    
     2281 361 91 169 2 2 2    
    330 

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/DOME/MY_SRC/usrdef_hgr.F90

    r14254 r14994  
    2323   IMPLICIT NONE 
    2424   PRIVATE 
     25 
     26   REAL(wp) :: roffsetx, roffsety ! Offset in km to first f-point 
    2527 
    2628   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    … …  
    6466      ! 
    6567      INTEGER  ::   ji, jj     ! dummy loop indices 
    66       REAL(wp) ::   zphi0, zlam0  
    6768      REAL(wp) ::   zti, ztj   ! local scalars 
    6869      !!------------------------------------------------------------------------------- 
    … …  
    7778      ! Position coordinates (in kilometers) 
    7879      !                          ========== 
    79       zlam0 = -REAL( 0.5 + 1700._wp * 1.e3 / rn_dx) 
    80       zphi0 = -REAL( 0.5 +  800._wp * 1.e3 / rn_dy) 
     80      ! Offsets in km of the first south west f-point:  
     81      roffsetx = -1700._wp 
     82      roffsety =  -800._wp  
    8183#if defined key_agrif 
    82       IF( .NOT.Agrif_Root() ) THEN  
    83          zlam0 = - REAL( 0.5 + 1700._wp * 1.e3 / rn_dx + nbghostcells) & 
    84                & + REAL((nbghostcells + Agrif_Ix() - 1)*Agrif_irhox())   
    85          zphi0 = - REAL( 0.5 +  800._wp * 1.e3 / rn_dy + nbghostcells) & 
    86                & + REAL((nbghostcells + Agrif_Iy() - 1)*Agrif_irhoy())   
    87       ENDIF  
     84      IF( .NOT.Agrif_Root() ) THEN 
     85         ! deduce offset from parent: 
     86         roffsetx = Agrif_Parent(roffsetx) & 
     87              & + (-(nbghostcells_x   - 1) + (Agrif_Parent(nbghostcells_x  ) & 
     88              & + Agrif_Ix()-2)*Agrif_Rhox()) * 1.e-3 * rn_dx 
     89         roffsety = Agrif_Parent(roffsety) & 
     90              & + (-(nbghostcells_y_s - 1) + (Agrif_Parent(nbghostcells_y_s) & 
     91              & + Agrif_Iy()-2)*Agrif_Rhoy()) * 1.e-3 * rn_dy 
     92      ENDIF 
    8893#endif 
    8994          
    90       DO_2D( 1, 1, 1, 1 ) 
    91          zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
    92          ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
     95      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     96         zti = REAL( mig0(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     97         ztj = REAL( mjg0(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
    9398          
    94          plamt(ji,jj) = rn_dx * 1.e-3 * ( zlam0 + zti ) 
    95          plamu(ji,jj) = rn_dx * 1.e-3 * ( zlam0 + zti + 0.5_wp ) 
     99         plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp ) 
     100         plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 *   zti  
    96101         plamv(ji,jj) = plamt(ji,jj)  
    97102         plamf(ji,jj) = plamu(ji,jj)  
    98103          
    99          pphit(ji,jj) = rn_dy * 1.e-3 * ( zphi0 + ztj ) 
    100          pphiv(ji,jj) = rn_dy * 1.e-3 * ( zphi0 + ztj + 0.5_wp ) 
     104         pphit(ji,jj) = roffsety + rn_dy * 1.e-3 * ( ztj - 0.5_wp ) 
     105         pphiv(ji,jj) = roffsety + rn_dy * 1.e-3 *   ztj 
    101106         pphiu(ji,jj) = pphit(ji,jj)  
    102107         pphif(ji,jj) = pphiv(ji,jj)  

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/DOME/MY_SRC/usrdef_nam.F90

    r14433 r14994  
    6060      ! 
    6161      INTEGER ::   ios          ! Local integer 
     62      INTEGER ::   ighost_w, ighost_e, ighost_s, ighost_n 
    6263      REAL(wp)::   zlx, zly, zh ! Local scalars 
    6364      !! 
    … …  
    7475         rn_dx = Agrif_Parent(rn_dx)/Agrif_Rhox() 
    7576         rn_dy = Agrif_Parent(rn_dy)/Agrif_Rhoy() 
    76          rn_dz = Agrif_Parent(rn_dz) 
    7777         rn_f0 = Agrif_Parent(rn_f0) 
    7878      ENDIF 
    … …  
    8484      kk_cfg = nINT( rn_dx ) 
    8585      ! 
     86#if defined key_agrif  
    8687      IF( Agrif_Root() ) THEN       ! Global Domain size:  DOME  global domain is  2000 km x 850 Km x 3600 m 
     88#endif 
    8789         kpi = NINT( 2000.e3  / rn_dx ) + 2   
    8890         kpj = NINT(  850.e3  / rn_dy ) + 2 + 1  
     91#if defined key_agrif  
    8992      ELSE                          ! Global Domain size: add nbghostcells + 1 "land" point on each side 
    90          kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
    91          kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
    92 !!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
    93 !!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
     93         ! At this stage, child ghosts have not been set 
     94         ighost_w = nbghostcells 
     95         ighost_e = nbghostcells 
     96         ighost_s = nbghostcells 
     97         ighost_n = nbghostcells 
     98 
     99         IF  ( Agrif_Ix() == 1 ) ighost_w = 1  
     100         IF  ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo)-1 ) ighost_e = 1  
     101         IF  ( Agrif_Iy() == 1 ) ighost_s = 1  
     102         IF  ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo)-1 ) ighost_n = 1  
     103         kpi  = nbcellsx + ighost_w + ighost_e 
     104         kpj  = nbcellsy + ighost_s + ighost_n 
     105!! JC: number of ghosts are unknown at this stage ! 
     106!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x    
     107!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n  
    94108      ENDIF 
     109#endif 
    95110      kpk = NINT( 3600._wp / rn_dz ) + 1 
    96111      ! 

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/DOME/MY_SRC/usrdef_zgr.F90

    r14433 r14994  
    193193            pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1)            ! st caution ik > 1 
    194194         END_2D          
    195          !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points 
    196          !                                   ! usually Computed as the minimum of neighbooring scale factors 
    197          pe3u (:,:,:) = pe3t(:,:,:)          ! HERE DOME configuration :  
    198          pe3v (:,:,:) = pe3t(:,:,:)          !    e3 increases with i-index and identical with j-index 
    199          pe3f (:,:,:) = pe3t(:,:,:)          !    so e3 minimum of (i,i+1) points is (i) point 
    200          pe3uw(:,:,:) = pe3w(:,:,:)          !    in j-direction e3v=e3t and e3f=e3v 
    201          pe3vw(:,:,:) = pe3w(:,:,:)          !    ==>>  no need of lbc_lnk calls 
     195         ! 
     196         DO_3D( 0, 0, 0, 0, 1, jpk )  
     197               pe3u (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji+1,jj,jk) ) 
     198               pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) 
     199               pe3uw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji+1,jj,jk) ) 
     200               pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) 
     201         END_3D  
     202         ! 
     203         CALL lbc_lnk('usrdef_zgr', pe3u , 'U', 1._wp, pe3uw, 'U', 1._wp )    
     204         CALL lbc_lnk('usrdef_zgr', pe3v , 'V', 1._wp, pe3vw, 'V', 1._wp )  
     205         ! 
     206         DO jk = 1, jpk                  
     207            WHERE( pe3u (:,:,jk) == 0._wp )   pe3u (:,:,jk) = pe3t_1d(jk) 
     208            WHERE( pe3v (:,:,jk) == 0._wp )   pe3v (:,:,jk) = pe3t_1d(jk) 
     209            WHERE( pe3uw(:,:,jk) == 0._wp )   pe3uw(:,:,jk) = pe3w_1d(jk) 
     210            WHERE( pe3vw(:,:,jk) == 0._wp )   pe3vw(:,:,jk) = pe3w_1d(jk) 
     211         END DO 
     212 
     213         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     214               pe3f(ji,jj,jk) = MIN( pe3v(ji,jj,jk), pe3v(ji+1,jj,jk) ) 
     215         END_3D 
     216         CALL lbc_lnk('usrdef_zgr', pe3f, 'F', 1._wp )       
    202217         !       
    203218      ENDIF 

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/ICE_AGRIF/EXPREF/AGRIF_FixedGrids.in

    r13286 r14994  
    111 
    2 33 62 33 62 3 3 3 
     234 63 34 63 3 3 3 
    330 

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/ICE_AGRIF/EXPREF/make_INITICE.py

    r10516 r14994  
    2020# Reading coordinates file 
    2121nccoord=netcdf(fcoord,'r') 
    22 nav_lon=nccoord.variables['nav_lon'] 
    23 nav_lat=nccoord.variables['nav_lat'] 
     22nav_lon=nccoord.variables['x'] 
     23nav_lat=nccoord.variables['y'] 
    2424time_counter=1 
    2525LON1= nav_lon.shape[1] 

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90

    r14223 r14994  
    2323   IMPLICIT NONE 
    2424   PRIVATE 
     25 
     26   REAL(wp) :: roffsetx, roffsety ! Offset in km to first f-point 
    2527 
    2628   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    … …  
    5052      !!                without Coriolis force (f=0) 
    5153      !! 
    52       !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees)  
     54      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in kms)  
    5355      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane) 
    5456      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters) 
    … …  
    6567      ! 
    6668      INTEGER  ::   ji, jj     ! dummy loop indices 
    67       REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
     69      REAL(wp) ::   zbeta, zf0 
    6870      REAL(wp) ::   zti, ztj   ! local scalars 
    6971      !!------------------------------------------------------------------------------- 
    … …  
    7476      IF(lwp) WRITE(numout,*) '          f-plane with irregular grid-spacing (+- 10%)' 
    7577      IF(lwp) WRITE(numout,*) '          the max is given by rn_dx and rn_dy'  
     78      ! 
     79      ! 
     80      ! Position coordinates (in kilometers) 
     81      !                          ========== 
     82      ! Offset is given at first f-point, i.e. at (i,j) = (nn_hls+1, nn_hls+1) 
     83      ! Here we assume the grid is centred around a T-point at the middle of 
     84      ! of the domain (hence domain size is odd) 
     85      roffsetx = (-REAL(Ni0glo-1, wp) + 1._wp) * 0.5 * 1.e-3 * rn_dx 
     86      roffsety = (-REAL(Nj0glo-1, wp) + 1._wp) * 0.5 * 1.e-3 * rn_dy 
     87#if defined key_agrif 
     88      IF( .NOT.Agrif_Root() ) THEN 
     89         ! deduce offset from parent: 
     90         roffsetx = Agrif_Parent(roffsetx) & 
     91            & + (-(nbghostcells_x   - 1) + (Agrif_Parent(nbghostcells_x  ) & 
     92            & + Agrif_Ix()-2)*Agrif_Rhox()) * 1.e-3 * rn_dx 
     93         roffsety = Agrif_Parent(roffsety) & 
     94            & + (-(nbghostcells_y_s - 1) + (Agrif_Parent(nbghostcells_y_s) & 
     95            & + Agrif_Iy()-2)*Agrif_Rhoy()) * 1.e-3 * rn_dy 
     96      ENDIF 
     97#endif 
     98      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     99         zti = REAL( mig0(ji)-1, wp )  ! start at i=0 in the global grid without halos 
     100         ztj = REAL( mjg0(jj)-1, wp )  ! start at j=0 in the global grid without halos 
    76101 
    77       !                          ========== 
    78 #if defined key_agrif  
    79       IF( Agrif_Root() ) THEN 
    80 #endif 
    81          zlam0 = -REAL(Ni0glo, wp) * 0.5 * 1.e-3 * rn_dx 
    82          zphi0 = -REAL(Nj0glo, wp) * 0.5 * 1.e-3 * rn_dy 
    83 #if defined key_agrif  
    84       ELSE 
    85          ! ! let lower left longitude and latitude from parent 
    86 !clem         zlam0  = Agrif_Parent(zlam0) + (Agrif_ix())*Agrif_Parent(rn_dx) * 1.e-5 
    87 !clem         zphi0  = Agrif_Parent(zphi0) + (Agrif_iy())*Agrif_Parent(rn_dy) * 1.e-5 
    88          zlam0 = ( 0.5_wp - REAL(Ni0glo, wp) * 0.5 ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
    89             &  + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 
    90          zphi0 = ( 0.5_wp - REAL(Nj0glo, wp) * 0.5 ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
    91             &  + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 
    92       ENDIF 
    93 #endif          
     102         plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp ) 
     103         plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 *   zti 
     104         plamv(ji,jj) = plamt(ji,jj) 
     105         plamf(ji,jj) = plamu(ji,jj) 
    94106 
    95       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    96          zti = REAL( mig0(ji), wp ) - 0.5_wp  ! start at i=0.5 in the global grid without halos 
    97          ztj = REAL( mjg0(jj), wp ) - 0.5_wp  ! start at j=0.5 in the global grid without halos 
    98            
    99          plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
    100          plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
    101          plamv(ji,jj) = plamt(ji,jj)  
    102          plamf(ji,jj) = plamu(ji,jj)  
    103           
    104          pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
    105          pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
    106          pphiu(ji,jj) = pphit(ji,jj)  
    107          pphif(ji,jj) = pphiv(ji,jj)  
     107         pphit(ji,jj) = roffsety + rn_dy * 1.e-3 * ( ztj - 0.5_wp ) 
     108         pphiv(ji,jj) = roffsety + rn_dy * 1.e-3 *   ztj 
     109         pphiu(ji,jj) = pphit(ji,jj) 
     110         pphif(ji,jj) = pphiv(ji,jj) 
    108111      END_2D 
    109           
    110          ! Horizontal scale factors (in meters) 
    111          !                              ====== 
     112      ! 
     113      ! Horizontal scale factors (in meters) 
     114      !                              ====== 
    112115!! ==> EITHER 1) variable scale factors 
    113116!! clem: This can be used with a 1proc simulation but I think it breaks repro when >1procs are used       

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90

    r14433 r14994  
    8888         kpj = NINT( 300.e3 / rn_dy ) - 3 
    8989      ELSE                           ! Global Domain size: add nbghostcells + 1 "land" point on each side 
    90          kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
    91          kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     90         kpi  = nbcellsx + 2 * nbghostcells 
     91         kpj  = nbcellsy + 2 * nbghostcells 
     92!! JC: number of ghosts unknown at this tage 
    9293!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
    9394!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/VORTEX/EXPREF/AGRIF_FixedGrids.in

    r9787 r14994  
    111 
    2 19 38 19 38 3 3 3  
     222 41 22 41 3 3 3  
    330 

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/VORTEX/MY_SRC/usrdef_hgr.F90

    r14223 r14994  
    2323   IMPLICIT NONE 
    2424   PRIVATE 
     25 
     26   REAL(wp) :: roffsetx, roffsety ! Offset in km to first f-point 
    2527 
    2628   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    … …  
    6466      ! 
    6567      INTEGER  ::   ji, jj     ! dummy loop indices 
    66       REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
     68      REAL(wp) ::   zbeta, zf0 
    6769      REAL(wp) ::   zti, ztj   ! local scalars 
    6870      !!------------------------------------------------------------------------------- 
    … …  
    7779      ! Position coordinates (in kilometers) 
    7880      !                          ========== 
    79 #if defined key_agrif  
    80       IF( Agrif_Root() ) THEN 
    81 #endif 
    82          zlam0 = -REAL(Ni0glo, wp) * 0.5 * 1.e-3 * rn_dx 
    83          zphi0 = -REAL(Nj0glo, wp) * 0.5 * 1.e-3 * rn_dy 
     81      ! offset is given at first f-point, i.e. at (i,j) = (nn_hls+1, nn_hls+1) 
     82      ! Here we assume the grid is centred around a T-point at the middle of 
     83      ! of the domain (hence domain size is odd)  
     84      roffsetx = (-REAL(Ni0glo-1, wp) + 1._wp) * 0.5 * 1.e-3 * rn_dx 
     85      roffsety = (-REAL(Nj0glo-1, wp) + 1._wp) * 0.5 * 1.e-3 * rn_dy 
    8486#if defined key_agrif 
    85       ELSE 
    86          ! ! let lower left longitude and latitude from parent 
    87          zlam0 = ( 0.5_wp - REAL(Ni0glo, wp) * 0.5 ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
    88             &  + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 
    89          zphi0 = ( 0.5_wp - REAL(Nj0glo, wp) * 0.5 ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
    90             &  + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 
    91       ENDIF  
    92 #endif 
     87      IF( .NOT.Agrif_Root() ) THEN 
     88         ! deduce offset from parent: 
     89         roffsetx = Agrif_Parent(roffsetx) & 
     90                  & + (-(nbghostcells_x   - 1) + (Agrif_Parent(nbghostcells_x  ) + Agrif_Ix()-2)*Agrif_Rhox()) * 1.e-3 * rn_dx 
     91         roffsety = Agrif_Parent(roffsety) & 
     92                  & + (-(nbghostcells_y_s - 1) + (Agrif_Parent(nbghostcells_y_s) + Agrif_Iy()-2)*Agrif_Rhoy()) * 1.e-3 * rn_dy 
     93      ENDIF 
     94#endif          
     95      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     96         zti = REAL( mig0(ji)-1, wp )  ! start at i=0 in the global grid without halos 
     97         ztj = REAL( mjg0(jj)-1, wp )  ! start at j=0 in the global grid without halos 
    9398          
    94       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    95          zti = REAL( mig0(ji), wp ) - 0.5_wp  ! start at i=0.5 in the global grid without halos 
    96          ztj = REAL( mjg0(jj), wp ) - 0.5_wp  ! start at j=0.5 in the global grid without halos 
    97           
    98          plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
    99          plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
     99         plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp ) 
     100         plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 *   zti  
    100101         plamv(ji,jj) = plamt(ji,jj)  
    101102         plamf(ji,jj) = plamu(ji,jj)  
    102103          
    103          pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
    104          pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
     104         pphit(ji,jj) = roffsety + rn_dy * 1.e-3 * ( ztj - 0.5_wp ) 
     105         pphiv(ji,jj) = roffsety + rn_dy * 1.e-3 *   ztj  
    105106         pphiu(ji,jj) = pphit(ji,jj)  
    106107         pphif(ji,jj) = pphiv(ji,jj)  

  • NEMO/branches/2021/ticket2669_isf_fluxes/tests/VORTEX/MY_SRC/usrdef_nam.F90

    r14433 r14994  
    6060      ! 
    6161      INTEGER ::   ios          ! Local integer 
     62      INTEGER :: ighost_n, ighost_s, ighost_w, ighost_e 
    6263      REAL(wp)::   zlx, zly, zh ! Local scalars 
    6364      !! 
    … …  
    8384      kk_cfg = nINT( rn_dx ) 
    8485      ! 
     86#if defined key_agrif  
    8587      IF( Agrif_Root() ) THEN       ! Global Domain size:  VORTEX global domain is  1800 km x 1800 Km x 5000 m 
     88#endif 
    8689         kpi = NINT( 1800.e3  / rn_dx ) + 3   
    8790         kpj = NINT( 1800.e3  / rn_dy ) + 3  
     91#if defined key_agrif  
    8892      ELSE                          ! Global Domain size: add nbghostcells + 1 "land" point on each side 
    89          kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
    90          kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
    91 !!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
    92 !!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
     93         ! At this stage, child ghosts have not been set 
     94         ighost_w = nbghostcells 
     95         ighost_e = nbghostcells 
     96         ighost_s = nbghostcells 
     97         ighost_n = nbghostcells 
     98 
     99         IF  ( Agrif_Ix() == 1 ) ighost_w = 1  
     100         IF  ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) - 1 ) ighost_e = 1  
     101         IF  ( Agrif_Iy() == 1 ) ighost_s = 1  
     102         IF  ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) - 1 ) ighost_n = 1  
     103!         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     104!         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     105         kpi  = nbcellsx + ighost_w + ighost_e  
     106         kpj  = nbcellsy + ighost_s + ighost_n 
    93107      ENDIF 
     108#endif 
    94109      kpk = NINT( 5000._wp / rn_dz ) + 1 
    95110      ! 
Note: See TracChangeset for help on using the changeset viewer.