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

Changeset 14054


Ignore:
Timestamp:
2020-12-03T14:55:50+01:00 (3 years ago)
Author:
ayoung
Message:

Updated to trunk at 14052. No conflicts since last sette test at 14034. Ticket #2567.

Location:
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC
Files:
21 deleted
109 edited
9 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

    r13558 r14054  
    299299!----------------------------------------------------------------------- 
    300300   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    301       nn_een_e3f = 0          ! =0   e3f = mean masked e3t divided by 4 
    302301/ 
    303302!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r13558 r14054  
    300300!----------------------------------------------------------------------- 
    301301   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    302       nn_een_e3f = 0          ! =0   e3f = mean masked e3t divided by 4 
    303302/ 
    304303!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/AMM12/EXPREF/namelist_cfg

    r13558 r14054  
    291291!----------------------------------------------------------------------- 
    292292   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    293       nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
     293   nn_e3f_typ = 1          !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    294294/ 
    295295!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r14049 r14054  
    334334!----------------------------------------------------------------------- 
    335335   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    336       nn_een_e3f = 0          ! =0   e3f = mean masked e3t divided by 4 
    337336/ 
    338337!----------------------------------------------------------------------- 
    … …  
    389388      !                       !                 = 3 as =2 with distinct dissipative an mixing length scale 
    390389      nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to NIWs 
    391                                !        = 0 none ; = 1 add a tke source below the ML 
    392                                !        = 2 add a tke source just at the base of the ML 
    393                                !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
     390      !                       !        = 0 none ; = 1 add a tke source below the ML 
     391      !                       !        = 2 add a tke source just at the base of the ML 
     392      !                       !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
    394393      ln_mxhsw    = .false.   !  surface mixing length scale = F(wave height) 
    395394/ 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_top_cfg

    r12845 r14054  
    2020! 
    2121   ln_trcdta     =  .true.  !  Initialisation from data input file (T) or not (F) 
    22    ln_trcbc      =  .false. !  Enables Boundary conditions 
     22   ln_trcbc      =  .true. !  Enables Boundary conditions 
    2323!                !           !                                           !             !         ! 
    24 !                !    name   !           title of the field              !   units     ! init    ! sbc    ! cbc    !  obc  !  
    25    sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' , .true.  , .false., .true. , .false.  
    26    sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   , .true.  , .false., .true. , .false. 
    27    sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' , .true.  , .false., .false., .false.  
    28    sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' , .false. , .false., .false., .false. 
    29    sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' , .true.  , .true. , .true. , .false. 
    30    sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' , .false. , .false., .false., .false. 
    31    sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' , .true.  , .true. , .true. , .false. 
    32    sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' , .false. , .false., .false., .false. 
    33    sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' , .false. , .false., .false., .false. 
    34    sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' , .true.  , .false., .true. , .false. 
    35    sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' , .false. , .false., .false., .false. 
    36    sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' , .false. , .false., .false., .false. 
    37    sn_tracer(13)  = 'DSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' , .false. , .false., .false., .false. 
    38    sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' , .true.  , .true. , .true. , .false. 
    39    sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. 
    40    sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. 
    41    sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' , .false. , .false., .false., .false. 
    42    sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' , .false. , .false., .false., .false. 
    43    sn_tracer(19)  = 'GSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' , .false. , .false., .false., .false. 
    44    sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' , .false. , .false., .false., .false. 
    45    sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' , .false. , .false., .false., .false. 
    46    sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. 
    47    sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' , .true.  , .true. , .true. , .false. 
    48    sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' , .false. , .false., .false., .false. 
     24!                !    name   !           title of the field              !   units     ! init    ! sbc    ! cbc    !  obc    !  ais 
     25   sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' , .true.  , .false., .true. , .false. , .false. 
     26   sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   , .true.  , .false., .true. , .false. , .false. 
     27   sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' , .true.  , .false., .false., .false. , .false. 
     28   sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     29   sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' , .true.  , .true. , .true. , .false. , .false. 
     30   sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     31   sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' , .true.  , .true. , .true. , .false. , .false. 
     32   sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     33   sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     34   sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' , .true.  , .false., .true. , .false. , .false. 
     35   sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     36   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     37   sn_tracer(13)  = 'DSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     38   sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' , .true.  , .true. , .true. , .false. , .true. 
     39   sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     40   sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     41   sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     42   sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     43   sn_tracer(19)  = 'GSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     44   sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     45   sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     46   sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     47   sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' , .true.  , .true. , .true. , .false. , .false. 
     48   sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
    4949/ 
    5050!----------------------------------------------------------------------- 
    … …  
    5757!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    5858!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    59    sn_trcdta(1)  = 'data_DIC_nomask'        ,        -12.       ,  'DIC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , '' 
    60    sn_trcdta(2)  = 'data_Alkalini_nomask'   ,        -12.       ,  'Alkalini',    .false.   , .true. , 'yearly'  , ''       , ''   , '' 
    61    sn_trcdta(3)  = 'data_O2_nomask'         ,        -1.        ,  'O2'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , '' 
    62    sn_trcdta(5)  = 'data_PO4_nomask'        ,        -1.        ,  'PO4'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , '' 
    63    sn_trcdta(7)  = 'data_Si_nomask'         ,        -1.        ,  'Si'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , '' 
    64    sn_trcdta(10) = 'data_DOC_nomask'        ,        -12.       ,  'DOC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , '' 
    65    sn_trcdta(14) = 'data_Fer_nomask'        ,        -12.       ,  'Fer'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , '' 
    66    sn_trcdta(23) = 'data_NO3_nomask'        ,        -1.        ,  'NO3'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , '' 
    67    rn_trfac(1)   =   1.0e-06  !  multiplicative factor 
    68    rn_trfac(2)   =   1.0e-06  !  -      -      -     - 
     59   sn_trcdta(1)  = 'data_DIC_nomask.nc',        -12        ,  'PiDIC'  ,    .false.   , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     60   sn_trcdta(2)  = 'data_ALK_nomask.nc',        -12        ,  'TALK'   ,    .false.   , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     61   sn_trcdta(3)  = 'data_OXY_nomask.nc',        -1         ,  'O2'     ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     62   sn_trcdta(5)  = 'data_PO4_nomask.nc',        -1         ,  'PO4'    ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     63   sn_trcdta(7)  = 'data_SIL_nomask.nc',        -1         ,  'Si'     ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     64   sn_trcdta(10) = 'data_DOC_nomask.nc',        -1         ,  'DOC'    ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     65   sn_trcdta(14) = 'data_FER_nomask.nc',        -1         ,  'Fer'    ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     66   sn_trcdta(23) = 'data_NO3_nomask.nc',        -1         ,  'NO3'    ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     67   rn_trfac(1)   =   1.028e-06  !  multiplicative factor 
     68   rn_trfac(2)   =   1.028e-06  !  -      -      -     - 
    6969   rn_trfac(3)   =  44.6e-06  !  -      -      -     - 
    7070   rn_trfac(5)   = 122.0e-06  !  -      -      -     - 
    7171   rn_trfac(7)   =   1.0e-06  !  -      -      -     - 
    72    rn_trfac(10)  =   1.0      !  -      -      -     - 
    73    rn_trfac(14)  =   1.0      !  -      -      -     - 
     72   rn_trfac(10)  =   1.0e-06  !  -      -      -     - 
     73   rn_trfac(14)  =   1.0e-06  !  -      -      -     - 
    7474   rn_trfac(23)  =   7.6e-06  !  -      -      -     - 
    7575/ 
    … …  
    110110!                !  file name        ! frequency (hours) ! variable      ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    111111!                !                   !  (if <0  months)  !   name        !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    112    sn_trcsbc(5)  = 'dust.orca.new'   ,       -1          , 'dustpo4'     ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    113    sn_trcsbc(7)  = 'dust.orca.new'   ,       -1          , 'dustsi'      ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    114    sn_trcsbc(14) = 'dust.orca.new'   ,       -1          , 'dustfer'     ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    115    sn_trcsbc(23) = 'ndeposition.orca',      -12          , 'ndep'        ,  .false.     , .true. , 'yearly'  , ''       , ''    , '' 
     112   sn_trcsbc(5)  = 'dust.orca.new'   ,       -1          , 'dustpo4'     ,  .true.      , .true. , 'yearly'  , 'weights_2D_r360x180_bilin.nc'       , ''    , '' 
     113   sn_trcsbc(7)  = 'dust.orca.new'   ,       -1          , 'dustsi'      ,  .true.      , .true. , 'yearly'  , 'weights_2D_r360x180_bilin.nc'       , ''    , '' 
     114   sn_trcsbc(14) = 'dust.orca.new'   ,       -1          , 'dustfer'     ,  .true.      , .true. , 'yearly'  , 'weights_2D_r360x180_bilin.nc'       , ''    , '' 
     115   sn_trcsbc(23) = 'ndeposition.orca',      -12          , 'ndep2'       ,  .false.     , .true. , 'yearly'  , 'weights_2D_r360x180_bilin.nc'       , ''    , '' 
    116116   rn_trsfac(5)  = 8.264e-02   !  (  0.021 / 31. * 122 ) 
    117117   rn_trsfac(7)  = 3.313e-01     !  ( 8.8   / 28.1 ) 
    … …  
    120120   rn_sbc_time   =  1.          !  Time scaling factor for SBC and CBC data (seconds in a day) 
    121121   ! 
    122    sn_trccbc(1)  = 'river.orca'      ,    120            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    123    sn_trccbc(2)  = 'river.orca'      ,    120            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    124    sn_trccbc(5)  = 'river.orca'      ,    120            , 'riverdip'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    125    sn_trccbc(7)  = 'river.orca'      ,    120            , 'riverdsi'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    126    sn_trccbc(10) = 'river.orca'      ,    120            , 'riverdoc'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    127    sn_trccbc(14) = 'river.orca'      ,    120            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    128    sn_trccbc(23) = 'river.orca'      ,    120            , 'riverdin'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     122   sn_trccbc(1)  = 'river.orca'      ,    -12            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     123   sn_trccbc(2)  = 'river.orca'      ,    -12            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     124   sn_trccbc(5)  = 'river.orca'      ,    -12            , 'riverdip'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     125   sn_trccbc(7)  = 'river.orca'      ,    -12            , 'riverdsi'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     126   sn_trccbc(10) = 'river.orca'      ,    -12            , 'riverdoc'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     127   sn_trccbc(14) = 'river.orca'      ,    -12            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     128   sn_trccbc(23) = 'river.orca'      ,    -12            , 'riverdin'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    129129   rn_trcfac(1)  = 8.333e+01   !  ( data in Mg/m2/yr : 1e3/12/ryyss) 
    130130   rn_trcfac(2)  = 8.333e+01   !  ( 1e3 /12 ) 
    … …  
    140140!----------------------------------------------------------------------- 
    141141/ 
     142!----------------------------------------------------------------------- 
     143&namtrc_ais      !  Representation of Antarctic Ice Sheet tracers supply 
     144!----------------------------------------------------------------------- 
     145/ 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_top_cfg

    r12845 r14054  
    1919   ln_c14        =  .false. 
    2020! 
    21    ln_trcdta     =  .true.   !  Initialisation from data input file (T) or not (F) 
    22    ln_trcbc      =  .false.  !  Enables Boundary conditions 
     21   ln_trcdta     =  .true.  !  Initialisation from data input file (T) or not (F) 
     22   ln_trcbc      =  .true.  !  Enables Boundary conditions 
    2323!                !           !                                           !             !         ! 
    24 !                !    name   !           title of the field              !   units     ! init    ! sbc    ! cbc    !  obc  !  
    25    sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' , .true.  , .false., .true. , .false.  
    26    sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   , .true.  , .false., .true. , .false. 
    27    sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' , .true.  , .false., .false., .false.  
    28    sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' , .false. , .false., .false., .false. 
    29    sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' , .true.  , .true. , .true. , .false. 
    30    sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' , .false. , .false., .false., .false. 
    31    sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' , .true.  , .true. , .true. , .false. 
    32    sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' , .false. , .false., .false., .false. 
    33    sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' , .false. , .false., .false., .false. 
    34    sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' , .true.  , .false., .true. , .false. 
    35    sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' , .false. , .false., .false., .false. 
    36    sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' , .false. , .false., .false., .false. 
    37    sn_tracer(13)  = 'DSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' , .false. , .false., .false., .false. 
    38    sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' , .true.  , .true. , .true. , .false. 
    39    sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. 
    40    sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. 
    41    sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' , .false. , .false., .false., .false. 
    42    sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' , .false. , .false., .false., .false. 
    43    sn_tracer(19)  = 'GSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' , .false. , .false., .false., .false. 
    44    sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' , .false. , .false., .false., .false. 
    45    sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' , .false. , .false., .false., .false. 
    46    sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. 
    47    sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' , .true.  , .true. , .true. , .false. 
    48    sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' , .false. , .false., .false., .false. 
     24!                !    name   !           title of the field              !   units     ! init    ! sbc    ! cbc    !  obc    !  ais 
     25   sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' , .true.  , .false., .true. , .false. , .false. 
     26   sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   , .true.  , .false., .true. , .false. , .false. 
     27   sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' , .true.  , .false., .false., .false. , .false. 
     28   sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     29   sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' , .true.  , .true. , .true. , .false. , .false. 
     30   sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     31   sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' , .true.  , .true. , .true. , .false. , .false. 
     32   sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     33   sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     34   sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' , .true.  , .false., .true. , .false. , .false. 
     35   sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     36   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     37   sn_tracer(13)  = 'DSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     38   sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' , .true.  , .true. , .true. , .false. , .true. 
     39   sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     40   sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     41   sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     42   sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     43   sn_tracer(19)  = 'GSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     44   sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     45   sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     46   sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
     47   sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' , .true.  , .true. , .true. , .false. , .false. 
     48   sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' , .false. , .false., .false., .false. , .false. 
    4949/ 
    5050!----------------------------------------------------------------------- 
    … …  
    5757!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    5858!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    59    sn_trcdta(1)  = 'data_DIC_nomask'        ,        -12.       ,  'DIC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , '' 
    60    sn_trcdta(2)  = 'data_Alkalini_nomask'   ,        -12.       ,  'Alkalini',    .false.   , .true. , 'yearly'  , ''       , ''   , '' 
    61    sn_trcdta(3)  = 'data_O2_nomask'         ,        -1.        ,  'O2'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , '' 
    62    sn_trcdta(5)  = 'data_PO4_nomask'        ,        -1.        ,  'PO4'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , '' 
    63    sn_trcdta(7)  = 'data_Si_nomask'         ,        -1.        ,  'Si'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , '' 
    64    sn_trcdta(10) = 'data_DOC_nomask'        ,        -12.       ,  'DOC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , '' 
    65    sn_trcdta(14) = 'data_Fer_nomask'        ,        -12.       ,  'Fer'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , '' 
    66    sn_trcdta(23) = 'data_NO3_nomask'        ,        -1.        ,  'NO3'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , '' 
    67    rn_trfac(1)   =   1.0e-06  !  multiplicative factor 
    68    rn_trfac(2)   =   1.0e-06  !  -      -      -     - 
     59   sn_trcdta(1)  = 'data_DIC_nomask.nc',        -12        ,  'PiDIC'  ,    .false.   , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     60   sn_trcdta(2)  = 'data_ALK_nomask.nc',        -12        ,  'TALK'   ,    .false.   , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     61   sn_trcdta(3)  = 'data_OXY_nomask.nc',        -1         ,  'O2'     ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     62   sn_trcdta(5)  = 'data_PO4_nomask.nc',        -1         ,  'PO4'    ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     63   sn_trcdta(7)  = 'data_SIL_nomask.nc',        -1         ,  'Si'     ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     64   sn_trcdta(10) = 'data_DOC_nomask.nc',        -1         ,  'DOC'    ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     65   sn_trcdta(14) = 'data_FER_nomask.nc',        -1         ,  'Fer'    ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     66   sn_trcdta(23) = 'data_NO3_nomask.nc',        -1         ,  'NO3'    ,    .true.    , .true. , 'yearly'  , 'weights_3D_r360x180_bilin.nc'       , ''   , '' 
     67   rn_trfac(1)   =   1.028e-06  !  multiplicative factor 
     68   rn_trfac(2)   =   1.028e-06  !  -      -      -     - 
    6969   rn_trfac(3)   =  44.6e-06  !  -      -      -     - 
    7070   rn_trfac(5)   = 122.0e-06  !  -      -      -     - 
    7171   rn_trfac(7)   =   1.0e-06  !  -      -      -     - 
    72    rn_trfac(10)  =   1.0      !  -      -      -     - 
    73    rn_trfac(14)  =   1.0      !  -      -      -     - 
     72   rn_trfac(10)  =   1.0e-06  !  -      -      -     - 
     73   rn_trfac(14)  =   1.0e-06  !  -      -      -     - 
    7474   rn_trfac(23)  =   7.6e-06  !  -      -      -     - 
    7575/ 
    … …  
    110110!                !  file name        ! frequency (hours) ! variable      ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    111111!                !                   !  (if <0  months)  !   name        !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    112    sn_trcsbc(5)  = 'dust.orca.new'   ,       -1          , 'dustpo4'     ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    113    sn_trcsbc(7)  = 'dust.orca.new'   ,       -1          , 'dustsi'      ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    114    sn_trcsbc(14) = 'dust.orca.new'   ,       -1          , 'dustfer'     ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    115    sn_trcsbc(23) = 'ndeposition.orca',      -12          , 'ndep'        ,  .false.     , .true. , 'yearly'  , ''       , ''    , '' 
     112   sn_trcsbc(5)  = 'dust.orca.new'   ,       -1          , 'dustpo4'     ,  .true.      , .true. , 'yearly'  , 'weights_2D_r360x180_bilin.nc'       , ''    , '' 
     113   sn_trcsbc(7)  = 'dust.orca.new'   ,       -1          , 'dustsi'      ,  .true.      , .true. , 'yearly'  , 'weights_2D_r360x180_bilin.nc'       , ''    , '' 
     114   sn_trcsbc(14) = 'dust.orca.new'   ,       -1          , 'dustfer'     ,  .true.      , .true. , 'yearly'  , 'weights_2D_r360x180_bilin.nc'       , ''    , '' 
     115   sn_trcsbc(23) = 'ndeposition.orca',      -12          , 'ndep2'       ,  .false.     , .true. , 'yearly'  , 'weights_2D_r360x180_bilin.nc'       , ''    , '' 
    116116   rn_trsfac(5)  = 8.264e-02   !  (  0.021 / 31. * 122 ) 
    117117   rn_trsfac(7)  = 3.313e-01     !  ( 8.8   / 28.1 ) 
    … …  
    120120   rn_sbc_time   =  1.          !  Time scaling factor for SBC and CBC data (seconds in a day) 
    121121   ! 
    122    sn_trccbc(1)  = 'river.orca'      ,    120            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    123    sn_trccbc(2)  = 'river.orca'      ,    120            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    124    sn_trccbc(5)  = 'river.orca'      ,    120            , 'riverdip'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    125    sn_trccbc(7)  = 'river.orca'      ,    120            , 'riverdsi'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    126    sn_trccbc(10) = 'river.orca'      ,    120            , 'riverdoc'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    127    sn_trccbc(14) = 'river.orca'      ,    120            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    128    sn_trccbc(23) = 'river.orca'      ,    120            , 'riverdin'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     122   sn_trccbc(1)  = 'river.orca'      ,    -12            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     123   sn_trccbc(2)  = 'river.orca'      ,    -12            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     124   sn_trccbc(5)  = 'river.orca'      ,    -12            , 'riverdip'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     125   sn_trccbc(7)  = 'river.orca'      ,    -12            , 'riverdsi'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     126   sn_trccbc(10) = 'river.orca'      ,    -12            , 'riverdoc'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     127   sn_trccbc(14) = 'river.orca'      ,    -12            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
     128   sn_trccbc(23) = 'river.orca'      ,    -12            , 'riverdin'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , '' 
    129129   rn_trcfac(1)  = 8.333e+01   !  ( data in Mg/m2/yr : 1e3/12/ryyss) 
    130130   rn_trcfac(2)  = 8.333e+01   !  ( 1e3 /12 ) 
    … …  
    140140!----------------------------------------------------------------------- 
    141141/ 
     142!----------------------------------------------------------------------- 
     143&namtrc_ais      !  Representation of Antarctic Ice Sheet tracers supply 
     144!----------------------------------------------------------------------- 
     145/ 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/axis_def_nemo.xml

    r12377 r14054  
    1414      <axis id="depthv"  long_name="Vertical V levels" unit="m" positive="down" /> 
    1515      <axis id="depthw"  long_name="Vertical W levels" unit="m" positive="down" /> 
     16      <axis id="depthf"  long_name="Vertical F levels" unit="m" positive="down" /> 
    1617      <axis id="nfloat"  long_name="Float number"      unit="-"                 /> 
    1718      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               /> 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/domain_def_nemo.xml

    r12276 r14054  
    181181     <domain id="EqW" domain_ref="grid_W" > <zoom_domain id="EqW"/> </domain> 
    182182 
     183     <!--   F grid   --> 
     184     <domain id="grid_F" long_name="grid F"/> 
     185      
    183186              <!--   zonal mean grid   --> 
    184187     <domain_group id="gznl"> 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/field_def_nemo-oce.xml

    r14049 r14054  
    171171        <field id="tosmint_pot"  long_name="vertical integral of potential temperature times density"   standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature"  unit="(kg m2) degree_C" /> 
    172172 
    173  
     173        <field id="ht"           long_name="water column height at T point"                     standard_name="water_column_height_T"                      unit="m" /> 
    174174        <field id="ssh"          long_name="sea surface height"                                 standard_name="sea_surface_height_above_geoid"             unit="m" /> 
    175175        <field id="ssh2"         long_name="square of sea surface height"                       standard_name="square_of_sea_surface_height_above_geoid"   unit="m2" > ssh * ssh </field > 
    … …  
    190190 
    191191        <!-- Energy - horizontal divergence --> 
     192        <field id="sKE"          long_name="surface kinetic energy"  standard_name="specific_kinetic_energy_of_sea_water"   unit="m2/s2"  grid_ref="grid_T_2D" /> 
    192193        <field id="hdiv"         long_name="horizontal divergence"                                                          unit="s-1"    grid_ref="grid_T_3D" /> 
    193194 
    … …  
    270271 
    271272      <field_group id="OSMOSIS_T" grid_ref="grid_T_2D"> 
     273        <field id="hml"                 long_name="mixed layr depth"                         unit="m"       /> 
     274        <field id="hbl"                 long_name="boundary layer depth"                     unit="m"       /> 
     275        <field id="dh"                  long_name="Pycnocline thickness"                     unit=" m"      /> 
     276        <field id="ibld"                long_name="index of boundary layer depth"            unit="#"       /> 
     277        <field id="imld"                long_name="index of mixed layer depth"            unit="#"       /> 
     278        <field id="zhbl"                long_name="boundary layer depth -grid"                     unit="m"       /> 
     279        <field id="zhml"                long_name="mixed layer depth - grid"                        unit="m"       /> 
     280        <field id="zdh"                 long_name="Pycnocline  depth - grid"                 unit=" m"      /> 
     281        <field id="zustke"              long_name="magnitude of stokes drift  at T-points"   unit="m/s"     /> 
     282        <field id="us_x"        long_name="i component of active Stokes drift"                      unit="m/s"     /> 
     283        <field id="us_y"        long_name="j component of active Stokes drift"                      unit="m/s"     /> 
     284        <field id="dstokes"             long_name="stokes drift  depth scale"                unit="m"       /> 
    272285        <field id="zwth0"               long_name="surface non-local temperature flux"       unit="deg m/s" /> 
    273286        <field id="zws0"                long_name="surface non-local salinity flux"          unit="psu m/s" /> 
    274         <field id="hbl"                 long_name="boundary layer depth"                     unit="m"       /> 
    275         <field id="hbli"                long_name="initial boundary layer depth"             unit="m"       /> 
    276         <field id="dstokes"             long_name="stokes drift  depth scale"                unit="m"       /> 
    277         <field id="zustke"              long_name="magnitude of stokes drift  at T-points"   unit="m/s"     /> 
    278287        <field id="zwstrc"              long_name="convective velocity scale"                unit="m/s"     /> 
     288        <field id="zustar"              long_name="friction velocity"                        unit="m/s"     /> 
    279289        <field id="zwstrl"              long_name="langmuir velocity scale"                  unit="m/s"     /> 
    280         <field id="zustar"              long_name="friction velocity"                        unit="m/s"     /> 
    281         <field id="zhbl"                long_name="boundary layer depth"                     unit="m"       /> 
    282         <field id="zhml"                long_name="mixed layer depth"                        unit="m"       /> 
     290        <field id="zvstr"               long_name="mixed velocity scale"                     unit="m/s"     /> 
     291        <field id="zla"                 long_name="langmuir number"                          unit="m/s"     /> 
    283292        <field id="wind_wave_abs_power" long_name="\rho |U_s| x u*^2"                        unit="mW"      /> 
    284293        <field id="wind_wave_power"     long_name="U_s \dot  tau"                            unit="mW"      /> 
    285294        <field id="wind_power"          long_name="\rho  u*^3"                               unit="mW"      /> 
    286295 
    287         <!-- extra OSMOSIS diagnostics --> 
     296       <!-- interior BL OSMOSIS diagnostics --> 
    288297        <field id="zwthav"              long_name="av turb flux of T in ml"                  unit="deg m/s" /> 
    289298        <field id="zt_ml"               long_name="av T in ml"                               unit="deg"     /> 
     299        <field id="zhol"                long_name="Hoenekker number"                         unit="#"       /> 
     300        <field id="zws_ent"            long_name="entrainment turb flux of S"                unit="10^-3 m/s" /> 
    290301        <field id="zwth_ent"            long_name="entrainment turb flux of T"               unit="deg m/s" /> 
    291         <field id="zhol"                long_name="Hoenekker number"                         unit="#"       /> 
    292         <field id="zdh"                 long_name="Pycnocline  depth - grid"                 unit=" m"      /> 
    293       </field_group> 
    294  
    295       <field_group id="OSMOSIS_W" grid_ref="grid_W_3D" operation="instant" > 
     302        <field id="zwb_ent"            long_name="entrainment turb flux of buoyancy"         unit="m^2/s^-3" /> 
     303  
     304        <field id="zdt_bl"             long_name="temperature jump at base of BL"                 unit="deg"      /> 
     305        <field id="zds_bl"             long_name="salinity jump at base of BL"                 unit="10^-3"      /> 
     306        <field id="zdb_bl"             long_name="buoyancy jump at base of BL"                 unit="m/s^2"      /> 
     307        <field id="zdu_bl"             long_name="u jump at base of BL"                       unit="m/s"      /> 
     308        <field id="zdv_bl"             long_name="v jump at base of BL"                       unit="m/s"      /> 
     309 
     310        <!-- extra OSMOSIS diagnostics for debugging --> 
     311       <field id="zsc_uw_1_0"       long_name="zsc u-momentum flux on T after Stokes"                       unit="m^2/s^2" /> 
     312        <field id="zsc_uw_1_f"       long_name="zsc u-momentum flux on T after Coriolis"                       unit="m^2/s^2" /> 
     313        <field id="zsc_vw_1_f"       long_name="zsc v-momentum flux on T after Coriolis"                       unit="m^2/s^2" /> 
     314        <field id="zsc_uw_2_f"       long_name="2nd zsc u-momentum flux on T after Coriolis"                       unit="m^2/s^2" /> 
     315        <field id="zsc_vw_2_f"       long_name="2nd zsc v-momentum flux on T after Coriolis"                       unit="m^2/s^2" /> 
     316        <field id="zuw_bse"       long_name="base u-flux T-points"                          unit="m^2/s^2" /> 
     317        <field id="zvw_bse"       long_name="base v-flux T-points"                          unit="m^2/s^2" /> 
     318 
     319       <!-- FK_OSM OSMOSIS diagnostics (require also ln_osm_mle=.true.--> 
     320         <field id="hmle"          long_name="OBL FK-layer thickness"                                     unit="m"        /> 
     321        <field id="mld_prof"              long_name="FK-layer depth index"                  unit="#" /> 
     322        <field id="zmld"          long_name="target FK-layer thickness"                                     unit="m"        /> 
     323        <field id="zwb_fk"          long_name="FK b-flux"                                     unit="m^2 s^-3"        /> 
     324        <field id="zwb_fk_b"          long_name="layer averaged FK b-flux"                 unit="m^2 s^-3"       /> 
     325        <field id="zdiff_mle"          long_name="max FK diffusivity in MLE"       unit=" 10^-4 m^2 s^-1"       /> 
     326        <field id="zvel_mle"          long_name="FK velocity scale in MLE"       unit=" m s^-1"       /> 
     327    </field_group> 
     328 
     329      <field_group id="OSMOSIS_W" grid_ref="grid_W_3D" > 
     330        <field id="zviscos"       long_name="BL viscosity"   unit="m^2/s" /> 
    296331        <field id="ghamt"       long_name="non-local temperature flux"                       unit="deg m/s" /> 
    297332        <field id="ghams"       long_name="non-local salinity flux"                          unit="psu m/s" /> 
    298333        <field id="zdtdz_pyc"   long_name="Pycnocline temperature gradient"                  unit=" deg/m"  /> 
    299       </field_group> 
     334        <field id="zdsdz_pyc"   long_name="Pycnocline salinity gradient"                  unit=" 10^-3/m"  /> 
     335        <field id="zdbdz_pyc"   long_name="Pycnocline buoyancy gradient"                  unit=" s^-2"  /> 
     336        <field id="zdudz_pyc"   long_name="Pycnocline u gradient"                  unit=" s^-2"  /> 
     337        <field id="zdvdz_pyc"   long_name="Pycnocline v gradient"                  unit=" s^-2"  /> 
     338 
     339        <!-- extra OSMOSIS diagnostics for debugging --> 
     340         <field id="ghamu_00"       long_name="initial non-local u-momentum flux"   unit="m^2/s^2" /> 
     341        <field id="ghamv_00"       long_name="initial non-local v-momentum flux"   unit="m^2/s^2" /> 
     342        <field id="ghamu_0"       long_name="after dstokes non-local u-momentum flux"   unit="m^2/s^2" /> 
     343        <field id="ghamu_f"       long_name="after Coriolis non-local u-momentum flux"   unit="m^2/s^2" /> 
     344        <field id="ghamv_f"       long_name="after Coriolis  non-local v-momentum flux"   unit="m^2/s^2" /> 
     345        <field id="ghamu_b"       long_name="after buoyancy added non-local u-momentum flux"   unit="m^2/s^2" /> 
     346        <field id="ghamv_b"       long_name="after buoyancy added  non-local v-momentum flux"  unit="m^2/s^2" /> 
     347        <field id="ghamu_1"       long_name="after entrainment non-local u-momentum flux"   unit="m^2/s^2" /> 
     348        <field id="ghamv_1"       long_name="after entrainment  non-local v-momentum flux"  unit="m^2/s^2" /> 
     349     </field_group> 
    300350 
    301351      <field_group id="OSMOSIS_U" grid_ref="grid_U_2D" > 
    302352        <field id="ghamu"       long_name="non-local u-momentum flux"   grid_ref="grid_U_3D" unit="m^2/s^2" /> 
    303         <field id="us_x"        long_name="i component of Stokes drift"                      unit="m/s"     /> 
    304       </field_group> 
     353       <!-- FK_OSM OSMOSIS diagnostics (require also ln_osm_mle=.true.--> 
     354       <field id="zdtdx"          long_name="FK  T x-gradient"                                     unit=" deg C m^-1"        /> 
     355        <field id="zdsdx"          long_name="FK  S x-gradient"                                     unit=" 10^-3 m^-1"        /> 
     356        <field id="dbdx_mle"          long_name="FK  B x-gradient"                                     unit=" s^-2"        /> 
     357     </field_group> 
    305358 
    306359      <field_group id="OSMOSIS_V" grid_ref="grid_V_2D" > 
    307360        <field id="ghamv"       long_name="non-local v-momentum flux"   grid_ref="grid_V_3D" unit="m^2/s^2" /> 
    308         <field id="us_y"        long_name="j component of Stokes drift"                      unit="m/s"     /> 
     361        <!-- FK_OSM OSMOSIS diagnostics (require also ln_osm_mle=.true.--> 
     362        <field id="zdtdy"          long_name="FK T y-gradient"                                     unit=" deg C m^-1"        /> 
     363        <field id="zdsdy"          long_name="FK S y-gradient"                                     unit=" 10^-3 m^-1"        /> 
     364        <field id="dbdy_mle"          long_name="FK B y-gradient"                                     unit=" s^-2"        /> 
    309365      </field_group> 
    310366 
    … …  
    501557 
    502558      <field_group id="grid_U"   grid_ref="grid_U_2D"> 
     559        <field id="hu"            long_name="water column height at U point"                         standard_name="water_column_height_U"       unit="m" /> 
    503560        <field id="e2u"           long_name="U-cell width in meridional direction"                   standard_name="cell_width"                  unit="m"                               /> 
    504561        <field id="e3u"           long_name="U-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_U_3D" /> 
    … …  
    571628        <field id="e3v"          long_name="V-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_V_3D" /> 
    572629        <field id="e3v_0"        long_name="Initial V-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_V_3D" /> 
     630        <field id="hv"            long_name="water column height at V point"                        standard_name="water_column_height_V"       unit="m" /> 
    573631        <field id="vtau"         long_name="Wind Stress along j-axis"                               standard_name="surface_downward_y_stress"   unit="N/m2"                            /> 
    574632        <field id="voce"         long_name="ocean current along j-axis"                             standard_name="sea_water_y_velocity"        unit="m/s"        grid_ref="grid_V_3D" /> 
    … …  
    679737 
    680738      <!-- F grid --> 
     739      <field_group id="grid_F" grid_ref="grid_F_2D"> 
     740   <field id="e3f"          long_name="F-cell thickness"                    standard_name="cell_thickness"        unit="m"   grid_ref="grid_F_3D" /> 
     741   <field id="e3f_0"        long_name="F-cell thickness"                    standard_name="cell_thickness"        unit="m"   grid_ref="grid_F_3D" /> 
     742        <field id="hf"           long_name="water column height at F point"    standard_name="water_column_height_F"  unit="m"                     /> 
     743        <field id="sKEf"         long_name="surface kinetic energy at F point" standard_name="specific_kinetic_energy_of_sea_water"   unit="m2/s2" /> 
     744        <field id="relvor"       long_name="relative vorticity"                standard_name="relative_vorticity"     unit="1/s"                   /> 
     745        <field id="plavor"       long_name="planetary vorticity"               standard_name="planetary_vorticity"    unit="1/s"                   /> 
     746        <field id="relpotvor"    long_name="relative potential vorticity"      standard_name="relpot_vorticity"       unit="1/m.s"                 /> 
     747        <field id="abspotvor"    long_name="absolute potential vorticity"      standard_name="abspot_vorticity"       unit="1/m.s"                 /> 
     748        <field id="Ens"          long_name="enstrophy"                         standard_name="enstrophy"              unit="1/m2.s2"               /> 
     749      </field_group>  
     750  
    681751      <!-- AGRIF sponge --> 
    682752      <field id="agrif_spf"    long_name=" AGRIF f-sponge coefficient"   unit=" " /> 
    … …  
    841911     <field id="strd_zdfp"     long_name="salinity   -trend: pure vert. diffusion"   unit="1e-3/s" /> 
    842912 
    843      <!-- --> 
     913     <!-- ln_zdfosm=T only (OSMOSIS-OBL) --> 
     914     <field id="ttrd_osm"      long_name="temperature-trend: OSM-OSBL non-local forcing"                             unit="degC/s" /> 
     915     <field id="strd_osm"      long_name="salinity   -trend: OSM-OSBL non-local forcing"                             unit="1e-3/s" /> 
     916 
     917 
     918    <!-- --> 
    844919     <field id="ttrd_dmp"      long_name="temperature-trend: interior restoring"        unit="degC/s" /> 
    845920     <field id="strd_dmp"      long_name="salinity   -trend: interior restoring"        unit="1e-3/s" /> 
    … …  
    877952     <field id="strd_zdfp_e3t"     unit="1e-3/s * m"  >  strd_zdfp * e3t </field> 
    878953 
     954          <!-- ln_zdfosm=T only (OSMOSIS-OBL) --> 
     955     <field id="ttrd_osm_e3t"      long_name="temperature-trend: OSM-OSBL non-local forcing"                             unit="degC/s * m" >  ttrd_osm * e3t </field> 
     956     <field id="strd_osm_e3t"      long_name="salinity   -trend: OSM-OSBL non-local forcing"                             unit="1e-3/s * m" >  strd_osm * e3t </field> 
     957      
    879958     <!-- --> 
    880959     <field id="ttrd_dmp_e3t"      unit="degC/s * m"  >  ttrd_dmp * e3t </field> 
    … …  
    892971     <field id="ttrd_totad_li"    long_name="layer integrated heat-trend: total advection"         unit="W/m^2"     > ttrd_totad_e3t * 1026.0 * 3991.86795711963 </field> 
    893972     <field id="strd_totad_li"    long_name="layer integrated salt-trend: total advection"         unit="kg/(m^2 s)"    > strd_totad_e3t * 1026.0 * 0.001  </field> 
     973     <field id="ttrd_osm_li"    long_name="layer integrated heat-trend: non-local OSM"         unit="W/m^2"     > ttrd_osm_e3t * 1026.0 * 3991.86795711963 </field> 
     974     <field id="strd_osm_li"    long_name="layer integrated salt-trend: non-local OSM"         unit="kg/(m^2 s)"    > strd_osm_e3t * 1026.0 * 0.001  </field> 
    894975     <field id="ttrd_evd_li"      long_name="layer integrated heat-trend: EVD convection"          unit="W/m^2"    > ttrd_evd_e3t * 1026.0 * 3991.86795711963 </field> 
    895976     <field id="strd_evd_li"      long_name="layer integrated salt-trend: EVD convection"          unit="kg/(m^2 s)"  > strd_evd_e3t * 1026.0 * 0.001  </field> 
    … …  
    10991180    </field_group> 
    11001181 
     1182    <!-- TMB diagnostic output --> 
     1183    <field_group  id="1h_grid_T_tmb" grid_ref="grid_T_2D" operation="instant"> 
     1184      <field id="top_temp"           name="votemper_top"  unit="degC"  /> 
     1185      <field id="mid_temp"           name="votemper_mid"  unit="degC"  /> 
     1186      <field id="bot_temp"           name="votemper_bot"  unit="degC"  /> 
     1187      <field id="top_sal"            name="vosaline_top"  unit="psu"   /> 
     1188      <field id="mid_sal"            name="vosaline_mid"  unit="psu"   /> 
     1189      <field id="bot_sal"            name="vosaline_bot"  unit="psu"   /> 
     1190      <field id="sshnmasked"         name="sossheig"      unit="m"     />  
     1191    </field_group> 
     1192 
    11011193    <field_group  id="1h_grid_U_tmb" grid_ref="grid_U_2D" operation="instant"> 
    11021194      <field id="top_u"           name="vozocrtx_top"  unit="m/s"  /> 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/grid_def_nemo.xml

    r12377 r14054  
    5353         <domain domain_ref="grid_W" /> 
    5454         <axis axis_ref="depthw" /> 
     55       </grid> 
     56       <!--  --> 
     57       <grid id="grid_F_2D" > 
     58         <domain domain_ref="grid_F" /> 
     59       </grid> 
     60        <!--  --> 
     61       <grid id="grid_F_3D" > 
     62         <domain domain_ref="grid_F" /> 
     63         <axis axis_ref="depthf" /> 
    5564       </grid> 
    5665        <!--  --> 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/namelist_ref

    r14049 r14054  
    629629   ln_use_calving          = .false. ! Use calving data even when nn_test_icebergs > 0 
    630630   rn_speed_limit          = 0.      ! CFL speed limit for a berg 
    631  
     631   ! 
     632   ln_M2016                = .false. ! use Merino et al. (2016) modification (use of 3d ocean data instead of only sea surface data) 
     633      ln_icb_grd           = .false. ! ground icb when icb bottom level hit oce bottom level (need ln_M2016 to be activated) 
     634   ! 
    632635   cn_dir      = './'      !  root directory for the calving data location 
    633636   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    … …  
    995998   ln_dynvor_eeT = .false. !  energy conserving scheme (een using e3t) 
    996999   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    997       nn_een_e3f = 0          ! =0  e3f = mi(mj(e3t))/4 
    998       !                       ! =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
     1000   ! 
    9991001   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T)        ==>>> PLEASE DO NOT ACTIVATE 
    1000       !                    !  (f-point vorticity schemes only) 
     1002   !                       !  (f-point vorticity schemes only) 
     1003   ! 
     1004   nn_e3f_typ = 0          !  type of e3f (EEN, ENE, ENS, MIX only)  =0  e3f = mi(mj(e3t))/4 
     1005   !                       !                                         =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
    10011006/ 
    10021007!----------------------------------------------------------------------- 
    … …  
    10301035   !                       !  Type of the operator : 
    10311036   ln_dynldf_OFF = .false.     !  No operator (i.e. no explicit diffusion) 
     1037   nn_dynldf_typ = 0           !  =0 div-rot (default)   ;   =1 symmetric 
    10321038   ln_dynldf_lap = .false.     !    laplacian operator 
    10331039   ln_dynldf_blp = .false.     !  bilaplacian operator 
    … …  
    11601166   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F) 
    11611167      nn_mxlice    = 2        ! type of scaling under sea-ice 
    1162                               !    = 0 no scaling under sea-ice 
    1163                               !    = 1 scaling with constant sea-ice thickness 
    1164                               !    = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 
    1165                               !    = 3 scaling with maximum sea-ice thickness 
     1168      !                       !    = 0 no scaling under sea-ice 
     1169      !                       !    = 1 scaling with constant sea-ice thickness 
     1170      !                       !    = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 
     1171      !                       !    = 3 scaling with maximum sea-ice thickness 
    11661172      rn_mxlice   = 10.       ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    11671173   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value 
    … …  
    11701176      rn_lc       =   0.15    !  coef. associated to Langmuir cells 
    11711177   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to NIWs 
    1172                               !        = 0 none ; = 1 add a tke source below the ML 
    1173                               !        = 2 add a tke source just at the base of the ML 
    1174                               !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
     1178   !                          !        = 0 none ; = 1 add a tke source below the ML 
     1179   !                          !        = 2 add a tke source just at the base of the ML 
     1180   !                          !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
    11751181      rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 
    11761182      nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML 
    1177                               !        = 0  constant 10 m length scale 
    1178                               !        = 1  0.5m at the equator to 30m poleward of 40 degrees 
     1183      !                       !        = 0  constant 10 m length scale 
     1184      !                       !        = 1  0.5m at the equator to 30m poleward of 40 degrees 
    11791185   nn_eice     =   1       !  attenutaion of langmuir & surface wave breaking under ice 
    11801186   !                       !           = 0 no impact of ice cover on langmuir & surface wave breaking 
    … …  
    12131219&namzdf_osm    !   OSM vertical diffusion                               (ln_zdfosm =T) 
    12141220!----------------------------------------------------------------------- 
    1215    ln_use_osm_la = .false.      !  Use namelist  rn_osm_la 
     1221   ln_use_osm_la = .false.     !  Use   rn_osm_la 
    12161222   rn_osm_la     = 0.3         !  Turbulent Langmuir number 
    1217    rn_osm_dstokes     = 5.     !  Depth scale of Stokes drift (m) 
     1223   rn_zdfosm_adjust_sd = 1.0   ! Stokes drift reduction factor 
     1224   rn_osm_hblfrac = 0.1        ! specify top part of hbl for nn_osm_wave = 3 or 4 
     1225   rn_osm_bl_thresh   = 5.e-5      !Threshold buoyancy for deepening of OSBL base 
    12181226   nn_ave = 0                  ! choice of horizontal averaging on avt, avmu, avmv 
    12191227   ln_dia_osm = .true.         ! output OSMOSIS-OBL variables 
    … …  
    12231231   rn_difri  =  0.005          ! max Ri# diffusivity at Ri_g = 0 (m^2/s) 
    12241232   ln_convmix  = .true.        ! Use convective instability mixing below BL 
    1225    rn_difconv = 1.             ! diffusivity when unstable below BL  (m2/s) 
     1233   rn_difconv = 1. !0.01 !1.             ! diffusivity when unstable below BL  (m2/s) 
     1234   rn_osm_dstokes     = 5.     !  Depth scale of Stokes drift (m) 
    12261235   nn_osm_wave = 0             ! Method used to calculate Stokes drift 
    12271236      !                        !  = 2: Use ECMWF wave fields 
    12281237      !                        !  = 1: Pierson Moskowitz wave spectrum 
    12291238      !                        !  = 0: Constant La# = 0.3 
    1230 / 
     1239   nn_osm_SD_reduce = 0        ! Method used to get active Stokes drift from surface value 
     1240      !                        !  = 0: No reduction 
     1241                               !  = 1: use SD avged over top 10% hbl 
     1242                               !  = 2:use surface value of SD fit to slope at rn_osm_hblfrac*hbl below surface 
     1243   ln_zdfosm_ice_shelter = .true.  ! reduce surface SD and depth scale under ice 
     1244   ln_osm_mle = .false.        !  Use integrated FK-OSM model 
     1245/ 
     1246!----------------------------------------------------------------------- 
     1247&namosm_mle    !   mixed layer eddy parametrisation (Fox-Kemper)       (default: OFF) 
     1248!----------------------------------------------------------------------- 
     1249   rn_osm_mle_ce       = 0.06      ! magnitude of the MLE (typical value: 0.06 to 0.08) 
     1250   nn_osm_mle          = 0         ! MLE type: =0 standard Fox-Kemper ; =1 new formulation 
     1251   rn_osm_mle_lf       = 5.e+3     ! typical scale of mixed layer front (meters)                      (case rn_osm_mle=0) 
     1252   rn_osm_mle_time     = 172800.   ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_osm_mle=0) 
     1253   rn_osm_mle_lat      = 20.       ! reference latitude (degrees) of MLE coef.                        (case rn_mle=1) 
     1254   rn_osm_mle_rho_c =    0.01      ! delta rho criterion used to calculate MLD for FK 
     1255   rn_osm_mle_thresh  = 0.0005     ! delta b criterion used for FK MLE criterion 
     1256   rn_osm_mle_tau     = 172800.    ! time scale for FK-OSM (seconds)  (case rn_osm_mle=0) 
     1257   ln_osm_hmle_limit   = .false.   ! limit hmle to rn_osm_hmle_limit*hbl 
     1258   rn_osm_hmle_limit   = 1.2 
     1259   / 
    12311260!----------------------------------------------------------------------- 
    12321261&namzdf_mfc     !   Mass Flux Convection 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/namelist_top_ref

    r12377 r14054  
    4141   ln_trcdmp_clo =  .false.  !  damping term (T) or not (F) on closed seas 
    4242   ln_trcbc      =  .false.  !  Surface, Lateral or Open Boundaries conditions 
     43   ln_trcais     =  .false.  !  Antarctic Ice Sheet nutrient supply 
    4344   ! 
    4445   jp_dia3d      = 0         ! Number of 3D diagnostic variables 
    … …  
    149150                             !  = 2 Damping applied to all tracers 
    150151/ 
     152!----------------------------------------------------------------------- 
     153&namtrc_ais      !  Representation of Antarctic Ice Sheet tracers supply 
     154!----------------------------------------------------------------------- 
     155   nn_ais_tr     =  1        !  tracer concentration in iceberg and ice shelf 
     156                             !    = 0 (null concentrations) 
     157                             !    = 1 prescribed concentrations 
     158   rn_icbdep     =  120.     ! Mean underwater depth of iceberg (m) 
     159/ 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/ICE/iceistate.F90

    r14049 r14054  
    2121   USE sbc_ice , ONLY : tn_ice, snwice_mass, snwice_mass_b 
    2222   USE eosbn2         ! equation of state 
     23# if defined key_qco 
     24   USE domqco         ! Variable volume 
     25# else 
    2326   USE domvvl         ! Variable volume 
     27# endif 
    2428   USE ice            ! sea-ice: variables 
    2529   USE ice1D          ! sea-ice: thermodynamics variables 
    … …  
    434438         ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0 
    435439         ! 
     440#if defined key_qco 
     441         IF( .NOT.ln_linssh )   CALL dom_qco_zgr( Kbb, Kmm )        ! interpolation scale factor, depth and water column 
     442#else 
    436443         IF( .NOT.ln_linssh )   CALL dom_vvl_zgr( Kbb, Kmm, Kaa )   ! interpolation scale factor, depth and water column 
    437 ! !!st 
    438 !          IF( .NOT.ln_linssh ) THEN 
    439 !             ! 
    440 !             WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 
    441 !             ELSEWHERE                ;   z2d(:,:) = 1._wp   ;   END WHERE 
    442 !             ! 
    443 !             DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    444 !                e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 
    445 !                e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    446 !                e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 
    447 !             END DO 
    448 !             ! 
    449 !             ! Reconstruction of all vertical scale factors at now and before time-steps 
    450 !             ! ========================================================================= 
    451 !             ! Horizontal scale factor interpolations 
    452 !             ! -------------------------------------- 
    453 !             CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 
    454 !             CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 
    455 !             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
    456 !             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
    457 !             CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 
    458 !             ! Vertical scale factor interpolations 
    459 !             ! ------------------------------------ 
    460 !             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  ) 
    461 !             CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
    462 !             CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 
    463 !             CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
    464 !             CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 
    465 !             ! t- and w- points depth 
    466 !             ! ---------------------- 
    467 !             !!gm not sure of that.... 
    468 !             gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 
    469 !             gdepw(:,:,1,Kmm) = 0.0_wp 
    470 !             gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    471 !             DO jk = 2, jpk 
    472 !                gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk  ,Kmm) 
    473 !                gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 
    474 !                gde3w(:,:,jk) = gdept(:,:,jk  ,Kmm) - ssh (:,:,Kmm) 
    475 !             END DO 
    476 !          ENDIF 
     444#endif 
     445 
    477446      ENDIF 
    478447 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/ICE/icerst.F90

    r14049 r14054  
    9999               CALL iom_swap( cxios_context ) 
    100100#else 
    101                clinfo = 'Can not use XIOS in rst_opn' 
    102                CALL ctl_stop(TRIM(clinfo)) 
     101               CALL ctl_stop( 'Can not use XIOS in rst_opn' ) 
    103102#endif 
    104103            ENDIF 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/NST/agrif_oce_interp.F90

    r13286 r14054  
    2828   USE agrif_oce 
    2929   USE phycst 
    30    USE dynspg_ts, ONLY: un_adv, vn_adv 
     30!!!   USE dynspg_ts, ONLY: un_adv, vn_adv 
    3131   ! 
    3232   USE in_out_manager 
    … …  
    5050   INTEGER ::   bdy_tinterp = 0 
    5151 
    52    !!---------------------------------------------------------------------- 
     52   !! * Substitutions 
     53#  include "domzgr_substitute.h90" 
    5354   !! NEMO/NST 4.0 , NEMO Consortium (2018) 
    5455   !! $Id$ 
    … …  
    11921193      !!----------------------------------------------------------------------   
    11931194      IF( before ) THEN 
    1194          IF ( ln_bt_fw ) THEN 
     1195!         IF ( ln_bt_fw ) THEN 
    11951196            ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 
    1196          ELSE 
    1197             ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2) 
    1198          ENDIF 
     1197!         ELSE 
     1198!            ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2) 
     1199!         ENDIF 
    11991200      ELSE 
    12001201         zrhot = Agrif_rhot() 
    … …  
    12281229      ! 
    12291230      IF( before ) THEN 
    1230          IF ( ln_bt_fw ) THEN 
     1231!         IF ( ln_bt_fw ) THEN 
    12311232            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 
    1232          ELSE 
    1233             ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 
    1234          ENDIF 
     1233!         ELSE 
     1234!            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 
     1235!         ENDIF 
    12351236      ELSE       
    12361237         zrhot = Agrif_rhot() 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/NST/agrif_oce_sponge.F90

    r13312 r14054  
    3232 
    3333   !! * Substitutions 
     34#  include "domzgr_substitute.h90" 
    3435#  include "do_loop_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/NST/agrif_oce_update.F90

    r13286 r14054  
    2727   USE vremap         ! Vertical remapping 
    2828   USE lbclnk  
    29  
     29#if defined key_qco 
     30   USE domqco 
     31#endif 
    3032   IMPLICIT NONE 
    3133   PRIVATE 
    … …  
    3436   PUBLIC   Update_Scales 
    3537 
     38   !! * Substitutions 
     39#  include "domzgr_substitute.h90" 
    3640   !!---------------------------------------------------------------------- 
    3741   !! NEMO/NST 4.0 , NEMO Consortium (2018) 
    … …  
    191195   END SUBROUTINE Agrif_Update_Tke 
    192196 
    193  
    194197   SUBROUTINE Agrif_Update_vvl( ) 
    195198      !!--------------------------------------------- 
    … …  
    201204      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step() 
    202205      ! 
     206#if ! defined key_qco 
    203207      Agrif_UseSpecialValueInUpdate = .TRUE. 
    204208      Agrif_SpecialValueFineGrid = 0. 
    … …  
    213217      CALL dom_vvl_update_UVF 
    214218      CALL Agrif_ParentGrid_To_ChildGrid() 
     219#else 
     220      CALL Agrif_ChildGrid_To_ParentGrid() 
     221      CALL Agrif_Update_qco 
     222      CALL Agrif_ParentGrid_To_ChildGrid() 
     223#endif 
    215224      ! 
    216225   END SUBROUTINE Agrif_Update_vvl 
    217226 
     227 
     228#if defined key_qco 
     229   SUBROUTINE Agrif_Update_qco 
     230      !!--------------------------------------------- 
     231      !!       *** ROUTINE dom_Update_qco *** 
     232      !!--------------------------------------------- 
     233      ! 
     234      ! Save arrays prior update (needed for asselin correction) 
     235      r3t(:,:,Krhs_a) = r3t(:,:,Kmm_a) 
     236      r3u(:,:,Krhs_a) = r3u(:,:,Kmm_a) 
     237      r3v(:,:,Krhs_a) = r3v(:,:,Kmm_a) 
     238 
     239      ! Update r3x arrays from updated ssh 
     240      CALL dom_qco_zgr( Kbb_a, Kmm_a ) 
     241      ! 
     242   END SUBROUTINE Agrif_Update_qco 
     243#endif 
     244 
     245 
     246#if ! defined key_qco 
    218247   SUBROUTINE dom_vvl_update_UVF 
    219248      !!--------------------------------------------- 
    … …  
    224253      REAL(wp):: zcoef 
    225254      !!--------------------------------------------- 
    226  
    227255      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Finalize e3 on grid Number', & 
    228256                  & Agrif_Fixed(), 'Step', Agrif_Nb_Step() 
    … …  
    290318      ! 
    291319   END SUBROUTINE dom_vvl_update_UVF 
     320#endif 
    292321 
    293322#if defined key_vertical 
    … …  
    13321361   END SUBROUTINE updateAVM 
    13331362 
     1363#if ! defined key_qco 
    13341364   SUBROUTINE updatee3t(ptab_dum, i1, i2, j1, j2, k1, k2, before ) 
    13351365      !!--------------------------------------------- 
    … …  
    14431473      ! 
    14441474   END SUBROUTINE updatee3t 
     1475#endif 
    14451476 
    14461477#else 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/NST/agrif_user.F90

    r13546 r14054  
    288288         CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 
    289289         CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 
     290#if ! defined key_qco 
    290291         DO jk = 1, jpk 
    291292               e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb)  ) & 
    … …  
    293294                        &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
    294295         END DO 
     296#endif 
    295297      ENDIF 
    296298 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DIA/diawri.F90

    r13497 r14054  
    1919   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output 
    2020   !!                 !                     change name of output variables in dia_wri_state 
     21   !!            4.0  ! 2020-10  (A. Nasser, S. Techene) add diagnostic for SWE 
    2122   !!---------------------------------------------------------------------- 
    2223 
    … …  
    4647   USE zdfdrg         ! ocean vertical physics: top/bottom friction 
    4748   USE zdfmxl         ! mixed layer 
     49   USE zdfosm         ! mixed layer 
    4850   ! 
    4951   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    … …  
    118120      INTEGER ::   ji, jj, jk       ! dummy loop indices 
    119121      INTEGER ::   ikbot            ! local integer 
    120       REAL(wp)::   ze3 
    121122      REAL(wp)::   zztmp , zztmpx   ! local scalar 
    122123      REAL(wp)::   zztmp2, zztmpy   !   -      - 
     124      REAL(wp)::   ze3 
    123125      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d   ! 2D workspace 
    124126      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z3d   ! 3D workspace 
    … …  
    137139      CALL iom_put("e3u_0", e3u_0(:,:,:) ) 
    138140      CALL iom_put("e3v_0", e3v_0(:,:,:) ) 
     141      CALL iom_put("e3f_0", e3f_0(:,:,:) ) 
    139142      ! 
    140143      IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN  ! time-varying e3t 
    … …  
    163166         CALL iom_put( "e3w" , z3d(:,:,:) ) 
    164167      ENDIF 
     168      IF ( iom_use("e3f") ) THEN                         ! time-varying e3f caution here at Kaa 
     169          DO jk = 1, jpk 
     170            z3d(:,:,jk) =  e3f(:,:,jk) 
     171         END DO 
     172         CALL iom_put( "e3f" , z3d(:,:,:) ) 
     173      ENDIF 
    165174 
    166175      IF( ll_wd ) THEN                                   ! sea surface height (brought back to the reference used for wetting and drying) 
    167          CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) 
     176         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*ssmask(:,:) ) 
    168177      ELSE 
    169178         CALL iom_put( "ssh" , ssh(:,:,Kmm) )              ! sea surface height 
    170179      ENDIF 
    171180 
    172       IF( iom_use("wetdep") )   &                  ! wet depth 
    173          CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) ) 
     181      IF( iom_use("wetdep") )    CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) )   ! wet depth 
     182          
     183#if defined key_qco 
     184      IF( iom_use("ht") )   CALL iom_put( "ht" , ht(:,:)     )   ! water column at t-point 
     185      IF( iom_use("hu") )   CALL iom_put( "hu" , hu(:,:,Kmm) )   ! water column at u-point 
     186      IF( iom_use("hv") )   CALL iom_put( "hv" , hv(:,:,Kmm) )   ! water column at v-point 
     187      IF( iom_use("hf") )   CALL iom_put( "hf" , hf_0(:,:)*( 1._wp + r3f(:,:) ) )   ! water column at f-point (caution here at Naa) 
     188#endif 
    174189       
    175190      CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) )    ! 3D temperature 
    … …  
    325340      ENDIF 
    326341      ! 
     342      IF ( iom_use("sKE") ) THEN                        ! surface kinetic energy at T point 
     343         z2d(:,:) = 0._wp 
     344         DO_2D( 0, 0, 0, 0 ) 
     345            z2d(ji,jj) = 0.25_wp * ( uu(ji  ,jj,1,Kmm) * uu(ji  ,jj,1,Kmm) * e1e2u(ji  ,jj) * e3u(ji  ,jj,1,Kmm)  & 
     346               &                   + uu(ji-1,jj,1,Kmm) * uu(ji-1,jj,1,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,1,Kmm)  & 
     347               &                   + vv(ji,jj  ,1,Kmm) * vv(ji,jj  ,1,Kmm) * e1e2v(ji,jj  ) * e3v(ji,jj  ,1,Kmm)  &  
     348               &                   + vv(ji,jj-1,1,Kmm) * vv(ji,jj-1,1,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,1,Kmm)  )  & 
     349               &                 * r1_e1e2t(ji,jj) / e3t(ji,jj,1,Kmm) * ssmask(ji,jj) 
     350         END_2D 
     351         CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
     352         IF ( iom_use("sKE" ) )  CALL iom_put( "sKE" , z2d )    
     353      ENDIF 
     354      !     
     355      IF ( iom_use("sKEf") ) THEN                        ! surface kinetic energy at F point 
     356         z2d(:,:) = 0._wp                                ! CAUTION : only valid in SWE, not with bathymetry 
     357         DO_2D( 0, 0, 0, 0 ) 
     358            z2d(ji,jj) = 0.25_wp * ( uu(ji,jj  ,1,Kmm) * uu(ji,jj  ,1,Kmm) * e1e2u(ji,jj  ) * e3u(ji,jj  ,1,Kmm)  & 
     359               &                   + uu(ji,jj+1,1,Kmm) * uu(ji,jj+1,1,Kmm) * e1e2u(ji,jj+1) * e3u(ji,jj+1,1,Kmm)  & 
     360               &                   + vv(ji  ,jj,1,Kmm) * vv(ji,jj  ,1,Kmm) * e1e2v(ji  ,jj) * e3v(ji  ,jj,1,Kmm)  &  
     361               &                   + vv(ji+1,jj,1,Kmm) * vv(ji+1,jj,1,Kmm) * e1e2v(ji+1,jj) * e3v(ji+1,jj,1,Kmm)  )  & 
     362               &                 * r1_e1e2f(ji,jj) / e3f(ji,jj,1) * ssfmask(ji,jj) 
     363         END_2D 
     364         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     365         CALL iom_put( "sKEf", z2d )                      
     366      ENDIF 
     367      ! 
    327368      CALL iom_put( "hdiv", hdiv )                  ! Horizontal divergence 
    328369 
    … …  
    424465       
    425466      IF (ln_dia25h)   CALL dia_25h( kt, Kmm )        ! 25h averaging 
     467       
     468      ! Output of vorticity terms 
     469      IF ( iom_use("relvor")    .OR. iom_use("plavor")    .OR.   & 
     470         & iom_use("relpotvor") .OR. iom_use("abspotvor") .OR.   & 
     471         & iom_use("Ens")                                        ) THEN 
     472         ! 
     473         z2d(:,:) = 0._wp  
     474         ze3 = 0._wp  
     475         DO_2D( 1, 0, 1, 0 ) 
     476            z2d(ji,jj) = (   e2v(ji+1,jj  ) * vv(ji+1,jj  ,1,Kmm) - e2v(ji,jj) * vv(ji,jj,1,Kmm)    & 
     477            &              - e1u(ji  ,jj+1) * uu(ji  ,jj+1,1,Kmm) + e1u(ji,jj) * uu(ji,jj,1,Kmm)  ) * r1_e1e2f(ji,jj) 
     478         END_2D 
     479         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     480         CALL iom_put( "relvor", z2d )                  ! relative vorticity ( zeta )  
     481         ! 
     482         CALL iom_put( "plavor", ff_f )                 ! planetary vorticity ( f ) 
     483         ! 
     484         DO_2D( 1, 0, 1, 0 )   
     485            ze3 = (  e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1)    & 
     486              &    + e3t(ji,jj  ,1,Kmm) * e1e2t(ji,jj  ) + e3t(ji+1,jj  ,1,Kmm) * e1e2t(ji+1,jj  )  ) * r1_e1e2f(ji,jj) 
     487            IF( ze3 /= 0._wp ) THEN   ;   ze3 = 4._wp / ze3 
     488            ELSE                      ;   ze3 = 0._wp 
     489            ENDIF 
     490            z2d(ji,jj) = ze3 * z2d(ji,jj)  
     491         END_2D 
     492         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     493         CALL iom_put( "relpotvor", z2d )                  ! relative potential vorticity (zeta/h) 
     494         ! 
     495         DO_2D( 1, 0, 1, 0 ) 
     496            ze3 = (  e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1)    & 
     497              &    + e3t(ji,jj  ,1,Kmm) * e1e2t(ji,jj  ) + e3t(ji+1,jj  ,1,Kmm) * e1e2t(ji+1,jj  )  ) * r1_e1e2f(ji,jj) 
     498            IF( ze3 /= 0._wp ) THEN   ;   ze3 = 4._wp / ze3 
     499            ELSE                      ;   ze3 = 0._wp 
     500            ENDIF 
     501            z2d(ji,jj) = ze3 * ff_f(ji,jj) + z2d(ji,jj)  
     502         END_2D 
     503         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     504         CALL iom_put( "abspotvor", z2d )                  ! absolute potential vorticity ( q ) 
     505         ! 
     506         DO_2D( 1, 0, 1, 0 )   
     507            z2d(ji,jj) = 0.5_wp * z2d(ji,jj)  * z2d(ji,jj)  
     508         END_2D 
     509         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     510         CALL iom_put( "Ens", z2d )                        ! potential enstrophy ( 1/2*q2 ) 
     511         ! 
     512      ENDIF 
    426513 
    427514      IF( ln_timing )   CALL timing_stop('dia_wri') 
    … …  
    9971084      !! 
    9981085      INTEGER :: inum, jk 
    999       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept      ! 3D workspace !!st patch to use substitution 
     1086      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept       ! 3D workspace for qco substitution 
    10001087      !!---------------------------------------------------------------------- 
    10011088      !  
    … …  
    10761163         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity 
    10771164      ENDIF 
     1165      IF( ln_zdfosm ) THEN 
     1166         CALL iom_rstput( 0, 0, inum, 'hbl', hbl*tmask(:,:,1)  )      ! now boundary-layer depth 
     1167         CALL iom_rstput( 0, 0, inum, 'hml', hml*tmask(:,:,1)  )      ! now mixed-layer depth 
     1168         CALL iom_rstput( 0, 0, inum, 'avt_k', avt_k*wmask     )      ! w-level diffusion 
     1169         CALL iom_rstput( 0, 0, inum, 'avm_k', avm_k*wmask     )      ! now w-level viscosity 
     1170         CALL iom_rstput( 0, 0, inum, 'ghamt', ghamt*wmask     )      ! non-local t forcing 
     1171         CALL iom_rstput( 0, 0, inum, 'ghams', ghams*wmask     )      ! non-local s forcing 
     1172         CALL iom_rstput( 0, 0, inum, 'ghamu', ghamu*umask     )      ! non-local u forcing 
     1173         CALL iom_rstput( 0, 0, inum, 'ghamv', ghamv*vmask     )      ! non-local v forcing 
     1174         IF( ln_osm_mle ) THEN 
     1175            CALL iom_rstput( 0, 0, inum, 'hmle', hmle*tmask(:,:,1)  ) ! now transition-layer depth 
     1176         END IF 
     1177      ENDIF 
    10781178      ! 
    10791179      CALL iom_close( inum ) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/dom_oce.F90

    r14049 r14054  
    131131   ! 
    132132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
    133    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , e2_e1u, r1_e1e2u        !: associated metrics at u-point 
    134    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , e1_e2v, r1_e1e2v        !: associated metrics at v-point 
     133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
     134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
    135135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
    136136   ! 
    … …  
    162162 
    163163   !                                                        !  reference depths of cells 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0  !: t- depth              [m] 
    165    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0  !: w- depth              [m] 
    166    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0  !: w- depth (sum of e3w) [m] 
     164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gdept_0  !: t- depth              [m] 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gdepw_0  !: w- depth              [m] 
     166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gde3w_0  !: w- depth (sum of e3w) [m] 
    167167   !                                                        !  time-dependent depths of cells 
    168168   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw   
    … …  
    205205 
    206206   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)           ::   ssmask, ssumask, ssvmask, ssfmask   !: surface mask at T-,U-, V- and F-pts 
    207    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask   !: land/ocean mask at T-, U-, V-, W- and F-pts 
    208    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    209  
     207   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   tmask, umask, vmask, wmask, fmask   !: land/ocean mask at T-, U-, V-, W- and F-pts 
     208   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   wumask, wvmask                      !: land/ocean mask at WU- and WV-pts 
     209#if defined key_qco    
     210   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   fe3mask                             !: land/ocean mask at F-pts for qco 
     211#endif 
    210212   !!---------------------------------------------------------------------- 
    211213   !! calendar variables 
    … …  
    306308         &       e3w_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk)                      ,  STAT=ierr(ii) ) 
    307309         ! 
    308 #if ! defined key_qco 
     310#if defined key_qco 
     311      ii = ii+1 
     312      ALLOCATE( r3t  (jpi,jpj,jpt)   , r3u  (jpi,jpj,jpt)    , r3v  (jpi,jpj,jpt)    , r3f  (jpi,jpj) ,      & 
     313         &      r3t_f(jpi,jpj)       , r3u_f(jpi,jpj)        , r3v_f(jpi,jpj)                         ,  STAT=ierr(ii) )              
     314#else 
    309315      ii = ii+1 
    310316      ALLOCATE( e3t(jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f(jpi,jpj,jpk) ,      & 
    … …  
    313319         ! 
    314320      ii = ii+1 
    315       ALLOCATE( r3t  (jpi,jpj,jpt)   , r3u  (jpi,jpj,jpt)    , r3v  (jpi,jpj,jpt)    , r3f  (jpi,jpj) ,  & 
    316          &      r3t_f(jpi,jpj)       , r3u_f(jpi,jpj)        , r3v_f(jpi,jpj)                         ,  STAT=ierr(ii) ) 
    317          ! 
    318       ii = ii+1 
    319321      ALLOCATE( ht_0(jpi,jpj) ,    hu_0(jpi,jpj)    ,    hv_0(jpi,jpj)     , hf_0(jpi,jpj) ,       & 
    320322         &   r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) ,    r1_hv_0(jpi,jpj),   r1_hf_0(jpi,jpj) ,   STAT=ierr(ii)  ) 
    … …  
    323325      ii = ii+1 
    324326      ALLOCATE( ht  (jpi,jpj) ,    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt)                 ,       & 
    325          &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt)                 ,   STAT=ierr(ii)  ) 
    326 #else 
    327       ii = ii+1 
    328       ALLOCATE(                    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt)                 ,       & 
    329327         &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt)                 ,   STAT=ierr(ii)  ) 
    330328#endif 
    … …  
    350348      ii = ii+1 
    351349      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 
     350#if defined key_qco 
     351         ! 
     352      ii = ii+1 
     353      ALLOCATE( fe3mask(jpi,jpj,jpk) , STAT=ierr(ii) ) 
     354#endif 
    352355      ! 
    353356      dom_oce_alloc = MAXVAL(ierr) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/domain.F90

    r14049 r14054  
    1515   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default 
    1616   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
    17    !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
     17   !!            4.1  !  2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1818   !!---------------------------------------------------------------------- 
    1919    
    … …  
    2828   USE oce            ! ocean variables 
    2929   USE dom_oce        ! domain: ocean 
     30#if defined key_qco 
     31   USE domqco         ! quasi-eulerian 
     32#else 
     33   USE domvvl         ! variable volume 
     34#endif 
     35   USE sshwzv  , ONLY : ssh_init_rst   ! set initial ssh  
    3036   USE sbc_oce        ! surface boundary condition: ocean 
    3137   USE trc_oce        ! shared ocean & passive tracers variab 
    … …  
    3541   USE dommsk         ! domain: set the mask system 
    3642   USE domwri         ! domain: write the meshmask file 
    37 #if ! defined key_qco 
    38    USE domvvl         ! variable volume 
    39 #else 
    40    USE domqco          ! variable volume 
    41 #endif 
    4243   USE c1d            ! 1D configuration 
    4344   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine) 
    44    USE wet_dry, ONLY : ll_wd 
    45    USE closea , ONLY : dom_clo ! closed seas 
     45   USE wet_dry , ONLY : ll_wd     ! wet & drying flag 
     46   USE closea  , ONLY : dom_clo   ! closed seas routine 
    4647   ! 
    4748   USE prtctl         ! Print control (prt_ctl_info routine) 
    … …  
    5051   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    5152   USE lib_mpp        ! distributed memory computing library 
     53   USE restart        ! only for lrst_oce 
    5254 
    5355   IMPLICIT NONE 
    … …  
    5860   PUBLIC   dom_tile     ! called by step.F90 
    5961 
     62   !! * Substitutions 
     63#  include "do_loop_substitute.h90" 
    6064   !!------------------------------------------------------------------------- 
    6165   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8488      INTEGER ::   ji, jj, jk, jt   ! dummy loop indices 
    8589      INTEGER ::   iconf = 0    ! local integers 
     90      REAL(wp)::   zrdt 
    8691      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))"  
    8792      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level 
    … …  
    121126         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg 
    122127      ENDIF 
    123       nn_wxios = 0 
    124       ln_xios_read = .FALSE. 
     128       
    125129      ! 
    126130      !           !==  Reference coordinate system  ==! 
    … …  
    143147      hv_0(:,:) = 0._wp 
    144148      hf_0(:,:) = 0._wp 
    145       DO jk = 1, jpk 
     149      DO jk = 1, jpkm1 
    146150         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
    147151         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 
    148152         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 
    149          hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * fmask(:,:,jk) 
    150153      END DO 
     154      ! 
     155      DO jk = 1, jpkm1 
     156         hf_0(1:jpim1,:) = hf_0(1:jpim1,:) + e3f_0(1:jpim1,:,jk)*vmask(1:jpim1,:,jk)*vmask(2:jpi,:,jk) 
     157      END DO 
     158      CALL lbc_lnk('domain', hf_0, 'F', 1._wp) 
     159      ! 
     160      IF( lk_SWE ) THEN      ! SWE case redefine hf_0 
     161         hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,1) * ssfmask(:,:) 
     162      ENDIF 
    151163      ! 
    152164      r1_ht_0(:,:) = ssmask (:,:) / ( ht_0(:,:) + 1._wp -  ssmask (:,:) ) 
    … …  
    154166      r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp -  ssvmask(:,:) ) 
    155167      r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp -  ssfmask(:,:) ) 
    156  
     168      ! 
     169      IF( ll_wd ) THEN       ! wet and drying (check ht_0 >= 0) 
     170         DO_2D( 1, 1, 1, 1 ) 
     171            IF( ht_0(ji,jj) < 0._wp .AND. ssmask(ji,jj) == 1._wp ) THEN 
     172               CALL ctl_stop( 'ssh_init_rst : ht_0 must be positive at potentially wet points' ) 
     173            ENDIF 
     174         END_2D 
     175      ENDIF 
     176      ! 
     177      !           !==  initialisation of time varying coordinate  ==! 
     178      ! 
     179      !                                 != ssh initialization 
     180      IF( .NOT.l_offline .AND. .NOT.l_SAS ) THEN 
     181         CALL ssh_init_rst( Kbb, Kmm, Kaa ) 
     182      ELSE 
     183         ssh(:,:,:) = 0._wp 
     184      ENDIF 
    157185      ! 
    158186#if defined key_qco 
    159       !           !==  initialisation of time varying coordinate  ==!  Quasi-Euerian coordinate case 
     187      !                                 != Quasi-Euerian coordinate case 
    160188      ! 
    161189      IF( .NOT.l_offline )   CALL dom_qco_init( Kbb, Kmm, Kaa ) 
    162       ! 
    163       IF( ln_linssh )        CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible') 
    164       ! 
    165190#else 
    166       !           !==  time varying part of coordinate system  ==! 
    167       ! 
    168       IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all 
     191      ! 
     192      IF( ln_linssh ) THEN              != Fix in time : set to the reference one for all 
    169193         ! 
    170194         DO jt = 1, jpt                         ! depth of t- and w-grid-points 
    … …  
    175199         ! 
    176200         DO jt = 1, jpt                         ! vertical scale factors 
    177             e3t(:,:,:,jt) =  e3t_0(:,:,:) 
    178             e3u(:,:,:,jt) =  e3u_0(:,:,:) 
    179             e3v(:,:,:,jt) =  e3v_0(:,:,:) 
    180             e3w(:,:,:,jt) =  e3w_0(:,:,:) 
     201            e3t (:,:,:,jt) =  e3t_0(:,:,:) 
     202            e3u (:,:,:,jt) =  e3u_0(:,:,:) 
     203            e3v (:,:,:,jt) =  e3v_0(:,:,:) 
     204            e3w (:,:,:,jt) =  e3w_0(:,:,:) 
    181205            e3uw(:,:,:,jt) = e3uw_0(:,:,:) 
    182206            e3vw(:,:,:,jt) = e3vw_0(:,:,:) 
    183207         END DO 
    184             e3f(:,:,:)    =  e3f_0(:,:,:) 
     208            e3f (:,:,:)    =  e3f_0(:,:,:) 
    185209         ! 
    186210         DO jt = 1, jpt                         ! water column thickness and its inverse 
    187             hu(:,:,jt)    =    hu_0(:,:) 
    188             hv(:,:,jt)    =    hv_0(:,:) 
     211               hu(:,:,jt) =    hu_0(:,:) 
     212               hv(:,:,jt) =    hv_0(:,:) 
    189213            r1_hu(:,:,jt) = r1_hu_0(:,:) 
    190214            r1_hv(:,:,jt) = r1_hv_0(:,:) 
    191215         END DO 
    192             ht(:,:) =    ht_0(:,:) 
    193          ! 
    194       ELSE                       != time varying : initialize before/now/after variables 
     216               ht   (:,:) =    ht_0(:,:) 
     217         ! 
     218      ELSE                              != Time varying : initialize before/now/after variables 
    195219         ! 
    196220         IF( .NOT.l_offline )   CALL dom_vvl_init( Kbb, Kmm, Kaa ) 
    … …  
    373397      USE ioipsl 
    374398      !! 
    375       INTEGER  ::   ios   ! Local integer 
     399      INTEGER ::   ios   ! Local integer 
     400      REAL(wp)::   zrdt 
     401      !!---------------------------------------------------------------------- 
    376402      ! 
    377403      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 & 
    … …  
    393419      ENDIF 
    394420      ! 
     421      !                       !=======================! 
     422      !                       !==  namelist namdom  ==! 
     423      !                       !=======================! 
     424      ! 
     425      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
     426903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' ) 
     427      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
     428904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 
     429      IF(lwm) WRITE( numond, namdom ) 
     430      ! 
     431#if defined key_agrif 
     432      IF( .NOT. Agrif_Root() ) THEN    ! AGRIF child, subdivide the Parent timestep 
     433         rn_Dt = Agrif_Parent (rn_Dt ) / Agrif_Rhot() 
     434      ENDIF 
     435#endif 
     436      ! 
     437      IF(lwp) THEN 
     438         WRITE(numout,*) 
     439         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain' 
     440         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh 
     441         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask 
     442         WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt 
     443         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp 
     444         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs 
     445      ENDIF 
     446      ! 
     447      ! set current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3 
     448      rDt   = 2._wp * rn_Dt 
     449      r1_Dt = 1._wp / rDt 
     450      ! 
     451      IF( l_SAS .AND. .NOT.ln_linssh ) THEN 
     452         CALL ctl_warn( 'SAS requires linear ssh : force ln_linssh = T' ) 
     453         ln_linssh = .TRUE. 
     454      ENDIF 
     455      ! 
     456#if defined key_qco 
     457      IF( ln_linssh )   CALL ctl_stop( 'STOP','domain: key_qco and ln_linssh = T are incompatible' ) 
     458#endif 
     459      ! 
     460      !                       !=======================! 
     461      !                       !==  namelist namrun  ==! 
     462      !                       !=======================! 
    395463      ! 
    396464      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
    … …  
    452520      nleapy = nn_leapy 
    453521      ninist = nn_istate 
     522      ! 
     523      !                                        !==  Set parameters for restart reading using xIOS  ==! 
     524      ! 
     525      IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
     526         lrxios = ln_xios_read .AND. ln_rstart 
     527         IF( nn_wxios > 0 )   lwxios = .TRUE.           !* set output file type for XIOS based on NEMO namelist 
     528         nxioso = nn_wxios 
     529      ENDIF 
     530      !                                        !==  Check consistency between ln_rstart and ln_1st_euler  ==!   (i.e. set l_1st_euler) 
    454531      l_1st_euler = ln_1st_euler 
    455       IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN 
     532      ! 
     533      IF( ln_rstart ) THEN                              !*  Restart case 
     534         ! 
     535         IF(lwp) WRITE(numout,*) 
     536         IF(lwp) WRITE(numout,*) '   open the restart file' 
     537         CALL rst_read_open                                              !- Open the restart file 
     538         ! 
     539         IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN     !- Check time-step consistency and force Euler restart if changed 
     540            CALL iom_get( numror, 'rdt', zrdt ) 
     541            IF( zrdt /= rn_Dt ) THEN 
     542               IF(lwp) WRITE( numout,*) 
     543               IF(lwp) WRITE( numout,*) '   rn_Dt = ', rn_Dt,' not equal to the READ one rdt = ', zrdt 
     544               IF(lwp) WRITE( numout,*) 
     545               IF(lwp) WRITE( numout,*) '      ==>>>   forced euler first time-step' 
     546               l_1st_euler =  .TRUE. 
     547            ENDIF 
     548         ENDIF 
     549         ! 
     550         IF( .NOT.l_SAS .AND. iom_varid( numror, 'sshb', ldstop = .FALSE. ) <= 0 ) THEN   !- Check absence of one of the Kbb field (here sshb) 
     551            !                                                                             !  (any Kbb field is missing ==> all Kbb fields are missing)  
     552            IF( .NOT.l_1st_euler ) THEN 
     553               CALL ctl_warn('dom_nam : ssh at Kbb not found in restart files ',   & 
     554                  &                        'l_1st_euler forced to .true. and ' ,   & 
     555                  &                        'ssh(Kbb) = ssh(Kmm) '                  ) 
     556               l_1st_euler = .TRUE. 
     557            ENDIF 
     558         ENDIF 
     559      ELSEIF( .NOT.l_1st_euler ) THEN                   !*  Initialization case 
    456560         IF(lwp) WRITE(numout,*)   
    457561         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)' 
    458562         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. '    
    459          l_1st_euler = .true. 
    460       ENDIF 
    461       !                             ! control of output frequency 
    462       IF( .NOT. ln_rst_list ) THEN     ! we use nn_stock 
     563         l_1st_euler = .TRUE. 
     564      ENDIF 
     565      ! 
     566      !                                        !==  control of output frequency  ==! 
     567      ! 
     568      IF( .NOT. ln_rst_list ) THEN   ! we use nn_stock 
    463569         IF( nn_stock == -1 )   CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' ) 
    464570         IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN 
    … …  
    479585      IF( Agrif_Root() ) THEN 
    480586         IF(lwp) WRITE(numout,*) 
    481          SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     587         SELECT CASE ( nleapy )                !==  Choose calendar for IOIPSL  ==! 
    482588         CASE (  1 )  
    483589            CALL ioconf_calendar('gregorian') 
    … …  
    491597         END SELECT 
    492598      ENDIF 
    493  
    494       READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
    495 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' ) 
    496       READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
    497 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 
    498       IF(lwm) WRITE( numond, namdom ) 
    499       ! 
    500 #if defined key_agrif 
    501       IF( .NOT. Agrif_Root() ) THEN 
    502             rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 
    503       ENDIF 
    504 #endif 
    505       ! 
    506       IF(lwp) THEN 
    507          WRITE(numout,*) 
    508          WRITE(numout,*) '   Namelist : namdom   ---   space & time domain' 
    509          WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh 
    510          WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask 
    511          WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt 
    512          WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp 
    513          WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs 
    514       ENDIF 
    515       ! 
    516       !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3 
    517       rDt  = 2._wp * rn_Dt 
    518       r1_Dt = 1._wp / rDt 
    519  
     599      ! 
     600      !                       !========================! 
     601      !                       !==  namelist namtile  ==! 
     602      !                       !========================! 
     603      ! 
    520604      READ  ( numnam_ref, namtile, IOSTAT = ios, ERR = 905 ) 
    521605905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtile in reference namelist' ) 
    … …  
    537621         ENDIF 
    538622      ENDIF 
    539  
    540       IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    541          lrxios = ln_xios_read.AND.ln_rstart 
    542 !set output file type for XIOS based on NEMO namelist  
    543          IF (nn_wxios > 0) lwxios = .TRUE.  
    544          nxioso = nn_wxios 
    545       ENDIF 
    546  
     623      ! 
    547624#if defined key_netcdf4 
    548       !                             ! NetCDF 4 case   ("key_netcdf4" defined) 
     625      !                       !=======================! 
     626      !                       !==  namelist namnc4  ==!   NetCDF 4 case   ("key_netcdf4" defined) 
     627      !                       !=======================! 
     628      ! 
    549629      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 
    550630907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist' ) 
    … …  
    555635      IF(lwp) THEN                        ! control print 
    556636         WRITE(numout,*) 
    557          WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters' 
     637         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters ("key_netcdf4" defined)' 
    558638         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i 
    559639         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j 
    … …  
    618698   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 
    619699      !!---------------------------------------------------------------------- 
    620       !!                     ***  ROUTINE dom_nam  *** 
     700      !!                     ***  ROUTINE domain_cfg  *** 
    621701      !!                     
    622702      !! ** Purpose :   read the domain size in domain configuration file 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/dommsk.F90

    r13461 r14054  
    181181      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 
    182182      ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 
     183      IF( lk_SWE ) THEN      ! Shallow Water Eq. case : redefine ssfmask 
     184         DO_2D( 0,0 , 0,0 ) 
     185            ssfmask(ji,jj) = MAX(  ssmask(ji,jj+1), ssmask(ji+1,jj+1),  &  
     186               &                   ssmask(ji,jj  ), ssmask(ji+1,jj  )   ) 
     187         END_2D 
     188         CALL lbc_lnk( 'dommsk', ssfmask, 'F', 1.0_wp ) 
     189      ENDIF 
     190#if defined key_qco 
     191      fe3mask(:,:,:) = fmask(:,:,:) 
     192#endif 
    183193 
    184194      ! Interior domain mask  (used for global sum) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/domqco.F90

    r14049 r14054  
    88   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl: vvl option includes z_star and z_tilde coordinates 
    99   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    10    !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 
    11    !!            4.x  !  2020-02  (G. Madec, S. Techene) pure z* (quasi-eulerian) coordinate 
    12    !!---------------------------------------------------------------------- 
    13  
    14    !!---------------------------------------------------------------------- 
    15    !!   dom_qe_init   : define initial vertical scale factors, depths and column thickness 
    16    !!   dom_qe_r3c    : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points 
    17    !!       qe_rst_read : read/write restart file 
    18    !!   dom_qe_ctl    : Check the vvl options 
     10   !!            4.1  !  2019-08  (A. Coward, D. Storkey) add time level indices for prognostic variables 
     11   !!             -   !  2020-02  (S. Techene, G. Madec) quasi-eulerian coordinate (z* or s*) 
     12   !!---------------------------------------------------------------------- 
     13 
     14   !!---------------------------------------------------------------------- 
     15   !!   dom_qco_init  : define initial vertical scale factors, depths and column thickness 
     16   !!   dom_qco_zgr   : Set ssh/h_0 ratio at t 
     17   !!   dom_qco_r3c   : Compute ssh/h_0 ratio at t-, u-, v-, and optionally f-points 
     18   !!       qco_ctl   : Check the vvl options 
    1919   !!---------------------------------------------------------------------- 
    2020   USE oce            ! ocean dynamics and tracers 
    … …  
    5555   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints 
    5656 
    57    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport 
    58  
    5957   !! * Substitutions 
    6058#  include "do_loop_substitute.h90" 
    … …  
    7977      !! 
    8078      !!---------------------------------------------------------------------- 
    81       INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
     79      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa   ! time level indices 
     80      !!---------------------------------------------------------------------- 
    8281      ! 
    8382      IF(lwp) WRITE(numout,*) 
    … …  
    8584      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    8685      ! 
    87       CALL dom_qco_ctl     ! choose vertical coordinate (z_star, z_tilde or layer) 
    88       ! 
    89       !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
    90       CALL qe_rst_read( nit000, Kbb, Kmm ) 
    91       ! 
    92       CALL dom_qco_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 
     86      CALL qco_ctl                            ! choose vertical coordinate (z_star, z_tilde or layer) 
     87      ! 
     88      CALL dom_qco_zgr( Kbb, Kmm )            ! interpolation scale factor, depth and water column 
     89      ! 
     90#if defined key_agrif 
     91      ! We need to define r3[tuv](Kaa) for AGRIF initialisation (should not be a 
     92      ! problem for the restartability...) 
     93      r3t(:,:,Kaa) = r3t(:,:,Kmm) 
     94      r3u(:,:,Kaa) = r3u(:,:,Kmm) 
     95      r3v(:,:,Kaa) = r3v(:,:,Kmm) 
     96#endif 
    9397      ! 
    9498   END SUBROUTINE dom_qco_init 
    9599 
    96100 
    97    SUBROUTINE dom_qco_zgr(Kbb, Kmm, Kaa) 
     101   SUBROUTINE dom_qco_zgr( Kbb, Kmm ) 
    98102      !!---------------------------------------------------------------------- 
    99103      !!                ***  ROUTINE dom_qco_init  *** 
    100104      !! 
    101       !! ** Purpose :  Initialization of all ssh. to h._0 ratio 
    102       !! 
    103       !! ** Method  :  - interpolate scale factors 
    104       !! 
    105       !! ** Action  : - r3(t/u/v)_b 
    106       !!              - r3(t/u/v/f)_n 
    107       !! 
    108       !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling. 
    109       !!---------------------------------------------------------------------- 
    110       INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
     105      !! ** Purpose :  Initialization of all r3. = ssh./h._0 ratios 
     106      !! 
     107      !! ** Method  :  Call domqco using Kbb and Kmm 
     108      !!               NB: dom_qco_zgr is called by dom_qco_init it uses ssh from ssh_init  
     109      !! 
     110      !! ** Action  : - r3(t/u/v)(Kbb) 
     111      !!              - r3(t/u/v/f)(Kmm) 
     112      !!---------------------------------------------------------------------- 
     113      INTEGER, INTENT(in) ::   Kbb, Kmm   ! time level indices 
    111114      !!---------------------------------------------------------------------- 
    112115      ! 
    113116      !                    !== Set of all other vertical scale factors  ==!  (now and before) 
    114117      !                                ! Horizontal interpolation of e3t 
    115       CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 
     118      CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb)           ) 
    116119      CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
    117120      ! 
    … …  
    143146      !                                      !==  ratio at u-,v-point  ==! 
    144147      ! 
    145       IF( ln_dynadv_vec ) THEN                     !- Vector Form   (thickness weighted averaging) 
     148!!st      IF( ln_dynadv_vec ) THEN                     !- Vector Form   (thickness weighted averaging) 
     149#if ! defined key_qcoTest_FluxForm 
     150      !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    146151         DO_2D( 0, 0, 0, 0 ) 
    147152            pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  & 
    … …  
    150155               &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 
    151156         END_2D 
    152       ELSE                                         !- Flux Form   (simple averaging) 
     157!!st      ELSE                                         !- Flux Form   (simple averaging) 
     158#else 
    153159         DO_2D( 0, 0, 0, 0 ) 
    154             pr3u(ji,jj) = 0.5_wp * (  pssh(ji  ,jj) + pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) 
    155             pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj  ) + pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) 
     160            pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj) 
     161            pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj) 
    156162         END_2D 
    157       ENDIF 
     163!!st      ENDIF 
     164#endif          
    158165      ! 
    159166      IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only 
    … …  
    163170      ELSE                                   !==  ratio at f-point  ==! 
    164171         ! 
    165          IF( ln_dynadv_vec )   THEN                !- Vector Form   (thickness weighted averaging) 
    166             DO_2D( 1, 0, 1, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
     172!!st         IF( ln_dynadv_vec )   THEN                !- Vector Form   (thickness weighted averaging) 
     173#if ! defined key_qcoTest_FluxForm 
     174         !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
     175 
     176            DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    167177               pr3f(ji,jj) = 0.25_wp * (  e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )  & 
    168178                  &                     + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )  & 
    … …  
    170180                  &                     + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 
    171181            END_2D 
    172          ELSE                                      !- Flux Form   (simple averaging) 
    173             DO_2D( 1, 0, 1, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    174                pr3f(ji,jj) = 0.25_wp * (  pssh(ji  ,jj  ) + pssh(ji+1,jj  )  & 
    175                   &                     + pssh(ji  ,jj+1) + pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) 
     182!!st         ELSE                                      !- Flux Form   (simple averaging) 
     183#else 
     184            DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
     185               pr3f(ji,jj) = 0.25_wp * (  pssh(ji,jj  ) + pssh(ji+1,jj  )  & 
     186                  &                     + pssh(ji,jj+1) + pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) 
    176187            END_2D 
    177          ENDIF 
     188!!st         ENDIF 
     189#endif 
    178190         !                                                 ! lbc on ratio at u-,v-,f-points 
    179191         CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
    … …  
    184196 
    185197 
    186    SUBROUTINE qe_rst_read( kt, Kbb, Kmm ) 
     198   SUBROUTINE qco_ctl 
    187199      !!--------------------------------------------------------------------- 
    188       !!                   ***  ROUTINE qe_rst_read  *** 
    189       !! 
    190       !! ** Purpose :   Read ssh in restart file 
    191       !! 
    192       !! ** Method  :   use of IOM library 
    193       !!                if the restart does not contain ssh, 
    194       !!                it is set to the _0 values. 
    195       !!---------------------------------------------------------------------- 
    196       INTEGER         , INTENT(in) ::   kt        ! ocean time-step 
    197       INTEGER         , INTENT(in) ::   Kbb, Kmm  ! ocean time level indices 
    198       ! 
    199       INTEGER ::   ji, jj, jk 
    200       INTEGER ::   id1, id2     ! local integers 
    201       !!---------------------------------------------------------------------- 
    202       ! 
    203          IF( ln_rstart ) THEN                   !* Read the restart file 
    204             CALL rst_read_open                  !  open the restart file if necessary 
    205             ! 
    206             id1 = iom_varid( numror, 'sshb', ldstop = .FALSE. ) 
    207             id2 = iom_varid( numror, 'sshn', ldstop = .FALSE. ) 
    208             ! 
    209             !                             ! --------- ! 
    210             !                             ! all cases ! 
    211             !                             ! --------- ! 
    212             ! 
    213             IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    214                CALL iom_get( numror, jpdom_auto, 'sshb'   , ssh(:,:,Kbb)    ) 
    215                CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
    216                ! needed to restart if land processor not computed 
    217                IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' 
    218                WHERE ( ssmask(:,:) == 0.0_wp )   !!gm/st ==> sm should not be necessary on ssh when it was required on e3 
    219                   ssh(:,:,Kmm) = 0._wp 
    220                   ssh(:,:,Kbb) = 0._wp 
    221                END WHERE 
    222                IF( l_1st_euler ) THEN 
    223                   ssh(:,:,Kbb) = ssh(:,:,Kmm) 
    224                ENDIF 
    225             ELSE IF( id1 > 0 ) THEN 
    226                IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart files' 
    227                IF(lwp) write(numout,*) 'sshn set equal to sshb.' 
    228                IF(lwp) write(numout,*) 'neuler is forced to 0' 
    229                CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 
    230                ssh(:,:,Kmm) = ssh(:,:,Kbb) 
    231                l_1st_euler = .TRUE. 
    232             ELSE IF( id2 > 0 ) THEN 
    233                IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kbb) not found in restart files' 
    234                IF(lwp) write(numout,*) 'sshb set equal to sshn.' 
    235                IF(lwp) write(numout,*) 'neuler is forced to 0' 
    236                CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm) ) 
    237                ssh(:,:,Kbb) = ssh(:,:,Kmm) 
    238                l_1st_euler = .TRUE. 
    239             ELSE 
    240                IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart file' 
    241                IF(lwp) write(numout,*) 'ssh_b and ssh_n set to zero' 
    242                IF(lwp) write(numout,*) 'neuler is forced to 0' 
    243                ssh(:,:,:) = 0._wp 
    244                l_1st_euler = .TRUE. 
    245             ENDIF 
    246             ! 
    247          ELSE                                   !* Initialize at "rest" 
    248             ! 
    249             IF( ll_wd ) THEN   ! MJB ll_wd edits start here - these are essential 
    250                ! 
    251                IF( cn_cfg == 'wad' ) THEN            ! Wetting and drying test case 
    252                   CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    253                   ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    254                   ssh(:,:    ,Kmm) = ssh(:,:    ,Kbb) 
    255                   uu (:,:,:  ,Kmm) = uu (:,:,:  ,Kbb) 
    256                   vv (:,:,:  ,Kmm) = vv (:,:,:  ,Kbb) 
    257                ELSE                                  ! if not test case 
    258                   ssh(:,:,Kmm) = -ssh_ref 
    259                   ssh(:,:,Kbb) = -ssh_ref 
    260                   ! 
    261                   DO_2D( 1, 1, 1, 1 ) 
    262                      IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
    263                         ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
    264                         ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
    265                      ENDIF 
    266                   END_2D 
    267                ENDIF 
    268  
    269                DO ji = 1, jpi 
    270                   DO jj = 1, jpj 
    271                      IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    272                        CALL ctl_stop( 'qe_rst_read: ht_0 must be positive at potentially wet points' ) 
    273                      ENDIF 
    274                   END DO 
    275                END DO 
    276                ! 
    277             ELSE 
    278                ! 
    279                ! Just to read set ssh in fact, called latter once vertical grid 
    280                ! is set up: 
    281 !               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    282 !               ! 
    283                 ssh(:,:,:) = 0._wp 
    284                ! 
    285             ENDIF           ! end of ll_wd edits 
    286             ! 
    287          ENDIF 
    288       ! 
    289    END SUBROUTINE qe_rst_read 
    290  
    291  
    292    SUBROUTINE dom_qco_ctl 
    293       !!--------------------------------------------------------------------- 
    294       !!                  ***  ROUTINE dom_qco_ctl  *** 
     200      !!                  ***  ROUTINE qco_ctl  *** 
    295201      !! 
    296202      !! ** Purpose :   Control the consistency between namelist options 
    … …  
    312218      IF(lwp) THEN                    ! Namelist print 
    313219         WRITE(numout,*) 
    314          WRITE(numout,*) 'dom_qco_ctl : choice/control of the variable vertical coordinate' 
    315          WRITE(numout,*) '~~~~~~~~~~~' 
     220         WRITE(numout,*) 'qco_ctl : choice/control of the variable vertical coordinate' 
     221         WRITE(numout,*) '~~~~~~~~' 
    316222         WRITE(numout,*) '   Namelist nam_vvl : chose a vertical coordinate' 
    317223         WRITE(numout,*) '      zstar                      ln_vvl_zstar   = ', ln_vvl_zstar 
    … …  
    357263#endif 
    358264      ! 
    359    END SUBROUTINE dom_qco_ctl 
     265   END SUBROUTINE qco_ctl 
    360266 
    361267   !!====================================================================== 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/domvvl.F90

    r14049 r14054  
    99   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1010   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 
    11    !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
     11   !!             -   ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1212   !!---------------------------------------------------------------------- 
    1313 
    … …  
    766766      !! ** Purpose :   Read or write VVL file in restart file 
    767767      !! 
    768       !! ** Method  :   use of IOM library 
    769       !!                if the restart does not contain vertical scale factors, 
    770       !!                they are set to the _0 values 
    771       !!                if the restart does not contain vertical scale factors increments (z_tilde), 
    772       !!                they are set to 0. 
     768      !! ** Method  : * restart comes from a linear ssh simulation : 
     769      !!                   an attempt to read e3t_n stops simulation 
     770      !!              * restart comes from a z-star, z-tilde, or layer : 
     771      !!                   read e3t_n and e3t_b 
     772      !!              * restart comes from a z-star : 
     773      !!                   set tilde_e3t_n, tilde_e3t_n, and hdiv_lf to 0 
     774      !!              * restart comes from layer : 
     775      !!                   read tilde_e3t_n and tilde_e3t_b 
     776      !!                   set hdiv_lf to 0 
     777      !!              * restart comes from a z-tilde: 
     778      !!                   read tilde_e3t_n, tilde_e3t_b, and hdiv_lf 
     779      !! 
     780      !!              NB: if l_1st_euler = T (ln_1st_euler or ssh_b not found) 
     781      !!                   Kbb fields set to Kmm ones 
    773782      !!---------------------------------------------------------------------- 
    774783      INTEGER         , INTENT(in) ::   kt        ! ocean time-step 
    … …  
    776785      CHARACTER(len=*), INTENT(in) ::   cdrw      ! "READ"/"WRITE" flag 
    777786      ! 
    778       INTEGER ::   ji, jj, jk 
    779       INTEGER ::   id1, id2, id3, id4, id5     ! local integers 
    780       !!---------------------------------------------------------------------- 
    781       ! 
    782       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    783          !                                   ! =============== 
    784          IF( ln_rstart ) THEN                   !* Read the restart file 
    785             CALL rst_read_open                  !  open the restart file if necessary 
    786             CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
     787      INTEGER ::   ji, jj, jk      ! dummy loop indices 
     788      INTEGER ::   id3, id4, id5   ! local integers 
     789      !!---------------------------------------------------------------------- 
     790      ! 
     791      !                                      !=====================! 
     792      IF( TRIM(cdrw) == 'READ' ) THEN        !  Read / initialise  ! 
     793         !                                   !=====================! 
     794         ! 
     795         IF( ln_rstart ) THEN                   !==  Read the restart file  ==! 
    787796            ! 
    788             id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    789             id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 
    790             id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
     797            CALL rst_read_open                                          !*  open the restart file if necessary 
     798            !                                         ! --------- ! 
     799            !                                         ! all cases ! 
     800            !                                         ! --------- ! 
     801            ! 
     802            id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. )  !*  check presence 
    791803            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    792             id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
     804            id5 = iom_varid( numror, 'hdiv_lf'    , ldstop = .FALSE. ) 
    793805            ! 
    794             !                             ! --------- ! 
    795             !                             ! all cases ! 
    796             !                             ! --------- ! 
    797             ! 
    798             IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
     806            !                                                           !*  scale factors 
     807            IF(lwp) WRITE(numout,*)    '          Kmm scale factor read in the restart file' 
     808            CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
     809            WHERE ( tmask(:,:,:) == 0.0_wp )  
     810               e3t(:,:,:,Kmm) = e3t_0(:,:,:) 
     811            END WHERE 
     812            IF( l_1st_euler ) THEN                       ! euler 
     813               IF(lwp) WRITE(numout,*) '          Euler first time step : e3t(Kbb) = e3t(Kmm)' 
     814               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
     815            ELSE                                         ! leap frog 
     816               IF(lwp) WRITE(numout,*) '          Kbb scale factor read in the restart file' 
    799817               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    800                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    801                ! needed to restart if land processor not computed  
    802                IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    803818               WHERE ( tmask(:,:,:) == 0.0_wp )  
    804                   e3t(:,:,:,Kmm) = e3t_0(:,:,:) 
    805819                  e3t(:,:,:,Kbb) = e3t_0(:,:,:) 
    806820               END WHERE 
    807                IF( l_1st_euler ) THEN 
    808                   e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    809                ENDIF 
    810             ELSE IF( id1 > 0 ) THEN 
    811                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 
    812                IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    813                IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    814                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    815                e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    816                l_1st_euler = .true. 
    817             ELSE IF( id2 > 0 ) THEN 
    818                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 
    819                IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    820                IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    821                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    822                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    823                l_1st_euler = .true. 
    824             ELSE 
    825                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 
    826                IF(lwp) write(numout,*) 'Compute scale factor from sshn' 
    827                IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    828                DO jk = 1, jpk 
    829                   e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 
    830                       &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
    831                       &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk)) 
    832                END DO 
    833                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    834                l_1st_euler = .true. 
    835821            ENDIF 
    836             !                             ! ----------- ! 
    837             IF( ln_vvl_zstar ) THEN       ! z_star case ! 
    838                !                          ! ----------- ! 
     822            !                                         ! ------------ ! 
     823            IF( ln_vvl_zstar ) THEN                   ! z_star case ! 
     824               !                                      ! ------------ ! 
    839825               IF( MIN( id3, id4 ) > 0 ) THEN 
    840826                  CALL ctl_stop( 'dom_vvl_rst: z_star cannot restart from a z_tilde or layer run' ) 
    841827               ENDIF 
    842                !                          ! ----------------------- ! 
    843             ELSE                          ! z_tilde and layer cases ! 
    844                !                          ! ----------------------- ! 
    845                IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    846                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     828               !                                      ! ------------------------ ! 
     829            ELSE                                      !  z_tilde and layer cases ! 
     830               !                                      ! ------------------------ ! 
     831               ! 
     832               IF( id4 > 0 ) THEN                                       !*  scale factor increments 
     833                  IF(lwp) WRITE(numout,*)    '          Kmm scale factor increments read in the restart file' 
    847834                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
    848                ELSE                            ! one at least array is missing 
     835                  IF( l_1st_euler ) THEN                 ! euler 
     836                     IF(lwp) WRITE(numout,*) '          Euler first time step : tilde_e3t(Kbb) = tilde_e3t(Kmm)' 
     837                     tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 
     838                  ELSE                                   ! leap frog 
     839                     IF(lwp) WRITE(numout,*) '          Kbb scale factor increments read in the restart file' 
     840                     CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     841                  ENDIF 
     842               ELSE  
    849843                  tilde_e3t_b(:,:,:) = 0.0_wp 
    850844                  tilde_e3t_n(:,:,:) = 0.0_wp 
    851845               ENDIF 
    852                !                          ! ------------ ! 
    853                IF( ln_vvl_ztilde ) THEN   ! z_tilde case ! 
    854                   !                       ! ------------ ! 
     846               !                                      ! ------------ ! 
     847               IF( ln_vvl_ztilde ) THEN               ! z_tilde case ! 
     848                  !                                   ! ------------ ! 
    855849                  IF( id5 > 0 ) THEN  ! required array exists 
    856850                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    857851                  ELSE                ! array is missing 
    858                      hdiv_lf(:,:,:) = 0.0_wp 
     852                     hdiv_lf(:,:,:) = 0.0_wp  
    859853                  ENDIF 
    860854               ENDIF 
    861855            ENDIF 
    862856            ! 
    863          ELSE                                   !* Initialize at "rest" 
     857         ELSE                                   !==  Initialize at "rest" with ssh  ==! 
    864858            ! 
    865  
    866             IF( ll_wd ) THEN   ! MJB ll_wd edits start here - these are essential  
    867                ! 
    868                IF( cn_cfg == 'wad' ) THEN 
    869                   ! Wetting and drying test case 
    870                   CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    871                   ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    872                   ssh (:,:,Kmm)     = ssh(:,:,Kbb) 
    873                   uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    874                   vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    875                ELSE 
    876                   ! if not test case 
    877                   ssh(:,:,Kmm) = -ssh_ref 
    878                   ssh(:,:,Kbb) = -ssh_ref 
    879  
    880                   DO_2D( 1, 1, 1, 1 ) 
    881                      IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
    882                         ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
    883                         ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
    884                      ENDIF 
    885                   END_2D 
    886                ENDIF !If test case else 
    887  
    888                ! Adjust vertical metrics for all wad 
    889                DO jk = 1, jpk 
    890                   e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm)  ) & 
    891                     &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
    892                     &            + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
    893                END DO 
    894                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    895  
    896                DO_2D( 1, 1, 1, 1 ) 
    897                   IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    898                      CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
    899                   ENDIF 
    900                END_2D 
    901                ! 
    902             ELSE 
    903                ! 
    904                ! Just to read set ssh in fact, called latter once vertical grid 
    905                ! is set up: 
    906 !               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    907 !               ! 
    908 !               DO jk=1,jpk 
    909 !                  e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 
    910 !                     &            / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) 
    911 !               END DO 
    912 !               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    913                 ssh(:,:,Kmm)=0._wp 
    914                 e3t(:,:,:,Kmm)=e3t_0(:,:,:) 
    915                 e3t(:,:,:,Kbb)=e3t_0(:,:,:) 
    916                ! 
    917             END IF           ! end of ll_wd edits 
    918  
     859            DO jk = 1, jpk 
     860               e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * r1_ht_0(:,:) * tmask(:,:,jk) ) 
     861            END DO 
     862            e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
     863            ! 
    919864            IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 
    920865               tilde_e3t_b(:,:,:) = 0._wp 
    921866               tilde_e3t_n(:,:,:) = 0._wp 
    922867               IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp 
    923             END IF 
     868            ENDIF 
    924869         ENDIF 
    925          ! 
    926       ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
    927          !                                   ! =================== 
     870         !                                       !=======================! 
     871      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN       !  Create restart file  ! 
     872         !                                       !=======================! 
     873         ! 
    928874         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 
    929875         !                                           ! --------- ! 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/domzgr_substitute.h90

    r13237 r14054  
    1515#   define  e3u(i,j,k,t)   (e3u_0(i,j,k)*(1._wp+r3u(i,j,t)*umask(i,j,k))) 
    1616#   define  e3v(i,j,k,t)   (e3v_0(i,j,k)*(1._wp+r3v(i,j,t)*vmask(i,j,k))) 
    17 #   define  e3f(i,j,k)     (e3f_0(i,j,k)*(1._wp+r3f(i,j)*fmask(i,j,k))) 
     17#   define  e3f(i,j,k)     (e3f_0(i,j,k)*(1._wp+r3f(i,j)*fe3mask(i,j,k))) 
     18#   define  e3f_vor(i,j,k) (e3f_0vor(i,j,k)*(1._wp+r3f(i,j)*fe3mask(i,j,k))) 
    1819#   define  e3w(i,j,k,t)   (e3w_0(i,j,k)*(1._wp+r3t(i,j,t))) 
    1920#   define  e3uw(i,j,k,t)  (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 
    2021#   define  e3vw(i,j,k,t)  (e3vw_0(i,j,k)*(1._wp+r3v(i,j,t))) 
    21 #   define  ht(i,j)        (ht_0(i,j)+ssh(i,j,Kmm)) 
     22#   define  ht(i,j)        (ht_0(i,j)*(1._wp+r3t(i,j,Kmm))) 
    2223#   define  hu(i,j,t)      (hu_0(i,j)*(1._wp+r3u(i,j,t))) 
    2324#   define  hv(i,j,t)      (hv_0(i,j)*(1._wp+r3v(i,j,t))) 
    … …  
    2930#endif 
    3031!!---------------------------------------------------------------------- 
     32!!#   define  e3t_f(i,j,k)   (e3t_0(i,j,k)*(1._wp+r3t_f(i,j)*tmask(i,j,k))) 
     33!!#   define  e3u_f(i,j,k)   (e3u_0(i,j,k)*(1._wp+r3u_f(i,j)*umask(i,j,k))) 
     34!!#   define  e3v_f(i,j,k)   (e3v_0(i,j,k)*(1._wp+r3v_f(i,j)*vmask(i,j,k))) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/istate.F90

    r13295 r14054  
    4242   PRIVATE 
    4343 
    44    PUBLIC   istate_init   ! routine called by step.F90 
     44   PUBLIC   istate_init   ! routine called by nemogcm.F90 
    4545 
    4646   !! * Substitutions 
    … …  
    5959      !!  
    6060      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
     61      !! 
     62      !! ** Method  :    
    6163      !!---------------------------------------------------------------------- 
    6264      INTEGER, INTENT( in )  ::  Kbb, Kmm, Kaa   ! ocean time level indices 
    6365      ! 
    6466      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    65       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zgdept     ! 3D table  !!st patch to use gdept subtitute 
     67      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zgdept     ! 3D table for qco substitute 
    6668!!gm see comment further down 
    6769      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
    … …  
    7375      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    7476 
    75 !!gm  Why not include in the first call of dta_tsd ?   
    76 !!gm  probably associated with the use of internal damping... 
    7777       CALL dta_tsd_init        ! Initialisation of T & S input data 
    78 !!gm to be moved in usrdef of C1D case 
     78 
    7979!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
    80 !!gm 
    8180 
    82       rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    83       rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
    84       ts  (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk 
    85       rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
     81      rhd  (:,:,:      ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
     82      rn2b (:,:,:      ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
     83      ts   (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk 
     84      rab_b(:,:,:,:    ) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
    8685#if defined key_agrif 
    8786      uu   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization 
    … …  
    9695         CALL agrif_istate( Kbb, Kmm, Kaa )   ! Interp from parent 
    9796         ! 
    98          ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)  
    99          ssh (:,:,Kmm)     = ssh(:,:,Kbb) 
    100          uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    101          vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
     97         ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) 
     98!!st 
     99!!st need for a recent agrif version to be displaced toward ssh_init_rst with agrif_istate_ssh 
     100         ssh(:,:,    Kmm) = ssh(:,:    ,Kbb) 
     101!!st end 
     102         uu (:,:,:  ,Kmm) = uu (:,:,:  ,Kbb) 
     103         vv (:,:,:  ,Kmm) = vv (:,:,:  ,Kbb) 
    102104      ELSE 
    103105#endif 
    … …  
    117119            CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000 
    118120            ! 
    119             ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
    120             uu  (:,:,:,Kbb) = 0._wp 
    121             vv  (:,:,:,Kbb) = 0._wp   
     121            uu (:,:,:,Kbb) = 0._wp 
     122            vv (:,:,:,Kbb) = 0._wp   
    122123            ! 
    123             IF( ll_wd ) THEN 
    124                ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
    125                ! 
    126                ! Apply minimum wetdepth criterion 
    127                ! 
    128                DO_2D( 1, 1, 1, 1 ) 
    129                   IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
    130                      ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    131                   ENDIF 
    132                END_2D 
    133             ENDIF  
    134              ! 
    135124         ELSE                                 ! user defined initial T and S 
    136125            DO jk = 1, jpk 
    137126               zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 
    138127            END DO 
    139             CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
     128            CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) ) 
    140129         ENDIF 
    141          ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    142          ssh (:,:,Kmm)     = ssh(:,:,Kbb)    
    143          uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    144          vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    145  
    146 !!gm POTENTIAL BUG : 
    147 !!gm  ISSUE :  if ssh(:,:,Kbb) /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
    148 !!             as well as gdept_ and gdepw_....   !!!!!  
    149 !!      ===>>>>   probably a call to domvvl initialisation here.... 
    150  
     130         ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
     131         uu (:,:,:  ,Kmm) = uu (:,:,:  ,Kbb) 
     132         vv (:,:,:  ,Kmm) = vv (:,:,:  ,Kbb) 
    151133 
    152134         ! 
    153 !!gm to be moved in usrdef of C1D case 
    154 !         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
    155 !            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
    156 !            CALL dta_uvd( nit000, zuvd ) 
    157 !            uu(:,:,:,Kbb) = zuvd(:,:,:,1) ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 
    158 !            vv(:,:,:,Kbb) = zuvd(:,:,:,2) ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 
    159 !            DEALLOCATE( zuvd ) 
    160 !         ENDIF 
     135!!gm ==>>>  to be moved in usrdef_istate of C1D case  
     136         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
     137            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
     138            CALL dta_uvd( nit000, Kbb, zuvd ) 
     139            uu(:,:,:,Kbb) = zuvd(:,:,:,1) ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 
     140            vv(:,:,:,Kbb) = zuvd(:,:,:,2) ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 
     141            DEALLOCATE( zuvd ) 
     142         ENDIF 
    161143         ! 
    162 !!gm This is to be changed !!!! 
    163 !         ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here 
    164 !         IF( .NOT.ln_linssh ) THEN 
    165 !            DO jk = 1, jpk 
    166 !               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    167 !            END DO 
    168 !         ENDIF 
    169 !!gm  
    170144         !  
    171145      ENDIF  

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/phycst.F90

    r12489 r14054  
    6666   REAL(wp), PUBLIC ::   r1_rhos                     !: 1 / rhos 
    6767   REAL(wp), PUBLIC ::   r1_rcpi                     !: 1 / rcpi 
     68    
    6869   !!---------------------------------------------------------------------- 
    6970   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynadv.F90

    r12377 r14054  
    127127      IF( ioptio /= 1 )   CALL ctl_stop( 'choose ONE and only ONE advection scheme' ) 
    128128      IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 
    129  
     129#if defined key_qcoTest_FluxForm 
     130      IF( ln_dynadv_vec  ) THEN CALL ctl_stop( 'STOP', 'key_qcoTest_FluxForm requires flux form advection' ) 
     131#endif 
    130132 
    131133      IF(lwp) THEN                    ! Print the choice 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynatf_qco.F90

    r13295 r14054  
    1 MODULE dynatfqco 
     1MODULE dynatf_qco 
    22   !!========================================================================= 
    3    !!                       ***  MODULE  dynatfqco  *** 
     3   !!                       ***  MODULE  dynatf_qco  *** 
    44   !! Ocean dynamics: time filtering 
    55   !!========================================================================= 
    … …  
    5050   USE prtctl         ! Print control 
    5151   USE timing         ! Timing 
    52 #if defined key_agrif 
    53    USE agrif_oce_interp 
    54 #endif 
    5552 
    5653   IMPLICIT NONE 
    … …  
    199196      ! JC: Would be more clever to swap variables than to make a full vertical 
    200197      ! integration 
    201       ! 
     198      ! CAUTION : calculation need to be done in the same way than see GM   
    202199      uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 
    203       uu_b(:,:,Kmm) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 
     200      uu_b(:,:,Kmm) = (e3u_0(:,:,1) * ( 1._wp + r3u_f(:,:) * umask(:,:,1) )) * puu(:,:,1,Kmm) * umask(:,:,1) 
    204201      vv_b(:,:,Kaa) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 
    205       vv_b(:,:,Kmm) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
     202      vv_b(:,:,Kmm) = (e3v_0(:,:,1) * ( 1._wp + r3v_f(:,:) * vmask(:,:,1))) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
    206203      DO jk = 2, jpkm1 
    207204         uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 
    208          uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
     205         uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + (e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) )) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
    209206         vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
    210          vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
     207         vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + (e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) )) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
    211208      END DO 
    212209      uu_b(:,:,Kaa) = uu_b(:,:,Kaa) * r1_hu(:,:,Kaa) 
    213210      vv_b(:,:,Kaa) = vv_b(:,:,Kaa) * r1_hv(:,:,Kaa) 
    214       uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 
    215       vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 
     211      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * (r1_hu_0(:,:)/( 1._wp + r3u_f(:,:) )) 
     212      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * (r1_hv_0(:,:)/( 1._wp + r3v_f(:,:) )) 
    216213      ! 
    217214      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents 
    … …  
    235232 
    236233   !!========================================================================= 
    237 END MODULE dynatfqco 
     234END MODULE dynatf_qco 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynldf_lap_blp.F90

    r13497 r14054  
    55   !!====================================================================== 
    66   !! History : 3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian 
     7   !!           4.0  ! 2020-04  (A. Nasser, G. Madec)  Add symmetric mixing tensor  
    78   !!---------------------------------------------------------------------- 
    89 
    … …  
    1920   USE in_out_manager ! I/O manager 
    2021   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    21  
     22   USE lib_mpp 
     23    
    2224   IMPLICIT NONE 
    2325   PRIVATE 
    … …  
    4749      !! 
    4850      !! ** Action : - pu_rhs, pv_rhs increased by the harmonic operator applied on pu, pv. 
     51      !! 
     52      !! Reference : S.Griffies, R.Hallberg 2000 Mon.Wea.Rev., DOI:/  
    4953      !!---------------------------------------------------------------------- 
    5054      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    5761      REAL(wp) ::   zsign        ! local scalars 
    5862      REAL(wp) ::   zua, zva     ! local scalars 
    59       REAL(wp), DIMENSION(jpi,jpj) ::   zcur, zdiv 
     63      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zcur, zdiv 
     64      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zten, zshe   ! tension (diagonal) and shearing (anti-diagonal) terms 
    6065      !!---------------------------------------------------------------------- 
    6166      ! 
    … …  
    7075      ENDIF 
    7176      ! 
    72       !                                                ! =============== 
    73       DO jk = 1, jpkm1                                 ! Horizontal slab 
    74          !                                             ! =============== 
    75          DO_2D( 0, 1, 0, 1 ) 
    76             !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    77             zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
    78                &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
    79                &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
    80             !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
    81             zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask 
    82                &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
    83                &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
    84          END_2D 
     77      SELECT CASE( nn_dynldf_typ )   
     78      !               
     79      CASE ( np_typ_rot )       !==  Vorticity-Divergence operator  ==! 
    8580         ! 
    86          DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div ) 
    87             pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    88                &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
    89                &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      ) 
     81         ALLOCATE( zcur(jpi,jpj) , zdiv(jpi,jpj) ) 
     82         ! 
     83         DO jk = 1, jpkm1                                 ! Horizontal slab 
     84            ! 
     85            DO_2D( 0, 1, 0, 1 ) 
     86               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
     87               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
     88                  &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
     89                  &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
     90               !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
     91               zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask 
     92                  &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
     93                  &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
     94            END_2D 
     95            ! 
     96            DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div ) 
     97               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
     98                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
     99                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      ) 
    90100               ! 
    91             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use 
    92                &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   & 
    93                &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      ) 
    94          END_2D 
    95          !                                             ! =============== 
    96       END DO                                           !   End of slab 
    97       !                                                ! =============== 
     101               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use 
     102                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   & 
     103                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      ) 
     104            END_2D 
     105            ! 
     106         END DO                                           !   End of slab 
     107         ! 
     108         DEALLOCATE( zcur , zdiv ) 
     109         ! 
     110      CASE ( np_typ_sym )       !==  Symmetric operator  ==! 
     111         ! 
     112         ALLOCATE( zten(jpi,jpj) , zshe(jpi,jpj) ) 
     113         ! 
     114         DO jk = 1, jpkm1                                 ! Horizontal slab 
     115            ! 
     116            DO_2D( 0, 1, 0, 1 ) 
     117               !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask 
     118               zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk)                                                              & 
     119                  &     * (    e1f(ji-1,jj-1)    * r1_e2f(ji-1,jj-1)                                             & 
     120                  &         * ( pu(ji-1,jj  ,jk) * r1_e1u(ji-1,jj  )  - pu(ji-1,jj-1,jk) * r1_e1u(ji-1,jj-1) )   & 
     121                  &         +  e2f(ji-1,jj-1)    * r1_e1f(ji-1,jj-1)                                             & 
     122                  &         * ( pv(ji  ,jj-1,jk) * r1_e2v(ji  ,jj-1)  - pv(ji-1,jj-1,jk) * r1_e2v(ji-1,jj-1) )   )  
     123               !                                      ! tension stress component (T-point)   NB : ahmt has already been multiplied by tmask 
     124               zten(ji,jj)    = ahmt(ji,jj,jk)                                                       & 
     125                  &     * (    e2t(ji,jj)    * r1_e1t(ji,jj)                                         & 
     126                  &         * ( pu(ji,jj,jk) * r1_e2u(ji,jj)  - pu(ji-1,jj,jk) * r1_e2u(ji-1,jj) )   & 
     127                  &         -  e1t(ji,jj)    * r1_e2t(ji,jj)                                         & 
     128                  &         * ( pv(ji,jj,jk) * r1_e1v(ji,jj)  - pv(ji,jj-1,jk) * r1_e1v(ji,jj-1) )   )    
     129            END_2D 
     130            ! 
     131            DO_2D( 0, 0, 0, 0 ) 
     132               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                               & 
     133                  &    * (   (   zten(ji+1,jj  ) * e2t(ji+1,jj  )*e2t(ji+1,jj  ) * e3t(ji+1,jj  ,jk,Kmm)                       & 
     134                  &            - zten(ji  ,jj  ) * e2t(ji  ,jj  )*e2t(ji  ,jj  ) * e3t(ji  ,jj  ,jk,Kmm) ) * r1_e2u(ji,jj)     &                                                     
     135                  &        + (   zshe(ji  ,jj  ) * e1f(ji  ,jj  )*e1f(ji  ,jj  ) * e3f(ji  ,jj  ,jk)                           & 
     136                  &            - zshe(ji  ,jj-1) * e1f(ji  ,jj-1)*e1f(ji  ,jj-1) * e3f(ji  ,jj-1,jk)     ) * r1_e1u(ji,jj) )    
     137               ! 
     138               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)                               & 
     139                  &    * (   (   zshe(ji  ,jj  ) * e2f(ji  ,jj  )*e2f(ji  ,jj  ) * e3f(ji  ,jj  ,jk)                           & 
     140                  &            - zshe(ji-1,jj  ) * e2f(ji-1,jj  )*e2f(ji-1,jj  ) * e3f(ji-1,jj  ,jk)     ) * r1_e2v(ji,jj)     & 
     141                  &        - (   zten(ji  ,jj+1) * e1t(ji  ,jj+1)*e1t(ji  ,jj+1) * e3t(ji  ,jj+1,jk,Kmm)                       & 
     142                  &            - zten(ji  ,jj  ) * e1t(ji  ,jj  )*e1t(ji  ,jj  ) * e3t(ji  ,jj  ,jk,Kmm) ) * r1_e1v(ji,jj) ) 
     143               ! 
     144            END_2D 
     145            ! 
     146         END DO 
     147         ! 
     148         DEALLOCATE( zten , zshe ) 
     149         ! 
     150      END SELECT 
    98151      ! 
    99152   END SUBROUTINE dyn_ldf_lap 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynspg_ts.F90

    r14049 r14054  
    306306      ENDIF 
    307307      ! 
    308       !                                   !=  Add atmospheric pressure forcing  =! 
    309       !                                   !  ----------------------------------  ! 
    310       IF( ln_bt_fw ) THEN                        ! Add wind forcing 
     308      !                                   !=  Add wind forcing  =! 
     309      !                                   !  ------------------  ! 
     310      IF( ln_bt_fw ) THEN 
    311311         DO_2D( 0, 0, 0, 0 ) 
    312312            zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kmm) 
    … …  
    386386      ! 
    387387      IF( ln_linssh ) THEN    ! mid-step ocean depth is fixed (hup2_e=hu_n=hu_0) 
    388          zhup2_e(:,:) = hu(:,:,Kmm) 
    389          zhvp2_e(:,:) = hv(:,:,Kmm) 
    390          zhtp2_e(:,:) = ht(:,:) 
    391       ENDIF 
    392       ! 
    393       IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    394          sshn_e(:,:) =    pssh(:,:,Kmm)             
     388         zhup2_e(:,:) = hu_0(:,:) 
     389         zhvp2_e(:,:) = hv_0(:,:) 
     390         zhtp2_e(:,:) = ht_0(:,:) 
     391      ENDIF 
     392      ! 
     393      IF( ln_bt_fw ) THEN                 ! FORWARD integration: start from NOW fields                     
     394         sshn_e(:,:) =    pssh (:,:,Kmm)             
    395395         un_e  (:,:) =    puu_b(:,:,Kmm)             
    396396         vn_e  (:,:) =    pvv_b(:,:,Kmm) 
    … …  
    401401         hvr_e (:,:) = r1_hv(:,:,Kmm) 
    402402      ELSE                                ! CENTRED integration: start from BEFORE fields 
    403          sshn_e(:,:) =    pssh(:,:,Kbb) 
     403         sshn_e(:,:) =    pssh (:,:,Kbb) 
    404404         un_e  (:,:) =    puu_b(:,:,Kbb)          
    405405         vn_e  (:,:) =    pvv_b(:,:,Kbb) 
    … …  
    412412      ! 
    413413      ! Initialize sums: 
    414       puu_b  (:,:,Kaa) = 0._wp       ! After barotropic velocities (or transport if flux form)           
    415       pvv_b  (:,:,Kaa) = 0._wp 
     414      puu_b (:,:,Kaa) = 0._wp       ! After barotropic velocities (or transport if flux form)           
     415      pvv_b (:,:,Kaa) = 0._wp 
    416416      pssh  (:,:,Kaa) = 0._wp       ! Sum for after averaged sea level 
    417       un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop 
    418       vn_adv(:,:) = 0._wp 
     417      un_adv(:,:)     = 0._wp       ! Sum for now transport issued from ts loop 
     418      vn_adv(:,:)     = 0._wp 
    419419      ! 
    420420      IF( ln_wd_dl ) THEN 
    … …  
    475475            ! 
    476476            !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk) 
     477#if defined key_qcoTest_FluxForm 
     478            !                                ! 'key_qcoTest_FluxForm' : simple ssh average 
     479            DO_2D( 1, 1, 1, 0 )   ! not jpi-column 
     480               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * (  zsshp2_e(ji,jj) + zsshp2_e(ji+1,jj  )  ) * ssumask(ji,jj) 
     481            END_2D 
     482            DO_2D( 1, 0, 1, 1 ) 
     483               zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * (  zsshp2_e(ji,jj) + zsshp2_e(ji  ,jj+1)  ) * ssvmask(ji,jj) 
     484            END_2D 
     485#else 
     486            !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    477487            DO_2D( 1, 1, 1, 0 )   ! not jpi-column 
    478488               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        & 
    … …  
    485495                    &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
    486496            END_2D 
     497#endif                
    487498            ! 
    488499         ENDIF 
    … …  
    540551         !   
    541552         ! Sea Surface Height at u-,v-points (vvl case only) 
    542          IF( .NOT.ln_linssh ) THEN                                 
     553         IF( .NOT.ln_linssh ) THEN 
     554#if defined key_qcoTest_FluxForm 
     555            !                                ! 'key_qcoTest_FluxForm' : simple ssh average 
     556            DO_2D( 1, 1, 1, 0 ) 
     557               zsshu_a(ji,jj) = r1_2 * (  ssha_e(ji,jj) + ssha_e(ji+1,jj  )  ) * ssumask(ji,jj) 
     558            END_2D 
     559            DO_2D( 1, 0, 1, 1 ) 
     560               zsshv_a(ji,jj) = r1_2 * (  ssha_e(ji,jj) + ssha_e(ji  ,jj+1)  ) * ssvmask(ji,jj) 
     561            END_2D 
     562#else 
    543563            DO_2D( 0, 0, 0, 0 ) 
    544                zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    & 
    545                   &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
    546                   &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) ) 
    547                zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    & 
    548                   &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
    549                   &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) ) 
    550             END_2D 
    551          ENDIF    
     564               zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  )   & 
     565                  &                                      + e1e2t(ji+1,jj  ) * ssha_e(ji+1,jj  ) ) * ssumask(ji,jj) 
     566               zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  )   & 
     567                  &                                      + e1e2t(ji  ,jj+1) * ssha_e(ji  ,jj+1) ) * ssvmask(ji,jj) 
     568            END_2D 
     569#endif 
     570         ENDIF 
    552571         !          
    553572         ! Half-step back interpolation of SSH for surface pressure computation at step jit+1/2 
    … …  
    624643               !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 
    625644               !                    ! backward interpolated depth used in spg terms at jn+1/2 
     645#if defined key_qcoTest_FluxForm 
     646            !                                ! 'key_qcoTest_FluxForm' : simple ssh average 
     647               zhu_bck = hu_0(ji,jj) + r1_2 * (  zsshp2_e(ji,jj) + zsshp2_e(ji+1,jj  )  ) * ssumask(ji,jj) 
     648               zhv_bck = hv_0(ji,jj) + r1_2 * (  zsshp2_e(ji,jj) + zsshp2_e(ji  ,jj+1)  ) * ssvmask(ji,jj) 
     649#else 
    626650               zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    & 
    627651                    &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
    628652               zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    & 
    629653                    &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
     654#endif 
    630655               !                    ! inverse depth at jn+1 
    631656               z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    … …  
    646671         IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 
    647672            DO_2D( 0, 0, 0, 0 ) 
    648                   ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj)) 
    649                   va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj)) 
     673               ua_e(ji,jj) =  ua_e(ji,jj) / ( 1._wp - rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj) ) 
     674               va_e(ji,jj) =  va_e(ji,jj) / ( 1._wp - rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj) ) 
    650675            END_2D 
    651676         ENDIF 
    652677        
    653678         IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 
    654             hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 
    655             hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 
    656             hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 
    657             hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 
     679            hu_e (2:jpim1,2:jpjm1) =    hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 
     680            hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / (  hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 
     681            hv_e (2:jpim1,2:jpjm1) =    hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 
     682            hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / (  hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 
    658683         ENDIF 
    659684         ! 
    … …  
    743768      ELSE 
    744769         ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points 
     770#if defined key_qcoTest_FluxForm 
     771         !                                ! 'key_qcoTest_FluxForm' : simple ssh average 
    745772         DO_2D( 1, 0, 1, 0 ) 
    746             zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) & 
    747                &              * ( e1e2t(ji  ,jj) * pssh(ji  ,jj,Kaa)      & 
    748                &              +   e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) 
    749             zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) & 
    750                &              * ( e1e2t(ji,jj  ) * pssh(ji,jj  ,Kaa)      & 
    751                &              +   e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) 
    752          END_2D 
     773            zsshu_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji+1,jj  ,Kaa) ) * ssumask(ji,jj) 
     774            zsshv_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji  ,jj+1,Kaa) ) * ssvmask(ji,jj) 
     775         END_2D 
     776#else 
     777         DO_2D( 1, 0, 1, 0 ) 
     778            zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji  ,jj) * pssh(ji  ,jj,Kaa)   & 
     779               &                                      + e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) * ssumask(ji,jj) 
     780            zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj  ) * pssh(ji,jj  ,Kaa)   & 
     781               &                                      + e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) * ssvmask(ji,jj) 
     782         END_2D 
     783#endif    
    753784         CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
    754785         ! 
    755786         DO jk=1,jpkm1 
    756             puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b 
    757             pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b 
     787            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm)   & 
     788               &             * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b 
     789            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm)   & 
     790               &             * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b 
    758791         END DO 
    759792         ! Save barotropic velocities not transport: 
    … …  
    899932      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    900933         !                                   ! --------------- 
    901          IF( ln_rstart .AND. ln_bt_fw .AND. (.NOT.l_1st_euler) ) THEN    !* Read the restart file 
     934         IF( ln_rstart .AND. ln_bt_fw .AND. .NOT.l_1st_euler ) THEN    !* Read the restart file 
    902935            CALL iom_get( numror, jpdom_auto, 'ub2_b'  , ub2_b  (:,:), cd_type = 'U', psgn = -1._wp )    
    903936            CALL iom_get( numror, jpdom_auto, 'vb2_b'  , vb2_b  (:,:), cd_type = 'V', psgn = -1._wp )  
    … …  
    10601093      !! although they should be updated in the variable volume case. Not a big approximation. 
    10611094      !! To remove this approximation, copy lines below inside barotropic loop 
    1062       !! and update depths at T-F points (ht and zhf resp.) at each barotropic time step 
     1095      !! and update depths at T- points (ht) at each barotropic time step 
    10631096      !! 
    10641097      !! Compute zwz = f / ( height of the water colomn ) 
    … …  
    10671100      INTEGER  ::   ji ,jj, jk              ! dummy loop indices 
    10681101      REAL(wp) ::   z1_ht 
    1069       REAL(wp), DIMENSION(jpi,jpj) :: zhf 
    10701102      !!---------------------------------------------------------------------- 
    10711103      ! 
    10721104      SELECT CASE( nvor_scheme ) 
    1073       CASE( np_EEN )                != EEN scheme using e3f energy & enstrophy scheme 
    1074          SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point 
     1105      CASE( np_EEN, np_ENE, np_ENS , np_MIX )   !=  schemes using the same e3f definition 
     1106         SELECT CASE( nn_e3f_typ )                  !* ff_f/e3 at F-point 
    10751107         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    1076             DO_2D( 1, 0, 1, 0 ) 
    1077                zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    & 
    1078                     &           ht(ji  ,jj  ) + ht(ji+1,jj  )  ) * 0.25_wp   
     1108            DO_2D( 0, 0, 0, 0 ) 
     1109               zwz(ji,jj) = ( ht(ji,jj+1) + ht(ji+1,jj+1)   & 
     1110                    &       + ht(ji,jj  ) + ht(ji+1,jj  ) ) * 0.25_wp   
    10791111               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    10801112            END_2D 
    10811113         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    1082             DO_2D( 1, 0, 1, 0 ) 
    1083                zwz(ji,jj) =             (  ht  (ji  ,jj+1) + ht  (ji+1,jj+1)      & 
    1084                     &                    + ht  (ji  ,jj  ) + ht  (ji+1,jj  )  )   & 
    1085                     &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      & 
    1086                     &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   ) 
     1114            DO_2D( 0, 0, 0, 0 ) 
     1115               zwz(ji,jj) =     (    ht(ji,jj+1) +     ht(ji+1,jj+1)      & 
     1116                    &            +   ht(ji,jj  ) +     ht(ji+1,jj  )  )   & 
     1117                    &    / ( MAX(ssmask(ji,jj+1) + ssmask(ji+1,jj+1)      & 
     1118                    &          + ssmask(ji,jj  ) + ssmask(ji+1,jj  ) , 1._wp  )   ) 
    10871119               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    10881120            END_2D 
    10891121         END SELECT 
    10901122         CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp ) 
    1091          ! 
    1092          ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
     1123      END SELECT 
     1124      ! 
     1125      SELECT CASE( nvor_scheme ) 
     1126      CASE( np_EEN ) 
     1127         ! 
     1128         ftne(1,:) = 0._wp   ;   ftnw(1,:) = 0._wp   ;   ftse(1,:) = 0._wp   ;   ftsw(1,:) = 0._wp 
    10931129         DO_2D( 0, 1, 0, 1 ) 
    10941130            ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
    … …  
    10981134         END_2D 
    10991135         ! 
    1100       CASE( np_EET )                  != EEN scheme using e3t energy conserving scheme 
    1101          ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
     1136      CASE( np_EET )                            != EEN scheme using e3t energy conserving scheme 
     1137         ftne(1,:) = 0._wp   ;   ftnw(1,:) = 0._wp   ;   ftse(1,:) = 0._wp   ;  ftsw(1,:) = 0._wp 
    11021138         DO_2D( 0, 1, 0, 1 ) 
    11031139            z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 
    … …  
    11081144         END_2D 
    11091145         ! 
    1110       CASE( np_ENE, np_ENS , np_MIX )  != all other schemes (ENE, ENS, MIX) except ENT ! 
    1111          ! 
    1112          zwz(:,:) = 0._wp 
    1113          zhf(:,:) = 0._wp 
    1114           
    1115          !!gm  assume 0 in both cases (which is almost surely WRONG ! ) as hvatf has been removed  
    1116 !!gm    A priori a better value should be something like : 
    1117 !!gm          zhf(i,j) = masked sum of  ht(i,j) , ht(i+1,j) , ht(i,j+1) , (i+1,j+1)  
    1118 !!gm                     divided by the sum of the corresponding mask  
    1119 !!gm  
    1120 !!             
    1121          IF( .NOT.ln_sco ) THEN 
    1122    
    1123    !!gm  agree the JC comment  : this should be done in a much clear way 
    1124    
    1125    ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case 
    1126    !     Set it to zero for the time being  
    1127    !              IF( rn_hmin < 0._wp ) THEN    ;   jk = - INT( rn_hmin )                                      ! from a nb of level 
    1128    !              ELSE                          ;   jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth 
    1129    !              ENDIF 
    1130    !              zhf(:,:) = gdepw_0(:,:,jk+1) 
    1131             ! 
    1132          ELSE 
    1133             ! 
    1134             !zhf(:,:) = hbatf(:,:) 
    1135             DO_2D( 1, 0, 1, 0 ) 
    1136                zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          & 
    1137                     &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      & 
    1138                     &     / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          & 
    1139                     &            + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  ) 
    1140             END_2D 
    1141          ENDIF 
    1142          ! 
    1143          DO jj = 1, jpjm1 
    1144             zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 
    1145          END DO 
    1146          ! 
    1147          DO jk = 1, jpkm1 
    1148             DO jj = 1, jpjm1 
    1149                zhf(:,jj) = zhf(:,jj) + e3f(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 
    1150             END DO 
    1151          END DO 
    1152          CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp ) 
    1153          ! JC: TBC. hf should be greater than 0  
    1154          DO_2D( 1, 1, 1, 1 ) 
    1155             IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj) 
    1156          END_2D 
    1157          zwz(:,:) = ff_f(:,:) * zwz(:,:) 
    11581146      END SELECT 
    11591147       
    11601148   END SUBROUTINE dyn_cor_2d_init 
    1161  
    11621149 
    11631150 
    … …  
    13531340   END SUBROUTINE wad_spg 
    13541341      
    1355  
    13561342 
    13571343   SUBROUTINE dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, pu_RHSi, pv_RHSi, pCdU_u, pCdU_v ) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynvor.F90

    r14049 r14054  
    2121   !!             -   ! 2018-03  (G. Madec)  add two new schemes (ln_dynvor_enT and ln_dynvor_eet) 
    2222   !!             -   ! 2018-04  (G. Madec)  add pre-computed gradient for metric term calculation 
     23   !!            4.x  ! 2020-03  (G. Madec, A. Nasser)  make ln_dynvor_msk truly efficient on relative vorticity 
    2324   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) add vortex force trends (ln_vortex_force=T) 
    2425   !!---------------------------------------------------------------------- 
    … …  
    2627   !!---------------------------------------------------------------------- 
    2728   !!   dyn_vor       : Update the momentum trend with the vorticity trend 
     29   !!       vor_enT   : energy conserving scheme at T-pt  (ln_dynvor_enT=T) 
     30   !!       vor_ene   : energy conserving scheme          (ln_dynvor_ene=T) 
    2831   !!       vor_ens   : enstrophy conserving scheme       (ln_dynvor_ens=T) 
    29    !!       vor_ene   : energy conserving scheme          (ln_dynvor_ene=T) 
    3032   !!       vor_een   : energy and enstrophy conserving   (ln_dynvor_een=T) 
     33   !!       vor_eeT   : energy conserving at T-pt         (ln_dynvor_eeT=T) 
    3134   !!   dyn_vor_init  : set and control of the different vorticity option 
    3235   !!---------------------------------------------------------------------- 
    … …  
    5861   LOGICAL, PUBLIC ::   ln_dynvor_eeT   !: t-point energy conserving scheme     (EET) 
    5962   LOGICAL, PUBLIC ::   ln_dynvor_een   !: energy & enstrophy conserving scheme (EEN) 
    60    INTEGER, PUBLIC ::      nn_een_e3f      !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    6163   LOGICAL, PUBLIC ::   ln_dynvor_mix   !: mixed scheme                         (MIX) 
    6264   LOGICAL, PUBLIC ::   ln_dynvor_msk   !: vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes) 
     65   INTEGER, PUBLIC ::   nn_e3f_typ      !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    6366 
    6467   INTEGER, PUBLIC ::   nvor_scheme     !: choice of the type of advection scheme 
    … …  
    8184   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2u_2        ! = di(e2u)/2          used in T-point metric term calculation 
    8285   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       -  
    83    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2v)/(2*e1e2f)  used in F-point metric term calculation 
    84    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1u)/(2*e1e2f)   -        -      -       -  
     86   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2u)/(2*e1e2f)  used in F-point metric term calculation 
     87   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1v)/(2*e1e2f)   -        -      -       - 
     88   ! 
     89   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   e3f_0vor   ! e3f used in EEN, ENE and ENS cases (key_qco only) 
    8590    
    8691   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4 
    … …  
    235240      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    236241      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars 
    237       REAL(wp), DIMENSION(jpi,jpj)       ::   zwx, zwy, zwt   ! 2D workspace 
    238       REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz             ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 
     242      REAL(wp), DIMENSION(jpi,jpj)     ::   zwx, zwy, zwt   ! 2D workspace 
     243      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwz      ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 
    239244      !!---------------------------------------------------------------------- 
    240245      ! 
    … …  
    246251      ! 
    247252      ! 
    248       SELECT CASE( kvor )                 !==  volume weighted vorticity considered  ==! 
    249       CASE ( np_RVO )                           !* relative vorticity 
    250          DO jk = 1, jpkm1                                 ! Horizontal slab 
     253      SELECT CASE( kvor )                 !== relative vorticity considered  ==! 
     254      ! 
     255      CASE ( np_RVO , np_CRV )                  !* relative vorticity at f-point is used 
     256         ALLOCATE( zwz(jpi,jpj,jpk) ) 
     257         DO jk = 1, jpkm1                                ! Horizontal slab 
    251258            DO_2D( 1, 0, 1, 0 ) 
    252259               zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    253260                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    254261            END_2D 
    255             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity  
     262            IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity  
    256263               DO_2D( 1, 0, 1, 0 ) 
    257264                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    … …  
    259266            ENDIF 
    260267         END DO 
    261  
    262268         CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    263  
    264       CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    265          DO jk = 1, jpkm1                                 ! Horizontal slab 
    266             DO_2D( 1, 0, 1, 0 )                          ! relative vorticity 
    267                zwz(ji,jj,jk) = (   e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)   & 
    268                   &              - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)   ) * r1_e1e2f(ji,jj) 
    269             END_2D 
    270             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity  
    271                DO_2D( 1, 0, 1, 0 ) 
    272                   zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    273                END_2D 
    274             ENDIF 
    275          END DO 
    276  
    277          CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    278  
     269         ! 
    279270      END SELECT 
    280271 
    281272      !                                                ! =============== 
    282273      DO jk = 1, jpkm1                                 ! Horizontal slab 
    283       !                                                ! =============== 
    284  
     274         !                                             ! =============== 
     275         ! 
    285276         SELECT CASE( kvor )                 !==  volume weighted vorticity considered  ==! 
     277         ! 
    286278         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    287279            zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm) 
    288280         CASE ( np_RVO )                           !* relative vorticity 
    289281            DO_2D( 0, 1, 0, 1 ) 
    290                zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)   & 
    291                   &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) & 
    292                   &                  * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 
     282               zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)       & 
     283                  &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk)   )  & 
     284                  &              * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 
    293285            END_2D 
    294286         CASE ( np_MET )                           !* metric term 
    295287            DO_2D( 0, 1, 0, 1 ) 
    296                zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)   & 
    297                   &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   ) & 
    298                   &             * e3t(ji,jj,jk,Kmm) 
     288               zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)       & 
     289                  &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   )   & 
     290                  &       * e3t(ji,jj,jk,Kmm) 
    299291            END_2D 
    300292         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    301293            DO_2D( 0, 1, 0, 1 ) 
    302                zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)    & 
    303                   &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  ) & 
    304                   &                                 * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 
     294               zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)        & 
     295                  &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  )   & 
     296                  &       * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 
    305297            END_2D 
    306298         CASE ( np_CME )                           !* Coriolis + metric 
    307299            DO_2D( 0, 1, 0, 1 ) 
    308                zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                           & 
    309                     &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)  & 
    310                     &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  ) & 
    311                     &          * e3t(ji,jj,jk,Kmm) 
     300               zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                               & 
     301                    &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)      & 
     302                    &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  )   & 
     303                    &     * e3t(ji,jj,jk,Kmm) 
    312304            END_2D 
    313305         CASE DEFAULT                                             ! error 
    314             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  ) 
     306            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor') 
    315307         END SELECT 
    316308         ! 
    … …  
    328320      END DO                                           !   End of slab 
    329321      !                                                ! =============== 
     322      ! 
     323      SELECT CASE( kvor )        ! deallocate zwz if necessary 
     324      CASE ( np_RVO , np_CRV )   ;   DEALLOCATE( zwz ) 
     325      END SELECT 
     326      ! 
    330327   END SUBROUTINE vor_enT 
    331328 
    … …  
    358355      ! 
    359356      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    360       REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars 
     357      REAL(wp) ::   zx1, zy1, zx2, zy2, ze3f, zmsk   ! local scalars 
    361358      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! 2D workspace 
    362359      !!---------------------------------------------------------------------- 
    … …  
    380377                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    381378            END_2D 
     379            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     380               DO_2D( 1, 0, 1, 0 ) 
     381                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
     382               END_2D 
     383            ENDIF 
    382384         CASE ( np_MET )                           !* metric term 
    383385            DO_2D( 1, 0, 1, 0 ) 
    … …  
    390392                  &                        - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    391393            END_2D 
     394            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity (NOT the Coriolis term) 
     395               DO_2D( 1, 0, 1, 0 ) 
     396                  zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
     397               END_2D 
     398            ENDIF 
    392399         CASE ( np_CME )                           !* Coriolis + metric 
    393400            DO_2D( 1, 0, 1, 0 ) 
    … …  
    399406         END SELECT 
    400407         ! 
    401          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
    402             DO_2D( 1, 0, 1, 0 ) 
    403                zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
    404             END_2D 
    405          ENDIF 
    406  
    407          IF( ln_sco ) THEN 
    408             zwz(:,:) = zwz(:,:) / e3f(:,:,jk) 
    409             zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    410             zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
    411          ELSE 
    412             zwx(:,:) = e2u(:,:) * pu(:,:,jk) 
    413             zwy(:,:) = e1v(:,:) * pv(:,:,jk) 
    414          ENDIF 
     408#if defined key_qco 
     409         DO_2D( 1, 0, 1, 0 )                 !==  potential vorticity  ==!   (key_qco) 
     410            zwz(ji,jj) = zwz(ji,jj) / e3f_vor(ji,jj,jk) 
     411         END_2D 
     412#else 
     413         SELECT CASE( nn_e3f_typ  )           !==  potential vorticity  ==! 
     414         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
     415            DO_2D( 1, 0, 1, 0 ) 
     416               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
     417                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
     418                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
     419                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  ) 
     420               IF( ze3f /= 0._wp ) THEN   ;   zwz(ji,jj) = zwz(ji,jj) * 4._wp / ze3f 
     421               ELSE                       ;   zwz(ji,jj) = 0._wp 
     422               ENDIF 
     423            END_2D 
     424         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
     425            DO_2D( 1, 0, 1, 0 ) 
     426               ze3f = (   e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
     427                  &     + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
     428                  &     + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
     429                  &     + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)   ) 
     430               zmsk = (   tmask(ji,jj+1,jk)   + tmask(ji+1,jj+1,jk)   & 
     431                  &     + tmask(ji,jj  ,jk)   + tmask(ji+1,jj  ,jk)   ) 
     432               IF( ze3f /= 0._wp ) THEN   ;   zwz(ji,jj) = zwz(ji,jj) * zmsk / ze3f 
     433               ELSE                       ;   zwz(ji,jj) = 0._wp 
     434               ENDIF 
     435            END_2D 
     436         END SELECT 
     437#endif 
     438         !                                   !==  horizontal fluxes  ==! 
     439         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
     440         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     441         ! 
    415442         !                                   !==  compute and add the vorticity term trend  =! 
    416443         DO_2D( 0, 0, 0, 0 ) 
    … …  
    455482      ! 
    456483      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    457       REAL(wp) ::   zuav, zvau   ! local scalars 
     484      REAL(wp) ::   zuav, zvau, ze3f, zmsk   ! local scalars 
    458485      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz, zww   ! 2D workspace 
    459486      !!---------------------------------------------------------------------- 
    … …  
    476503                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    477504            END_2D 
     505            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     506               DO_2D( 1, 0, 1, 0 ) 
     507                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
     508               END_2D 
     509            ENDIF 
    478510         CASE ( np_MET )                           !* metric term 
    479511            DO_2D( 1, 0, 1, 0 ) 
    … …  
    486518                  &                        - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    487519            END_2D 
     520            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity (NOT the Coriolis term) 
     521               DO_2D( 1, 0, 1, 0 ) 
     522                  zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
     523               END_2D 
     524            ENDIF 
    488525         CASE ( np_CME )                           !* Coriolis + metric 
    489526            DO_2D( 1, 0, 1, 0 ) 
    … …  
    495532         END SELECT 
    496533         ! 
    497          IF( ln_dynvor_msk ) THEN           !==  mask/unmask vorticity ==! 
    498             DO_2D( 1, 0, 1, 0 ) 
    499                zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
    500             END_2D 
    501          ENDIF 
    502          ! 
    503          IF( ln_sco ) THEN                   !==  horizontal fluxes  ==! 
    504             zwz(:,:) = zwz(:,:) / e3f(:,:,jk) 
    505             zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    506             zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
    507          ELSE 
    508             zwx(:,:) = e2u(:,:) * pu(:,:,jk) 
    509             zwy(:,:) = e1v(:,:) * pv(:,:,jk) 
    510          ENDIF 
     534         ! 
     535#if defined key_qco 
     536         DO_2D( 1, 0, 1, 0 )                 !==  potential vorticity  ==!   (key_qco) 
     537            zwz(ji,jj) = zwz(ji,jj) / e3f_vor(ji,jj,jk) 
     538         END_2D 
     539#else 
     540         SELECT CASE( nn_e3f_typ )           !==  potential vorticity  ==! 
     541         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
     542            DO_2D( 1, 0, 1, 0 ) 
     543               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
     544                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
     545                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
     546                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  ) 
     547               IF( ze3f /= 0._wp ) THEN   ;   zwz(ji,jj) = zwz(ji,jj) * 4._wp / ze3f 
     548               ELSE                       ;   zwz(ji,jj) = 0._wp 
     549               ENDIF 
     550            END_2D 
     551         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
     552            DO_2D( 1, 0, 1, 0 ) 
     553               ze3f = (   e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
     554                  &     + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
     555                  &     + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
     556                  &     + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)   ) 
     557               zmsk = (   tmask(ji,jj+1,jk)   + tmask(ji+1,jj+1,jk)   & 
     558                  &     + tmask(ji,jj  ,jk)   + tmask(ji+1,jj  ,jk)   ) 
     559               IF( ze3f /= 0._wp ) THEN   ;   zwz(ji,jj) = zwz(ji,jj) * zmsk / ze3f 
     560               ELSE                       ;   zwz(ji,jj) = 0._wp 
     561               ENDIF 
     562            END_2D 
     563         END SELECT 
     564#endif 
     565         !                                   !==  horizontal fluxes  ==! 
     566         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
     567         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     568         ! 
    511569         !                                   !==  compute and add the vorticity term trend  =! 
    512570         DO_2D( 0, 0, 0, 0 ) 
    … …  
    566624         !                                             ! =============== 
    567625         ! 
    568          SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point 
     626#if defined key_qco 
     627         DO_2D( 1, 0, 1, 0 )                 ! == reciprocal of e3 at F-point (key_qco) 
     628            z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk) 
     629         END_2D 
     630#else 
     631         SELECT CASE( nn_e3f_typ )           ! == reciprocal of e3 at F-point 
    569632         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    570633            DO_2D( 1, 0, 1, 0 ) 
    … …  
    590653            END_2D 
    591654         END SELECT 
     655#endif 
    592656         ! 
    593657         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
     658         ! 
    594659         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    595660            DO_2D( 1, 0, 1, 0 ) 
    … …  
    601666                  &            - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 
    602667            END_2D 
     668            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     669               DO_2D( 1, 0, 1, 0 ) 
     670                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
     671               END_2D 
     672            ENDIF 
    603673         CASE ( np_MET )                           !* metric term 
    604674            DO_2D( 1, 0, 1, 0 ) 
    … …  
    612682                  &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    613683            END_2D 
     684            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     685               DO_2D( 1, 0, 1, 0 ) 
     686                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)  
     687               END_2D 
     688            ENDIF 
    614689         CASE ( np_CME )                           !* Coriolis + metric 
    615690            DO_2D( 1, 0, 1, 0 ) 
    … …  
    620695            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  ) 
    621696         END SELECT 
    622          ! 
    623          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
    624             DO_2D( 1, 0, 1, 0 ) 
    625                zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    626             END_2D 
    627          ENDIF 
     697         !                                             ! =============== 
    628698      END DO                                           !   End of slab 
    629          ! 
     699      !                                                ! =============== 
     700      ! 
    630701      CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    631  
     702      ! 
     703      !                                                ! =============== 
    632704      DO jk = 1, jpkm1                                 ! Horizontal slab 
     705         !                                             ! =============== 
    633706         ! 
    634707         !                                   !==  horizontal fluxes  ==! 
    635708         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    636709         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
    637  
     710         ! 
    638711         !                                   !==  compute and add the vorticity term trend  =! 
    639          jj = 2 
    640          ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 
    641          DO ji = 2, jpi          ! split in 2 parts due to vector opt. 
    642                ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
    643                ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
    644                ztse(ji,jj) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
    645                ztsw(ji,jj) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) 
    646          END DO 
    647          DO jj = 3, jpj 
    648             DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3 
    649                ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
    650                ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
    651                ztse(ji,jj) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
    652                ztsw(ji,jj) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) 
    653             END DO 
    654          END DO 
     712         DO_2D( 0, 1, 0, 1 ) 
     713            ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
     714            ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
     715            ztse(ji,jj) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
     716            ztsw(ji,jj) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) 
     717         END_2D 
     718         ! 
    655719         DO_2D( 0, 0, 0, 0 ) 
    656720            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
    … …  
    667731 
    668732 
    669  
    670733   SUBROUTINE vor_eeT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs ) 
    671734      !!---------------------------------------------------------------------- 
    … …  
    685748      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    686749      !!---------------------------------------------------------------------- 
    687       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index 
     750      INTEGER                         , INTENT(in   ) ::   kt               ! ocean time-step index 
    688751      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index 
    689       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric 
    690       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
    691       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend 
     752      INTEGER                         , INTENT(in   ) ::   kvor             ! total, planetary, relative, or metric 
     753      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities 
     754      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! total v-trend 
    692755      ! 
    693756      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    … …  
    702765      IF( kt == nit000 ) THEN 
    703766         IF(lwp) WRITE(numout,*) 
    704          IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme' 
     767         IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme' 
    705768         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    706769      ENDIF 
    … …  
    722785                  &          * r1_e1e2f(ji,jj) 
    723786            END_2D 
     787            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     788               DO_2D( 1, 0, 1, 0 ) 
     789                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
     790               END_2D 
     791            ENDIF 
    724792         CASE ( np_MET )                           !* metric term 
    725793            DO_2D( 1, 0, 1, 0 ) 
    … …  
    733801                  &                         * r1_e1e2f(ji,jj)    ) 
    734802            END_2D 
     803            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     804               DO_2D( 1, 0, 1, 0 ) 
     805                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)  
     806               END_2D 
     807            ENDIF 
    735808         CASE ( np_CME )                           !* Coriolis + metric 
    736809            DO_2D( 1, 0, 1, 0 ) 
    … …  
    742815         END SELECT 
    743816         ! 
    744          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
    745             DO_2D( 1, 0, 1, 0 ) 
    746                zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    747             END_2D 
    748          ENDIF 
    749       END DO 
     817         !                                             ! =============== 
     818      END DO                                           !   End of slab 
     819      !                                                ! =============== 
    750820      ! 
    751821      CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    752822      ! 
     823      !                                                ! =============== 
    753824      DO jk = 1, jpkm1                                 ! Horizontal slab 
    754  
    755       !                                   !==  horizontal fluxes  ==! 
     825         !                                             ! =============== 
     826         ! 
     827         !                                   !==  horizontal fluxes  ==! 
    756828         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    757829         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
    758  
     830         ! 
    759831         !                                   !==  compute and add the vorticity term trend  =! 
    760          jj = 2 
    761          ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 
    762          DO ji = 2, jpi          ! split in 2 parts due to vector opt. 
    763                z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
    764                ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t 
    765                ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t 
    766                ztse(ji,jj) = ( zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 
    767                ztsw(ji,jj) = ( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) ) * z1_e3t 
    768          END DO 
    769          DO jj = 3, jpj 
    770             DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3 
    771                z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
    772                ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t 
    773                ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t 
    774                ztse(ji,jj) = ( zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 
    775                ztsw(ji,jj) = ( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) ) * z1_e3t 
    776             END DO 
    777          END DO 
     832         DO_2D( 0, 1, 0, 1 ) 
     833            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
     834            ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t 
     835            ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t 
     836            ztse(ji,jj) = ( zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 
     837            ztsw(ji,jj) = ( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) ) * z1_e3t 
     838         END_2D 
     839         ! 
    778840         DO_2D( 0, 0, 0, 0 ) 
    779841            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
    … …  
    799861      INTEGER ::   ji, jj, jk    ! dummy loop indices 
    800862      INTEGER ::   ioptio, ios   ! local integer 
     863      REAL(wp) ::   zmsk    ! local scalars 
    801864      !! 
    802865      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_enT, ln_dynvor_eeT,   & 
    803          &                 ln_dynvor_een, nn_een_e3f   , ln_dynvor_mix, ln_dynvor_msk 
     866         &                 ln_dynvor_een, nn_e3f_typ   , ln_dynvor_mix, ln_dynvor_msk 
    804867      !!---------------------------------------------------------------------- 
    805868      ! 
    … …  
    823886         WRITE(numout,*) '      energy conserving scheme  (een using e3t)      ln_dynvor_eeT = ', ln_dynvor_eeT 
    824887         WRITE(numout,*) '      enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een 
    825          WRITE(numout,*) '         e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f 
     888         WRITE(numout,*) '         e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_e3f_typ = ', nn_e3f_typ 
    826889         WRITE(numout,*) '      mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix 
    827890         WRITE(numout,*) '      masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk 
    828891      ENDIF 
    829  
    830       IF( ln_dynvor_msk )   CALL ctl_stop( 'dyn_vor_init:   masked vorticity is not currently not available') 
    831892 
    832893!!gm  this should be removed when choosing a unique strategy for fmask at the coast 
    … …  
    891952         ! 
    892953      END SELECT 
    893        
     954#if defined key_qco 
     955      SELECT CASE( nvor_scheme )    ! qco case: pre-computed a specific e3f_0 for some vorticity schemes 
     956      CASE( np_ENS , np_ENE , np_EEN , np_MIX ) 
     957         ! 
     958         ALLOCATE( e3f_0vor(jpi,jpj,jpk) ) 
     959         ! 
     960         SELECT CASE( nn_e3f_typ ) 
     961         CASE ( 0 )                        ! original formulation  (masked averaging of e3t divided by 4) 
     962            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     963               e3f_0vor(ji,jj,jk) = (   e3t_0(ji  ,jj+1,jk)*tmask(ji  ,jj+1,jk)   & 
     964                  &                   + e3t_0(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     965                  &                   + e3t_0(ji  ,jj  ,jk)*tmask(ji  ,jj  ,jk)   & 
     966                  &                   + e3t_0(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)   ) * 0.25_wp 
     967            END_3D 
     968         CASE ( 1 )                        ! new formulation  (masked averaging of e3t divided by the sum of mask) 
     969            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     970               zmsk = (tmask(ji,jj+1,jk) +tmask(ji+1,jj+1,jk)   & 
     971                  &  + tmask(ji,jj  ,jk) +tmask(ji+1,jj  ,jk)  ) 
     972               ! 
     973               IF( zmsk /= 0._wp ) THEN  
     974                  e3f_0vor(ji,jj,jk) = (   e3t_0(ji  ,jj+1,jk)*tmask(ji  ,jj+1,jk)   & 
     975                     &                   + e3t_0(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     976                     &                   + e3t_0(ji  ,jj  ,jk)*tmask(ji  ,jj  ,jk)   & 
     977                     &                   + e3t_0(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)   ) / zmsk 
     978               ENDIF 
     979            END_3D 
     980         END SELECT 
     981         ! 
     982         CALL lbc_lnk( 'dynvor', e3f_0vor, 'F', 1._wp ) 
     983         !                                 ! insure e3f_0vor /= 0 
     984         WHERE( e3f_0vor(:,:,:) == 0._wp )   e3f_0vor(:,:,:) = e3f_0(:,:,:) 
     985         ! 
     986      END SELECT 
     987      ! 
     988#endif 
    894989      IF(lwp) THEN                   ! Print the choice 
    895990         WRITE(numout,*) 
    … …  
    898993         CASE( np_ENE )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme (Coriolis at F-points) (ENE)' 
    899994         CASE( np_ENT )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme (Coriolis at T-points) (ENT)' 
     995                              IF( ln_dynadv_vec )   CALL ctl_warn('dyn_vor_init: ENT scheme may not work in vector form') 
    900996         CASE( np_EET )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme (EEN scheme using e3t) (EET)' 
    901997         CASE( np_EEN )   ;   WRITE(numout,*) '   ==>>>   energy and enstrophy conserving scheme (EEN)' 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/sshwzv.F90

    r13497 r14054  
    66   !! History :  3.1  !  2009-02  (G. Madec, M. Leclair)  Original code 
    77   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA  
    8    !!             -   !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    9    !!             -   !  2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module 
    10    !!            3.3  !  2011-10  (M. Leclair) split former ssh_wzv routine and remove all vvl related work 
    11    !!            4.0  !  2018-12  (A. Coward) add mixed implicit/explicit advection 
    12    !!            4.1  !  2019-08  (A. Coward, D. Storkey) Rename ssh_nxt -> ssh_atf. Now only does time filtering. 
     8   !!             -   !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea)  Assimilation interface 
     9   !!             -   !  2010-09  (D.Storkey and E.O'Dea)  bug fixes for BDY module 
     10   !!            3.3  !  2011-10  (M. Leclair)  split former ssh_wzv routine and remove all vvl related work 
     11   !!            4.0  !  2018-12  (A. Coward)  add mixed implicit/explicit advection 
     12   !!            4.1  !  2019-08  (A. Coward, D. Storkey)  Rename ssh_nxt -> ssh_atf. Now only does time filtering. 
     13   !!             -   !  2020-08  (S. Techene, G. Madec)  add here ssh initiatlisation 
    1314   !!---------------------------------------------------------------------- 
    1415 
    … …  
    1718   !!   ssh_atf       : time filter the ssh arrays 
    1819   !!   wzv           : compute now vertical velocity 
     20   !!   ssh_init_rst  : ssh set from restart or domcfg.nc file or usr_def_istat_ssh 
    1921   !!---------------------------------------------------------------------- 
    2022   USE oce            ! ocean dynamics and tracers variables 
    … …  
    4042   USE timing         ! Timing 
    4143   USE wet_dry        ! Wetting/Drying flux limiting 
    42  
     44   USE usrdef_istate, ONLY : usr_def_istate_ssh   ! user defined ssh initial state  
     45    
    4346   IMPLICIT NONE 
    4447   PRIVATE 
    4548 
    46    PUBLIC   ssh_nxt    ! called by step.F90 
    47    PUBLIC   wzv        ! called by step.F90 
    48    PUBLIC   wAimp      ! called by step.F90 
    49    PUBLIC   ssh_atf    ! called by step.F90 
     49   PUBLIC   ssh_nxt        ! called by step.F90 
     50   PUBLIC   wzv            ! called by step.F90 
     51   PUBLIC   wAimp          ! called by step.F90 
     52   PUBLIC   ssh_atf        ! called by step.F90 
     53   PUBLIC   ssh_init_rst   ! called by domain.F90 
    5054 
    5155   !! * Substitutions 
    5256#  include "do_loop_substitute.h90" 
    5357#  include "domzgr_substitute.h90" 
    54  
    5558   !!---------------------------------------------------------------------- 
    5659   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    299302         !                                                  ! filtered "now" field 
    300303         pssh(:,:,Kmm) = pssh(:,:,Kmm) + rn_atfp * ( pssh(:,:,Kbb) - 2 * pssh(:,:,Kmm) + pssh(:,:,Kaa) ) 
     304         ! 
    301305         IF( .NOT.ln_linssh ) THEN                          ! "now" <-- with forcing removed 
    302306            zcoef = rn_atfp * rn_Dt * r1_rho0 
    … …  
    307311 
    308312            ! ice sheet coupling 
    309             IF ( ln_isf .AND. ln_isfcpl .AND. kt == nit000+1) pssh(:,:,Kbb) = pssh(:,:,Kbb) - rn_atfp * rn_Dt * ( risfcpl_ssh(:,:) - 0.0 ) * ssmask(:,:) 
     313            IF( ln_isf .AND. ln_isfcpl .AND. kt == nit000+1 )   & 
     314               &   pssh(:,:,Kbb) = pssh(:,:,Kbb) - rn_atfp * rn_Dt * ( risfcpl_ssh(:,:) - 0.0 ) * ssmask(:,:) 
    310315 
    311316         ENDIF 
    312317      ENDIF 
    313318      ! 
    314       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kmm), clinfo1=' pssh(:,:,Kmm)  - : ', mask1=tmask ) 
     319      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kmm), clinfo1=' atf  - pssh(:,:,Kmm): ', mask1=tmask ) 
    315320      ! 
    316321      IF( ln_timing )   CALL timing_stop('ssh_atf') 
    … …  
    431436      ! 
    432437   END SUBROUTINE wAimp 
     438 
     439 
     440   SUBROUTINE ssh_init_rst( Kbb, Kmm, Kaa ) 
     441      !!--------------------------------------------------------------------- 
     442      !!                   ***  ROUTINE ssh_init_rst  *** 
     443      !! 
     444      !! ** Purpose :   ssh initialization of the sea surface height (ssh) 
     445      !! 
     446      !! ** Method  :   set ssh from restart or read configuration, or user_def 
     447      !!              * ln_rstart = T 
     448      !!                   USE of IOM library to read ssh in the restart file 
     449      !!                   Leap-Frog: Kbb and Kmm are read except for l_1st_euler=T 
     450      !! 
     451      !!              * otherwise  
     452      !!                   call user defined ssh or 
     453      !!                   set to -ssh_ref in wet and drying case with domcfg.nc 
     454      !! 
     455      !!              NB: ssh_b/n are written by restart.F90 
     456      !!---------------------------------------------------------------------- 
     457      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa   ! ocean time level indices 
     458      ! 
     459      INTEGER ::   ji, jj, jk 
     460      !!---------------------------------------------------------------------- 
     461      ! 
     462      IF(lwp) THEN 
     463         WRITE(numout,*) 
     464         WRITE(numout,*) 'ssh_init_rst : ssh initialization' 
     465         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     466      ENDIF 
     467      ! 
     468      !                            !=============================! 
     469      IF( ln_rstart ) THEN         !==  Read the restart file  ==! 
     470         !                         !=============================! 
     471         ! 
     472         !                                     !*  Read ssh at Kmm 
     473         IF(lwp) WRITE(numout,*) 
     474         IF(lwp) WRITE(numout,*)    '      Kmm sea surface height read in the restart file' 
     475         CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm) ) 
     476         ! 
     477         IF( l_1st_euler ) THEN                !* Euler at first time-step 
     478            IF(lwp) WRITE(numout,*) 
     479            IF(lwp) WRITE(numout,*) '      Euler first time step : ssh(Kbb) = ssh(Kmm)' 
     480            ssh(:,:,Kbb) = ssh(:,:,Kmm) 
     481            ! 
     482         ELSE                                  !* read ssh at Kbb 
     483            IF(lwp) WRITE(numout,*) 
     484            IF(lwp) WRITE(numout,*) '      Kbb sea surface height read in the restart file' 
     485            CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 
     486         ENDIF 
     487         !                         !============================! 
     488      ELSE                         !==  Initialize at "rest"  ==! 
     489         !                         !============================! 
     490         ! 
     491         IF(lwp) WRITE(numout,*) 
     492         IF(lwp) WRITE(numout,*)    '      initialization at rest' 
     493         ! 
     494         IF( ll_wd ) THEN                      !* wet and dry  
     495            ! 
     496            IF( ln_read_cfg  ) THEN                 ! read configuration : ssh_ref is read in domain_cfg file 
     497!!st  why ssh is not masked : i.e. ssh(:,:,Kmm) = -ssh_ref*ssmask(:,:), 
     498!!st  since at the 1st time step lbclnk will be applied on ssh at Kaa but not initially at Kbb and Kmm 
     499               ssh(:,:,Kbb) = -ssh_ref 
     500               ! 
     501               DO_2D( 1, 1, 1, 1 ) 
     502                  IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN   ! if total depth is less than min depth 
     503                     ssh(ji,jj,Kbb) = rn_wdmin1 - ht_0(ji,jj) 
     504                  ENDIF 
     505               END_2D 
     506            ELSE                                    ! user define configuration case   
     507               CALL usr_def_istate_ssh( tmask, ssh(:,:,Kbb) ) 
     508            ENDIF 
     509            ! 
     510         ELSE                                  !* user defined configuration 
     511            CALL usr_def_istate_ssh( tmask, ssh(:,:,Kbb) ) 
     512            ! 
     513         ENDIF 
     514         ! 
     515         ssh(:,:,Kmm) = ssh(:,:,Kbb)           !* set now values from to before ones 
     516         ssh(:,:,Kaa) = 0._wp  
     517      ENDIF 
     518      ! 
     519   END SUBROUTINE ssh_init_rst 
     520       
    433521   !!====================================================================== 
    434522END MODULE sshwzv 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icb_oce.F90

    r13286 r14054  
    5757   TYPE, PUBLIC ::   point              !: properties of an individual iceberg (position, mass, size, etc...) 
    5858      INTEGER  ::   year 
    59       REAL(wp) ::   xi , yj                                                   ! iceberg coordinates in the (i,j) referential (global) 
     59      REAL(wp) ::   xi , yj , zk                                              ! iceberg coordinates in the (i,j) referential (global) and deepest level affected 
    6060      REAL(wp) ::   e1 , e2                                                   ! horizontal scale factors at the iceberg position 
    6161      REAL(wp) ::   lon, lat, day                                             ! geographic position 
    6262      REAL(wp) ::   mass, thickness, width, length, uvel, vvel                ! iceberg physical properties 
    63       REAL(wp) ::   uo, vo, ui, vi, ua, va, ssh_x, ssh_y, sst, cn, hi, sss    ! properties of iceberg environment  
     63      REAL(wp) ::   ssu, ssv, ui, vi, ua, va, ssh_x, ssh_y, sst, sss, cn, hi  ! properties of iceberg environment  
    6464      REAL(wp) ::   mass_of_bits, heat_density 
     65      INTEGER  ::   kb                                                   ! icb bottom level 
    6566   END TYPE point 
    6667 
    … …  
    8586   ! Extra arrays with bigger halo, needed when interpolating forcing onto iceberg position 
    8687   ! particularly for MPP when iceberg can lie inside T grid but outside U, V, or f grid 
    87    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   uo_e, vo_e 
    88    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ff_e, tt_e, fr_e, ss_e 
     88   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssu_e, ssv_e 
     89   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   sst_e, sss_e, fr_e 
    8990   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ua_e, va_e 
    9091   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_e 
    9192   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   tmask_e, umask_e, vmask_e 
     93   REAl(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   rlon_e, rlat_e, ff_e 
     94   REAl(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   uoce_e, voce_e, toce_e, e3t_e 
     95   ! 
    9296#if defined key_si3 || defined key_cice 
    9397   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   hi_e, ui_e, vi_e 
    … …  
    117121   INTEGER , PUBLIC ::   nn_verbose_write                !: timesteps between verbose messages 
    118122   REAL(wp), PUBLIC ::   rn_rho_bergs                    !: Density of icebergs 
     123   REAL(wp), PUBLIC ::   rho_berg_1_oce                  !: convertion factor (thickness to draft) (rn_rho_bergs/pp_rho_seawater) 
    119124   REAL(wp), PUBLIC ::   rn_LoW_ratio                    !: Initial ratio L/W for newly calved icebergs 
    120125   REAL(wp), PUBLIC ::   rn_bits_erosion_fraction        !: Fraction of erosion melt flux to divert to bergy bits 
    … …  
    124129   LOGICAL , PUBLIC ::   ln_time_average_weight          !: Time average the weight on the ocean    !!gm I don't understand that ! 
    125130   REAL(wp), PUBLIC ::   rn_speed_limit                  !: CFL speed limit for a berg 
     131   LOGICAL , PUBLIC ::   ln_M2016, ln_icb_grd            !: use Nacho's Merino 2016 work 
    126132   ! 
    127133   ! restart 
    … …  
    135141   REAL(wp), DIMENSION(nclasses), PUBLIC ::   rn_initial_thickness !  Single instance of an icebergs type initialised in icebergs_init and updated in icebergs_run 
    136142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   src_calving, src_calving_hflx    !: accumulate input ice 
     143   INTEGER , PUBLIC             , SAVE                     ::   micbkb                           !: deepest level affected by icebergs 
    137144   INTEGER , PUBLIC             , SAVE                     ::   numicb                           !: iceberg IO 
    138145   INTEGER , PUBLIC             , SAVE, DIMENSION(nkounts) ::   num_bergs                        !: iceberg counter 
    … …  
    171178      ! 
    172179      ! expanded arrays for bilinear interpolation 
    173       ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,    & 
    174          &      vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,    & 
     180      ALLOCATE( ssu_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,   & 
     181         &      ssv_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,   & 
    175182#if defined key_si3 || defined key_cice 
    176183         &      ui_e(0:jpi+1,0:jpj+1) ,                            & 
    … …  
    178185         &      hi_e(0:jpi+1,0:jpj+1) ,                            & 
    179186#endif 
    180          &      ff_e(0:jpi+1,0:jpj+1) , fr_e(0:jpi+1,0:jpj+1)  ,   & 
    181          &      tt_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,   & 
    182          &      ss_e(0:jpi+1,0:jpj+1) ,                            &  
     187         &      fr_e(0:jpi+1,0:jpj+1) ,                            & 
     188         &      sst_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,  & 
     189         &      sss_e(0:jpi+1,0:jpj+1) ,                           &  
    183190         &      first_width(nclasses) , first_length(nclasses) ,   & 
    184191         &      src_calving (jpi,jpj) ,                            & 
    … …  
    186193      icb_alloc = icb_alloc + ill 
    187194 
     195      IF ( ln_M2016 ) THEN 
     196         ALLOCATE( uoce_e(0:jpi+1,0:jpj+1,jpk), voce_e(0:jpi+1,0:jpj+1,jpk), & 
     197            &      toce_e(0:jpi+1,0:jpj+1,jpk), e3t_e(0:jpi+1,0:jpj+1,jpk) , STAT=ill ) 
     198         icb_alloc = icb_alloc + ill 
     199      END IF 
     200      ! 
    188201      ALLOCATE( tmask_e(0:jpi+1,0:jpj+1), umask_e(0:jpi+1,0:jpj+1), vmask_e(0:jpi+1,0:jpj+1), & 
    189          &      STAT=ill) 
     202         &      rlon_e(0:jpi+1,0:jpj+1) , rlat_e(0:jpi+1,0:jpj+1) , ff_e(0:jpi+1,0:jpj+1)   , STAT=ill) 
    190203      icb_alloc = icb_alloc + ill 
    191204 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbclv.F90

    r13295 r14054  
    2121   USE lbclnk         ! NEMO boundary exchanges for gridded data 
    2222 
    23    USE icb_oce        ! iceberg variables 
    2423   USE icbdia         ! iceberg diagnostics 
    2524   USE icbutl         ! iceberg utility routines 
    … …  
    142141                  newpt%mass           = rn_initial_mass     (jn) 
    143142                  newpt%thickness      = rn_initial_thickness(jn) 
     143                  newpt%kb             = 1         ! compute correctly in icbthm if needed         
    144144                  newpt%width          = first_width         (jn) 
    145145                  newpt%length         = first_length        (jn) 
    … …  
    172172      END DO 
    173173      ! 
    174       DO jn = 1, nclasses 
    175          CALL lbc_lnk( 'icbclv', berg_grid%stored_ice(:,:,jn), 'T', 1._wp ) 
    176       END DO 
    177       CALL lbc_lnk( 'icbclv', berg_grid%stored_heat, 'T', 1._wp ) 
    178       ! 
    179174      IF( nn_verbose_level > 0 .AND. icntmax > 1 )   WRITE(numicb,*) 'icb_clv: icnt=', icnt,' on', narea 
    180175      ! 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbdyn.F90

    r13281 r14054  
    1414   USE dom_oce        ! NEMO ocean domain 
    1515   USE phycst         ! NEMO physical constants 
     16   USE in_out_manager                      ! IO parameters 
    1617   ! 
    1718   USE icb_oce        ! define iceberg arrays 
    … …  
    9798         zyj2 = zyj1 + zdt_2 * zv1          ;   zvvel2 = zvvel1 + zdt_2 * zay1 
    9899         ! 
    99          CALL icb_ground( zxi2, zxi1, zu1,   & 
    100             &             zyj2, zyj1, zv1, ll_bounced ) 
     100         CALL icb_ground( berg, zxi2, zxi1, zu1,   & 
     101            &                   zyj2, zyj1, zv1, ll_bounced ) 
    101102 
    102103         !                                         !**   A2 = A(X2,V2) 
    … …  
    113114         zyj3  = zyj1  + zdt_2 * zv2   ;   zvvel3 = zvvel1 + zdt_2 * zay2 
    114115         ! 
    115          CALL icb_ground( zxi3, zxi1, zu3,   & 
    116             &                zyj3, zyj1, zv3, ll_bounced ) 
     116         CALL icb_ground( berg, zxi3, zxi1, zu3,   & 
     117            &                   zyj3, zyj1, zv3, ll_bounced ) 
    117118 
    118119         !                                         !**   A3 = A(X3,V3) 
    … …  
    129130         zyj4 = zyj1 + zdt * zv3   ;   zvvel4 = zvvel1 + zdt * zay3 
    130131 
    131          CALL icb_ground( zxi4, zxi1, zu4,   & 
    132             &             zyj4, zyj1, zv4, ll_bounced ) 
     132         CALL icb_ground( berg, zxi4, zxi1, zu4,   & 
     133            &                   zyj4, zyj1, zv4, ll_bounced ) 
    133134 
    134135         !                                         !**   A4 = A(X4,V4) 
    … …  
    148149         zvvel_n = pt%vvel + zdt_6 * (  zay1 + 2.*(zay2 + zay3) + zay4 ) 
    149150 
    150          CALL icb_ground( zxi_n, zxi1, zuvel_n,   & 
    151             &             zyj_n, zyj1, zvvel_n, ll_bounced ) 
     151         CALL icb_ground( berg, zxi_n, zxi1, zuvel_n,   & 
     152            &                   zyj_n, zyj1, zvvel_n, ll_bounced ) 
    152153 
    153154         pt%uvel = zuvel_n                        !** save in berg structure 
    … …  
    156157         pt%yj   = zyj_n 
    157158 
    158          ! update actual position 
    159          pt%lon  = icb_utl_bilin_x(glamt, pt%xi, pt%yj ) 
    160          pt%lat  = icb_utl_bilin(gphit, pt%xi, pt%yj, 'T' ) 
    161  
    162159         berg => berg%next                         ! switch to the next berg 
    163160         ! 
    … …  
    167164 
    168165 
    169    SUBROUTINE icb_ground( pi, pi0, pu,   & 
    170       &                   pj, pj0, pv, ld_bounced ) 
     166   SUBROUTINE icb_ground( berg, pi, pi0, pu,   & 
     167      &                         pj, pj0, pv, ld_bounced ) 
    171168      !!---------------------------------------------------------------------- 
    172169      !!                  ***  ROUTINE icb_ground  *** 
    … …  
    177174      !!                NB two possibilities available one of which is hard-coded here 
    178175      !!---------------------------------------------------------------------- 
     176      TYPE(iceberg ), POINTER, INTENT(in   ) ::   berg             ! berg 
     177      ! 
    179178      REAL(wp), INTENT(inout) ::   pi , pj      ! current iceberg position 
    180179      REAL(wp), INTENT(in   ) ::   pi0, pj0     ! previous iceberg position 
    … …  
    184183      INTEGER  ::   ii, ii0 
    185184      INTEGER  ::   ij, ij0 
     185      INTEGER  ::   ikb 
    186186      INTEGER  ::   ibounce_method 
     187      ! 
     188      REAL(wp) :: zD  
     189      REAL(wp), DIMENSION(jpk) :: ze3t 
    187190      !!---------------------------------------------------------------------- 
    188191      ! 
    … …  
    200203      ij  = mj1( ij  ) 
    201204      ! 
    202       IF(  tmask(ii,ij,1)  /=   0._wp  )   RETURN           ! berg reach a new t-cell, but an ocean one 
     205      ! assume icb is grounded if tmask(ii,ij,1) or tmask(ii,ij,ikb), depending of the option is not 0 
     206      IF ( ln_M2016 .AND. ln_icb_grd ) THEN 
     207         ! 
     208         ! draught (keel depth) 
     209         zD = rho_berg_1_oce * berg%current_point%thickness 
     210         ! 
     211         ! interpol needed data 
     212         CALL icb_utl_interp( pi, pj, pe3t=ze3t ) 
     213         !  
     214         !compute bottom level 
     215         CALL icb_utl_getkb( ikb, ze3t, zD ) 
     216         ! 
     217         ! berg reach a new t-cell, but an ocean one 
     218         ! .AND. needed in case berg hit an isf (tmask(ii,ij,1) == 0 and tmask(ii,ij,ikb) /= 0) 
     219         IF(  tmask(ii,ij,ikb) /= 0._wp .AND. tmask(ii,ij,1) /= 0._wp ) RETURN 
     220         ! 
     221      ELSE 
     222         IF(  tmask(ii,ij,1)  /=   0._wp  )   RETURN           ! berg reach a new t-cell, but an ocean one 
     223      END IF 
    203224      ! 
    204225      ! From here, berg have reach land: treat grounding/bouncing 
    … …  
    257278      REAL(wp), PARAMETER ::   pp_Cr0       = 0.06_wp    ! 
    258279      ! 
    259       INTEGER  ::   itloop 
    260       REAL(wp) ::   zuo, zui, zua, zuwave, zssh_x, zsst, zcn, zhi, zsss 
    261       REAL(wp) ::   zvo, zvi, zva, zvwave, zssh_y 
     280      INTEGER  ::   itloop, ikb, jk 
     281      REAL(wp) ::   zuo, zssu, zui, zua, zuwave, zssh_x, zcn, zhi 
     282      REAL(wp) ::   zvo, zssv, zvi, zva, zvwave, zssh_y 
    262283      REAL(wp) ::   zff, zT, zD, zW, zL, zM, zF 
    263284      REAL(wp) ::   zdrag_ocn, zdrag_atm, zdrag_ice, zwave_rad 
    264       REAL(wp) ::   z_ocn, z_atm, z_ice 
     285      REAL(wp) ::   z_ocn, z_atm, z_ice, zdep 
    265286      REAL(wp) ::   zampl, zwmod, zCr, zLwavelength, zLcutoff, zLtop 
    266287      REAL(wp) ::   zlambda, zdetA, zA11, zA12, zaxe, zaye, zD_hi 
    267288      REAL(wp) ::   zuveln, zvveln, zus, zvs, zspeed, zloc_dx, zspeed_new 
     289      REAL(wp), DIMENSION(jpk) :: zuoce, zvoce, ze3t, zdepw 
    268290      !!---------------------------------------------------------------------- 
    269291 
    270292      ! Interpolate gridded fields to berg 
    271293      nknberg = berg%number(1) 
    272       CALL icb_utl_interp( pxi, pe1, zuo, zui, zua, zssh_x,                     & 
    273          &                 pyj, pe2, zvo, zvi, zva, zssh_y, zsst, zcn, zhi, zff, zsss ) 
     294      CALL icb_utl_interp( pxi, pyj, pe1=pe1, pe2=pe2,     &   ! scale factor 
     295         &                 pssu=zssu, pui=zui, pua=zua,    &   ! oce/ice/atm velocities 
     296         &                 pssv=zssv, pvi=zvi, pva=zva,    &   ! oce/ice/atm velocities 
     297         &                 pssh_i=zssh_x, pssh_j=zssh_y,   &   ! ssh gradient 
     298         &                 phi=zhi, pff=zff)                   ! ice thickness and coriolis 
    274299 
    275300      zM = berg%current_point%mass 
    276301      zT = berg%current_point%thickness               ! total thickness 
    277       zD = ( rn_rho_bergs / pp_rho_seawater ) * zT    ! draught (keel depth) 
     302      zD = rho_berg_1_oce * zT                        ! draught (keel depth) 
    278303      zF = zT - zD                                    ! freeboard 
    279304      zW = berg%current_point%width 
    … …  
    282307      zhi   = MIN( zhi   , zD    ) 
    283308      zD_hi = MAX( 0._wp, zD-zhi ) 
    284  
    285       ! Wave radiation 
    286       zuwave = zua - zuo   ;   zvwave = zva - zvo     ! Use wind speed rel. to ocean for wave model 
     309  
     310     ! Wave radiation 
     311      zuwave = zua - zssu   ;   zvwave = zva - zssv   ! Use wind speed rel. to ocean for wave model 
    287312      zwmod  = zuwave*zuwave + zvwave*zvwave          ! The wave amplitude and length depend on the  current; 
    288313      !                                               ! wind speed relative to the ocean. Actually wmod is wmod**2 here. 
    … …  
    309334      IF( abs(zui) + abs(zvi) == 0._wp )   z_ice = 0._wp 
    310335 
     336      ! lateral velocities 
     337      ! default ssu and ssv 
     338      ! ln_M2016: mean velocity along the profile 
     339      IF ( ln_M2016 ) THEN 
     340         ! interpol needed data 
     341         CALL icb_utl_interp( pxi, pyj, puoce=zuoce, pvoce=zvoce, pe3t=ze3t )   ! 3d velocities 
     342         
     343         !compute bottom level 
     344         CALL icb_utl_getkb( ikb, ze3t, zD ) 
     345          
     346         ! compute mean velocity  
     347         CALL icb_utl_zavg(zuo, zuoce, ze3t, zD, ikb) 
     348         CALL icb_utl_zavg(zvo, zvoce, ze3t, zD, ikb) 
     349      ELSE 
     350         zuo = zssu 
     351         zvo = zssv 
     352      END IF 
     353 
    311354      zuveln = puvel   ;   zvveln = pvvel ! Copy starting uvel, vvel 
    312355      ! 
    … …  
    321364         ! Explicit accelerations 
    322365         !zaxe= zff*pvvel -grav*zssh_x +zwave_rad*zuwave & 
    323          !    -zdrag_ocn*(puvel-zuo) -zdrag_atm*(puvel-zua) -zdrag_ice*(puvel-zui) 
     366         !    -zdrag_ocn*(puvel-zssu) -zdrag_atm*(puvel-zua) -zdrag_ice*(puvel-zui) 
    324367         !zaye=-zff*puvel -grav*zssh_y +zwave_rad*zvwave & 
    325          !    -zdrag_ocn*(pvvel-zvo) -zdrag_atm*(pvvel-zva) -zdrag_ice*(pvvel-zvi) 
     368         !    -zdrag_ocn*(pvvel-zssv) -zdrag_atm*(pvvel-zva) -zdrag_ice*(pvvel-zvi) 
    326369         zaxe = -grav * zssh_x + zwave_rad * zuwave 
    327370         zaye = -grav * zssh_y + zwave_rad * zvwave 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbini.F90

    r13295 r14054  
    7373      ! 
    7474      IF( .NOT. ln_icebergs )   RETURN 
    75  
     75      ! 
    7676      !                          ! allocate gridded fields 
    7777      IF( icb_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'icb_alloc : unable to allocate arrays' ) 
    7878      ! 
    7979      !                          ! initialised variable with extra haloes to zero 
    80       uo_e(:,:) = 0._wp   ;   vo_e(:,:) = 0._wp   ; 
    81       ua_e(:,:) = 0._wp   ;   va_e(:,:) = 0._wp   ; 
    82       ff_e(:,:) = 0._wp   ;   tt_e(:,:) = 0._wp   ; 
    83       fr_e(:,:) = 0._wp   ;   ss_e(:,:) = 0._wp   ; 
     80      ssu_e(:,:) = 0._wp   ;   ssv_e(:,:) = 0._wp   ; 
     81      ua_e(:,:)  = 0._wp   ;   va_e(:,:)  = 0._wp   ; 
     82      ff_e(:,:)  = 0._wp   ;   sst_e(:,:) = 0._wp   ; 
     83      fr_e(:,:)  = 0._wp   ;   sss_e(:,:) = 0._wp   ; 
     84      ! 
     85      IF ( ln_M2016 ) THEN 
     86         toce_e(:,:,:) = 0._wp 
     87         uoce_e(:,:,:) = 0._wp 
     88         voce_e(:,:,:) = 0._wp 
     89         e3t_e(:,:,:)  = 0._wp 
     90      END IF 
     91      ! 
    8492#if defined key_si3 
    8593      hi_e(:,:) = 0._wp   ; 
    … …  
    100108      first_width (:) = SQRT(  rn_initial_mass(:) / ( rn_LoW_ratio * rn_rho_bergs * rn_initial_thickness(:) )  ) 
    101109      first_length(:) = rn_LoW_ratio * first_width(:) 
     110      rho_berg_1_oce  = rn_rho_bergs / pp_rho_seawater  ! scale factor used for convertion thickness to draft 
     111      ! 
     112      ! deepest level affected by icebergs 
     113      ! can be tuned but the safest is this  
     114      ! (with z* and z~ the depth of each level change overtime, so the more robust micbkb is jpk) 
     115      micbkb = jpk 
    102116 
    103117      berg_grid%calving      (:,:)   = 0._wp 
    … …  
    240254      vmask_e(:,:) = 0._wp   ;   vmask_e(1:jpi,1:jpj) = vmask(:,:,1) 
    241255      CALL lbc_lnk_icb( 'icbini', tmask_e, 'T', +1._wp, 1, 1 ) 
    242       CALL lbc_lnk_icb( 'icbini', umask_e, 'T', +1._wp, 1, 1 ) 
    243       CALL lbc_lnk_icb( 'icbini', vmask_e, 'T', +1._wp, 1, 1 ) 
    244       ! 
     256      CALL lbc_lnk_icb( 'icbini', umask_e, 'U', +1._wp, 1, 1 ) 
     257      CALL lbc_lnk_icb( 'icbini', vmask_e, 'V', +1._wp, 1, 1 ) 
     258 
     259      ! definition of extended lat/lon array needed by icb_bilin_h 
     260      rlon_e(:,:) = 0._wp     ;  rlon_e(1:jpi,1:jpj) = glamt(:,:)  
     261      rlat_e(:,:) = 0._wp     ;  rlat_e(1:jpi,1:jpj) = gphit(:,:) 
     262      CALL lbc_lnk_icb( 'icbini', rlon_e, 'T', +1._wp, 1, 1 ) 
     263      CALL lbc_lnk_icb( 'icbini', rlat_e, 'T', +1._wp, 1, 1 ) 
     264      ! 
     265      ! definnitionn of extennded ff_f array needed by icb_utl_interp 
     266      ff_e(:,:) = 0._wp       ;  ff_e(1:jpi,1:jpj) = ff_f(:,:) 
     267      CALL lbc_lnk_icb( 'icbini', ff_e, 'F', +1._wp, 1, 1 ) 
     268 
    245269      ! assign each new iceberg with a unique number constructed from the processor number 
    246270      ! and incremented by the total number of processors 
    … …  
    338362               localpt%xi = REAL( mig(ji), wp ) 
    339363               localpt%yj = REAL( mjg(jj), wp ) 
    340                localpt%lon = icb_utl_bilin(glamt, localpt%xi, localpt%yj, 'T' ) 
    341                localpt%lat = icb_utl_bilin(gphit, localpt%xi, localpt%yj, 'T' ) 
     364               CALL icb_utl_interp( localpt%xi, localpt%yj, plat=localpt%lat, plon=localpt%lon )    
    342365               localpt%mass      = rn_initial_mass     (iberg) 
    343366               localpt%thickness = rn_initial_thickness(iberg) 
    … …  
    350373               localpt%uvel = 0._wp 
    351374               localpt%vvel = 0._wp 
     375               localpt%kb   = 1 
    352376               CALL icb_utl_incr() 
    353377               localberg%number(:) = num_bergs(:) 
    … …  
    383407         &              rn_bits_erosion_fraction        , rn_sicn_shift       , ln_passive_mode      ,   & 
    384408         &              ln_time_average_weight          , nn_test_icebergs    , rn_test_box          ,   & 
    385          &              ln_use_calving , rn_speed_limit , cn_dir, sn_icb      ,                          & 
    386          &              cn_icbrst_indir, cn_icbrst_in   , cn_icbrst_outdir    , cn_icbrst_out 
     409         &              ln_use_calving , rn_speed_limit , cn_dir, sn_icb      , ln_M2016             ,   & 
     410         &              cn_icbrst_indir, cn_icbrst_in   , cn_icbrst_outdir    , cn_icbrst_out        ,   & 
     411         &              ln_icb_grd 
    387412      !!---------------------------------------------------------------------- 
    388413 
    … …  
    463488            &                    'bits_erosion_fraction = ', rn_bits_erosion_fraction 
    464489 
     490         WRITE(numout,*) '   Use icb module modification from Merino et al. (2016) : ln_M2016 = ', ln_M2016 
     491         WRITE(numout,*) '       ground icebergs if icb bottom lvl hit the oce bottom level : ln_icb_grd = ', ln_icb_grd 
     492 
    465493         WRITE(numout,*) '   Shift of sea-ice concentration in erosion flux modulation ',   & 
    466494            &                    '(0<sicn_shift<1)    rn_sicn_shift  = ', rn_sicn_shift 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbstp.F90

    r11536 r14054  
    5252CONTAINS 
    5353 
    54    SUBROUTINE icb_stp( kt ) 
     54   SUBROUTINE icb_stp( kt, Kmm ) 
    5555      !!---------------------------------------------------------------------- 
    5656      !!                  ***  ROUTINE icb_stp  *** 
    … …  
    6161      !!---------------------------------------------------------------------- 
    6262      INTEGER, INTENT(in) ::   kt   ! time step index 
     63      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
    6364      ! 
    6465      LOGICAL ::   ll_sample_traj, ll_budget, ll_verbose   ! local logical 
    … …  
    7071      ! 
    7172      nktberg = kt 
     73      ! 
     74      !CALL test_icb_utl_getkb 
     75      !CALL ctl_stop('end test icb') 
    7276      ! 
    7377      IF( nn_test_icebergs < 0 .OR. ln_use_calving ) THEN !* read calving data 
    … …  
    9296      ! 
    9397      !                                   !* copy nemo forcing arrays into iceberg versions with extra halo 
    94       CALL icb_utl_copy()                 ! only necessary for variables not on T points 
     98      CALL icb_utl_copy( Kmm )                 ! only necessary for variables not on T points 
    9599      ! 
    96100      ! 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbthm.F90

    r13281 r14054  
    4949      INTEGER, INTENT(in) ::   kt   ! timestep number, just passed to icb_utl_print_berg 
    5050      ! 
    51       INTEGER  ::   ii, ij 
    52       REAL(wp) ::   zM, zT, zW, zL, zSST, zVol, zLn, zWn, zTn, znVol, zIC, zDn 
     51      INTEGER  ::   ii, ij, jk, ikb 
     52      REAL(wp) ::   zM, zT, zW, zL, zSST, zVol, zLn, zWn, zTn, znVol, zIC, zDn, zD, zvb, zub, ztb 
     53      REAL(wp) ::   zMv, zMe, zMb, zmelt, zdvo, zdvob, zdva, zdM, zSs, zdMe, zdMb, zdMv 
    5354      REAL(wp) ::   zSSS, zfzpt 
    54       REAL(wp) ::   zMv, zMe, zMb, zmelt, zdvo, zdva, zdM, zSs, zdMe, zdMb, zdMv 
    5555      REAL(wp) ::   zMnew, zMnew1, zMnew2, zheat_hcflux, zheat_latent, z1_12 
    5656      REAL(wp) ::   zMbits, znMbits, zdMbitsE, zdMbitsM, zLbits, zAbits, zMbb 
    57       REAL(wp) ::   zxi, zyj, zff, z1_rday, z1_e1e2, zdt, z1_dt, z1_dt_e1e2 
     57      REAL(wp) ::   zxi, zyj, zff, z1_rday, z1_e1e2, zdt, z1_dt, z1_dt_e1e2, zdepw 
     58      REAL(wp), DIMENSION(jpk) :: ztoce, zuoce, zvoce, ze3t, zzMv 
    5859      TYPE(iceberg), POINTER ::   this, next 
    5960      TYPE(point)  , POINTER ::   pt 
    … …  
    8586         pt => this%current_point 
    8687         nknberg = this%number(1) 
    87          CALL icb_utl_interp( pt%xi, pt%e1, pt%uo, pt%ui, pt%ua, pt%ssh_x,   & 
    88             &                 pt%yj, pt%e2, pt%vo, pt%vi, pt%va, pt%ssh_y,   & 
    89             &                 pt%sst, pt%cn, pt%hi, zff, pt%sss ) 
     88 
     89         CALL icb_utl_interp( pt%xi, pt%yj,            &   ! position 
     90             &                 pssu=pt%ssu, pua=pt%ua, &   ! oce/atm velocities 
     91             &                 pssv=pt%ssv, pva=pt%va, &   ! oce/atm velocities 
     92             &                 psst=pt%sst, pcn=pt%cn, & 
     93             &                 psss=pt%sss             ) 
     94 
     95         IF ( nn_sample_rate > 0 .AND. MOD(kt-1,nn_sample_rate) == 0 ) THEN 
     96            CALL icb_utl_interp( pt%xi, pt%yj, pe1=pt%e1, pe2=pt%e2,                 & 
     97               &                 pui=pt%ui, pssh_i=pt%ssh_x, & 
     98               &                 pvi=pt%vi, pssh_j=pt%ssh_y, & 
     99               &                 phi=pt%hi,                  & 
     100               &                 plat=pt%lat, plon=pt%lon ) 
     101         END IF 
    90102         ! 
    91103         zSST = pt%sst 
    … …  
    95107         zM   = pt%mass 
    96108         zT   = pt%thickness                               ! total thickness 
    97        ! D   = (rn_rho_bergs/pp_rho_seawater)*zT ! draught (keel depth) 
    98        ! F   = zT - D ! freeboard 
     109         zD   = rho_berg_1_oce * zT                        ! draught (keel depth) 
    99110         zW   = pt%width 
    100111         zL   = pt%length 
    … …  
    108119 
    109120         ! Environment 
    110          zdvo = SQRT( (pt%uvel-pt%uo)**2 + (pt%vvel-pt%vo)**2 ) 
    111          zdva = SQRT( (pt%ua  -pt%uo)**2 + (pt%va  -pt%vo)**2 ) 
    112          zSs  = 1.5_wp * SQRT( zdva ) + 0.1_wp * zdva                ! Sea state      (eqn M.A9) 
    113  
     121         ! default sst, ssu and ssv 
     122         ! ln_M2016: use temp, u and v profile 
     123         IF ( ln_M2016 ) THEN 
     124 
     125            ! load t, u, v and e3 profile at icb position 
     126            CALL icb_utl_interp( pt%xi, pt%yj, ptoce=ztoce, puoce=zuoce, pvoce=zvoce, pe3t=ze3t ) 
     127             
     128            !compute bottom level 
     129            CALL icb_utl_getkb( pt%kb, ze3t, zD ) 
     130 
     131            ikb = MIN(pt%kb,mbkt(ii,ij))                             ! limit pt%kb by mbkt  
     132                                                                     ! => bottom temperature used to fill ztoce(mbkt:jpk) 
     133            ztb = ztoce(ikb)                                         ! basal temperature 
     134            zub = zuoce(ikb) 
     135            zvb = zvoce(ikb) 
     136         ELSE 
     137            ztb = pt%sst 
     138            zub = pt%ssu 
     139            zvb = pt%ssv 
     140         END IF 
     141 
     142         zdvob = SQRT( (pt%uvel-zub)**2 + (pt%vvel-zvb)**2 )        ! relative basal velocity 
     143         zdva  = SQRT( (pt%ua  -pt%ssu)**2 + (pt%va  -pt%ssv)**2 )  ! relative wind 
     144         zSs   = 1.5_wp * SQRT( zdva ) + 0.1_wp * zdva              ! Sea state      (eqn M.A9) 
     145         ! 
    114146         ! Melt rates in m/s (i.e. division by rday) 
    115          zMv = MAX( 7.62d-3*zSST+1.29d-3*(zSST**2)                    , 0._wp ) * z1_rday      ! Buoyant convection at sides (eqn M.A10) 
     147         ! Buoyant convection at sides (eqn M.A10) 
     148         IF ( ln_M2016 ) THEN 
     149            ! averaging along all the iceberg draft 
     150            zzMv(:) = MAX( 7.62d-3*ztoce(:)+1.29d-3*(ztoce(:)**2), 0._wp ) * z1_rday 
     151            CALL icb_utl_zavg(zMv, zzMv, ze3t, zD, ikb ) 
     152         ELSE 
     153            zMv = MAX( 7.62d-3*zSST+1.29d-3*(zSST**2), 0._wp ) * z1_rday 
     154         END IF 
     155         ! 
     156         ! Basal turbulent melting     (eqn M.A7 ) 
    116157         IF ( zSST > zfzpt ) THEN                                                              ! Calculate basal melting only if SST above freezing point   
    117             zMb = MAX( 0.58_wp*(zdvo**0.8_wp)*(zSST+4.0_wp)/(zL**0.2_wp) , 0._wp ) * z1_rday   ! Basal turbulent melting     (eqn M.A7 ) 
     158            zMb = MAX( 0.58_wp*(zdvob**0.8_wp)*(ztb+4.0_wp)/(zL**0.2_wp) , 0._wp ) * z1_rday 
    118159         ELSE 
    119160            zMb = 0._wp                                                                        ! No basal melting if SST below freezing point      
    120161         ENDIF 
    121          zMe = MAX( z1_12*(zSST+2.)*zSs*(1._wp+COS(rpi*(zIC**3)))     , 0._wp ) * z1_rday      ! Wave erosion                (eqn M.A8 ) 
     162         ! 
     163         ! Wave erosion                (eqn M.A8 ) 
     164         zMe = MAX( z1_12*(zSST+2.)*zSs*(1._wp+COS(rpi*(zIC**3)))     , 0._wp ) * z1_rday 
    122165 
    123166         IF( ln_operator_splitting ) THEN      ! Operator split update of volume/mass 
    … …  
    207250 
    208251         ! Rolling 
    209          zDn = ( rn_rho_bergs / pp_rho_seawater ) * zTn       ! draught (keel depth) 
     252         zDn = rho_berg_1_oce * zTn       ! draught (keel depth) 
    210253         IF( zDn > 0._wp .AND. MAX(zWn,zLn) < SQRT( 0.92*(zDn**2) + 58.32*zDn ) ) THEN 
    211254            zT  = zTn 
    … …  
    224267 
    225268!!gm  add a test to avoid over melting ? 
     269!!pm  I agree, over melting could break conservation (more melt than calving) 
    226270 
    227271         IF( zMnew <= 0._wp ) THEN       ! Delete the berg if completely melted 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbtrj.F90

    r13558 r14054  
    4040   INTEGER ::   numberid, nstepid, nscaling_id 
    4141   INTEGER ::   nlonid, nlatid, nxid, nyid, nuvelid, nvvelid, nmassid 
    42    INTEGER ::   nuoid, nvoid, nuaid, nvaid, nuiid, nviid 
     42   INTEGER ::   nssuid, nssvid, nuaid, nvaid, nuiid, nviid 
    4343   INTEGER ::   nsshxid, nsshyid, nsstid, ncntid, nthkid 
    4444   INTEGER ::   nthicknessid, nwidthid, nlengthid 
    … …  
    111111      iret = NF90_DEF_VAR( ntrajid, 'uvel'          , NF90_DOUBLE, n_dim          , nuvelid          ) 
    112112      iret = NF90_DEF_VAR( ntrajid, 'vvel'          , NF90_DOUBLE, n_dim          , nvvelid          ) 
    113       iret = NF90_DEF_VAR( ntrajid, 'uto'           , NF90_DOUBLE, n_dim          , nuoid            ) 
    114       iret = NF90_DEF_VAR( ntrajid, 'vto'           , NF90_DOUBLE, n_dim          , nvoid            ) 
     113      iret = NF90_DEF_VAR( ntrajid, 'ssu'           , NF90_DOUBLE, n_dim          , nssuid           ) 
     114      iret = NF90_DEF_VAR( ntrajid, 'ssv'           , NF90_DOUBLE, n_dim          , nssvid           ) 
    115115      iret = NF90_DEF_VAR( ntrajid, 'uta'           , NF90_DOUBLE, n_dim          , nuaid            ) 
    116116      iret = NF90_DEF_VAR( ntrajid, 'vta'           , NF90_DOUBLE, n_dim          , nvaid            ) 
    … …  
    148148      iret = NF90_PUT_ATT( ntrajid, nvvelid         , 'long_name', 'meridional velocity' ) 
    149149      iret = NF90_PUT_ATT( ntrajid, nvvelid         , 'units'    , 'm/s' ) 
    150       iret = NF90_PUT_ATT( ntrajid, nuoid           , 'long_name', 'ocean u component' ) 
    151       iret = NF90_PUT_ATT( ntrajid, nuoid           , 'units'    , 'm/s' ) 
    152       iret = NF90_PUT_ATT( ntrajid, nvoid           , 'long_name', 'ocean v component' ) 
    153       iret = NF90_PUT_ATT( ntrajid, nvoid           , 'units'    , 'm/s' ) 
     150      iret = NF90_PUT_ATT( ntrajid, nssuid          , 'long_name', 'ocean u component' ) 
     151      iret = NF90_PUT_ATT( ntrajid, nssuid          , 'units'    , 'm/s' ) 
     152      iret = NF90_PUT_ATT( ntrajid, nssvid          , 'long_name', 'ocean v component' ) 
     153      iret = NF90_PUT_ATT( ntrajid, nssvid          , 'units'    , 'm/s' ) 
    154154      iret = NF90_PUT_ATT( ntrajid, nuaid           , 'long_name', 'atmosphere u component' ) 
    155155      iret = NF90_PUT_ATT( ntrajid, nuaid           , 'units'    , 'm/s' ) 
    … …  
    231231         iret = NF90_PUT_VAR( ntrajid, nuvelid         , pt%uvel          , (/ jn /) ) 
    232232         iret = NF90_PUT_VAR( ntrajid, nvvelid         , pt%vvel          , (/ jn /) ) 
    233          iret = NF90_PUT_VAR( ntrajid, nuoid           , pt%uo            , (/ jn /) ) 
    234          iret = NF90_PUT_VAR( ntrajid, nvoid           , pt%vo            , (/ jn /) ) 
     233         iret = NF90_PUT_VAR( ntrajid, nssuid          , pt%ssu           , (/ jn /) ) 
     234         iret = NF90_PUT_VAR( ntrajid, nssvid          , pt%ssv           , (/ jn /) ) 
    235235         iret = NF90_PUT_VAR( ntrajid, nuaid           , pt%ua            , (/ jn /) ) 
    236236         iret = NF90_PUT_VAR( ntrajid, nvaid           , pt%va            , (/ jn /) ) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbutl.F90

    r13281 r14054  
    88   !!            -    !                            Removal of mapping from another grid 
    99   !!            -    !  2011-04  (Alderson)       Split into separate modules 
     10   !!           4.2   !  2020-07  (P. Mathiot)     simplification of interpolation routine 
     11   !!                 !                            and add Nacho Merino work 
    1012   !!---------------------------------------------------------------------- 
    1113 
    1214   !!---------------------------------------------------------------------- 
    1315   !!   icb_utl_interp   : 
    14    !!   icb_utl_bilin    : 
    15    !!   icb_utl_bilin_e  : 
     16   !!   icb_utl_pos      : compute bottom left corner indice, weight and mask 
     17   !!   icb_utl_bilin_h  : interpolation field to icb position 
     18   !!   icb_utl_bilin_e  : interpolation of scale factor to icb position 
    1619   !!---------------------------------------------------------------------- 
    1720   USE par_oce                             ! ocean parameters 
     21   USE oce,    ONLY: ts, uu, vv 
    1822   USE dom_oce                             ! ocean domain 
    1923   USE in_out_manager                      ! IO parameters 
    … …  
    3135   PRIVATE 
    3236 
     37   INTERFACE icb_utl_bilin_h 
     38      MODULE PROCEDURE icb_utl_bilin_2d_h, icb_utl_bilin_3d_h 
     39   END INTERFACE 
     40 
    3341   PUBLIC   icb_utl_copy          ! routine called in icbstp module 
     42   PUBLIC   icb_utl_getkb         ! routine called in icbdyn and icbthm modules 
     43   PUBLIC   test_icb_utl_getkb    ! routine called in icbdyn and icbthm modules 
     44   PUBLIC   icb_utl_zavg          ! routine called in icbdyn and icbthm modules 
    3445   PUBLIC   icb_utl_interp        ! routine called in icbdyn, icbthm modules 
    35    PUBLIC   icb_utl_bilin         ! routine called in icbini, icbdyn modules 
    36    PUBLIC   icb_utl_bilin_x       ! routine called in icbdyn module 
     46   PUBLIC   icb_utl_bilin_h       ! routine called in icbdyn module 
    3747   PUBLIC   icb_utl_add           ! routine called in icbini.F90, icbclv, icblbc and icbrst modules 
    3848   PUBLIC   icb_utl_delete        ! routine called in icblbc, icbthm modules 
    … …  
    5464CONTAINS 
    5565 
    56    SUBROUTINE icb_utl_copy() 
     66   SUBROUTINE icb_utl_copy( Kmm ) 
    5767      !!---------------------------------------------------------------------- 
    5868      !!                  ***  ROUTINE icb_utl_copy  *** 
    … …  
    6272      !! ** Method  : - blah blah 
    6373      !!---------------------------------------------------------------------- 
     74      REAL(wp), DIMENSION(0:jpi+1,0:jpj+1) :: ztmp 
    6475#if defined key_si3 
    6576      REAL(wp), DIMENSION(jpi,jpj) :: zssh_lead_m    !    ocean surface (ssh_m) if ice is not embedded 
    6677      !                                              !    ocean surface in leads if ice is embedded    
    6778#endif 
     79      INTEGER :: jk   ! vertical loop index 
     80      INTEGER :: Kmm  ! ocean time levelindex 
     81      ! 
    6882      ! copy nemo forcing arrays into iceberg versions with extra halo 
    6983      ! only necessary for variables not on T points 
    7084      ! and ssh which is used to calculate gradients 
    71  
    72       uo_e(1:jpi,1:jpj) = ssu_m(:,:) * umask(:,:,1) 
    73       vo_e(1:jpi,1:jpj) = ssv_m(:,:) * vmask(:,:,1) 
     85      ! 
     86      ! surface forcing 
     87      ! 
     88      ssu_e(1:jpi,1:jpj) = ssu_m(:,:) * umask(:,:,1) 
     89      ssv_e(1:jpi,1:jpj) = ssv_m(:,:) * vmask(:,:,1) 
     90      sst_e(1:jpi,1:jpj) = sst_m(:,:) 
     91      sss_e(1:jpi,1:jpj) = sss_m(:,:) 
     92      fr_e (1:jpi,1:jpj) = fr_i (:,:) 
     93      ua_e (1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
     94      va_e (1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    7495      ff_e(1:jpi,1:jpj) = ff_f (:,:)  
    75       tt_e(1:jpi,1:jpj) = sst_m(:,:) 
    76       ss_e(1:jpi,1:jpj) = sss_m(:,:) 
    77       fr_e(1:jpi,1:jpj) = fr_i (:,:) 
    78       ua_e(1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    79       va_e(1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    80       ! 
    81       CALL lbc_lnk_icb( 'icbutl', uo_e, 'U', -1._wp, 1, 1 ) 
    82       CALL lbc_lnk_icb( 'icbutl', vo_e, 'V', -1._wp, 1, 1 ) 
    83       CALL lbc_lnk_icb( 'icbutl', ff_e, 'F', +1._wp, 1, 1 ) 
    84       CALL lbc_lnk_icb( 'icbutl', ua_e, 'U', -1._wp, 1, 1 ) 
    85       CALL lbc_lnk_icb( 'icbutl', va_e, 'V', -1._wp, 1, 1 ) 
    86       CALL lbc_lnk_icb( 'icbutl', fr_e, 'T', +1._wp, 1, 1 ) 
    87       CALL lbc_lnk_icb( 'icbutl', tt_e, 'T', +1._wp, 1, 1 ) 
    88       CALL lbc_lnk_icb( 'icbutl', ss_e, 'T', +1._wp, 1, 1 ) 
     96      ! 
     97      CALL lbc_lnk_icb( 'icbutl', ssu_e, 'U', -1._wp, 1, 1 ) 
     98      CALL lbc_lnk_icb( 'icbutl', ssv_e, 'V', -1._wp, 1, 1 ) 
     99      CALL lbc_lnk_icb( 'icbutl', ua_e , 'U', -1._wp, 1, 1 ) 
     100      CALL lbc_lnk_icb( 'icbutl', va_e , 'V', -1._wp, 1, 1 ) 
    89101#if defined key_si3 
    90102      hi_e(1:jpi, 1:jpj) = hm_i (:,:)   
    … …  
    96108      ssh_e(1:jpi, 1:jpj) = zssh_lead_m(:,:) * tmask(:,:,1) 
    97109      ! 
    98       CALL lbc_lnk_icb( 'icbutl', hi_e , 'T', +1._wp, 1, 1 ) 
    99110      CALL lbc_lnk_icb( 'icbutl', ui_e , 'U', -1._wp, 1, 1 ) 
    100111      CALL lbc_lnk_icb( 'icbutl', vi_e , 'V', -1._wp, 1, 1 ) 
    101112#else 
    102       ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1) 
     113      ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1)          
    103114#endif 
    104       CALL lbc_lnk_icb( 'icbutl', ssh_e, 'T', +1._wp, 1, 1 ) 
     115      ! 
     116      ! (PM) could be improve with a 3d lbclnk gathering both variables 
     117      ! should be done once extra haloe generalised 
     118      IF ( ln_M2016 ) THEN 
     119         DO jk = 1,jpk 
     120            ! uoce 
     121            ztmp(1:jpi,1:jpj) = uu(:,:,jk,Kmm) 
     122            CALL lbc_lnk_icb( 'icbutl', ztmp, 'U', -1._wp, 1, 1 ) 
     123            uoce_e(:,:,jk) = ztmp(:,:) 
     124            ! 
     125            ! voce 
     126            ztmp(1:jpi,1:jpj) = vv(:,:,jk,Kmm) 
     127            CALL lbc_lnk_icb( 'icbutl', ztmp, 'V', -1._wp, 1, 1 ) 
     128            voce_e(:,:,jk) = ztmp(:,:) 
     129         END DO 
     130         toce_e(1:jpi,1:jpj,1:jpk) = ts(:,:,:,1,Kmm) 
     131         e3t_e (1:jpi,1:jpj,1:jpk) = e3t(:,:,:,Kmm) 
     132      END IF 
    105133      ! 
    106134   END SUBROUTINE icb_utl_copy 
    107135 
    108136 
    109    SUBROUTINE icb_utl_interp( pi, pe1, puo, pui, pua, pssh_i,   & 
    110       &                       pj, pe2, pvo, pvi, pva, pssh_j,   & 
    111       &                       psst, pcn, phi, pff, psss        ) 
     137   SUBROUTINE icb_utl_interp( pi, pj, pe1 , pssu, pui, pua, pssh_i,         & 
     138      &                               pe2 , pssv, pvi, pva, pssh_j,         & 
     139      &                               psst, psss, pcn, phi, pff   ,         & 
     140      &                               plon, plat, ptoce, puoce, pvoce, pe3t ) 
    112141      !!---------------------------------------------------------------------- 
    113142      !!                  ***  ROUTINE icb_utl_interp  *** 
    … …  
    127156      !!---------------------------------------------------------------------- 
    128157      REAL(wp), INTENT(in   ) ::   pi , pj                        ! position in (i,j) referential 
    129       REAL(wp), INTENT(  out) ::   pe1, pe2                       ! i- and j scale factors 
    130       REAL(wp), INTENT(  out) ::   puo, pvo, pui, pvi, pua, pva   ! ocean, ice and wind speeds 
    131       REAL(wp), INTENT(  out) ::   pssh_i, pssh_j                 ! ssh i- & j-gradients 
    132       REAL(wp), INTENT(  out) ::   psst, pcn, phi, pff, psss      ! SST, ice concentration, ice thickness, Coriolis, SSS 
    133       ! 
     158      REAL(wp), INTENT(  out), OPTIONAL ::   pe1, pe2                       ! i- and j scale factors 
     159      REAL(wp), INTENT(  out), OPTIONAL ::   pssu, pssv, pui, pvi, pua, pva ! ocean, ice and wind speeds 
     160      REAL(wp), INTENT(  out), OPTIONAL ::   pssh_i, pssh_j                 ! ssh i- & j-gradients 
     161      REAL(wp), INTENT(  out), OPTIONAL ::   psst, psss, pcn, phi, pff      ! SST, SSS, ice concentration, ice thickness, Coriolis 
     162      REAL(wp), INTENT(  out), OPTIONAL ::   plat, plon                     ! position 
     163      REAL(wp), DIMENSION(jpk), INTENT(  out), OPTIONAL ::   ptoce, puoce, pvoce, pe3t   ! 3D variables 
     164      ! 
     165      REAL(wp), DIMENSION(4) :: zwT  , zwU  , zwV  , zwF   ! interpolation weight 
     166      REAL(wp), DIMENSION(4) :: zmskF, zmskU, zmskV, zmskT ! mask 
     167      REAL(wp), DIMENSION(4) :: zwTp, zmskTp, zwTm, zmskTm 
     168      REAL(wp), DIMENSION(4,jpk) :: zw1d 
     169      INTEGER                :: iiT, iiU, iiV, iiF, ijT, ijU, ijV, ijF ! bottom left corner 
     170      INTEGER                :: iiTp, iiTm, ijTp, ijTm 
    134171      REAL(wp) ::   zcd, zmod       ! local scalars 
    135172      !!---------------------------------------------------------------------- 
    136  
    137       pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )      ! scale factors 
    138       pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
    139       ! 
    140       puo  = icb_utl_bilin_h( uo_e, pi, pj, 'U', .false.  )    ! ocean velocities 
    141       pvo  = icb_utl_bilin_h( vo_e, pi, pj, 'V', .false.  ) 
    142       psst = icb_utl_bilin_h( tt_e, pi, pj, 'T', .true.   )    ! SST 
    143       psss = icb_utl_bilin_h( ss_e, pi, pj, 'T', .true.   )    ! SSS 
    144       pcn  = icb_utl_bilin_h( fr_e, pi, pj, 'T', .true.   )    ! ice concentration 
    145       pff  = icb_utl_bilin_h( ff_e, pi, pj, 'F', .false.  )    ! Coriolis parameter 
    146       ! 
    147       pua  = icb_utl_bilin_h( ua_e, pi, pj, 'U', .true.   )    ! 10m wind 
    148       pva  = icb_utl_bilin_h( va_e, pi, pj, 'V', .true.   )    ! here (ua,va) are stress => rough conversion from stress to speed 
    149       zcd  = 1.22_wp * 1.5e-3_wp                               ! air density * drag coefficient  
    150       zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  ) 
    151       pua  = pua * zmod                                       ! note: stress module=0 necessarly implies ua=va=0 
    152       pva  = pva * zmod 
    153  
     173      ! 
     174      ! get position, weight and mask  
     175      CALL icb_utl_pos( pi, pj, 'T', iiT, ijT, zwT, zmskT ) 
     176      CALL icb_utl_pos( pi, pj, 'U', iiU, ijU, zwU, zmskU ) 
     177      CALL icb_utl_pos( pi, pj, 'V', iiV, ijV, zwV, zmskV ) 
     178      CALL icb_utl_pos( pi, pj, 'F', iiF, ijF, zwF, zmskF ) 
     179      ! 
     180      ! metrics and coordinates 
     181      IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )      ! scale factors 
     182      IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
     183      IF ( PRESENT(plon) ) plon= icb_utl_bilin_h( rlon_e, iiT, ijT, zwT, .true.  ) 
     184      IF ( PRESENT(plat) ) plat= icb_utl_bilin_h( rlat_e, iiT, ijT, zwT, .false. ) 
     185      ! 
     186      IF ( PRESENT(pssu) ) pssu = icb_utl_bilin_h( ssu_e, iiU, ijU, zwU        , .false. ) ! ocean velocities 
     187      IF ( PRESENT(pssv) ) pssv = icb_utl_bilin_h( ssv_e, iiV, ijV, zwV        , .false. ) ! 
     188      IF ( PRESENT(psst) ) psst = icb_utl_bilin_h( sst_e, iiT, ijT, zwT * zmskT, .false. ) ! sst 
     189      IF ( PRESENT(psss) ) psss = icb_utl_bilin_h( sss_e, iiT, ijT, zwT * zmskT, .false. ) ! sss 
     190      IF ( PRESENT(pcn ) ) pcn  = icb_utl_bilin_h( fr_e , iiT, ijT, zwT * zmskT, .false. ) ! ice concentration 
     191      IF ( PRESENT(pff ) ) pff  = icb_utl_bilin_h( ff_e , iiF, ijF, zwF        , .false. ) ! Coriolis parameter 
     192      ! 
     193      IF ( PRESENT(pua) .AND. PRESENT(pva) ) THEN 
     194         pua  = icb_utl_bilin_h( ua_e, iiU, ijU, zwU * zmskU, .false. ) ! 10m wind 
     195         pva  = icb_utl_bilin_h( va_e, iiV, ijV, zwV * zmskV, .false. ) ! here (ua,va) are stress => rough conversion from stress to speed 
     196         zcd  = 1.22_wp * 1.5e-3_wp                               ! air density * drag coefficient  
     197         zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  ) 
     198         pua  = pua * zmod                                       ! note: stress module=0 necessarly implies ua=va=0 
     199         pva  = pva * zmod 
     200      END IF 
     201      ! 
    154202#if defined key_si3 
    155       pui = icb_utl_bilin_h( ui_e , pi, pj, 'U', .false. )    ! sea-ice velocities 
    156       pvi = icb_utl_bilin_h( vi_e , pi, pj, 'V', .false. ) 
    157       phi = icb_utl_bilin_h( hi_e , pi, pj, 'T', .true.  )    ! ice thickness 
     203      IF ( PRESENT(pui) ) pui = icb_utl_bilin_h( ui_e , iiU, ijU, zwU        , .false. ) ! sea-ice velocities 
     204      IF ( PRESENT(pvi) ) pvi = icb_utl_bilin_h( vi_e , iiV, ijV, zwV        , .false. ) 
     205      IF ( PRESENT(phi) ) phi = icb_utl_bilin_h( hi_e , iiT, ijT, zwT * zmskT, .false. ) ! ice thickness 
    158206#else 
    159       pui = 0._wp 
    160       pvi = 0._wp 
    161       phi = 0._wp 
     207      IF ( PRESENT(pui) ) pui = 0._wp 
     208      IF ( PRESENT(pvi) ) pvi = 0._wp 
     209      IF ( PRESENT(phi) ) phi = 0._wp 
    162210#endif 
    163  
     211      ! 
    164212      ! Estimate SSH gradient in i- and j-direction (centred evaluation) 
    165       pssh_i = ( icb_utl_bilin_h( ssh_e, pi+0.1_wp, pj, 'T', .true. ) -   & 
    166          &       icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T', .true. )  ) / ( 0.2_wp * pe1 ) 
    167       pssh_j = ( icb_utl_bilin_h( ssh_e, pi, pj+0.1_wp, 'T', .true. ) -   & 
    168          &       icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T', .true. )  ) / ( 0.2_wp * pe2 ) 
     213      IF ( PRESENT(pssh_i) .AND. PRESENT(pssh_j) ) THEN 
     214         CALL icb_utl_pos( pi+0.1, pj    , 'T', iiTp, ijTp, zwTp, zmskTp ) 
     215         CALL icb_utl_pos( pi-0.1, pj    , 'T', iiTm, ijTm, zwTm, zmskTm ) 
     216         ! 
     217         IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) 
     218         pssh_i = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) -   & 
     219            &       icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. )  ) / ( 0.2_wp * pe1 ) 
     220         ! 
     221         CALL icb_utl_pos( pi    , pj+0.1, 'T', iiTp, ijTp, zwTp, zmskTp ) 
     222         CALL icb_utl_pos( pi    , pj-0.1, 'T', iiTm, ijTm, zwTm, zmskTm ) 
     223         ! 
     224         IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
     225         pssh_j = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) -   & 
     226            &       icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. )  ) / ( 0.2_wp * pe2 ) 
     227      END IF 
     228      ! 
     229      ! 3d interpolation 
     230      IF ( PRESENT(puoce) .AND. PRESENT(pvoce) ) THEN 
     231         ! no need to mask as 0 is a valid data for land 
     232         zw1d(1,:) = zwU(1) ; zw1d(2,:) = zwU(2) ; zw1d(3,:) = zwU(3) ; zw1d(4,:) = zwU(4) ; 
     233         puoce(:) = icb_utl_bilin_h( uoce_e , iiU, ijU, zw1d ) 
     234 
     235         zw1d(1,:) = zwV(1) ; zw1d(2,:) = zwV(2) ; zw1d(3,:) = zwV(3) ; zw1d(4,:) = zwV(4) ; 
     236         pvoce(:) = icb_utl_bilin_h( voce_e , iiV, ijV, zw1d ) 
     237      END IF 
     238 
     239      IF ( PRESENT(ptoce) ) THEN 
     240         ! for temperature we need to mask the weight properly 
     241         ! no need of extra halo as it is a T point variable 
     242         zw1d(1,:) = tmask(iiT  ,ijT  ,:) * zwT(1) * zmskT(1) 
     243         zw1d(2,:) = tmask(iiT+1,ijT  ,:) * zwT(2) * zmskT(2) 
     244         zw1d(3,:) = tmask(iiT  ,ijT+1,:) * zwT(3) * zmskT(3) 
     245         zw1d(4,:) = tmask(iiT+1,ijT+1,:) * zwT(4) * zmskT(4) 
     246         ptoce(:) = icb_utl_bilin_h( toce_e , iiT, ijT, zw1d ) 
     247      END IF 
     248      ! 
     249      IF ( PRESENT(pe3t)  ) pe3t(:)  = e3t_e(iiT,ijT,:)    ! as in Nacho tarball need to be fix once we are able to reproduce Nacho results 
    169250      ! 
    170251   END SUBROUTINE icb_utl_interp 
    171252 
    172  
    173    REAL(wp) FUNCTION icb_utl_bilin_h( pfld, pi, pj, cd_type, plmask ) 
     253   SUBROUTINE icb_utl_pos( pi, pj, cd_type, kii, kij, pw, pmsk ) 
    174254      !!---------------------------------------------------------------------- 
    175255      !!                  ***  FUNCTION icb_utl_bilin  *** 
    … …  
    182262      !! 
    183263      !!---------------------------------------------------------------------- 
    184       REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) ::   pfld      ! field to be interpolated 
    185       REAL(wp)                            , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    186       CHARACTER(len=1)                    , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
    187       LOGICAL                             , INTENT(in) ::   plmask    ! special treatment of mask point 
    188       ! 
    189       INTEGER  ::   ii, ij   ! local integer 
    190       REAL(wp) ::   zi, zj   ! local real 
    191       REAL(wp) :: zw1, zw2, zw3, zw4 
    192       REAL(wp), DIMENSION(4) :: zmask 
     264      REAL(wp)              , INTENT(IN)  ::   pi, pj    ! targeted coordinates in (i,j) referential 
     265      CHARACTER(len=1)      , INTENT(IN)  ::   cd_type   ! point type 
     266      REAL(wp), DIMENSION(4), INTENT(OUT) ::   pw, pmsk  ! weight and mask 
     267      INTEGER ,               INTENT(OUT) ::   kii, kij  ! bottom left corner position in local domain 
     268      ! 
     269      REAL(wp) :: zwi, zwj ! distance to bottom left corner 
     270      INTEGER  :: ierr  
     271      ! 
    193272      !!---------------------------------------------------------------------- 
    194273      ! 
    … …  
    198277         ! since we're looking for four T points containing quadrant we're in of  
    199278         ! current T cell 
    200          ii = MAX(0, INT( pi     )) 
    201          ij = MAX(0, INT( pj     ))    ! T-point 
    202          zi = pi - REAL(ii,wp) 
    203          zj = pj - REAL(ij,wp) 
     279         kii = MAX(0, INT( pi        )) 
     280         kij = MAX(0, INT( pj        ))    ! T-point 
     281         zwi = pi - REAL(kii,wp) 
     282         zwj = pj - REAL(kij,wp) 
    204283      CASE ( 'U' ) 
    205          ii = MAX(0, INT( pi-0.5_wp )) 
    206          ij = MAX(0, INT( pj     ))    ! U-point 
    207          zi = pi - 0.5_wp - REAL(ii,wp) 
    208          zj = pj - REAL(ij,wp) 
     284         kii = MAX(0, INT( pi-0.5_wp )) 
     285         kij = MAX(0, INT( pj        ))    ! U-point 
     286         zwi = pi - 0.5_wp - REAL(kii,wp) 
     287         zwj = pj - REAL(kij,wp) 
    209288      CASE ( 'V' ) 
    210          ii = MAX(0, INT( pi     )) 
    211          ij = MAX(0, INT( pj-0.5_wp ))    ! V-point 
    212          zi = pi - REAL(ii,wp) 
    213          zj = pj - 0.5_wp - REAL(ij,wp) 
     289         kii = MAX(0, INT( pi        )) 
     290         kij = MAX(0, INT( pj-0.5_wp ))    ! V-point 
     291         zwi = pi - REAL(kii,wp) 
     292         zwj = pj - 0.5_wp - REAL(kij,wp) 
    214293      CASE ( 'F' ) 
    215          ii = MAX(0, INT( pi-0.5_wp )) 
    216          ij = MAX(0, INT( pj-0.5_wp ))    ! F-point 
    217          zi = pi - 0.5_wp - REAL(ii,wp) 
    218          zj = pj - 0.5_wp - REAL(ij,wp) 
     294         kii = MAX(0, INT( pi-0.5_wp )) 
     295         kij = MAX(0, INT( pj-0.5_wp ))    ! F-point 
     296         zwi = pi - 0.5_wp - REAL(kii,wp) 
     297         zwj = pj - 0.5_wp - REAL(kij,wp) 
    219298      END SELECT 
     299      ! 
     300      ! compute weight 
     301      pw(1) = (1._wp-zwi) * (1._wp-zwj) 
     302      pw(2) =        zwi  * (1._wp-zwj) 
     303      pw(3) = (1._wp-zwi) *        zwj 
     304      pw(4) =        zwi  *        zwj 
     305      ! 
     306      ! find position in this processor. Prevent near edge problems (see #1389) 
     307      ! 
     308      IF (TRIM(cd_type) == 'T' ) THEN 
     309         ierr = 0 
     310         IF    ( kii <  mig( 1 ) ) THEN   ;  ierr = ierr + 1 
     311         ELSEIF( kii >= mig(jpi) ) THEN   ;  ierr = ierr + 1 
     312         ENDIF 
     313         ! 
     314         IF    ( kij <  mjg( 1 ) ) THEN   ;   ierr = ierr + 1 
     315         ELSEIF( kij >= mjg(jpj) ) THEN   ;   ierr = ierr + 1 
     316         ENDIF 
     317         ! 
     318         IF ( ierr > 0 ) THEN 
     319            WRITE(numout,*) 'bottom left corner T point out of bound' 
     320            WRITE(numout,*) pi, kii, mig( 1 ), mig(jpi) 
     321            WRITE(numout,*) pj, kij, mjg( 1 ), mjg(jpj) 
     322            WRITE(numout,*) pmsk 
     323            CALL ctl_stop('STOP','icb_utl_bilin_h: an icebergs coordinates is out of valid range (out of bound error)') 
     324         END IF 
     325      END IF 
    220326      ! 
    221327      ! find position in this processor. Prevent near edge problems (see #1389) 
    222328      ! (PM) will be useless if extra halo is used in NEMO 
    223329      ! 
    224       IF    ( ii <= mig(1)-1 ) THEN   ;   ii = 0 
    225       ELSEIF( ii  > mig(jpi) ) THEN   ;   ii = jpi 
    226       ELSE                            ;   ii = mi1(ii) 
     330      IF    ( kii <= mig(1)-1 ) THEN   ;   kii = 0 
     331      ELSEIF( kii  > mig(jpi) ) THEN   ;   kii = jpi 
     332      ELSE                             ;   kii = mi1(kii) 
    227333      ENDIF 
    228       IF    ( ij <= mjg(1)-1 ) THEN   ;   ij = 0 
    229       ELSEIF( ij  > mjg(jpj) ) THEN   ;   ij = jpj 
    230       ELSE                            ;   ij = mj1(ij) 
     334      IF    ( kij <= mjg(1)-1 ) THEN   ;   kij = 0 
     335      ELSEIF( kij  > mjg(jpj) ) THEN   ;   kij = jpj 
     336      ELSE                             ;   kij = mj1(kij) 
    231337      ENDIF 
    232338      ! 
    233339      ! define mask array  
    234       IF (plmask) THEN 
    235          ! land value is not used in the interpolation 
    236          SELECT CASE ( cd_type ) 
    237          CASE ( 'T' ) 
    238             zmask = (/tmask_e(ii,ij), tmask_e(ii+1,ij), tmask_e(ii,ij+1), tmask_e(ii+1,ij+1)/) 
    239          CASE ( 'U' ) 
    240             zmask = (/umask_e(ii,ij), umask_e(ii+1,ij), umask_e(ii,ij+1), umask_e(ii+1,ij+1)/) 
    241          CASE ( 'V' ) 
    242             zmask = (/vmask_e(ii,ij), vmask_e(ii+1,ij), vmask_e(ii,ij+1), vmask_e(ii+1,ij+1)/) 
    243          CASE ( 'F' ) 
    244             ! F case only used for coriolis, ff_f is not mask so zmask = 1 
    245             zmask = 1. 
    246          END SELECT 
    247       ELSE 
    248          ! land value is used during interpolation 
    249          zmask = 1. 
    250       END iF 
    251       ! 
    252       ! compute weight 
    253       zw1 = zmask(1) * (1._wp-zi) * (1._wp-zj) 
    254       zw2 = zmask(2) *        zi  * (1._wp-zj) 
    255       zw3 = zmask(3) * (1._wp-zi) *        zj 
    256       zw4 = zmask(4) *        zi  *        zj 
    257       ! 
    258       ! compute interpolated value 
    259       icb_utl_bilin_h = ( pfld(ii,ij)*zw1 + pfld(ii+1,ij)*zw2 + pfld(ii,ij+1)*zw3 + pfld(ii+1,ij+1)*zw4 ) / MAX(1.e-20, zw1+zw2+zw3+zw4)  
    260       ! 
    261    END FUNCTION icb_utl_bilin_h 
    262  
    263  
    264    REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type ) 
     340      ! land value is not used in the interpolation 
     341      SELECT CASE ( cd_type ) 
     342      CASE ( 'T' ) 
     343         pmsk = (/tmask_e(kii,kij), tmask_e(kii+1,kij), tmask_e(kii,kij+1), tmask_e(kii+1,kij+1)/) 
     344      CASE ( 'U' ) 
     345         pmsk = (/umask_e(kii,kij), umask_e(kii+1,kij), umask_e(kii,kij+1), umask_e(kii+1,kij+1)/) 
     346      CASE ( 'V' ) 
     347         pmsk = (/vmask_e(kii,kij), vmask_e(kii+1,kij), vmask_e(kii,kij+1), vmask_e(kii+1,kij+1)/) 
     348      CASE ( 'F' ) 
     349         ! F case only used for coriolis, ff_f is not mask so zmask = 1 
     350         pmsk = 1. 
     351      END SELECT 
     352   END SUBROUTINE icb_utl_pos 
     353 
     354   REAL(wp) FUNCTION icb_utl_bilin_2d_h( pfld, pii, pij, pw, pllon ) 
    265355      !!---------------------------------------------------------------------- 
    266356      !!                  ***  FUNCTION icb_utl_bilin  *** 
    267357      !! 
    268358      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
     359      !!                this version deals with extra halo points 
    269360      !! 
    270361      !!       !!gm  CAUTION an optional argument should be added to handle 
    … …  
    272363      !! 
    273364      !!---------------------------------------------------------------------- 
    274       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfld      ! field to be interpolated 
    275       REAL(wp)                    , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    276       CHARACTER(len=1)            , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
    277       ! 
    278       INTEGER  ::   ii, ij   ! local integer 
    279       REAL(wp) ::   zi, zj   ! local real 
    280       !!---------------------------------------------------------------------- 
    281       ! 
    282       SELECT CASE ( cd_type ) 
    283          CASE ( 'T' ) 
    284             ! note that here there is no +0.5 added 
    285             ! since we're looking for four T points containing quadrant we're in of  
    286             ! current T cell 
    287             ii = MAX(1, INT( pi     )) 
    288             ij = MAX(1, INT( pj     ))    ! T-point 
    289             zi = pi - REAL(ii,wp) 
    290             zj = pj - REAL(ij,wp) 
    291          CASE ( 'U' ) 
    292             ii = MAX(1, INT( pi-0.5 )) 
    293             ij = MAX(1, INT( pj     ))    ! U-point 
    294             zi = pi - 0.5 - REAL(ii,wp) 
    295             zj = pj - REAL(ij,wp) 
    296          CASE ( 'V' ) 
    297             ii = MAX(1, INT( pi     )) 
    298             ij = MAX(1, INT( pj-0.5 ))    ! V-point 
    299             zi = pi - REAL(ii,wp) 
    300             zj = pj - 0.5 - REAL(ij,wp) 
    301          CASE ( 'F' ) 
    302             ii = MAX(1, INT( pi-0.5 )) 
    303             ij = MAX(1, INT( pj-0.5 ))    ! F-point 
    304             zi = pi - 0.5 - REAL(ii,wp) 
    305             zj = pj - 0.5 - REAL(ij,wp) 
    306       END SELECT 
    307       ! 
    308       ! find position in this processor. Prevent near edge problems (see #1389) 
    309       IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1 
    310       ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi 
    311       ELSE                           ;   ii = mi1(ii) 
     365      REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) ::   pfld      ! field to be interpolated 
     366      REAL(wp), DIMENSION(4)              , INTENT(in) ::   pw        ! weight 
     367      LOGICAL                             , INTENT(in) ::   pllon     ! input data is a longitude 
     368      INTEGER ,                             INTENT(in) ::   pii, pij  ! bottom left corner 
     369      ! 
     370      REAL(wp), DIMENSION(4) :: zdat ! input data 
     371      !!---------------------------------------------------------------------- 
     372      ! 
     373      ! data 
     374      zdat(1) = pfld(pii  ,pij  ) 
     375      zdat(2) = pfld(pii+1,pij  ) 
     376      zdat(3) = pfld(pii  ,pij+1) 
     377      zdat(4) = pfld(pii+1,pij+1) 
     378      ! 
     379      IF( pllon .AND. MAXVAL(zdat) - MINVAL(zdat) > 90._wp ) THEN 
     380         WHERE( zdat < 0._wp ) zdat = zdat + 360._wp 
    312381      ENDIF 
    313       IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1 
    314       ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj 
    315       ELSE                           ;   ij  = mj1(ij) 
    316       ENDIF 
    317       ! 
    318       IF( ii == jpi )   ii = ii-1       
    319       IF( ij == jpj )   ij = ij-1 
    320       ! 
    321       icb_utl_bilin = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
    322          &          + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
    323       ! 
    324    END FUNCTION icb_utl_bilin 
    325  
    326  
    327    REAL(wp) FUNCTION icb_utl_bilin_x( pfld, pi, pj ) 
    328       !!---------------------------------------------------------------------- 
    329       !!                  ***  FUNCTION icb_utl_bilin_x  *** 
     382      ! 
     383      ! compute interpolated value 
     384      icb_utl_bilin_2d_h = ( zdat(1)*pw(1) + zdat(2)*pw(2) + zdat(3)*pw(3) + zdat(4)*pw(4) ) / MAX(1.e-20, pw(1)+pw(2)+pw(3)+pw(4))  
     385      ! 
     386      IF( pllon .AND. icb_utl_bilin_2d_h > 180._wp ) icb_utl_bilin_2d_h = icb_utl_bilin_2d_h - 360._wp 
     387      ! 
     388   END FUNCTION icb_utl_bilin_2d_h 
     389 
     390   FUNCTION icb_utl_bilin_3d_h( pfld, pii, pij, pw ) 
     391      !!---------------------------------------------------------------------- 
     392      !!                  ***  FUNCTION icb_utl_bilin  *** 
    330393      !! 
    331394      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
    332       !!                Special case for interpolating longitude 
     395      !!                this version deals with extra halo points 
    333396      !! 
    334397      !!       !!gm  CAUTION an optional argument should be added to handle 
    … …  
    336399      !! 
    337400      !!---------------------------------------------------------------------- 
    338       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfld      ! field to be interpolated 
    339       REAL(wp)                    , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    340       ! 
    341       INTEGER                                  ::   ii, ij   ! local integer 
    342       REAL(wp)                                 ::   zi, zj   ! local real 
    343       REAL(wp)                                 ::   zret     ! local real 
    344       REAL(wp), DIMENSION(4)                   ::   z4 
    345       !!---------------------------------------------------------------------- 
    346       ! 
    347       ! note that here there is no +0.5 added 
    348       ! since we're looking for four T points containing quadrant we're in of  
    349       ! current T cell 
    350       ii = MAX(1, INT( pi     )) 
    351       ij = MAX(1, INT( pj     ))    ! T-point 
    352       zi = pi - REAL(ii,wp) 
    353       zj = pj - REAL(ij,wp) 
    354       ! 
    355       ! find position in this processor. Prevent near edge problems (see #1389) 
    356       IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1 
    357       ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi 
    358       ELSE                           ;   ii = mi1(ii) 
    359       ENDIF 
    360       IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1 
    361       ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj 
    362       ELSE                           ;   ij  = mj1(ij) 
    363       ENDIF 
    364       ! 
    365       IF( ii == jpi )   ii = ii-1       
    366       IF( ij == jpj )   ij = ij-1 
    367       ! 
    368       z4(1) = pfld(ii  ,ij  ) 
    369       z4(2) = pfld(ii+1,ij  ) 
    370       z4(3) = pfld(ii  ,ij+1) 
    371       z4(4) = pfld(ii+1,ij+1) 
    372       IF( MAXVAL(z4) - MINVAL(z4) > 90._wp ) THEN 
    373          WHERE( z4 < 0._wp ) z4 = z4 + 360._wp 
    374       ENDIF 
    375       ! 
    376       zret = (z4(1) * (1.-zi) + z4(2) * zi) * (1.-zj) + (z4(3) * (1.-zi) + z4(4) * zi) * zj 
    377       IF( zret > 180._wp ) zret = zret - 360._wp 
    378       icb_utl_bilin_x = zret 
    379       ! 
    380    END FUNCTION icb_utl_bilin_x 
    381  
     401      REAL(wp), DIMENSION(0:jpi+1,0:jpj+1, jpk), INTENT(in) ::   pfld      ! field to be interpolated 
     402      REAL(wp), DIMENSION(4,jpk)               , INTENT(in) ::   pw        ! weight 
     403      INTEGER ,                                  INTENT(in) ::   pii, pij  ! bottom left corner 
     404      REAL(wp), DIMENSION(jpk) :: icb_utl_bilin_3d_h 
     405      ! 
     406      REAL(wp), DIMENSION(4,jpk) :: zdat ! input data 
     407      INTEGER :: jk 
     408      !!---------------------------------------------------------------------- 
     409      ! 
     410      ! data 
     411      zdat(1,:) = pfld(pii  ,pij  ,:) 
     412      zdat(2,:) = pfld(pii+1,pij  ,:) 
     413      zdat(3,:) = pfld(pii  ,pij+1,:) 
     414      zdat(4,:) = pfld(pii+1,pij+1,:) 
     415      ! 
     416      ! compute interpolated value 
     417      DO jk=1,jpk 
     418         icb_utl_bilin_3d_h(jk) =   ( zdat(1,jk)*pw(1,jk) + zdat(2,jk)*pw(2,jk) + zdat(3,jk)*pw(3,jk) + zdat(4,jk)*pw(4,jk) ) & 
     419            &                     /   MAX(1.e-20, pw(1,jk)+pw(2,jk)+pw(3,jk)+pw(4,jk))  
     420      END DO 
     421      ! 
     422   END FUNCTION icb_utl_bilin_3d_h 
    382423 
    383424   REAL(wp) FUNCTION icb_utl_bilin_e( pet, peu, pev, pef, pi, pj ) 
    … …  
    390431      !!---------------------------------------------------------------------- 
    391432      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pet, peu, pev, pef   ! horizontal scale factor to be interpolated at t-,u-,v- & f-pts 
    392       REAL(wp)                , INTENT(in) ::   pi, pj               ! targeted coordinates in (i,j) referential 
    393       ! 
    394       INTEGER  ::   ii, ij, icase, ierr   ! local integer 
     433      REAL(wp)                , INTENT(IN) ::   pi , pj              ! iceberg position 
    395434      ! 
    396435      ! weights corresponding to corner points of a T cell quadrant 
    397436      REAL(wp) ::   zi, zj          ! local real 
     437      INTEGER  ::   ii, ij          ! bottom left corner coordinate in local domain 
    398438      ! 
    399439      ! values at corner points of a T cell quadrant 
    … …  
    402442      !!---------------------------------------------------------------------- 
    403443      ! 
     444      ! cannot used iiT because need ii/ij reltaive to global indices not local one 
    404445      ii = MAX(1, INT( pi ))   ;   ij = MAX(1, INT( pj ))            ! left bottom T-point (i,j) indices 
    405  
     446      !  
    406447      ! fractional box spacing 
    407448      ! 0   <= zi < 0.5, 0   <= zj < 0.5   -->  NW quadrant of current T cell 
    … …  
    413454      zj = pj - REAL(ij,wp) 
    414455 
    415       ! find position in this processor. Prevent near edge problems (see #1389) 
    416       ! 
    417       ierr = 0 
    418       IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1       ; ierr = ierr + 1 
    419       ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi     ; ierr = ierr + 1 
    420       ELSE                           ;   ii = mi1(ii) 
    421       ENDIF 
    422       IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1       ; ierr = ierr + 1 
    423       ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj     ; ierr = ierr + 1 
    424       ELSE                           ;   ij  = mj1(ij) 
    425       ENDIF 
    426       ! 
    427       IF( ii == jpi ) THEN ; ii = ii-1 ; ierr = ierr + 1 ; END IF      
    428       IF( ij == jpj ) THEN ; ij = ij-1 ; ierr = ierr + 1 ; END IF 
    429       ! 
    430       IF ( ierr > 0 ) CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error)') 
     456      ! conversion to local domain (no need to do a sanity check already done in icbpos) 
     457      ii = mi1(ii) 
     458      ij = mj1(ij) 
    431459      ! 
    432460      IF(    0.0_wp <= zi .AND. zi < 0.5_wp   ) THEN 
    … …  
    465493   END FUNCTION icb_utl_bilin_e 
    466494 
     495   SUBROUTINE icb_utl_getkb( kb, pe3, pD ) 
     496      !!---------------------------------------------------------------------- 
     497      !!                ***  ROUTINE icb_utl_getkb         *** 
     498      !! 
     499      !! ** Purpose :   compute the latest level affected by icb 
     500      !! 
     501      !!---------------------------------------------------------------------- 
     502      INTEGER,                INTENT(out):: kb 
     503      REAL(wp), DIMENSION(:), INTENT(in) :: pe3 
     504      REAL(wp),               INTENT(in) :: pD 
     505      !! 
     506      INTEGER  :: jk 
     507      REAL(wp) :: zdepw 
     508      !!---------------------------------------------------------------------- 
     509      !! 
     510      zdepw = pe3(1) ; kb = 2 
     511      DO WHILE ( zdepw <  pD) 
     512         zdepw = zdepw + pe3(kb) 
     513         kb = kb + 1 
     514      END DO 
     515      kb = MIN(kb - 1,jpk) 
     516   END SUBROUTINE 
     517 
     518   SUBROUTINE icb_utl_zavg(pzavg, pdat, pe3, pD, kb ) 
     519      !!---------------------------------------------------------------------- 
     520      !!                ***  ROUTINE icb_utl_getkb         *** 
     521      !! 
     522      !! ** Purpose :   compute the vertical average of ocean properties affected by icb 
     523      !! 
     524      !!---------------------------------------------------------------------- 
     525      INTEGER,                INTENT(in ) :: kb        ! deepest level affected by icb 
     526      REAL(wp), DIMENSION(:), INTENT(in ) :: pe3, pdat ! vertical profile 
     527      REAL(wp),               INTENT(in ) :: pD        ! draft 
     528      REAL(wp),               INTENT(out) :: pzavg     ! z average 
     529      !!---------------------------------------------------------------------- 
     530      INTEGER  :: jk 
     531      REAL(wp) :: zdep 
     532      !!---------------------------------------------------------------------- 
     533      pzavg = 0.0 ; zdep = 0.0 
     534      DO jk = 1,kb-1 
     535         pzavg = pzavg + pe3(jk)*pdat(jk) 
     536         zdep  = zdep  + pe3(jk) 
     537      END DO 
     538      ! if kb is limited by mbkt  => bottom value is used between bathy and icb tail 
     539      ! if kb not limited by mbkt => ocean value over mask is used (ie 0.0 for u, v) 
     540      pzavg = ( pzavg + (pD - zdep)*pdat(kb)) / pD 
     541   END SUBROUTINE 
    467542 
    468543   SUBROUTINE icb_utl_add( bergvals, ptvals ) 
    … …  
    653728      WRITE(numicb, 9200) kt, berg%number(1), & 
    654729                   pt%xi, pt%yj, pt%lon, pt%lat, pt%uvel, pt%vvel,  & 
    655                    pt%uo, pt%vo, pt%ua, pt%va, pt%ui, pt%vi 
     730                   pt%ssu, pt%ssv, pt%ua, pt%va, pt%ui, pt%vi 
    656731      CALL flush( numicb ) 
    657732 9200 FORMAT(5x,i5,2x,i10,6(2x,2f10.4)) 
    … …  
    679754         WRITE(numicb,'(a," pe=(",i3,")")' ) cd_label, narea 
    680755         WRITE(numicb,'(a8,4x,a6,12x,a5,15x,a7,19x,a3,17x,a5,17x,a5,17x,a5)' )   & 
    681             &         'timestep', 'number', 'xi,yj','lon,lat','u,v','uo,vo','ua,va','ui,vi' 
     756            &         'timestep', 'number', 'xi,yj','lon,lat','u,v','ssu,ssv','ua,va','ui,vi' 
    682757      ENDIF 
    683758      DO WHILE( ASSOCIATED(this) ) 
    … …  
    823898   END FUNCTION icb_utl_heat 
    824899 
     900   SUBROUTINE test_icb_utl_getkb 
     901      !!---------------------------------------------------------------------- 
     902      !!                 ***  FUNCTION test_icb_utl_getkb  *** 
     903      !! 
     904      !! ** Purpose : Test routine icb_utl_getkb, icb_utl_zavg 
     905      !! ** Methode : Call each subroutine with specific input data 
     906      !!              What should be the output is easy to determined and check  
     907      !!              if NEMO return the correct answer. 
     908      !! ** Comments : not called, if needed a CALL test_icb_utl_getkb need to be added in icb_step 
     909      !!---------------------------------------------------------------------- 
     910      INTEGER :: ikb 
     911      REAL(wp) :: zD, zout 
     912      REAL(wp), DIMENSION(jpk) :: ze3, zin 
     913      WRITE(numout,*) 'Test icb_utl_getkb : ' 
     914      zD = 0.0 ; ze3= 20.0 
     915      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     916      CALL icb_utl_getkb(ikb, ze3, zD) 
     917      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     918 
     919      zD = 8000000.0 ; ze3= 20.0 
     920      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     921      CALL icb_utl_getkb(ikb, ze3, zD) 
     922      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     923 
     924      zD = 80.0 ; ze3= 20.0 
     925      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     926      CALL icb_utl_getkb(ikb, ze3, zD) 
     927      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     928 
     929      zD = 85.0 ; ze3= 20.0 
     930      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     931      CALL icb_utl_getkb(ikb, ze3, zD) 
     932      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     933 
     934      zD = 75.0 ; ze3= 20.0 
     935      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     936      CALL icb_utl_getkb(ikb, ze3, zD) 
     937      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     938 
     939      WRITE(numout,*) '==================================' 
     940      WRITE(numout,*) 'Test icb_utl_zavg' 
     941      zD = 0.0 ; ze3= 20.0 ; zin=1.0 
     942      CALL icb_utl_getkb(ikb, ze3, zD) 
     943      CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 
     944      WRITE(numout,*) 'INPUT  : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 
     945      WRITE(numout,*) 'OUTPUT : zout = ',zout 
     946 
     947      zD = 50.0 ; ze3= 20.0 ; zin=1.0; zin(3:jpk) = 0.0 
     948      CALL icb_utl_getkb(ikb, ze3, zD) 
     949      CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 
     950      WRITE(numout,*) 'INPUT  : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 
     951      WRITE(numout,*) 'OUTPUT : zout = ',zout 
     952      CALL FLUSH(numout) 
     953 
     954      zD = 80.0 ; ze3= 20.0 ; zin=1.0; zin(3:jpk) = 0.0 
     955      CALL icb_utl_getkb(ikb, ze3, zD) 
     956      CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 
     957      WRITE(numout,*) 'INPUT  : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 
     958      WRITE(numout,*) 'OUTPUT : zout = ',zout 
     959 
     960      zD = 80 ; ze3= 20.0 ; zin=1.0 ; zin(3:jpk) = 0.0 
     961      CALL icb_utl_getkb(ikb, ze3, zD) 
     962      ikb = 2 
     963      CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 
     964      WRITE(numout,*) 'INPUT  : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 
     965      WRITE(numout,*) 'OUTPUT : zout = ',zout 
     966 
     967      CALL FLUSH(numout) 
     968 
     969   END SUBROUTINE test_icb_utl_getkb 
     970 
    825971   !!====================================================================== 
    826972END MODULE icbutl 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/IOM/iom.F90

    r14049 r14054  
    2929   USE in_out_manager  ! I/O manager 
    3030   USE lib_mpp           ! MPP library 
    31 #if defined key_iomput 
    3231   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1 
    3332   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes 
    … …  
    3736   USE phycst          ! physical constants 
    3837   USE dianam          ! build name of file 
     38#if defined key_iomput 
    3939   USE xios 
    4040# endif 
    … …  
    174174         CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. ) 
    175175         CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. ) 
     176         CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. ) 
    176177         CALL set_grid_znl( gphit ) 
    177178         ! 
    … …  
    180181            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 
    181182            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 
    182             CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
     183            CALL iom_set_domain_attr("grid_W", area = REAL( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
     184            CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp)) 
    183185            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    184186            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
    185187            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 
    186188            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 
     189            CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif ) 
    187190         ENDIF 
    188191      ENDIF 
    … …  
    191194         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    192195         ! 
    193          CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. )  
    194          CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. )  
    195          CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. )  
    196          CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. )  
     196         CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 
     197         CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. ) 
     198         CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. ) 
     199         CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 
    197200         CALL set_grid_znl( gphit_crs ) 
    198201          ! 
    … …  
    217220         CALL iom_set_axis_attr(  "depthv", paxis = gdept_1d ) 
    218221         CALL iom_set_axis_attr(  "depthw", paxis = gdepw_1d ) 
     222          CALL iom_set_axis_attr(  "depthf", paxis = gdept_1d ) 
    219223 
    220224          ! ABL 
    … …  
    238242         CALL iom_set_axis_attr(  "depthv", bounds=zw_bnds ) 
    239243         CALL iom_set_axis_attr(  "depthw", bounds=zt_bnds ) 
     244          CALL iom_set_axis_attr(  "depthf", bounds=zw_bnds ) 
    240245 
    241246         ! ABL 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/IOM/restart.F90

    r14049 r14054  
    1111   !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart 
    1212   !!             -   !  2014-12  (G. Madec) remove KPP scheme 
     13   !!            4.1  !  2020-11  (S. Techene, G. Madec)  move ssh initiatlisation in DYN/sshwzv:ssh_init_rst 
    1314   !!---------------------------------------------------------------------- 
    1415 
    … …  
    139140      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF 
    140141      !!              file, save fields which are necessary for restart 
     142      !! 
     143      !!                NB: ssh is written here (rst_write) 
     144      !!                    but is read or set in DYN/sshwzv:shh_init_rst 
    141145      !!---------------------------------------------------------------------- 
    142146      INTEGER, INTENT(in) ::   kt         ! ocean time-step 
    … …  
    233237      !!                   ***  ROUTINE rst_read  *** 
    234238      !!  
    235       !! ** Purpose :   Read files for NetCDF restart 
    236       !!  
    237       !! ** Method  :   Read in restart.nc file fields which are necessary for restart 
     239      !! ** Purpose :   Read velocity and T-S fields in the restart file 
     240      !!  
     241      !! ** Method  :   Read in restart.nc fields which are necessary for restart 
     242      !! 
     243      !!                NB: restart file openned           in DOM/domain.F90:dom_init 
     244      !!                    before field in restart tested in DOM/domain.F90:dom_init 
     245      !!                    (sshb) 
     246      !! 
     247      !!                NB: ssh is read or set in DYN/sshwzv:shh_init_rst 
     248      !!                    but is written     in IOM/restart:rst_write 
    238249      !!---------------------------------------------------------------------- 
    239250      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    240       REAL(wp) ::   zrdt 
    241251      INTEGER  ::   jk 
    242252      REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 
    243253      !!---------------------------------------------------------------------- 
    244  
    245       CALL rst_read_open           ! open restart for reading (if not already opened) 
    246  
    247       ! Check dynamics and tracer time-step consistency and force Euler restart if changed 
    248       IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN 
    249          CALL iom_get( numror, 'rdt', zrdt ) 
    250          IF( zrdt /= rn_Dt ) THEN 
    251             IF(lwp) WRITE( numout,*) 
    252             IF(lwp) WRITE( numout,*) 'rst_read:  rdt not equal to the read one' 
    253             IF(lwp) WRITE( numout,*) 
    254             IF(lwp) WRITE( numout,*) '      ==>>>   forced euler first time-step' 
    255             l_1st_euler =  .TRUE. 
    256          ENDIF 
    257       ENDIF 
    258  
     254      ! 
    259255      IF(.NOT.lrxios ) CALL iom_delay_rst( 'READ', 'OCE', numror )   ! read only ocean delayed global communication variables 
    260        
    261       ! Diurnal DSST  
    262       IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst )  
     256      ! 
     257      !                             !*  Diurnal DSST  
     258      IF( ln_diurnal )   CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst )  
    263259      IF ( ln_diurnal_only ) THEN  
    264260         IF(lwp) WRITE( numout, * ) & 
    … …  
    269265         RETURN  
    270266      ENDIF   
    271  
    272       IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    273          ! before fields 
     267      ! 
     268      !                             !*  Read Kmm fields 
     269      IF(lwp) WRITE(numout,*)    '           Kmm u, v and T-S fields read in the restart file' 
     270      CALL iom_get( numror, jpdom_auto, 'un'     , uu(:,:,:       ,Kmm), cd_type = 'U', psgn = -1._wp ) 
     271      CALL iom_get( numror, jpdom_auto, 'vn'     , vv(:,:,:       ,Kmm), cd_type = 'V', psgn = -1._wp ) 
     272      CALL iom_get( numror, jpdom_auto, 'tn'     , ts(:,:,:,jp_tem,Kmm) ) 
     273      CALL iom_get( numror, jpdom_auto, 'sn'     , ts(:,:,:,jp_sal,Kmm) ) 
     274      ! 
     275      IF( l_1st_euler ) THEN        !*  Euler restart 
     276         IF(lwp) WRITE(numout,*) '           Kbb u, v and T-S fields set to Kmm values' 
     277         ts(:,:,:,:,Kbb) = ts(:,:,:,:,Kmm)         ! all before fields set to now values 
     278         uu(:,:,:  ,Kbb) = uu(:,:,:  ,Kmm) 
     279         vv(:,:,:  ,Kbb) = vv(:,:,:  ,Kmm) 
     280      ELSE                          !* Leap frog restart 
     281         IF(lwp) WRITE(numout,*) '           Kbb u, v and T-S fields read in the restart file' 
    274282         CALL iom_get( numror, jpdom_auto, 'ub'     , uu(:,:,:       ,Kbb), cd_type = 'U', psgn = -1._wp ) 
    275283         CALL iom_get( numror, jpdom_auto, 'vb'     , vv(:,:,:       ,Kbb), cd_type = 'V', psgn = -1._wp ) 
    276284         CALL iom_get( numror, jpdom_auto, 'tb'     , ts(:,:,:,jp_tem,Kbb) ) 
    277285         CALL iom_get( numror, jpdom_auto, 'sb'     , ts(:,:,:,jp_sal,Kbb) ) 
    278          CALL iom_get( numror, jpdom_auto, 'sshb'   ,ssh(:,:         ,Kbb) ) 
    279       ELSE 
    280          l_1st_euler =  .TRUE.      ! before field not found, forced euler 1st time-step 
    281       ENDIF 
    282       ! 
    283       ! now fields 
    284       CALL iom_get( numror, jpdom_auto, 'un'     , uu(:,:,:       ,Kmm), cd_type = 'U', psgn = -1._wp ) 
    285       CALL iom_get( numror, jpdom_auto, 'vn'     , vv(:,:,:       ,Kmm), cd_type = 'V', psgn = -1._wp ) 
    286       CALL iom_get( numror, jpdom_auto, 'tn'     , ts(:,:,:,jp_tem,Kmm) ) 
    287       CALL iom_get( numror, jpdom_auto, 'sn'     , ts(:,:,:,jp_sal,Kmm) ) 
    288       CALL iom_get( numror, jpdom_auto, 'sshn'   ,ssh(:,:         ,Kmm) ) 
     286      ENDIF 
     287      ! 
    289288      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    290289         CALL iom_get( numror, jpdom_auto, 'rhop'   , rhop )   ! now    potential density 
    … …  
    293292      ENDIF 
    294293      ! 
    295       IF( l_1st_euler ) THEN                                  ! Euler restart  
    296          ts   (:,:,:,:,Kbb) = ts   (:,:,:,:,Kmm)              ! all before fields set to now values 
    297          uu   (:,:,:  ,Kbb) = uu   (:,:,:  ,Kmm) 
    298          vv   (:,:,:  ,Kbb) = vv   (:,:,:  ,Kmm) 
    299          ssh  (:,:    ,Kbb) = ssh  (:,:    ,Kmm) 
    300       ENDIF 
    301       ! 
    302294   END SUBROUTINE rst_read 
    303295 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ISF/isfcpl.F90

    r14049 r14054  
    1010 
    1111   !!---------------------------------------------------------------------- 
    12    !!   isfrst : read/write iceshelf variables in/from restart 
     12   !!   isfrst        : read/write iceshelf variables in/from restart 
    1313   !!---------------------------------------------------------------------- 
    14    USE isf_oce                          ! ice shelf variable 
     14   USE oce            ! ocean dynamics and tracers 
     15#if defined key_qco 
     16   USE domqco  , ONLY : dom_qco_zgr      ! vertical scale factor interpolation 
     17#else 
     18   USE domvvl  , ONLY : dom_vvl_zgr      ! vertical scale factor interpolation 
     19#endif 
     20   USE domutl  , ONLY : dom_ngb          ! find the closest grid point from a given lon/lat position 
     21   USE isf_oce        ! ice shelf variable 
    1522   USE isfutils, ONLY : debug 
    16    USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine 
    17 #if ! defined key_qco 
    18    USE domvvl  , ONLY: dom_vvl_zgr      ! vertical scale factor interpolation 
    19 #else 
    20    USE domqco   , ONLY: dom_qco_zgr      ! vertical scale factor interpolation 
    21 #endif 
    22    USE domutl  , ONLY: dom_ngb          ! find the closest grid point from a given lon/lat position 
    2323   ! 
    24    USE oce            ! ocean dynamics and tracers 
    2524   USE in_out_manager ! I/O manager 
    2625   USE iom            ! I/O library 
     26   USE lib_mpp , ONLY : mpp_sum, mpp_max ! mpp routine 
    2727   ! 
    2828   IMPLICIT NONE 
    … …  
    3434 
    3535   TYPE isfcons 
    36       INTEGER :: ii     ! i global 
    37       INTEGER :: jj     ! j global 
    38       INTEGER :: kk     ! k level 
    39       REAL(wp):: dvol   ! volume increment 
    40       REAL(wp):: dsal   ! salt increment 
    41       REAL(wp):: dtem   ! heat increment 
    42       REAL(wp):: lon    ! lon 
    43       REAL(wp):: lat    ! lat 
    44       INTEGER :: ngb    ! 0/1 (valid location or not (ie on halo or no neigbourg)) 
     36      INTEGER ::   ii     ! i global 
     37      INTEGER ::   jj     ! j global 
     38      INTEGER ::   kk     ! k level 
     39      REAL(wp)::   dvol   ! volume increment 
     40      REAL(wp)::   dsal   ! salt increment 
     41      REAL(wp)::   dtem   ! heat increment 
     42      REAL(wp)::   lon    ! lon 
     43      REAL(wp)::   lat    ! lat 
     44      INTEGER ::   ngb    ! 0/1 (valid location or not (ie on halo or no neigbourg)) 
    4545   END TYPE 
    4646   ! 
    … …  
    121121#endif  
    122122   END SUBROUTINE isfcpl_init 
    123    !  
    124    SUBROUTINE isfcpl_rst_write(kt, Kmm) 
     123 
     124    
     125   SUBROUTINE isfcpl_rst_write( kt, Kmm ) 
    125126      !!--------------------------------------------------------------------- 
    126127      !!                   ***  ROUTINE iscpl_rst_write  *** 
    … …  
    133134      !!---------------------------------------------------------------------- 
    134135      INTEGER :: jk                               ! loop index 
    135       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! e3t , e3u, e3v !!st patch to use substitution 
     136      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! for qco substitution 
    136137      !!---------------------------------------------------------------------- 
    137138      ! 
    … …  
    153154   END SUBROUTINE isfcpl_rst_write 
    154155 
     156    
    155157   SUBROUTINE isfcpl_ssh(Kbb, Kmm, Kaa) 
    156158      !!----------------------------------------------------------------------  
    … …  
    184186         zdssmask(:,:) = ssmask(:,:) - zssmask0(:,:) 
    185187         DO_2D( 0, 0, 0, 0 ) 
    186             jip1=ji+1; jim1=ji-1; 
    187             jjp1=jj+1; jjm1=jj-1; 
     188            jip1=ji+1   ;   jim1=ji-1 
     189            jjp1=jj+1   ;   jjm1=jj-1 
    188190            ! 
    189191            zsummsk = zssmask0(jip1,jj) + zssmask0(jim1,jj) + zssmask0(ji,jjp1) + zssmask0(ji,jjm1) 
    … …  
    191193            IF (zdssmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp) THEN 
    192194               ssh(ji,jj,Kmm)=( zssh(jip1,jj)*zssmask0(jip1,jj)     & 
    193                &           + zssh(jim1,jj)*zssmask0(jim1,jj)     & 
    194                &           + zssh(ji,jjp1)*zssmask0(ji,jjp1)     & 
    195                &           + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk 
     195                  &           + zssh(jim1,jj)*zssmask0(jim1,jj)     & 
     196                  &           + zssh(ji,jjp1)*zssmask0(ji,jjp1)     & 
     197                  &           + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk 
    196198               zssmask_b(ji,jj) = 1._wp 
    197199            ENDIF 
    … …  
    222224      CALL dom_vvl_zgr(Kbb, Kmm, Kaa) 
    223225#else 
    224       CALL dom_qco_zgr(Kbb, Kmm, Kaa) 
     226      CALL dom_qco_zgr(Kbb, Kmm) 
    225227#endif 
    226228      ! 
    227229   END SUBROUTINE isfcpl_ssh 
    228230 
     231    
    229232   SUBROUTINE isfcpl_tra(Kmm) 
    230233      !!----------------------------------------------------------------------  
    … …  
    375378      !  
    376379   END SUBROUTINE isfcpl_tra 
     380    
    377381 
    378382   SUBROUTINE isfcpl_vol(Kmm) 
    … …  
    466470         risfcpl_ssh(:,:) = risfcpl_ssh(:,:) + risfcpl_vol(:,:,jk) * r1_e1e2t(:,:) 
    467471      END DO 
    468  
     472      ! 
    469473   END SUBROUTINE isfcpl_vol 
    470474 
     475    
    471476   SUBROUTINE isfcpl_cons(Kmm) 
    472477      !!----------------------------------------------------------------------  

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ISF/isfdynatf.F90

    r13237 r14054  
    1515   USE phycst , ONLY: r1_rho0         ! physical constant 
    1616   USE dom_oce                        ! time and space domain 
    17    USE oce, ONLY : ssh                ! sea-surface height !!st needed for substitution 
     17   USE oce, ONLY : ssh                ! sea-surface height for qco substitution 
    1818 
    1919   USE in_out_manager 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ISF/isfrst.F90

    r14049 r14054  
    2828   !!---------------------------------------------------------------------- 
    2929CONTAINS 
    30    !  
    31    SUBROUTINE isfrst_read(cdisf, ptsc, pfwf, ptsc_b, pfwf_b ) 
     30    
     31   SUBROUTINE isfrst_read( cdisf, ptsc, pfwf, ptsc_b, pfwf_b ) 
    3232      !!--------------------------------------------------------------------- 
    3333      !! 
    … …  
    5151      ! 
    5252      ! read restart 
    53       IF( iom_varid( numror, cfwf_b, ldstop = .FALSE. ) > 0 ) THEN 
     53      IF( .NOT.l_1st_euler ) THEN 
    5454         IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file' 
    5555         CALL iom_get( numror, jpdom_auto, cfwf_b, pfwf_b(:,:)         )   ! before ice shelf melt 
    … …  
    6262      ! 
    6363   END SUBROUTINE isfrst_read 
    64    !  
    65    SUBROUTINE isfrst_write(kt, cdisf, ptsc, pfwf ) 
     64 
     65    
     66   SUBROUTINE isfrst_write( kt, cdisf, ptsc, pfwf ) 
    6667      !!--------------------------------------------------------------------- 
    6768      !! 
    … …  
    9495      ! 
    9596   END SUBROUTINE isfrst_write 
    96    ! 
     97    
     98   !!====================================================================== 
    9799END MODULE isfrst 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/LBC/mppini.F90

    r14049 r14054  
    217217      ! then we calculate them here now that we have our communicator size 
    218218      IF(lwp) THEN 
     219         WRITE(numout,*) 
    219220         WRITE(numout,*) 'mpp_init:' 
    220221         WRITE(numout,*) '~~~~~~~~ ' 
    221          WRITE(numout,*) 
    222222      ENDIF 
    223223      IF( jpni < 1 .OR. jpnj < 1 ) THEN 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/LDF/ldfdyn.F90

    r13497 r14054  
    3434   !                                    !!* Namelist namdyn_ldf : lateral mixing on momentum * 
    3535   LOGICAL , PUBLIC ::   ln_dynldf_OFF   !: No operator (i.e. no explicit diffusion) 
     36   INTEGER , PUBLIC ::   nn_dynldf_typ   !: operator type (0: div-rot ; 1: symmetric) 
    3637   LOGICAL , PUBLIC ::   ln_dynldf_lap   !: laplacian operator 
    3738   LOGICAL , PUBLIC ::   ln_dynldf_blp   !: bilaplacian operator 
    … …  
    5253 
    5354   !                                    !!* Parameter to control the type of lateral viscous operator 
    54    INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10                       !: error in setting the operator 
    55    INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00                       !: without operator (i.e. no lateral viscous trend) 
     55   INTEGER, PARAMETER, PUBLIC ::   np_ERROR   =-10                      !: error in setting the operator 
     56   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf  = 00                      !: without operator (i.e. no lateral viscous trend) 
     57   ! 
     58   INTEGER, PARAMETER, PUBLIC ::   np_typ_rot = 0                       !: div-rot   operator 
     59   INTEGER, PARAMETER, PUBLIC ::   np_typ_sym = 1                       !: symmetric operator 
     60   ! 
    5661   !                          !!      laplacian     !    bilaplacian    ! 
    5762   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  !: iso-level operator 
    … …  
    109114      CHARACTER(len=5) ::   cl_Units               ! units (m2/s or m4/s) 
    110115      !! 
    111       NAMELIST/namdyn_ldf/ ln_dynldf_OFF, ln_dynldf_lap, ln_dynldf_blp,   &   ! type of operator 
    112          &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,   &   ! acting direction of the operator 
    113          &                 nn_ahm_ijk_t , rn_Uv    , rn_Lv,   rn_ahm_b,   &   ! lateral eddy coefficient 
    114          &                 rn_csmc      , rn_minfac    , rn_maxfac            ! Smagorinsky settings 
     116      NAMELIST/namdyn_ldf/ ln_dynldf_OFF, nn_dynldf_typ, ln_dynldf_lap, ln_dynldf_blp,   &   ! type of operator 
     117         &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,                  &   ! acting direction of the operator 
     118         &                 nn_ahm_ijk_t , rn_Uv        , rn_Lv        ,   rn_ahm_b,      &   ! lateral eddy coefficient 
     119         &                 rn_csmc      , rn_minfac    , rn_maxfac                           ! Smagorinsky settings 
    115120      !!---------------------------------------------------------------------- 
    116121      ! 
    … …  
    130135         WRITE(numout,*) '      type :' 
    131136         WRITE(numout,*) '         no explicit diffusion                ln_dynldf_OFF = ', ln_dynldf_OFF 
     137         WRITE(numout,*) '         type of operator (div-rot or sym)    nn_dynldf_typ = ', nn_dynldf_typ 
    132138         WRITE(numout,*) '         laplacian operator                   ln_dynldf_lap = ', ln_dynldf_lap 
    133139         WRITE(numout,*) '         bilaplacian operator                 ln_dynldf_blp = ', ln_dynldf_blp 
    … …  
    147153         WRITE(numout,*) '         Smagorinsky coefficient              rn_csmc       = ', rn_csmc 
    148154         WRITE(numout,*) '         factor multiplier for eddy visc.' 
    149          WRITE(numout,*) '            lower limit (default 1.0)         rn_minfac    = ', rn_minfac 
    150          WRITE(numout,*) '            upper limit (default 1.0)         rn_maxfac    = ', rn_maxfac 
     155         WRITE(numout,*) '            lower limit (default 1.0)         rn_minfac     = ', rn_minfac 
     156         WRITE(numout,*) '            upper limit (default 1.0)         rn_maxfac     = ', rn_maxfac 
    151157      ENDIF 
    152158 
    … …  
    160166      IF( ln_dynldf_lap ) THEN   ;                              ioptio = ioptio + 1   ;   ENDIF 
    161167      IF( ln_dynldf_blp ) THEN   ;                              ioptio = ioptio + 1   ;   ENDIF 
    162       IF( ioptio /= 1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 
     168      IF( ioptio /= 1   )   CALL ctl_stop( 'ldf_dyn_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 
    163169      ! 
    164170      IF(.NOT.ln_dynldf_OFF ) THEN     !==  direction ==>> type of operator  ==! 
     171         ! 
     172         SELECT CASE( nn_dynldf_typ )  ! div-rot or symmetric 
     173         CASE( np_typ_rot )   ;   IF(lwp)   WRITE(numout,*) '   ==>>>   use div-rot   operator ' 
     174         CASE( np_typ_sym )   ;   IF(lwp)   WRITE(numout,*) '   ==>>>   use symmetric operator ' 
     175         CASE DEFAULT                                     ! error 
     176            CALL ctl_stop('ldf_dyn_init: wrong value for nn_dynldf_typ (0 or 1)'  ) 
     177         END SELECT 
     178         ! 
    165179         ioptio = 0 
    166180         IF( ln_dynldf_lev )   ioptio = ioptio + 1 
    167181         IF( ln_dynldf_hor )   ioptio = ioptio + 1 
    168182         IF( ln_dynldf_iso )   ioptio = ioptio + 1 
    169          IF( ioptio /= 1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 direction options (level/hor/iso)' ) 
     183         IF( ioptio /= 1   )   CALL ctl_stop( 'ldf_dyn_init: use ONE of the 3 direction options (level/hor/iso)' ) 
    170184         ! 
    171185         !                             ! Set nldf_dyn, the type of lateral diffusion, from ln_dynldf_... logicals 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/SBC/sbcapr.F90

    r14049 r14054  
    148148         !                                      ! ---------------------------------------- ! 
    149149         !                                            !* Restart: read in restart file 
    150          IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN  
     150         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN  
    151151            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file' 
    152152            CALL iom_get( numror, jpdom_auto, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/SBC/sbcice_cice.F90

    r13295 r14054  
    1212   USE oce             ! ocean dynamics and tracers 
    1313   USE dom_oce         ! ocean space and time domain 
    14 # if ! defined key_qco 
    15    USE domvvl 
     14# if defined key_qco 
     15   USE domqco         ! Variable volume 
    1616# else 
    17    USE domqco 
     17   USE domvvl         ! Variable volume 
    1818# endif 
    1919   USE phycst, only : rcp, rho0, r1_rho0, rhos, rhoi 
    … …  
    238238!!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 
    239239#if defined key_qco 
    240             IF( .NOT.ln_linssh )   CALL dom_qco_zgr( Kbb, Kmm, Kaa )   ! interpolation scale factor, depth and water column 
     240            IF( .NOT.ln_linssh )   CALL dom_qco_zgr( Kbb, Kmm )   ! interpolation scale factor, depth and water column 
    241241#else 
    242242            IF( .NOT.ln_linssh ) THEN 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/SBC/sbcmod.F90

    r14049 r14054  
    475475 
    476476      IF( ln_icebergs    )   THEN 
    477                                      CALL icb_stp( kt )           ! compute icebergs 
     477                                     CALL icb_stp( kt, Kmm )           ! compute icebergs 
    478478         ! Icebergs do not melt over the haloes.  
    479479         ! So emp values over the haloes are no more consistent with the inner domain values.  
    … …  
    523523      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    524524         !                                             ! ---------------------------------------- ! 
    525          IF( ln_rstart .AND.    &                               !* Restart: read in restart file 
    526             & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 
    527             IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file' 
    528             CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b )   ! before i-stress  (U-point) 
    529             CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b )   ! before j-stress  (V-point) 
    530             CALL iom_get( numror, jpdom_auto,  'qns_b',  qns_b )   ! before non solar heat flux (T-point) 
    531             ! The 3D heat content due to qsr forcing is treated in traqsr 
    532             ! CALL iom_get( numror, jpdom_auto, 'qsr_b' , qsr_b  ) ! before     solar heat flux (T-point) 
    533             CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b  )    ! before     freshwater flux (T-point) 
     525         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN            !* Restart: read in restart file 
     526            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields read in the restart file' 
     527            CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b )   ! i-stress 
     528            CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b )   ! j-stress 
     529            CALL iom_get( numror, jpdom_auto,  'qns_b',  qns_b )   ! non solar heat flux 
     530            CALL iom_get( numror, jpdom_auto,  'emp_b',  emp_b )   ! freshwater flux 
     531            ! NB: The 3D heat content due to qsr forcing (qsr_hc_b) is treated in traqsr 
    534532            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6 
    535533            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 
    … …  
    566564      !                                                ! ---------------------------------------- ! 
    567565      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    568          CALL iom_put( "empmr"  , emp    - rnf )                ! upward water flux 
    569          CALL iom_put( "empbmr" , emp_b  - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 
    570          CALL iom_put( "saltflx", sfx  )                        ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case) 
    571          CALL iom_put( "fmmflx", fmmflx  )                      ! Freezing-melting water flux 
    572          CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux 
    573          CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    574          CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
     566         CALL iom_put( "empmr"  , emp   - rnf )                ! upward water flux 
     567         CALL iom_put( "empbmr" , emp_b - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 
     568         CALL iom_put( "saltflx", sfx         )                ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case) 
     569         CALL iom_put( "fmmflx" , fmmflx      )                ! Freezing-melting water flux 
     570         CALL iom_put( "qt"     , qns + qsr   )                ! total heat flux 
     571         CALL iom_put( "qns"    , qns         )                ! solar heat flux 
     572         CALL iom_put( "qsr"    ,       qsr   )                ! solar heat flux 
    575573         IF( nn_ice > 0 .OR. ll_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
    576          CALL iom_put( "taum"  , taum       )                   ! wind stress module 
    577          CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
    578          CALL iom_put( "qrp", qrp )                             ! heat flux damping 
    579          CALL iom_put( "erp", erp )                             ! freshwater flux damping 
     574         CALL iom_put( "taum"   , taum        )                ! wind stress module 
     575         CALL iom_put( "wspd"   , wndm        )                ! wind speed  module over free ocean or leads in presence of sea-ice 
     576         CALL iom_put( "qrp"    , qrp         )                ! heat flux damping 
     577         CALL iom_put( "erp"    , erp         )                ! freshwater flux damping 
    580578      ENDIF 
    581579      ! 
    582580      IF(sn_cfctl%l_prtctl) THEN     ! print mean trends (used for debugging) 
    583          CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask ) 
    584          CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask ) 
    585          CALL prt_ctl(tab2d_1=(sfx-rnf)        , clinfo1=' sfx-rnf  - : ', mask1=tmask ) 
    586          CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask ) 
    587          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask ) 
    588          CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
     581         CALL prt_ctl(tab2d_1=fr_i                , clinfo1=' fr_i     - : ', mask1=tmask ) 
     582         CALL prt_ctl(tab2d_1=(emp-rnf)           , clinfo1=' emp-rnf  - : ', mask1=tmask ) 
     583         CALL prt_ctl(tab2d_1=(sfx-rnf)           , clinfo1=' sfx-rnf  - : ', mask1=tmask ) 
     584         CALL prt_ctl(tab2d_1=qns                 , clinfo1=' qns      - : ', mask1=tmask ) 
     585         CALL prt_ctl(tab2d_1=qsr                 , clinfo1=' qsr      - : ', mask1=tmask ) 
     586         CALL prt_ctl(tab3d_1=tmask               , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
    589587         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst      - : ', mask1=tmask, kdim=1   ) 
    590588         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss      - : ', mask1=tmask, kdim=1   ) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/SBC/sbcrnf.F90

    r14049 r14054  
    4242   REAL(wp)                   ::      rn_dep_max        !: depth over which runoffs is spread       (ln_rnf_depth_ini =T) 
    4343   INTEGER                    ::      nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 
    44    LOGICAL                   ::   ln_rnf_icb        !: iceberg flux is specified in a file 
     44   LOGICAL           , PUBLIC ::   ln_rnf_icb        !: iceberg flux is specified in a file 
    4545   LOGICAL                    ::   ln_rnf_tem        !: temperature river runoffs attribute specified in a file 
    4646   LOGICAL           , PUBLIC ::   ln_rnf_sal        !: salinity    river runoffs attribute specified in a file 
    … …  
    157157      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    158158         !                                             ! ---------------------------------------- ! 
    159          IF( ln_rstart .AND.    &                               !* Restart: read in restart file 
    160             & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 
     159         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN         !* Restart: read in restart file 
    161160            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file', lrxios 
    162             CALL iom_get( numror, jpdom_auto, 'rnf_b', rnf_b )     ! before runoff 
     161            CALL iom_get( numror, jpdom_auto, 'rnf_b'   , rnf_b                 )   ! before runoff 
    163162            CALL iom_get( numror, jpdom_auto, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) )   ! before heat content of runoff 
    164163            CALL iom_get( numror, jpdom_auto, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) )   ! before salinity content of runoff 
    165          ELSE                                                   !* no restart: set from nit000 values 
     164         ELSE                                                !* no restart: set from nit000 values 
    166165            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
    167166            rnf_b    (:,:  ) = rnf    (:,:  ) 
    … …  
    176175            &                    'at it= ', kt,' date= ', ndastp 
    177176         IF(lwp) WRITE(numout,*) '~~~~' 
    178          CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf ) 
     177         CALL iom_rstput( kt, nitrst, numrow, 'rnf_b'   , rnf                ) 
    179178         CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) ) 
    180179         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/traatf.F90

    r14049 r14054  
    117117      IF( l_trdtra )   THEN                     
    118118         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    119          ztrdt(:,:,jpk) = 0._wp 
    120          ztrds(:,:,jpk) = 0._wp 
     119         ztrdt(:,:,:) = 0._wp 
     120         ztrds(:,:,:) = 0._wp 
    121121         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend  
    122122            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/traatf_qco.F90

    r14049 r14054  
    1 MODULE traatfqco 
     1MODULE traatf_qco 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  traatfqco  *** 
     3   !!                       ***  MODULE  traatf_qco  *** 
    44   !! Ocean active tracers:  Asselin time filtering for temperature and salinity 
    55   !!====================================================================== 
    … …  
    4545   USE prtctl          ! Print control 
    4646   USE timing          ! Timing 
    47 #if defined key_agrif 
    48    USE agrif_oce_interp 
    49 #endif 
    5047 
    5148   IMPLICIT NONE 
    … …  
    149146         ENDIF 
    150147         ! 
    151          CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1. ) 
    152  
     148         CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 
     149         ! 
    153150      ENDIF 
    154151      ! 
    … …  
    370367 
    371368   !!====================================================================== 
    372 END MODULE traatfqco 
     369END MODULE traatf_qco 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/tramle.F90

    r14049 r14054  
    2020   USE lib_mpp        ! MPP library 
    2121   USE lbclnk         ! lateral boundary condition / mpp link 
     22 
     23   ! where OSMOSIS_OBL is used with integrated FK 
     24   USE zdf_oce, ONLY : ln_zdfosm 
     25   USE zdfosm, ONLY  : ln_osm_mle, hmle, dbdx_mle, dbdy_mle, mld_prof 
    2226 
    2327   IMPLICIT NONE 
    … …  
    99103      !!---------------------------------------------------------------------- 
    100104      ! 
    101       !                                      !==  MLD used for MLE  ==! 
    102       !                                                ! compute from the 10m density to deal with the diurnal cycle 
    103       DO_2D( 1, 1, 1, 1 ) 
    104          inml_mle(ji,jj) = mbkt(ji,jj) + 1                    ! init. to number of ocean w-level (T-level + 1) 
    105       END_2D 
    106       IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m 
    107          DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) 
    108             IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer 
     105      ! 
     106      IF(ln_osm_mle.and.ln_zdfosm) THEN 
     107         ikmax = MIN( MAXVAL( mld_prof(:,:) ), jpkm1 )                  ! max level of the computation 
     108         ! 
     109         ! 
     110         SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
     111         CASE ( 0 )                                               != min of the 2 neighbour MLDs 
     112            DO_2D( 1, 0, 1, 0 ) 
     113               zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) ) 
     114               zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) ) 
     115            END_2D 
     116         CASE ( 1 )                                               != average of the 2 neighbour MLDs 
     117            DO_2D( 1, 0, 1, 0 ) 
     118               zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 
     119               zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) 
     120            END_2D 
     121         CASE ( 2 )                                               != max of the 2 neighbour MLDs 
     122            DO_2D( 1, 0, 1, 0 ) 
     123               zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 
     124               zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) 
     125            END_2D 
     126         END SELECT 
     127         IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
     128            DO_2D( 1, 0, 1, 0 ) 
     129               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            & 
     130                    &           * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
     131                    &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   ) 
     132               ! 
     133               zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1v(ji,jj)                                            & 
     134                    &           * dbdy_mle(ji,jj)  * MIN( 111.e3_wp , e2v(ji,jj) )   & 
     135                    &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   ) 
     136            END_2D 
     137            ! 
     138         ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
     139            DO_2D( 1, 0, 1, 0 ) 
     140               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj)               & 
     141                    &                  * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) 
     142               ! 
     143               zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1v(ji,jj)               & 
     144                    &                  * dbdy_mle(ji,jj) * MIN( 111.e3_wp , e2v(ji,jj) ) 
     145            END_2D 
     146         ENDIF 
     147 
     148      ELSE !do not use osn_mle 
     149         !                                      !==  MLD used for MLE  ==! 
     150         !                                                ! compute from the 10m density to deal with the diurnal cycle 
     151         DO_2D( 1, 1, 1, 1 ) 
     152            inml_mle(ji,jj) = mbkt(ji,jj) + 1                    ! init. to number of ocean w-level (T-level + 1) 
     153         END_2D 
     154         IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m 
     155           DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) 
     156              IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer 
     157           END_3D 
     158         ENDIF 
     159         ikmax = MIN( MAXVAL( inml_mle(:,:) ), jpkm1 )                  ! max level of the computation 
     160         ! 
     161         ! 
     162         zmld(:,:) = 0._wp                      !==   Horizontal shape of the MLE  ==! 
     163         zbm (:,:) = 0._wp 
     164         zn2 (:,:) = 0._wp 
     165         DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer 
     166            zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
     167            zmld(ji,jj) = zmld(ji,jj) + zc 
     168            zbm (ji,jj) = zbm (ji,jj) + zc * (rho0 - rhop(ji,jj,jk) ) * r1_rho0 
     169            zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp 
    109170         END_3D 
    110       ENDIF 
    111       ikmax = MIN( MAXVAL( inml_mle(:,:) ), jpkm1 )                  ! max level of the computation 
    112       ! 
    113       ! 
    114       zmld(:,:) = 0._wp                      !==   Horizontal shape of the MLE  ==! 
    115       zbm (:,:) = 0._wp 
    116       zn2 (:,:) = 0._wp 
    117       DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer 
    118          zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
    119          zmld(ji,jj) = zmld(ji,jj) + zc 
    120          zbm (ji,jj) = zbm (ji,jj) + zc * (rho0 - rhop(ji,jj,jk) ) * r1_rho0 
    121          zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp 
    122       END_3D 
    123  
    124       SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
    125       CASE ( 0 )                                               != min of the 2 neighbour MLDs 
    126          DO_2D( 1, 0, 1, 0 ) 
    127             zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 
    128             zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 
     171    
     172         SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
     173         CASE ( 0 )                                               != min of the 2 neighbour MLDs 
     174            DO_2D( 1, 0, 1, 0 ) 
     175               zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 
     176               zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 
     177            END_2D 
     178         CASE ( 1 )                                               != average of the 2 neighbour MLDs 
     179            DO_2D( 1, 0, 1, 0 ) 
     180               zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 
     181               zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 
     182            END_2D 
     183         CASE ( 2 )                                               != max of the 2 neighbour MLDs 
     184            DO_2D( 1, 0, 1, 0 ) 
     185               zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 
     186               zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) 
     187            END_2D 
     188         END SELECT 
     189         !                                                ! convert density into buoyancy 
     190         DO_2D( 1, 1, 1, 1 ) 
     191            zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 
    129192         END_2D 
    130       CASE ( 1 )                                               != average of the 2 neighbour MLDs 
    131          DO_2D( 1, 0, 1, 0 ) 
    132             zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 
    133             zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 
    134          END_2D 
    135       CASE ( 2 )                                               != max of the 2 neighbour MLDs 
    136          DO_2D( 1, 0, 1, 0 ) 
    137             zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 
    138             zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) 
    139          END_2D 
    140       END SELECT 
    141       !                                                ! convert density into buoyancy 
    142       DO_2D( 1, 1, 1, 1 ) 
    143          zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 
    144       END_2D 
    145       ! 
    146       ! 
    147       !                                      !==  Magnitude of the MLE stream function  ==! 
    148       ! 
    149       !                 di[bm]  Ds 
    150       ! Psi = Ce  H^2 ---------------- e2u  mu(z)   where fu Lf = MAX( fu*rn_fl , (Db H)^1/2 ) 
    151       !                  e1u   Lf fu                      and the e2u for the "transport" 
    152       !                                                      (not *e3u as divided by e3u at the end) 
    153       ! 
    154       IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
    155          DO_2D( 1, 0, 1, 0 ) 
    156             zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & 
    157                &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
    158                &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   ) 
     193         ! 
     194         ! 
     195         !                                      !==  Magnitude of the MLE stream function  ==! 
     196         ! 
     197         !                 di[bm]  Ds 
     198         ! Psi = Ce  H^2 ---------------- e2u  mu(z)   where fu Lf = MAX( fu*rn_fl , (Db H)^1/2 ) 
     199         !                  e1u   Lf fu                      and the e2u for the "transport" 
     200         !                                                      (not *e3u as divided by e3u at the end) 
     201         ! 
     202         IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
     203            DO_2D( 1, 0, 1, 0 ) 
     204               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & 
     205                    &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
     206                    &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   ) 
    159207               ! 
    160             zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            & 
    161                &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   & 
    162                &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   ) 
    163          END_2D 
    164          ! 
    165       ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
    166          DO_2D( 1, 0, 1, 0 ) 
    167             zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & 
    168                &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 
     208               zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            & 
     209                    &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   & 
     210                    &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   ) 
     211            END_2D 
     212            ! 
     213         ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
     214            DO_2D( 1, 0, 1, 0 ) 
     215               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & 
     216                    &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 
    169217               ! 
    170             zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               & 
    171                &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 
    172          END_2D 
    173       ENDIF 
    174       ! 
    175       IF( nn_conv == 1 ) THEN              ! No MLE in case of convection 
    176          DO_2D( 1, 0, 1, 0 ) 
    177             IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp 
    178             IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp 
    179          END_2D 
    180       ENDIF 
    181       ! 
    182       !                                      !==  structure function value at uw- and vw-points  ==! 
    183       DO_2D( 1, 0, 1, 0 ) 
    184          zhu(ji,jj) = 1._wp / zhu(ji,jj)                   ! hu --> 1/hu 
    185          zhv(ji,jj) = 1._wp / zhv(ji,jj) 
    186       END_2D 
    187       ! 
    188       zpsi_uw(:,:,:) = 0._wp 
    189       zpsi_vw(:,:,:) = 0._wp 
    190       ! 
     218               zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               & 
     219                    &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 
     220            END_2D 
     221         ENDIF 
     222         ! 
     223         IF( nn_conv == 1 ) THEN              ! No MLE in case of convection 
     224            DO_2D( 1, 0, 1, 0 ) 
     225               IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp 
     226               IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp 
     227            END_2D 
     228         ENDIF 
     229         ! 
     230      ENDIF  ! end of ln_osm_mle conditional 
     231    !                                      !==  structure function value at uw- and vw-points  ==! 
     232    DO_2D( 1, 0, 1, 0 ) 
     233       zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall)                   ! hu --> 1/hu 
     234       zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall)  
     235    END_2D 
     236    ! 
     237    zpsi_uw(:,:,:) = 0._wp 
     238    zpsi_vw(:,:,:) = 0._wp 
     239    ! 
    191240      DO_3D( 1, 0, 1, 0, 2, ikmax )                ! start from 2 : surface value = 0 
    192241         zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) 
    … …  
    220269         ENDIF 
    221270         ! 
    222          DO_2D( 0, 0, 0, 0 ) 
    223             zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
    224          END_2D 
     271         IF (ln_osm_mle.and.ln_zdfosm) THEN 
     272            DO_2D( 0, 0, 0, 0 ) 
     273               zLf_NH(ji,jj) = SQRT( rb_c * hmle(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
     274            END_2D 
     275         ELSE 
     276            DO_2D( 0, 0, 0, 0 ) 
     277               zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
     278            END_2D 
     279         ENDIF 
    225280         ! 
    226281         ! divide by cross distance to give streamfunction with dimensions m^2/s 
    … …  
    239294      ! 
    240295   END SUBROUTINE tra_mle_trp 
    241  
    242296 
    243297   SUBROUTINE tra_mle_init 
    … …  
    301355            IF( ierr /= 0 )   CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 
    302356            z1_t2 = 1._wp / ( rn_time * rn_time ) 
    303             DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls )                      ! "coriolis+ time^-1" at u- & v-points 
     357            DO_2D( 0, 1, 0, 1 )                      ! "coriolis+ time^-1" at u- & v-points 
    304358               zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 
    305359               zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp 
    … …  
    307361               rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 ) 
    308362            END_2D 
    309             IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp ) 
     363            CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp ) 
    310364            ! 
    311365         ELSEIF( nn_mle == 1 ) THEN           ! MLE array allocation & initialisation 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/traqsr.F90

    r14049 r14054  
    144144 
    145145      IF( kt == nit000 ) THEN          !==  1st time step  ==! 
    146          IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0  .AND. .NOT.l_1st_euler ) THEN    ! read in restart 
     146         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN    ! read in restart 
    147147            z1_2 = 0.5_wp 
    148148            IF( ntile == 0 .OR. ntile == 1 )  THEN                        ! Do only on the first tile 
    … …  
    150150               CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux 
    151151            ENDIF 
    152          ELSE                                           ! No restart or restart not found: Euler forward time stepping 
     152         ELSE                                           ! No restart or Euler forward at 1st time step 
    153153            z1_2 = 1._wp 
    154154            DO_3D( isj, iej, isi, iei, 1, jpk ) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/trasbc.F90

    r14049 r14054  
    7272      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T) 
    7373      !!---------------------------------------------------------------------- 
    74       INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index 
    75       INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices 
    76       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation 
     74      INTEGER,                                   INTENT(in   ) ::   kt         ! ocean time-step index 
     75      INTEGER,                                   INTENT(in   ) ::   Kmm, Krhs  ! time level indices 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts        ! active tracers and RHS of tracer Eq. 
    7777      ! 
    7878      INTEGER  ::   ji, jj, jk, jn               ! dummy loop indices 
    … …  
    117117      !                             !==  Set before sbc tracer content fields  ==! 
    118118      IF( kt == nit000 ) THEN             !* 1st time-step 
    119          IF( ln_rstart .AND.    &               ! Restart: read in restart file 
    120               & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 
     119         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN      ! Restart: read in restart file 
    121120            zfact = 0.5_wp 
    122121            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    … …  
    126125               CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend 
    127126            ENDIF 
    128          ELSE                                   ! No restart or restart not found: Euler forward time stepping 
     127         ELSE                                             ! No restart or restart not found: Euler forward time stepping 
    129128            zfact = 1._wp 
    130129            DO_2D( isj, iej, isi, iei ) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRD/trd_oce.F90

    r10068 r14054  
    3333# endif 
    3434   !                                                  !!!* Active tracers trends indexes 
    35    INTEGER, PUBLIC, PARAMETER ::   jptot_tra  = 20     !: Total trend nb: change it when adding/removing one indice below 
     35   INTEGER, PUBLIC, PARAMETER ::   jptot_tra  = 21     !: Total trend nb: change it when adding/removing one indice below 
    3636   !                               ===============     !   
    3737   INTEGER, PUBLIC, PARAMETER ::   jptra_xad  =  1     !: x- horizontal advection 
    … …  
    4646   INTEGER, PUBLIC, PARAMETER ::   jptra_bbc  = 10     !: Bottom Boundary Condition (geoth. heating)  
    4747   INTEGER, PUBLIC, PARAMETER ::   jptra_bbl  = 11     !: Bottom Boundary Layer (diffusive and/or advective) 
     48   INTEGER, PUBLIC, PARAMETER ::   jptra_osm  = 21     !: Non-local terms from OSMOSIS OBL model 
    4849   INTEGER, PUBLIC, PARAMETER ::   jptra_npc  = 12     !: non-penetrative convection treatment 
    4950   INTEGER, PUBLIC, PARAMETER ::   jptra_dmp  = 13     !: internal restoring (damping) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/USR/usrdef_istate.F90

    r13497 r14054  
    77   !! User defined : set the initial state of a user configuration 
    88   !!====================================================================== 
    9    !! History :  4.0 ! 2016-03  (S. Flavoni) Original code 
     9   !! History :  4.0  ! 2016-03  (S. Flavoni) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2223   PRIVATE 
    2324 
    24    PUBLIC   usr_def_istate   ! called in istate.F90 
     25   PUBLIC   usr_def_istate       ! called in istate.F90 
     26   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2527 
    2628   !! * Substitutions 
    … …  
    3335CONTAINS 
    3436   
    35    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     37   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3638      !!---------------------------------------------------------------------- 
    3739      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4850      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    4951      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    50       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5152      ! 
    5253      INTEGER :: ji, jj, jk  ! dummy loop indices 
    … …  
    5960      pu  (:,:,:) = 0._wp           ! ocean at rest 
    6061      pv  (:,:,:) = 0._wp 
    61       pssh(:,:)   = 0._wp 
    6262      ! 
    6363      DO_3D( 1, 1, 1, 1, 1, jpk )   ! horizontally uniform T & S profiles 
    … …  
    8080   END SUBROUTINE usr_def_istate 
    8181 
     82    
     83   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     84      !!---------------------------------------------------------------------- 
     85      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     86      !!  
     87      !! ** Purpose :   Initialization of ssh 
     88      !! 
     89      !! ** Method  :   Set ssh as null, ptmask is required for test cases 
     90      !!---------------------------------------------------------------------- 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     92      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     93      !!---------------------------------------------------------------------- 
     94      ! 
     95      IF(lwp) WRITE(numout,*) 
     96      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : GYRE configuration, analytical definition of initial state' 
     97      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~   Ocean at rest, ssh is zero' 
     98      ! 
     99      ! Sea level: 
     100      pssh(:,:) = 0._wp 
     101      ! 
     102   END SUBROUTINE usr_def_istate_ssh 
     103 
    82104   !!====================================================================== 
    83105END MODULE usrdef_istate 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ZDF/zdfddm.F90

    r13497 r14054  
    3131   !! * Substitutions 
    3232#  include "do_loop_substitute.h90" 
     33#  include "domzgr_substitute.h90" 
    3334   !!---------------------------------------------------------------------- 
    3435   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ZDF/zdfosm.F90

    r14049 r14054  
    2525   !!            (12) Replace zwstrl with zvstr in calculation of eddy viscosity. 
    2626   !! 27/09/2017 (13) Calculate Stokes drift and Stokes penetration depth from wave information 
    27    !!            (14) Bouyancy flux due to entrainment changed to include contribution from shear turbulence (for testing commented out). 
     27   !!            (14) Buoyancy flux due to entrainment changed to include contribution from shear turbulence. 
    2828   !! 28/09/2017 (15) Calculation of Stokes drift moved into separate do-loops to allow for different options for the determining the Stokes drift to be added. 
    2929   !!            (16) Calculation of Stokes drift from windspeed for PM spectrum (for testing, commented out) 
    3030   !!            (17) Modification to Langmuir velocity scale to include effects due to the Stokes penetration depth (for testing, commented out) 
     31   !! ??/??/2018 (18) Revision to code structure, selected using key_osmldpth1. Inline code moved into subroutines. Changes to physics made, 
     32   !!                  (a) Pycnocline temperature and salinity profies changed for unstable layers 
     33   !!                  (b) The stable OSBL depth parametrization changed. 
     34   !! 16/05/2019 (19) Fox-Kemper parametrization of restratification through mixed layer eddies added to revised code. 
     35   !! 23/05/19   (20) Old code where key_osmldpth1` is *not* set removed, together with the key key_osmldpth1 
    3136   !!---------------------------------------------------------------------- 
    3237 
    … …  
    4045   !!   trc_osm       : compute and add to the passive tracer trend the non-local flux (TBD) 
    4146   !!   dyn_osm       : compute and add to u & v trensd the non-local flux 
     47   !! 
     48   !! Subroutines in revised code. 
    4249   !!---------------------------------------------------------------------- 
    4350   USE oce            ! ocean dynamics and active tracers 
    … …  
    6976   PUBLIC   tra_osm       ! routine called by step.F90 
    7077   PUBLIC   trc_osm       ! routine called by trcstp.F90 
    71    PUBLIC   dyn_osm       ! routine called by 'step.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 
    7281 
    7382   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghamu    !: non-local u-momentum flux 
    … …  
    7786   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean   !: averaging operator for avt 
    7887   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hbl      !: boundary layer depth 
    79    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hbli     !: intial boundary layer depth for stable blayer 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dh       ! depth of pycnocline 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hml      ! ML depth 
    8090   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. 
    8197 
    8298   !                      !!** Namelist  namzdf_osm  ** 
    8399   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 
    84103   REAL(wp) ::   rn_osm_la          ! Turbulent Langmuir number 
    85104   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 
    86108   REAL(wp) ::   rn_osm_hbl0 = 10._wp       ! Initial value of hbl for 1D runs 
    87109   INTEGER  ::   nn_ave             ! = 0/1 flag for horizontal average on avt 
    88110   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 
    89112   LOGICAL  ::   ln_dia_osm         ! Use namelist  rn_osm_la 
    90113 
    … …  
    96119   REAL(wp) ::   rn_difconv = 1._wp     ! diffusivity when unstable below BL  (m2/s) 
    97120 
     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 
    98140   !                                    !!! ** General constants  ** 
    99    REAL(wp) ::   epsln   = 1.0e-20_wp   ! a small positive number 
     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 
    100143   REAL(wp) ::   pthird  = 1._wp/3._wp  ! 1/3 
    101144   REAL(wp) ::   p2third = 2._wp/3._wp  ! 2/3 
    … …  
    118161      !!                 ***  FUNCTION zdf_osm_alloc  *** 
    119162      !!---------------------------------------------------------------------- 
    120      ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk), ghams(jpi,jpj,jpk), & 
    121           &      hbl(jpi,jpj)    ,  hbli(jpi,jpj)    , dstokes(jpi, jpj) ,                     & 
    122           &   etmean(jpi,jpj,jpk),  STAT= zdf_osm_alloc ) 
     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 ) 
    123171     IF( zdf_osm_alloc /= 0 )   CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 
    124      CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 
     172 
    125173   END FUNCTION zdf_osm_alloc 
    126174 
    … …  
    166214      !! 
    167215      INTEGER ::   ji, jj, jk                   ! dummy loop indices 
     216 
     217      INTEGER ::   jl                   ! dummy loop indices 
     218 
    168219      INTEGER ::   ikbot, jkmax, jkm1, jkp2     ! 
    169220 
    … …  
    196247      REAL(wp), DIMENSION(jpi,jpj) :: zwbav     ! Buoyancy flux - bl average 
    197248      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 
    198257      REAL(wp), DIMENSION(jpi,jpj) :: zustke    ! Surface Stokes drift 
    199258      REAL(wp), DIMENSION(jpi,jpj) :: zla       ! Trubulent Langmuir number 
    … …  
    201260      REAL(wp), DIMENSION(jpi,jpj) :: zsin_wind ! Sin angle of surface stress 
    202261      REAL(wp), DIMENSION(jpi,jpj) :: zhol      ! Stability parameter for boundary layer 
    203       LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lconv ! unstable/stable bl 
     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. 
    204267 
    205268      ! mixed-layer variables 
    … …  
    207270      INTEGER, DIMENSION(jpi,jpj) :: ibld ! level of boundary layer base 
    208271      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 
    209274 
    210275      REAL(wp) :: ztgrad,zsgrad,zbgrad ! Temporary variables used to calculate pycnocline gradients 
    … …  
    213278      REAL(wp), DIMENSION(jpi,jpj) :: zhbl  ! bl depth - grid 
    214279      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 
    215284      REAL(wp), DIMENSION(jpi,jpj) :: zdh   ! pycnocline depth - grid 
    216285      REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! BL depth tendency 
    217       REAL(wp), DIMENSION(jpi,jpj) :: zt_bl,zs_bl,zu_bl,zv_bl,zrh_bl  ! averages over the depth of the blayer 
    218       REAL(wp), DIMENSION(jpi,jpj) :: zt_ml,zs_ml,zu_ml,zv_ml,zrh_ml  ! averages over the depth of the mixed layer 
    219       REAL(wp), DIMENSION(jpi,jpj) :: zdt_bl,zds_bl,zdu_bl,zdv_bl,zdrh_bl,zdb_bl ! difference between blayer average and parameter at base of blayer 
    220       REAL(wp), DIMENSION(jpi,jpj) :: zdt_ml,zds_ml,zdu_ml,zdv_ml,zdrh_ml,zdb_ml ! difference between mixed layer average and parameter at base of blayer 
    221       REAL(wp), DIMENSION(jpi,jpj) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 
    222       REAL(wp), DIMENSION(jpi,jpj) :: zuw_bse,zvw_bse  ! momentum fluxes at the top of the pycnocline 
     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 
    223300      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz_pyc    ! parametrized gradient of temperature in pycnocline 
    224301      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdsdz_pyc    ! parametrised gradient of salinity in pycnocline 
    … …  
    226303      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz_pyc    ! u-shear across the pycnocline 
    227304      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdvdz_pyc    ! v-shear across the pycnocline 
    228  
     305      REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle    ! Magnitude of horizontal buoyancy gradient. 
    229306      ! Flux-gradient relationship variables 
     307      REAL(wp), DIMENSION(jpi, jpj) :: zshear, zri_i ! Shear production and interfacial richardon number. 
    230308 
    231309      REAL(wp) :: zl_c,zl_l,zl_eps  ! Used to calculate turbulence length scale. 
    232310 
    233       REAL(wp), DIMENSION(jpi,jpj) :: zdifml_sc,zvisml_sc,zdifpyc_sc,zvispyc_sc,zbeta_d_sc,zbeta_v_sc ! Scales for eddy diffusivity/viscosity 
     311      REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! coefficients in cubic polynomial specifying diffusivity in pycnocline.   
    234312      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/ 
    235314      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. 
    236315      REAL(wp), DIMENSION(jpi,jpj) :: zhbl_t ! holds boundary layer depth updated by full timestep 
    … …  
    243322      ! Temporary variables 
    244323      INTEGER :: inhml 
    245       INTEGER :: i_lconv_alloc 
    246324      REAL(wp) :: znd,znd_d,zznd_ml,zznd_pyc,zznd_d ! temporary non-dimensional depths used in various routines 
    247325      REAL(wp) :: ztemp, zari, zpert, zzdhdt, zdb   ! temporary variables 
    248326      REAL(wp) :: zthick, zz0, zz1 ! temporary variables 
    249327      REAL(wp) :: zvel_max, zhbl_s ! temporary variables 
    250       REAL(wp) :: zfac             ! temporary variable 
     328      REAL(wp) :: zfac, ztmp       ! temporary variable 
    251329      REAL(wp) :: zus_x, zus_y     ! temporary Stokes drift 
    252330      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zviscos ! viscosity 
    253331      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 
    254343 
    255344      ! For debugging 
    … …  
    257346      !!-------------------------------------------------------------------- 
    258347      ! 
    259       ALLOCATE( lconv(jpi,jpj),  STAT= i_lconv_alloc ) 
    260       IF( i_lconv_alloc /= 0 )   CALL ctl_warn('zdf_osm: failed to allocate lconv') 
    261  
    262348      ibld(:,:)   = 0     ; imld(:,:)  = 0 
    263349      zrad0(:,:)  = 0._wp ; zradh(:,:) = 0._wp ; zradav(:,:)    = 0._wp ; zustar(:,:)    = 0._wp 
    … …  
    267353      zustke(:,:) = 0._wp ; zla(:,:)   = 0._wp ; zcos_wind(:,:) = 0._wp ; zsin_wind(:,:) = 0._wp 
    268354      zhol(:,:)   = 0._wp 
    269       lconv(:,:)  = .FALSE. 
     355      lconv(:,:)  = .FALSE.; lpyc(:,:) = .FALSE. ; lflux(:,:) = .FALSE. ;  lmle(:,:) = .FALSE. 
    270356      ! mixed layer 
    271357      ! no initialization of zhbl or zhml (or zdh?) 
    272358      zhbl(:,:)    = 1._wp ; zhml(:,:)    = 1._wp ; zdh(:,:)      = 1._wp ; zdhdt(:,:)   = 0._wp 
    273       zt_bl(:,:)   = 0._wp ; zs_bl(:,:)   = 0._wp ; zu_bl(:,:)    = 0._wp ; zv_bl(:,:)   = 0._wp 
    274       zrh_bl(:,:)  = 0._wp ; zt_ml(:,:)   = 0._wp ; zs_ml(:,:)    = 0._wp ; zu_ml(:,:)   = 0._wp 
    275       zv_ml(:,:)   = 0._wp ; zrh_ml(:,:)  = 0._wp ; zdt_bl(:,:)   = 0._wp ; zds_bl(:,:)  = 0._wp 
    276       zdu_bl(:,:)  = 0._wp ; zdv_bl(:,:)  = 0._wp ; zdrh_bl(:,:)  = 0._wp ; zdb_bl(:,:)  = 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 
    277366      zdt_ml(:,:)  = 0._wp ; zds_ml(:,:)  = 0._wp ; zdu_ml(:,:)   = 0._wp ; zdv_ml(:,:)  = 0._wp 
    278       zdrh_ml(:,:) = 0._wp ; zdb_ml(:,:)  = 0._wp ; zwth_ent(:,:) = 0._wp ; zws_ent(:,:) = 0._wp 
    279       zuw_bse(:,:) = 0._wp ; zvw_bse(:,:) = 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 
    280371      ! 
    281372      zdtdz_pyc(:,:,:) = 0._wp ; zdsdz_pyc(:,:,:) = 0._wp ; zdbdz_pyc(:,:,:) = 0._wp 
    282373      zdudz_pyc(:,:,:) = 0._wp ; zdvdz_pyc(:,:,:) = 0._wp 
    283374      ! 
     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 
     382      ENDIF 
     383      zwb_fk_b(:,:) = 0._wp   ! must be initialised even with ln_osm_mle=F as used in zdf_osm_calculate_dhdt 
     384 
    284385      ! Flux-Gradient arrays. 
    285       zdifml_sc(:,:)  = 0._wp ; zvisml_sc(:,:)  = 0._wp ; zdifpyc_sc(:,:) = 0._wp 
    286       zvispyc_sc(:,:) = 0._wp ; zbeta_d_sc(:,:) = 0._wp ; zbeta_v_sc(:,:) = 0._wp 
    287386      zsc_wth_1(:,:)  = 0._wp ; zsc_ws_1(:,:)   = 0._wp ; zsc_uw_1(:,:)   = 0._wp 
    288387      zsc_uw_2(:,:)   = 0._wp ; zsc_vw_1(:,:)   = 0._wp ; zsc_vw_2(:,:)   = 0._wp 
    … …  
    292391      ghams(:,:,:)   = 0._wp ; ghamu(:,:,:)   = 0._wp ; ghamv(:,:,:) = 0._wp 
    293392 
     393      zddhdt(:,:) = 0._wp 
    294394      ! hbl = MAX(hbl,epsln) 
    295395      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    326426        zwbav(ji,jj) = grav  * zthermal * zwthav(ji,jj) - grav  * zbeta * zwsav(ji,jj) 
    327427        ! Surface upward velocity fluxes 
    328         zuw0(ji,jj) = -utau(ji,jj) * r1_rho0 * tmask(ji,jj,1) 
    329         zvw0(ji,jj) = -vtau(ji,jj) * r1_rho0 * tmask(ji,jj,1) 
     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) 
    330430        ! Friction velocity (zustar), at T-point : LMD94 eq. 2 
    331431        zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) 
    … …  
    340440           zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
    341441           zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
     442           ! Linearly 
    342443           zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 
    343            ! dstokes(ji,jj) set to constant value rn_osm_dstokes from namelist in zdf_osm_init 
     444           dstokes(ji,jj) = rn_osm_dstokes 
    344445        END_2D 
    345446     ! Assume Pierson-Moskovitz wind-wave spectrum 
    … …  
    347448        DO_2D( 0, 0, 0, 0 ) 
    348449           ! Use wind speed wndm included in sbc_oce module 
    349            zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 
    350            dstokes(ji,jj) = 0.12 * wndm(ji,jj)**2 / grav 
     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) 
    351452        END_2D 
    352453     ! Use ECMWF wave fields as output from SBCWAVE 
    353454     CASE(2) 
    354455        zfac =  2.0_wp * rpi / 16.0_wp 
     456 
    355457        DO_2D( 0, 0, 0, 0 ) 
    356            ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas. 
    357            !    The coefficient 0.8 gives La=0.3  in this situation. 
    358            ! It could represent the effects of the spread of wave directions 
    359            ! around the mean wind. The effect of this adjustment needs to be tested. 
    360            zustke(ji,jj) = MAX ( 1.0 * ( zcos_wind(ji,jj) * ut0sd(ji,jj ) + zsin_wind(ji,jj)  * vt0sd(ji,jj) ), & 
    361                 &                zustar(ji,jj) / ( 0.45 * 0.45 )                                                  ) 
    362            dstokes(ji,jj) = MAX(zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zustke(ji,jj)*wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) !rn_osm_dstokes ! 
     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) 
    363527        END_2D 
    364528     END SELECT 
    … …  
    369533        ! Langmuir velocity scale (zwstrl), at T-point 
    370534        zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 
    371         ! Modify zwstrl to allow for small and large values of dstokes/hbl. 
    372         ! Intended as a possible test. Doesn't affect LES results for entrainment, 
    373         !  but hasn't been shown to be correct as dstokes/h becomes large or small. 
    374         zwstrl(ji,jj) = zwstrl(ji,jj) *  & 
    375              & (1.12 * ( 1.0 - ( 1.0 - EXP( -hbl(ji,jj) / dstokes(ji,jj) ) ) * dstokes(ji,jj) / hbl(ji,jj) ))**pthird * & 
    376              & ( 1.0 - EXP( -15.0 * dstokes(ji,jj) / hbl(ji,jj) )) 
    377         ! define La this way so effects of Stokes penetration depth on velocity scale are included 
    378         zla(ji,jj) = SQRT ( zustar(ji,jj) / zwstrl(ji,jj) )**3 
     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)) 
    379537        ! Velocity scale that tends to zustar for large Langmuir numbers 
    380538        zvstr(ji,jj) = ( zwstrl(ji,jj)**3  + & 
    … …  
    383541        ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 
    384542        ! Note zustke and zwstrl are not amended. 
    385         IF ( zla(ji,jj) >= 0.45 ) zla(ji,jj) = 0.45 
    386543        ! 
    387544        ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 
    … …  
    389546           zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 
    390547           zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 
    391            lconv(ji,jj) = .TRUE. 
    392         ELSE 
     548         ELSE 
    393549           zhol(ji,jj) = -hbl(ji,jj) *  2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3  + epsln ) 
    394            lconv(ji,jj) = .FALSE. 
    395550        ENDIF 
    396551     END_2D 
    … …  
    399554     ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth 
    400555     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    401      ! BL must be always 2 levels deep. 
    402       hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,3,Kmm) ) 
    403       ibld(:,:) = 3 
    404       DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 
     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 ) 
    405566         IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 
    406567            ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 
    407568         ENDIF 
    408569      END_3D 
     570     ! ########################################################################## 
    409571 
    410572      DO_2D( 0, 0, 0, 0 ) 
    411             zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    412             zbeta    = rab_n(ji,jj,1,jp_sal) 
    413             zt   = 0._wp 
    414             zs   = 0._wp 
    415             zu   = 0._wp 
    416             zv   = 0._wp 
    417             ! average over depth of boundary layer 
    418             zthick=0._wp 
    419             DO jm = 2, ibld(ji,jj) 
    420                zthick=zthick+e3t(ji,jj,jm,Kmm) 
    421                zt   = zt  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 
    422                zs   = zs  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 
    423                zu   = zu  + e3t(ji,jj,jm,Kmm) & 
    424                   &            * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 
    425                   &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
    426                zv   = zv  + e3t(ji,jj,jm,Kmm) & 
    427                   &            * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 
    428                   &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
    429             END DO 
    430             zt_bl(ji,jj) = zt / zthick 
    431             zs_bl(ji,jj) = zs / zthick 
    432             zu_bl(ji,jj) = zu / zthick 
    433             zv_bl(ji,jj) = zv / zthick 
    434             zdt_bl(ji,jj) = zt_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 
    435             zds_bl(ji,jj) = zs_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 
    436             zdu_bl(ji,jj) = zu_bl(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 
    437                   &    / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
    438             zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 
    439                   &   / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
    440             zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 
    441             IF ( lconv(ji,jj) ) THEN    ! Convective 
    442                    zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & 
    443                         &            + 0.135 * zla(ji,jj) * zwstrl(ji,jj)**3/hbl(ji,jj) ) 
    444  
    445                    zvel_max =  - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) & 
    446                         &   * zwb_ent(ji,jj) / ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    447 ! Entrainment including component due to shear turbulence. Modified Langmuir component, but gives same result for La=0.3 For testing uncomment. 
    448 !                      zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & 
    449 !                           &            + ( 0.15 * ( 1.0 - EXP( -0.5 * zla(ji,jj) ) ) + 0.03 / zla(ji,jj)**2 ) * zustar(ji,jj)**3/hbl(ji,jj) ) 
    450  
    451 !                      zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / zhbl(ji,jj) ) * zwb_ent(ji,jj) / & 
    452 !                           &       ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    453                    zzdhdt = - zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj),0.0) ) 
    454             ELSE                        ! Stable 
    455                    zzdhdt = 0.32 * ( hbli(ji,jj) / hbl(ji,jj) -1.0 ) * zwstrl(ji,jj)**3 / hbli(ji,jj) & 
    456                         &   + ( ( 0.32 / 3.0 ) * exp ( -2.5 * ( hbli(ji,jj) / hbl(ji,jj) - 1.0 ) ) & 
    457                         & - ( 0.32 / 3.0 - 0.135 * zla(ji,jj) ) * exp ( -12.5 * ( hbli(ji,jj) / hbl(ji,jj) ) ) ) & 
    458                         &  * zwstrl(ji,jj)**3 / hbli(ji,jj) 
    459                    zzdhdt = zzdhdt + zwbav(ji,jj) 
    460                    IF ( zzdhdt < 0._wp ) THEN 
    461                    ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 
    462                       zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_Dt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) 
    463                    ELSE 
    464                       zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_Dt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) & 
    465                            &  + MAX( zdb_bl(ji,jj), 0.0 ) 
    466                    ENDIF 
    467                    zzdhdt = 2.0 * zzdhdt / zpert 
    468             ENDIF 
    469             zdhdt(ji,jj) = zzdhdt 
     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) 
     576         zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    470577      END_2D 
    471  
    472       ! Calculate averages over depth of boundary layer 
    473       imld = ibld           ! use imld to hold previous blayer index 
    474       ibld(:,:) = 3 
    475  
    476       zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need wb here, so subtract it 
    477       zhbl_t(:,:) = MIN(zhbl_t(:,:), ht(:,:)) 
    478       zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 
     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 
     589      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) 
     594         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) 
     600         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 ) 
     608      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. 
     615         END_2D 
     616      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 
    479651 
    480652      DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 
    481653         IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 
    482             ibld(ji,jj) =  MIN(mbkt(ji,jj), jk) 
     654            ibld(ji,jj) = jk 
    483655         ENDIF 
    484656      END_3D 
    … …  
    487659! Step through model levels taking account of buoyancy change to determine the effect on dhdt 
    488660! 
     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 
    489671      DO_2D( 0, 0, 0, 0 ) 
    490          IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 
     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. 
    491676! 
    492 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 
    493 ! 
    494             zhbl_s = hbl(ji,jj) 
    495             jm = imld(ji,jj) 
    496             zthermal = rab_n(ji,jj,1,jp_tem) 
    497             zbeta = rab_n(ji,jj,1,jp_sal) 
    498             IF ( lconv(ji,jj) ) THEN 
    499 !unstable 
    500                zvel_max =  - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) & 
    501                     &   * zwb_ent(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    502  
    503                DO jk = imld(ji,jj), ibld(ji,jj) 
    504                   zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 
    505                        & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0 ) + zvel_max 
    506  
    507                   zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_Dt / FLOAT(ibld(ji,jj)-imld(ji,jj) ),   & 
    508                      &                     e3w(ji,jj,jk,Kmm) ) 
    509                   zhbl_s = MIN(zhbl_s, ht(ji,jj)) 
    510  
    511                   IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 
    512                END DO 
    513                hbl(ji,jj) = zhbl_s 
    514                ibld(ji,jj) = jm 
    515                hbli(ji,jj) = hbl(ji,jj) 
    516             ELSE 
    517 ! stable 
    518                DO jk = imld(ji,jj), ibld(ji,jj) 
    519                   zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) )          & 
    520                        &               - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0 ) & 
    521                        & + 2.0 * zwstrl(ji,jj)**2 / zhbl_s 
    522  
    523                   zhbl_s = zhbl_s +  (                                                                                & 
    524                        &                     0.32         *                         ( hbli(ji,jj) / zhbl_s -1.0 )     & 
    525                        &               * zwstrl(ji,jj)**3 / hbli(ji,jj)                                               & 
    526                        &               + ( ( 0.32 / 3.0 )           * EXP( -  2.5 * ( hbli(ji,jj) / zhbl_s -1.0 ) )   & 
    527                        &               -   ( 0.32 / 3.0  - 0.0485 ) * EXP( - 12.5 * ( hbli(ji,jj) / zhbl_s      ) ) ) & 
    528                        &          * zwstrl(ji,jj)**3 / hbli(ji,jj) ) / zdb * e3w(ji,jj,jk,Kmm) / zdhdt(ji,jj)  ! ALMG to investigate whether need to include ww here 
    529  
    530                   zhbl_s = MIN(zhbl_s, ht(ji,jj)) 
    531                   IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 
    532                END DO 
    533                hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,3,Kmm) ) 
    534                ibld(ji,jj) = MAX(jm, 3 ) 
    535                IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 
    536             ENDIF   ! IF ( lconv ) 
    537          ELSE 
    538 ! change zero or one model level. 
    539             hbl(ji,jj) = zhbl_t(ji,jj) 
    540             IF ( lconv(ji,jj) ) THEN 
    541                hbli(ji,jj) = hbl(ji,jj) 
    542             ELSE 
    543                hbl(ji,jj) = MAX(hbl(ji,jj), gdepw(ji,jj,3,Kmm) ) 
    544                IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 
    545             ENDIF 
    546          ENDIF 
    547          zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 
    548       END_2D 
    549       dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. )  !  Limit delta for shallow boundary layers for calculating flux-gradient terms. 
    550  
    551 ! Recalculate averages over boundary layer after depth updated 
    552      ! Consider later  combining this into the loop above and looking for columns 
    553      ! where the index for base of the boundary layer have changed 
    554       DO_2D( 0, 0, 0, 0 ) 
    555             zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    556             zbeta    = rab_n(ji,jj,1,jp_sal) 
    557             zt   = 0._wp 
    558             zs   = 0._wp 
    559             zu   = 0._wp 
    560             zv   = 0._wp 
    561             ! average over depth of boundary layer 
    562             zthick=0._wp 
    563             DO jm = 2, ibld(ji,jj) 
    564                zthick=zthick+e3t(ji,jj,jm,Kmm) 
    565                zt   = zt  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 
    566                zs   = zs  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 
    567                zu   = zu  + e3t(ji,jj,jm,Kmm) & 
    568                   &            * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 
    569                   &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
    570                zv   = zv  + e3t(ji,jj,jm,Kmm) & 
    571                   &            * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 
    572                   &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
    573             END DO 
    574             zt_bl(ji,jj) = zt / zthick 
    575             zs_bl(ji,jj) = zs / zthick 
    576             zu_bl(ji,jj) = zu / zthick 
    577             zv_bl(ji,jj) = zv / zthick 
    578             zdt_bl(ji,jj) = zt_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 
    579             zds_bl(ji,jj) = zs_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 
    580             zdu_bl(ji,jj) = zu_bl(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 
    581                    &   / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
    582             zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 
    583                    &  / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
    584             zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 
    585             zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 
    586             IF ( lconv(ji,jj) ) THEN 
    587                IF ( zdb_bl(ji,jj) > 0._wp )THEN 
    588                   IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN  ! near neutral stability 
    589                         zari = 4.5 * ( zvstr(ji,jj)**2 ) & 
    590                           & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 
    591                   ELSE                                                     ! unstable 
    592                         zari = 4.5 * ( zwstrc(ji,jj)**2 ) & 
    593                           & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 
    594                   ENDIF 
    595                   IF ( zari > 0.2 ) THEN                                                ! This test checks for weakly stratified pycnocline 
    596                      zari = 0.2 
    597                      zwb_ent(ji,jj) = 0._wp 
    598                   ENDIF 
    599                   inhml = MAX( INT( zari * zhbl(ji,jj)   & 
    600                      &              / e3t(ji,jj,ibld(ji,jj),Kmm) ), 1 ) 
    601                   imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 
    602                   zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
    603                   zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    604                ELSE  ! IF (zdb_bl) 
    605                   imld(ji,jj) = ibld(ji,jj) - 1 
    606                   zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
    607                   zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    608                ENDIF 
    609             ELSE   ! IF (lconv) 
    610                IF ( zdhdt(ji,jj) >= 0.0 ) THEN    ! probably shouldn't include wm here 
    611                ! boundary layer deepening 
    612                   IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    613                ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 
    614                      zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 
    615                        & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01  , 0.2 ) 
    616                      inhml = MAX( INT( zari * zhbl(ji,jj)   & 
    617                         &             / e3t(ji,jj,ibld(ji,jj),Kmm) ), 1 ) 
    618                      imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 
    619                      zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
    620                      zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    621                   ELSE 
    622                      imld(ji,jj) = ibld(ji,jj) - 1 
    623                      zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
    624                      zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    625                   ENDIF ! IF (zdb_bl > 0.0) 
    626                ELSE     ! IF(dhdt >= 0) 
    627                ! boundary layer collapsing. 
    628                   imld(ji,jj) = ibld(ji,jj) 
    629                   zhml(ji,jj) = zhbl(ji,jj) 
    630                   zdh(ji,jj) = 0._wp 
    631                ENDIF    ! IF (dhdt >= 0) 
    632             ENDIF       ! IF (lconv) 
    633       END_2D 
    634  
    635       ! Average over the depth of the mixed layer in the convective boundary layer 
    636       ! Also calculate entrainment fluxes for temperature and salinity 
    637       DO_2D( 0, 0, 0, 0 ) 
    638          zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    639          zbeta    = rab_n(ji,jj,1,jp_sal) 
    640          IF ( lconv(ji,jj) ) THEN 
    641             zt   = 0._wp 
    642             zs   = 0._wp 
    643             zu   = 0._wp 
    644             zv   = 0._wp 
    645             ! average over depth of boundary layer 
    646             zthick=0._wp 
    647             DO jm = 2, imld(ji,jj) 
    648                zthick=zthick+e3t(ji,jj,jm,Kmm) 
    649                zt   = zt  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 
    650                zs   = zs  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 
    651                zu   = zu  + e3t(ji,jj,jm,Kmm) & 
    652                   &            * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 
    653                   &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
    654                zv   = zv  + e3t(ji,jj,jm,Kmm) & 
    655                   &            * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 
    656                   &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
    657             END DO 
    658             zt_ml(ji,jj) = zt / zthick 
    659             zs_ml(ji,jj) = zs / zthick 
    660             zu_ml(ji,jj) = zu / zthick 
    661             zv_ml(ji,jj) = zv / zthick 
    662             zdt_ml(ji,jj) = zt_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 
    663             zds_ml(ji,jj) = zs_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 
    664             zdu_ml(ji,jj) = zu_ml(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 
    665                   &    / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
    666             zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 
    667                   &    / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
    668             zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj) 
    669          ELSE 
    670          ! stable, if entraining calulate average below interface layer. 
    671             IF ( zdhdt(ji,jj) >= 0._wp ) THEN 
    672                zt   = 0._wp 
    673                zs   = 0._wp 
    674                zu   = 0._wp 
    675                zv   = 0._wp 
    676                ! average over depth of boundary layer 
    677                zthick=0._wp 
    678                DO jm = 2, imld(ji,jj) 
    679                   zthick=zthick+e3t(ji,jj,jm,Kmm) 
    680                   zt   = zt  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 
    681                   zs   = zs  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 
    682                   zu   = zu  + e3t(ji,jj,jm,Kmm) & 
    683                      &            * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 
    684                      &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
    685                   zv   = zv  + e3t(ji,jj,jm,Kmm) & 
    686                      &            * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 
    687                      &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
    688                END DO 
    689                zt_ml(ji,jj) = zt / zthick 
    690                zs_ml(ji,jj) = zs / zthick 
    691                zu_ml(ji,jj) = zu / zthick 
    692                zv_ml(ji,jj) = zv / zthick 
    693                zdt_ml(ji,jj) = zt_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 
    694                zds_ml(ji,jj) = zs_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 
    695                zdu_ml(ji,jj) = zu_ml(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 
    696                      &    / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
    697                zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 
    698                      &    / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
    699                zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj) 
    700             ENDIF 
    701          ENDIF 
    702       END_2D 
    703     ! 
     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 ) 
    704680    ! rotate mean currents and changes onto wind align co-ordinates 
    705681    ! 
    706  
    707       DO_2D( 0, 0, 0, 0 ) 
    708          ztemp = zu_ml(ji,jj) 
    709          zu_ml(ji,jj) = zu_ml(ji,jj) * zcos_wind(ji,jj) + zv_ml(ji,jj) * zsin_wind(ji,jj) 
    710          zv_ml(ji,jj) = zv_ml(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
    711          ztemp = zdu_ml(ji,jj) 
    712          zdu_ml(ji,jj) = zdu_ml(ji,jj) * zcos_wind(ji,jj) + zdv_ml(ji,jj) * zsin_wind(ji,jj) 
    713          zdv_ml(ji,jj) = zdv_ml(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
    714  ! 
    715          ztemp = zu_bl(ji,jj) 
    716          zu_bl = zu_bl(ji,jj) * zcos_wind(ji,jj) + zv_bl(ji,jj) * zsin_wind(ji,jj) 
    717          zv_bl(ji,jj) = zv_bl(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
    718          ztemp = zdu_bl(ji,jj) 
    719          zdu_bl(ji,jj) = zdu_bl(ji,jj) * zcos_wind(ji,jj) + zdv_bl(ji,jj) * zsin_wind(ji,jj) 
    720          zdv_bl(ji,jj) = zdv_bl(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
    721       END_2D 
    722  
    723      zuw_bse = 0._wp 
    724      zvw_bse = 0._wp 
    725      DO_2D( 0, 0, 0, 0 ) 
    726  
    727         IF ( lconv(ji,jj) ) THEN 
    728            IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    729               zwth_ent(ji,jj) = zwb_ent(ji,jj) * zdt_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 
    730               zws_ent(ji,jj) = zwb_ent(ji,jj) * zds_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 
    731            ENDIF 
    732         ELSE 
    733            zwth_ent(ji,jj) = -2.0 * zwthav(ji,jj) * ( (1.0 - 0.8) - ( 1.0 - 0.8)**(3.0/2.0) ) 
    734            zws_ent(ji,jj) = -2.0 * zwsav(ji,jj) * ( (1.0 - 0.8 ) - ( 1.0 - 0.8 )**(3.0/2.0) ) 
    735         ENDIF 
    736      END_2D 
    737  
     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 ) 
    738684      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    739685      !  Pycnocline gradients for scalars and velocity 
    740686      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    741687 
    742        DO_2D( 0, 0, 0, 0 ) 
    743        ! 
    744           IF ( lconv (ji,jj) ) THEN 
    745           ! Unstable conditions 
    746              IF( zdb_bl(ji,jj) > 0._wp ) THEN 
    747              ! calculate pycnocline profiles, no need if zdb_bl <= 0. since profile is zero and arrays have been initialized to zero 
    748                 ztgrad = ( zdt_ml(ji,jj) / zdh(ji,jj) ) 
    749                 zsgrad = ( zds_ml(ji,jj) / zdh(ji,jj) ) 
    750                 zbgrad = ( zdb_ml(ji,jj) / zdh(ji,jj) ) 
    751                 DO jk = 2 , ibld(ji,jj) 
    752                    znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
    753                    zdtdz_pyc(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    754                    zdbdz_pyc(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    755                    zdsdz_pyc(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    756                 END DO 
    757              ENDIF 
    758           ELSE 
    759           ! stable conditions 
    760           ! if pycnocline profile only defined when depth steady of increasing. 
    761              IF ( zdhdt(ji,jj) >= 0.0 ) THEN        ! Depth increasing, or steady. 
    762                 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    763                   IF ( zhol(ji,jj) >= 0.5 ) THEN      ! Very stable - 'thick' pycnocline 
    764                       ztgrad = zdt_bl(ji,jj) / zhbl(ji,jj) 
    765                       zsgrad = zds_bl(ji,jj) / zhbl(ji,jj) 
    766                       zbgrad = zdb_bl(ji,jj) / zhbl(ji,jj) 
    767                       DO jk = 2, ibld(ji,jj) 
    768                          znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    769                          zdtdz_pyc(ji,jj,jk) =  ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
    770                          zdbdz_pyc(ji,jj,jk) =  zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
    771                          zdsdz_pyc(ji,jj,jk) =  zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
    772                       END DO 
    773                   ELSE                                   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 
    774                       ztgrad = zdt_bl(ji,jj) / zdh(ji,jj) 
    775                       zsgrad = zds_bl(ji,jj) / zdh(ji,jj) 
    776                       zbgrad = zdb_bl(ji,jj) / zdh(ji,jj) 
    777                       DO jk = 2, ibld(ji,jj) 
    778                          znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
    779                          zdtdz_pyc(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    780                          zdbdz_pyc(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    781                          zdsdz_pyc(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    782                       END DO 
    783                    ENDIF ! IF (zhol >=0.5) 
    784                 ENDIF    ! IF (zdb_bl> 0.) 
    785              ENDIF       ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero, profile arrays are intialized to zero 
    786           ENDIF          ! IF (lconv) 
    787          ! 
    788        END_2D 
    789 ! 
    790        DO_2D( 0, 0, 0, 0 ) 
    791        ! 
    792           IF ( lconv (ji,jj) ) THEN 
    793           ! Unstable conditions 
    794               zugrad = ( zdu_ml(ji,jj) / zdh(ji,jj) ) + 0.275 * zustar(ji,jj)*zustar(ji,jj) / & 
    795             & (( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) / zla(ji,jj)**(8.0/3.0) 
    796              zvgrad = ( zdv_ml(ji,jj) / zdh(ji,jj) ) + 3.5 * ff_t(ji,jj) * zustke(ji,jj) / & 
    797            & ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    798              DO jk = 2 , ibld(ji,jj)-1 
    799                 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
    800                 zdudz_pyc(ji,jj,jk) =  zugrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    801                 zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    802              END DO 
    803           ELSE 
    804           ! stable conditions 
    805              zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj) 
    806              zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj) 
    807              DO jk = 2, ibld(ji,jj) 
    808                 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    809                 IF ( znd < 1.0 ) THEN 
    810                    zdudz_pyc(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 ) 
    811                 ELSE 
    812                    zdudz_pyc(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 ) 
    813                 ENDIF 
    814                 zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 ) 
    815              END DO 
    816           ENDIF 
    817          ! 
    818        END_2D 
     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 ) 
    819691       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    820692       ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship 
    821693       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    822  
    823       ! WHERE ( lconv ) 
    824       !     zdifml_sc = zhml * ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird 
    825       !     zvisml_sc = zdifml_sc 
    826       !     zdifpyc_sc = 0.165 * ( zwstrl**3 + zwstrc**3 )**pthird * ( zhbl - zhml ) 
    827       !     zvispyc_sc = 0.142 * ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * ( zhbl - zhml ) 
    828       !     zbeta_d_sc = 1.0 - (0.165 / 0.8 * ( zhbl - zhml ) / zhbl )**p2third 
    829       !     zbeta_v_sc = 1.0 -  2.0 * (0.142 /0.375) * (zhbl - zhml ) / zhml 
    830       !  ELSEWHERE 
    831       !     zdifml_sc = zwstrl * zhbl * EXP ( -( zhol / 0.183_wp )**2 ) 
    832       !     zvisml_sc = zwstrl * zhbl * EXP ( -( zhol / 0.183_wp )**2 ) 
    833       !  ENDWHERE 
    834        DO_2D( 0, 0, 0, 0 ) 
    835           IF ( lconv(ji,jj) ) THEN 
    836             zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    837             zvisml_sc(ji,jj) = zdifml_sc(ji,jj) 
    838             zdifpyc_sc(ji,jj) = 0.165 * ( zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 
    839             zvispyc_sc(ji,jj) = 0.142 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 
    840             zbeta_d_sc(ji,jj) = 1.0 - (0.165 / 0.8 * zdh(ji,jj) / zhbl(ji,jj) )**p2third 
    841             zbeta_v_sc(ji,jj) = 1.0 -  2.0 * (0.142 /0.375) * zdh(ji,jj) / zhml(ji,jj) 
    842           ELSE 
    843             zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 
    844             zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 
    845          END IF 
    846        END_2D 
    847 ! 
    848        DO_2D( 0, 0, 0, 0 ) 
    849           IF ( lconv(ji,jj) ) THEN 
    850              DO jk = 2, imld(ji,jj)   ! mixed layer diffusivity 
    851                  zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
    852                  ! 
    853                  zdiffut(ji,jj,jk) = 0.8   * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml    )**1.5 
    854                  ! 
    855                  zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml    ) & 
    856                       &            *                                      ( 1.0 -               0.5 * zznd_ml**2 ) 
    857              END DO 
    858              ! pycnocline - if present linear profile 
    859              IF ( zdh(ji,jj) > 0._wp ) THEN 
    860                 DO jk = imld(ji,jj)+1 , ibld(ji,jj) 
    861                     zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
    862                     ! 
    863                     zdiffut(ji,jj,jk) = zdifpyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 
    864                     ! 
    865                     zviscos(ji,jj,jk) = zvispyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 
    866                 END DO 
    867              ENDIF 
    868              ! Temporay fix to ensure zdiffut is +ve; won't be necessary with ww taken out 
    869              zdiffut(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj)* e3t(ji,jj,ibld(ji,jj),Kmm) 
    870              ! could be taken out, take account of entrainment represents as a diffusivity 
    871              ! should remove w from here, represents entrainment 
    872           ELSE 
    873           ! stable conditions 
    874              DO jk = 2, ibld(ji,jj) 
    875                 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    876                 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 
    877                 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 
    878              END DO 
    879           ENDIF   ! end if ( lconv ) 
    880 ! 
    881        END_2D 
     694       CALL zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 
    882695 
    883696       ! 
    … …  
    918731       END_2D 
    919732 
    920  
    921733! 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) 
    922734       WHERE ( lconv ) 
    923           zsc_uw_1 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke /( 1.0 - 1.0 * 6.5 * zla**(8.0/3.0) ) 
    924           zsc_uw_2 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / ( zla**(8.0/3.0) + epsln ) 
    925           zsc_vw_1 = ff_t * zhml * zustke**3 * zla**(8.0/3.0) / ( ( zvstr**3 + 0.5 * zwstrc**3 )**(2.0/3.0) + epsln ) 
     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 ) 
    926738       ELSEWHERE 
    927739          zsc_uw_1 = zustar**2 
    928           zsc_vw_1 = ff_t * zhbl * zustke**3 * zla**(8.0/3.0) / (zvstr**2 + epsln) 
     740          zsc_vw_1 = ff_t * zhbl * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / (zvstr**2 + epsln) 
    929741       ENDWHERE 
    930  
     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 
    931746       DO_2D( 0, 0, 0, 0 ) 
    932747          IF ( lconv(ji,jj) ) THEN 
    … …  
    970785                zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           & 
    971786                     &     * ( 1.0 - EXP ( - 5.0 * (     1.0 - zznd_ml          ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) ) 
    972                 zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( 3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0/2.0) 
     787                zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( -3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0 / 2.0) 
    973788                ! non-gradient buoyancy terms 
    974789                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 ) 
    975790                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 ) 
    976791             END DO 
    977           ELSE 
     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 
    978824             DO jk = 2, ibld(ji,jj) 
    979825                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) 
    … …  
    982828          ENDIF 
    983829       END_2D 
    984  
    985830 
    986831       WHERE ( lconv ) 
    … …  
    1011856       END_2D 
    1012857 
     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 
    1013891! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 
    1014892 
    1015        WHERE ( lconv ) 
    1016           zsc_wth_1 = zwth0 
    1017           zsc_ws_1 = zws0 
    1018        ELSEWHERE 
    1019           zsc_wth_1 = 2.0 * zwthav 
    1020           zsc_ws_1 = zws0 
    1021        ENDWHERE 
     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 
    1022908 
    1023909       DO_2D( 0, 0, 0, 0 ) 
    … …  
    1035921                    &          * ( 1.0 - EXP ( -15.0 * (         1.0 - zznd_ml    ) ) ) 
    1036922            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 
    1037932         ELSE 
    1038             DO jk = 2, ibld(ji,jj) 
    1039                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
    1040                znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    1041                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 
    1042             &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 
    1043                ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 
    1044             &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 
    1045             END DO 
     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 
     942            ENDIF 
    1046943         ENDIF 
    1047944       END_2D 
    1048  
    1049945 
    1050946       WHERE ( lconv ) 
    … …  
    1090986          ENDIF 
    1091987       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 
    1092997! 
    1093998! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer. 
    1094999 
     1000 
     1001 ! Make surface forced velocity non-gradient terms go to zero at the base of the boundary layer. 
     1002 
    10951003      DO_2D( 0, 0, 0, 0 ) 
    1096          IF ( lconv(ji,jj) ) THEN 
     1004         IF ( .not. lconv(ji,jj) ) THEN 
    10971005            DO jk = 2, ibld(ji,jj) 
    1098                znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 
    1099                IF ( znd >= 0.0 ) THEN 
    1100                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 
    1101                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 
    1102                ELSE 
    1103                   ghamu(ji,jj,jk) = 0._wp 
    1104                   ghamv(ji,jj,jk) = 0._wp 
    1105                ENDIF 
    1106             END DO 
    1107          ELSE 
    1108             DO jk = 2, ibld(ji,jj) 
    1109                znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 
     1006               znd = ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zhbl(ji,jj) !ALMG to think about 
    11101007               IF ( znd >= 0.0 ) THEN 
    11111008                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 
    … …  
    11201017 
    11211018      ! pynocline contributions 
    1122        ! Temporary fix to avoid instabilities when zdb_bl becomes very very small 
    1123        zsc_uw_1 = 0._wp ! 50.0 * zla**(8.0/3.0) * zustar**2 * zhbl / ( zdb_bl + epsln ) 
    11241019       DO_2D( 0, 0, 0, 0 ) 
    1125           DO jk= 2, ibld(ji,jj) 
    1126              znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
    1127              ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk) 
    1128              ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk) 
    1129              ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk) 
    1130              ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) * ( 1.0 - znd )**(7.0/4.0) * zdbdz_pyc(ji,jj,jk) 
    1131              ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk) 
    1132           END DO 
     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 
    11331031       END_2D 
    1134  
    1135 ! Entrainment contribution. 
     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 
    11361036 
    11371037       DO_2D( 0, 0, 0, 0 ) 
    1138           IF ( lconv(ji,jj) ) THEN 
    1139             DO jk = 1, imld(ji,jj) - 1 
    1140                znd=gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
    1141                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * znd 
    1142                ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * znd 
    1143                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * znd 
    1144                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * znd 
    1145             END DO 
    1146             DO jk = imld(ji,jj), ibld(ji,jj) 
    1147                znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
    1148                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * ( 1.0 + znd ) 
    1149                ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * ( 1.0 + znd ) 
    1150                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * ( 1.0 + znd ) 
    1151                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * ( 1.0 + znd ) 
    1152              END DO 
    1153           ENDIF 
    1154           ghamt(ji,jj,ibld(ji,jj)) = 0._wp 
    1155           ghams(ji,jj,ibld(ji,jj)) = 0._wp 
    1156           ghamu(ji,jj,ibld(ji,jj)) = 0._wp 
    1157           ghamv(ji,jj,ibld(ji,jj)) = 0._wp 
     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 
    11581042       END_2D 
    11591043 
    1160  
     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 
    11611051       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    11621052       ! Need to put in code for contributions that are applied explicitly to 
    … …  
    11801070       IF(ln_dia_osm) THEN 
    11811071          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 ) 
    11821074       END IF 
    11831075 
    … …  
    12221114       END IF ! ln_convmix = .true. 
    12231115 
     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 
    12241155       ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 
    1225        CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp ) 
     1156       !CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp ) 
    12261157 
    12271158       ! GN 25/8: need to change tmask --> wmask 
    … …  
    12441175            ghams(ji,jj,jk) =  ghams(ji,jj,jk) * tmask(ji,jj,jk) 
    12451176       END_3D 
     1177        ! Lateral boundary conditions on final outputs for hbl,  on T-grid (sign unchanged) 
     1178        CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 
    12461179        ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged) 
    1247         ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign unchanged) 
    1248         CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W', 1.0_wp,   & 
    1249          &                  ghamu, 'U', 1.0_wp , ghamv, 'V', 1.0_wp ) 
    1250  
    1251        IF(ln_dia_osm) THEN 
     1180        ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign changed) 
     1181        CALL lbc_lnk_multi( '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 
    12521185         SELECT CASE (nn_osm_wave) 
    12531186         ! Stokes drift set by assumimg onstant La#=0.3(=0)  or Pierson-Moskovitz spectrum (=1). 
    … …  
    12571190            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 
    12581191         ! Stokes drift read in from sbcwave  (=2). 
    1259          CASE(2) 
    1260             IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd )               ! x surface Stokes drift 
    1261             IF ( iom_use("us_y") ) CALL iom_put( "us_y", vt0sd )               ! y surface Stokes drift 
     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 
    12621200            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2* & 
    12631201                 & SQRT(ut0sd**2 + vt0sd**2 ) ) 
    … …  
    12701208         IF ( iom_use("zws0") ) CALL iom_put( "zws0", tmask(:,:,1)*zws0 )                ! <Sw_0> 
    12711209         IF ( iom_use("hbl") ) CALL iom_put( "hbl", tmask(:,:,1)*hbl )                  ! boundary-layer depth 
    1272          IF ( iom_use("hbli") ) CALL iom_put( "hbli", tmask(:,:,1)*hbli )               ! Initial 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 
    12731218         IF ( iom_use("dstokes") ) CALL iom_put( "dstokes", tmask(:,:,1)*dstokes )      ! Stokes drift penetration depth 
    12741219         IF ( iom_use("zustke") ) CALL iom_put( "zustke", tmask(:,:,1)*zustke )            ! Stokes drift magnitude at T-points 
    … …  
    12761221         IF ( iom_use("zwstrl") ) CALL iom_put( "zwstrl", tmask(:,:,1)*zwstrl )         ! Langmuir velocity scale 
    12771222         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 # 
    12781225         IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rho0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine 
    12791226         IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 
    12801227         IF ( iom_use("zhbl") ) CALL iom_put( "zhbl", tmask(:,:,1)*zhbl )               ! BL depth internal to zdf_osm routine 
    12811228         IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml )               ! ML depth internal to zdf_osm routine 
    1282          IF ( iom_use("zdh") ) CALL iom_put( "zdh", tmask(:,:,1)*zdh )               ! 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 
    12831231         IF ( iom_use("zhol") ) CALL iom_put( "zhol", tmask(:,:,1)*zhol )               ! ML depth internal to zdf_osm routine 
    1284          IF ( iom_use("zwthav") ) CALL iom_put( "zwthav", tmask(:,:,1)*zwthav )               ! ML depth internal to zdf_osm routine 
    1285          IF ( iom_use("zwth_ent") ) CALL iom_put( "zwth_ent", tmask(:,:,1)*zwth_ent )               ! ML depth internal to zdf_osm routine 
    1286          IF ( iom_use("zt_ml") ) CALL iom_put( "zt_ml", tmask(:,:,1)*zt_ml )               ! average T in ML 
     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 
    12871252      END IF 
    1288       ! Lateral boundary conditions on p_avt  (sign unchanged) 
    1289       CALL lbc_lnk( 'zdfosm', p_avt(:,:,:), 'W', 1.0_wp ) 
     1253 
     1254CONTAINS 
     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 ) 
     1853      !!--------------------------------------------------------------------- 
     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 
    12901867      ! 
    1291    END SUBROUTINE zdf_osm 
    1292  
    1293  
    1294    SUBROUTINE zdf_osm_init( Kmm )  
     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  *** 
     2160      !! 
     2161      !! ** Purpose : Calculates thickness of the pycnocline 
     2162      !! 
     2163      !! ** Method  : The thickness is calculated from a prognostic equation 
     2164      !!              that relaxes the pycnocine thickness to a diagnostic 
     2165      !!              value. The time change is calculated assuming the 
     2166      !!              thickness relaxes exponentially. This is done to deal 
     2167      !!              with large timesteps. 
     2168      !! 
     2169      !!---------------------------------------------------------------------- 
     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) 
     2208               ELSE 
     2209                  zdh_ref = 0.2 * hbl(ji,jj) 
     2210               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? 
     2217         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) 
     2235                  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) 
     2238                  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. 
     2298      !! 
     2299      !! ** Method  : 
     2300      !! 
     2301      !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 
     2302      !!             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 ) 
     2325         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 
     2328      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 
     2341         ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem,Kmm) 
     2342         zsm(ji,jj) = zsm(ji,jj) + zc * ts(ji,jj,jk,jp_sal,Kmm) 
     2343      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( 0, 0, 1, 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( 1, 0, 0, 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( 0, 0, 1, 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( 1, 0, 0, 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. 
     2387      !! 
     2388      !! ** Method  : 
     2389      !! 
     2390      !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 
     2391      !!             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) 
     2437      END_3D 
     2438      DO_2D( 0, 0, 0, 0 ) 
     2439         zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj),Kmm) 
     2440      END_2D 
     2441END SUBROUTINE zdf_osm_mle_parameters 
     2442 
     2443END SUBROUTINE zdf_osm 
     2444 
     2445 
     2446   SUBROUTINE zdf_osm_init( Kmm ) 
    12952447     !!---------------------------------------------------------------------- 
    12962448     !!                  ***  ROUTINE zdf_osm_init  *** 
    … …  
    13042456     !! ** input   :   Namlist namosm 
    13052457     !!---------------------------------------------------------------------- 
    1306      INTEGER, INTENT(in)    :: Kmm ! time level index (middle) 
    1307      ! 
     2458     INTEGER, INTENT(in)   ::   Kmm       ! time level 
    13082459     INTEGER  ::   ios            ! local integer 
    13092460     INTEGER  ::   ji, jj, jk     ! dummy loop indices 
     2461     REAL z1_t2 
    13102462     !! 
    13112463     NAMELIST/namzdf_osm/ ln_use_osm_la, rn_osm_la, rn_osm_dstokes, nn_ave & 
    1312           & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0 & 
    1313           & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv 
     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 
    13142471     !!---------------------------------------------------------------------- 
    13152472     ! 
    … …  
    13252482        WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation' 
    13262483        WRITE(numout,*) '~~~~~~~~~~~~' 
    1327         WRITE(numout,*) '   Namelist namzdf_osm : set tke mixing parameters' 
    1328         WRITE(numout,*) '     Use namelist  rn_osm_la                     ln_use_osm_la = ', ln_use_osm_la 
     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 
    13292487        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 
    13302489        WRITE(numout,*) '     Initial hbl for 1D runs                       rn_osm_hbl0   = ', rn_osm_hbl0 
    1331         WRITE(numout,*) '     Depth scale of Stokes drift                rn_osm_dstokes = ', rn_osm_dstokes 
     2490        WRITE(numout,*) '     Depth scale of Stokes drift                   rn_osm_dstokes = ', rn_osm_dstokes 
    13322491        WRITE(numout,*) '     horizontal average flag                       nn_ave      = ', nn_ave 
    13332492        WRITE(numout,*) '     Stokes drift                                  nn_osm_wave = ', nn_osm_wave 
    … …  
    13392498        CASE(2) 
    13402499           WRITE(numout,*) '     calculated from ECMWF wave fields' 
     2500         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' 
    13412511        END SELECT 
     2512        WRITE(numout,*) '     reduce surface SD and depth scale under ice   ln_zdfosm_ice_shelter=', ln_zdfosm_ice_shelter 
    13422513        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' 
    13432515        WRITE(numout,*) '     Use KPP-style shear instability mixing       ln_kpprimix = ', ln_kpprimix 
    13442516        WRITE(numout,*) '     local Richardson Number limit for shear instability rn_riinfty = ', rn_riinfty 
    … …  
    13592531     IF( zdf_osm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 
    13602532 
    1361      call osm_rst( nit000, Kmm, 'READ' ) !* read or initialize hbl 
     2533 
     2534     IF( ln_osm_mle ) THEN 
     2535! Initialise Fox-Kemper parametrization 
     2536         READ  ( numnam_ref, namosm_mle, IOSTAT = ios, ERR = 903) 
     2537903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namosm_mle in reference namelist') 
     2538 
     2539         READ  ( numnam_cfg, namosm_mle, IOSTAT = ios, ERR = 904 ) 
     2540904      IF( ios >  0 )   CALL ctl_nam ( ios , 'namosm_mle in configuration namelist') 
     2541         IF(lwm) WRITE ( numond, namosm_mle ) 
     2542 
     2543         IF(lwp) THEN                     ! Namelist print 
     2544            WRITE(numout,*) 
     2545            WRITE(numout,*) 'zdf_osm_init : initialise mixed layer eddy (MLE)' 
     2546            WRITE(numout,*) '~~~~~~~~~~~~~' 
     2547            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 
     2560      ! 
     2561      IF(lwp) THEN 
     2562         WRITE(numout,*) 
     2563         IF( ln_osm_mle ) THEN 
     2564            WRITE(numout,*) '   ==>>>   Mixed Layer Eddy induced transport added to OSMOSIS BL calculation' 
     2565            IF( nn_osm_mle == 0 )   WRITE(numout,*) '              Fox-Kemper et al 2010 formulation' 
     2566            IF( nn_osm_mle == 1 )   WRITE(numout,*) '              New formulation' 
     2567         ELSE 
     2568            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 
     2573         ! 
     2574         rb_c = grav * rn_osm_mle_rho_c /rho0        ! Mixed Layer buoyancy criteria 
     2575         IF(lwp) WRITE(numout,*) 
     2576         IF(lwp) WRITE(numout,*) '      ML buoyancy criteria = ', rb_c, ' m/s2 ' 
     2577         IF(lwp) WRITE(numout,*) '      associated ML density criteria defined in zdfmxl = ', rn_osm_mle_rho_c, 'kg/m3' 
     2578         ! 
     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) 
     2589         END_2D 
     2590         ! z1_t2 = 1._wp / ( rn_osm_mle_time * rn_osm_mle_timeji,jj ) 
     2591         ! r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  ) 
     2592         ! 
     2593      ENDIF 
     2594 
     2595     call osm_rst( nit000, Kmm,  'READ' ) !* read or initialize hbl, dh, hmle 
     2596 
    13622597 
    13632598     IF( ln_zdfddm) THEN 
    … …  
    14542689     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    14552690 
    1456      INTEGER ::   id1, id2   ! iom enquiry index 
     2691     INTEGER ::   id1, id2, id3   ! iom enquiry index 
    14572692     INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    14582693     INTEGER  ::   iiki, ikt ! local integer 
    … …  
    14602695     REAL(wp) ::   zN2_c           ! local scalar 
    14612696     REAL(wp) ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth 
    1462      INTEGER, DIMENSION(:,:), ALLOCATABLE :: imld_rst ! level of mixed-layer depth (pycnocline top) 
     2697     INTEGER, DIMENSION(jpi,jpj) :: imld_rst ! level of mixed-layer depth (pycnocline top) 
    14632698     !!---------------------------------------------------------------------- 
    14642699     ! 
    … …  
    14702705        IF( id1 > 0 ) THEN                       ! 'wn' exists; read 
    14712706           CALL iom_get( numror, jpdom_auto, 'wn', ww ) 
    1472            WRITE(numout,*) ' ===>>>> :  ww read from restart file' 
     2707           WRITE(numout,*) ' ===>>>> :  wn read from restart file' 
    14732708        ELSE 
    14742709           ww(:,:,:) = 0._wp 
    1475            WRITE(numout,*) ' ===>>>> :  ww not in restart file, set to zero initially' 
     2710           WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially' 
    14762711        END IF 
     2712 
    14772713        id1 = iom_varid( numror, 'hbl'   , ldstop = .FALSE. ) 
    1478         id2 = iom_varid( numror, 'hbli'   , ldstop = .FALSE. ) 
     2714        id2 = iom_varid( numror, 'dh'   , ldstop = .FALSE. ) 
    14792715        IF( id1 > 0 .AND. id2 > 0) THEN                       ! 'hbl' exists; read and return 
    14802716           CALL iom_get( numror, jpdom_auto, 'hbl' , hbl  ) 
    1481            CALL iom_get( numror, jpdom_auto, 'hbli', hbli  ) 
    1482            WRITE(numout,*) ' ===>>>> :  hbl & hbli read from restart file' 
     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 
    14832729           RETURN 
    1484         ELSE                      ! 'hbl' & 'hbli' not in restart file, recalculate 
     2730        ELSE                      ! 'hbl' & 'dh' not in restart file, recalculate 
    14852731           WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification' 
    14862732        END IF 
    … …  
    14902736     ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return 
    14912737     !!----------------------------------------------------------------------------- 
    1492      IF( TRIM(cdrw) == 'WRITE') THEN     !* Write hbli into the restart file, then return 
    1493         IF( ntile /= 0 .AND. ntile /= nijtile ) RETURN        ! Do only on the last tile 
    1494  
     2738     IF( TRIM(cdrw) == 'WRITE') THEN     !* Write hbl into the restart file, then return 
    14952739        IF(lwp) WRITE(numout,*) '---- osm-rst ----' 
    1496          CALL iom_rstput( kt, nitrst, numrow, 'wn'     , ww   ) 
    1497          CALL iom_rstput( kt, nitrst, numrow, 'hbl'    , hbl  ) 
    1498          CALL iom_rstput( kt, nitrst, numrow, 'hbli'   , hbli ) 
     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 
     2744            CALL iom_rstput( kt, nitrst, numrow, 'hmle', hmle ) 
     2745         END IF 
    14992746        RETURN 
    15002747     END IF 
    … …  
    15042751     !!----------------------------------------------------------------------------- 
    15052752     IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification' 
    1506      ALLOCATE( imld_rst(jpi,jpj) ) 
    15072753     ! w-level of the mixing and mixed layers 
    15082754     CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) 
    … …  
    15132759     ! 
    15142760     hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
    1515      DO_3D( 1, 1, 1, 1, 1, jpkm1 )  ! Mixed layer level: w-level 
     2761     DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    15162762        ikt = mbkt(ji,jj) 
    15172763        hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 
    … …  
    15202766     ! 
    15212767     DO_2D( 1, 1, 1, 1 ) 
    1522         iiki = imld_rst(ji,jj) 
    1523         hbl (ji,jj) = gdepw(ji,jj,iiki  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth 
     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 
    15242771     END_2D 
    1525      hbl = MAX(hbl,epsln) 
    1526      hbli(:,:) = hbl(:,:) 
    1527      DEALLOCATE( imld_rst ) 
     2772 
    15282773     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' 
    15292782   END SUBROUTINE osm_rst 
    15302783 
    … …  
    15592812      ENDIF 
    15602813 
    1561       ! add non-local temperature and salinity flux 
    15622814      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    15632815         pts(ji,jj,jk,jp_tem,Krhs) =  pts(ji,jj,jk,jp_tem,Krhs)                      & 
    … …  
    15692821      END_3D 
    15702822 
    1571  
    1572       ! save the non-local tracer flux trends for diagnostic 
     2823      ! save the non-local tracer flux trends for diagnostics 
    15732824      IF( l_trdtra )   THEN 
    15742825         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    15752826         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    1576 !!bug gm jpttdzdf ==> jpttosm 
    1577          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
    1578          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_zdf, ztrds ) 
     2827 
     2828         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_osm, ztrdt ) 
     2829         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_osm, ztrds ) 
    15792830         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
    15802831      ENDIF 
    … …  
    16422893 
    16432894   !!====================================================================== 
     2895 
    16442896END MODULE zdfosm 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ZDF/zdfphy.F90

    r14049 r14054  
    179179      IF( ln_zdfmfc .AND. ln_zdfosm )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfosm' ) 
    180180      IF( lk_top    .AND. ln_zdfnpc )   CALL ctl_stop( 'zdf_phy_init: npc scheme is not working with key_top' ) 
    181       IF( lk_top    .AND. ln_zdfosm )   CALL ctl_stop( 'zdf_phy_init: osmosis scheme is not working with key_top' ) 
     181      IF( lk_top    .AND. ln_zdfosm )   CALL ctl_warn( 'zdf_phy_init: osmosis gives no non-local fluxes for TOP tracers yet' ) 
    182182      IF( lk_top    .AND. ln_zdfmfc )   CALL ctl_stop( 'zdf_phy_init: Mass Flux scheme is not working with key_top' ) 
    183183      IF(lwp) THEN 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/nemogcm.F90

    r14049 r14054  
    4242   !!---------------------------------------------------------------------- 
    4343   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     44   ! 
    4445   USE phycst         ! physical constant                  (par_cst routine) 
    4546   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
    46    USE closea         ! treatment of closed seas (for ln_closea) 
    47    USE usrdef_nam     ! user defined configuration 
    48    USE tide_mod, ONLY : tide_init ! tidal components initialization   (tide_init routine) 
    49    USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
     47   USE wet_dry        ! Wetting and drying setting   (wad_init routine) 
     48   USE usrdef_nam     ! user defined configuration namelist 
     49   USE tide_mod, ONLY : tide_init   ! tidal components initialization   (tide_init routine) 
     50   USE bdyini  , ONLY : bdy_init    ! open boundary cond. setting       (bdy_init routine) 
    5051   USE istate         ! initial state setting          (istate_init routine) 
    51    USE ldfdyn         ! lateral viscosity setting      (ldfdyn_init routine) 
    52    USE ldftra         ! lateral diffusivity setting    (ldftra_init routine) 
    5352   USE trdini         ! dyn/tra trends initialization     (trd_init routine) 
    54    USE asminc         ! assimilation increments      
    55    USE asmbkg         ! writing out state trajectory 
    56    USE diadct         ! sections transports           (dia_dct_init routine) 
    57    USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
    58    USE diacfl         ! CFL diagnostics               (dia_cfl_init routine) 
    59    USE diamlr         ! IOM context management for multiple-linear-regression analysis 
     53   USE icbini         ! handle bergs, initialisation 
     54   USE icbstp  , ONLY : icb_end     ! handle bergs, close iceberg files 
     55   USE cpl_oasis3     ! OASIS3 coupling 
     56   USE dyndmp         ! Momentum damping (C1D only) 
     57   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
     58   USE crsini         ! initialise grid coarsening utility 
     59   USE dia25h  , ONLY : dia_25h_init   ! 25h mean output (initialisation) 
     60   USE c1d            ! 1D configuration 
     61   USE step_c1d       ! Time stepping loop for the 1D configuration 
     62#if defined key_top 
     63   USE trcini         ! passive tracer initialisation 
     64#endif 
     65#if defined key_nemocice_decomp 
     66   USE ice_domain_size, only: nx_global, ny_global 
     67#endif 
    6068#if defined key_qco 
    61    USE stepMLF        ! NEMO time-stepping               (stp_MLF   routine) 
     69   USE stpmlf         ! NEMO time-stepping               (stp_MLF   routine) 
    6270#else 
    6371   USE step           ! NEMO time-stepping                 (stp     routine) 
    6472#endif 
    65    USE isfstp         ! ice shelf                     (isf_stp_init routine) 
    66    USE icbini         ! handle bergs, initialisation 
    67    USE icbstp         ! handle bergs, calving, themodynamics and transport 
    68    USE cpl_oasis3     ! OASIS3 coupling 
    69    USE c1d            ! 1D configuration 
    70    USE step_c1d       ! Time stepping loop for the 1D configuration 
    71    USE dyndmp         ! Momentum damping 
    72    USE stopar         ! Stochastic param.: ??? 
    73    USE stopts         ! Stochastic param.: ??? 
    74    USE diu_layers     ! diurnal bulk SST and coolskin 
    75    USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
    76    USE crsini         ! initialise grid coarsening utility 
    77    USE dia25h         ! 25h mean output 
    78    USE diadetide      ! Weights computation for daily detiding of model diagnostics 
    79    USE sbc_oce , ONLY : lk_oasis 
    80    USE wet_dry        ! Wetting and drying setting   (wad_init routine) 
    81 #if defined key_top 
    82    USE trcini         ! passive tracer initialisation 
    83 #endif 
    84 #if defined key_nemocice_decomp 
    85    USE ice_domain_size, only: nx_global, ny_global 
    86 #endif 
    8773   ! 
    88    USE prtctl         ! Print control 
    89    USE in_out_manager ! I/O manager 
    9074   USE lib_mpp        ! distributed memory computing 
    9175   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    9276   USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges  
    9377   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    94 #if defined key_iomput 
    95    USE xios           ! xIOserver 
    96 #endif 
    97 #if defined key_agrif 
    98    USE agrif_all_update   ! Master Agrif update 
    99 #endif 
    100    USE halo_mng 
     78   USE halo_mng       ! Halo manager 
    10179 
    10280   IMPLICIT NONE 
    … …  
    182160      ! 
    183161      DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    184 #if defined key_qco 
     162#  if defined key_qco 
    185163         CALL stp_MLF 
    186 #else 
     164#  else 
    187165         CALL stp 
    188 #endif 
     166#  endif 
    189167         istp = istp + 1 
    190168      END DO 
    … …  
    195173         ! 
    196174         DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    197  
     175            ! 
    198176            ncom_stp = istp 
    199177            IF( ln_timing ) THEN 
    … …  
    202180               IF ( istp ==         nitend ) elapsed_time = zstptiming - elapsed_time 
    203181            ENDIF 
    204              
    205 #if defined key_qco 
     182            ! 
     183#  if defined key_qco 
    206184            CALL stp_MLF      ( istp ) 
    207 #else 
     185#  else 
    208186            CALL stp        ( istp )  
    209 #endif 
     187#  endif 
    210188            istp = istp + 1 
    211  
     189            ! 
    212190            IF( lwp .AND. ln_timing )   WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 
    213  
     191            ! 
    214192         END DO 
    215193         ! 
    … …  
    279257      INTEGER ::   ios, ilocal_comm   ! local integers 
    280258      !! 
    281       NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
    282          &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
     259      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, nn_isplt, nn_jsplt , nn_ictls,   & 
     260         &                                             nn_ictle, nn_jctls , nn_jctle 
    283261      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    284262      !!---------------------------------------------------------------------- 
    … …  
    350328      IF(lwp) THEN                      ! open listing units 
    351329         ! 
    352          IF( .NOT. lwm )   &            ! alreay opened for narea == 1 
     330         IF( .NOT.lwm )   &            ! alreay opened for narea == 1 
    353331            &            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
    354332         ! 
    … …  
    357335         WRITE(numout,*) '                       NEMO team' 
    358336         WRITE(numout,*) '            Ocean General Circulation Model' 
    359          WRITE(numout,*) '                NEMO version 4.0  (2019) ' 
     337         WRITE(numout,*) '                NEMO version 4.0  (2020) ' 
    360338         WRITE(numout,*) 
    361339         WRITE(numout,*) "           ._      ._      ._      ._      ._    " 
    … …  
    373351         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    374352         WRITE(numout,*) 
    375           
    376          ! Print the working precision to ocean.output 
    377          IF (wp == dp) THEN 
    378             WRITE(numout,*) "Working precision = double-precision" 
    379          ELSE 
    380             WRITE(numout,*) "Working precision = single-precision" 
     353         ! 
     354         WRITE(numout,cform_aaa)    ! Flag AAAAAAA 
     355         ! 
     356         !                          ! Control print of the working precision 
     357         WRITE(numout,*) 
     358         IF( wp == dp ) THEN   ;   WRITE(numout,*) "par_kind : wp = Working precision = dp = double-precision" 
     359         ELSE                  ;   WRITE(numout,*) "par_kind : wp = Working precision = sp = single-precision" 
    381360         ENDIF 
    382          WRITE(numout,*) 
    383          ! 
    384          WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
     361                                   WRITE(numout,*) "~~~~~~~~                                 ****************" 
     362                                   WRITE(numout,*) 
    385363         ! 
    386364      ENDIF 
    … …  
    415393 
    416394      ! Initialise time level indices 
    417       Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
     395      Nbb = 1   ;   Nnn = 2   ;   Naa = 3   ;  Nrhs = Naa 
    418396#if defined key_agrif 
    419       Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     397      Kbb_a = Nbb   ;   Kmm_a = Nnn   ;  Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    420398#endif  
    421399      !                             !-------------------------------! 
    … …  
    423401      !                             !-------------------------------! 
    424402 
    425       CALL nemo_ctl                          ! Control prints 
     403      CALL nemo_ctl                          ! Control prints of namctl and namcfg 
    426404      ! 
    427405      !                                      ! General initialization 
    … …  
    437415     CALL Agrif_Declare_Var_ini   !  "      "   "   "      "  DOM 
    438416#endif 
    439                            CALL     dom_init( Nbb, Nnn, Naa ) ! Domain 
    440       IF( ln_crs       )   CALL     crs_init(      Nnn )       ! coarsened grid: domain initialization  
     417                           CALL     dom_init( Nbb, Nnn, Naa )   ! Domain 
     418      IF( ln_crs       )   CALL     crs_init(      Nnn      )   ! coarsened grid: domain initialization  
    441419      IF( sn_cfctl%l_prtctl )   & 
    442420         &                 CALL prt_ctl_init        ! Print control 
    … …  
    490468                           CALL dyn_spg_init         ! surface pressure gradient 
    491469 
     470      !                                      ! Icebergs 
     471                           CALL icb_init( rn_Dt, nit000)   ! initialise icebergs instance 
     472 
     473                                                ! ice shelf 
     474                           CALL isf_init( Nbb, Nnn, Naa ) 
    492475#if defined key_top 
    493476      !                                      ! Passive tracers 
    … …  
    495478#endif 
    496479      IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing 
    497  
    498       !                                      ! Icebergs 
    499                            CALL icb_init( rn_Dt, nit000)   ! initialise icebergs instance 
    500  
    501                                                 ! ice shelf 
    502                            CALL isf_init( Nbb, Nnn, Naa ) 
    503480 
    504481      !                                      ! Misc. options 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/oce.F90

    r13237 r14054  
    1616   PRIVATE 
    1717 
    18    PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 
     18   PUBLIC oce_alloc       ! routine called by nemo_init in     nemogcm.F90 
     19   PUBLIC oce_SWE_alloc   ! routine called by nemo_init in SWE/nemogcm.F90 (Shallow Water Eq. case) 
    1920 
    2021   !! dynamics and tracer fields 
    … …  
    6869   INTEGER, PUBLIC, DIMENSION(2) :: noce_array                             !: unused array but seems to be needed to prevent agrif from creating an empty module 
    6970 
     71   !! Shallow Water Eq. case (SWE) 
     72   LOGICAL, PUBLIC ::   lk_SWE = .FALSE.                                   !: shallow water flag =T in SWE configurations only 
     73 
     74   !! Stand-Alone Surface module (SAS) 
     75   LOGICAL, PUBLIC ::   l_SAS = .FALSE.                                    !: SAS flag =T in SAS configurations only 
     76    
     77    
    7078   !!---------------------------------------------------------------------- 
    7179   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    115123   END FUNCTION oce_alloc 
    116124 
     125 
     126   INTEGER FUNCTION oce_SWE_alloc() 
     127      !!---------------------------------------------------------------------- 
     128      !!                   ***  FUNCTION oce_SWE_alloc  *** 
     129      !!---------------------------------------------------------------------- 
     130      INTEGER :: ierr(2) 
     131      !!---------------------------------------------------------------------- 
     132      ! 
     133      lk_SWE  = .TRUE.                   ! =T SWE case  
     134      ! 
     135      ierr(:) = 0  
     136      ALLOCATE( uu(jpi,jpj,jpk,jpt) , vv  (jpi,jpj,jpk,jpt) ,     &           
     137         &      ww(jpi,jpj,jpk)     , hdiv(jpi,jpj,jpk)     , ssh(jpi,jpj,jpt) , STAT=ierr(1) ) 
     138         ! 
     139      ALLOCATE(   ts(jpi,jpj,jpk,jpts,jpt) , fraqsr_1lev(jpi,jpj) ,  & 
     140         &      uu_b(jpi,jpj,jpt) , vv_b(jpi,jpj,jpt)       , rn2(jpi,jpj,jpk) , STAT=ierr(2) ) 
     141         ! 
     142      oce_SWE_alloc = MAXVAL( ierr ) 
     143      IF( oce_SWE_alloc /= 0 )   CALL ctl_stop( 'STOP', 'oce_SWE_alloc: failed to allocate arrays' ) 
     144      ! 
     145   END FUNCTION oce_SWE_alloc 
     146 
    117147   !!====================================================================== 
    118148END MODULE oce 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/step.F90

    r14049 r14054  
    4242   !!---------------------------------------------------------------------- 
    4343   USE step_oce         ! time stepping definition modules 
    44    ! 
    45    USE iom              ! xIOs server 
    4644 
    4745   IMPLICIT NONE 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/step_oce.F90

    r14049 r14054  
    33   !!                       ***  MODULE step_oce  *** 
    44   !! Ocean time-stepping : module used in both initialisation phase and time stepping 
     5   !!                                     (i.e. nemo_init and stp or stp_MLF routines) 
    56   !!====================================================================== 
    67   !! History :   3.3  !  2010-08  (C. Ethe)  Original code - reorganisation of the initial phase 
    … …  
    910   USE oce             ! ocean dynamics and tracers variables 
    1011   USE dom_oce         ! ocean space and time domain variables 
    11    USE domain, ONLY : dom_tile 
    12    USE zdf_oce         ! ocean vertical physics variables 
    13    USE zdfdrg  ,  ONLY : ln_drgimp   ! implicit top/bottom friction 
     12   USE domain  ,  ONLY : dom_tile 
    1413 
    1514   USE daymod          ! calendar                         (day     routine) 
    … …  
    2019   USE sbccpl          ! surface boundary condition: coupled formulation (call send at end of step) 
    2120   USE sbcapr          ! surface boundary condition: atmospheric pressure 
    22    USE tide_mod, ONLY : ln_tide, tide_update 
    2321   USE sbcwave         ! Wave intialisation 
     22   USE tide_mod        ! tides 
     23 
     24   USE bdy_oce  , ONLY : ln_bdy 
     25   USE bdydta          ! open boundary condition data     (bdy_dta routine) 
     26   USE bdytra          ! bdy cond. for tracers            (bdy_tra routine) 
     27   USE bdydyn3d        ! bdy cond. for baroclinic vel.  (bdy_dyn3d routine) 
    2428 
    2529   USE isf_oce         ! ice shelf boundary condition 
    2630   USE isfstp          ! ice shelf boundary condition     (isf_stp routine) 
     31 
     32   USE sshwzv          ! vertical velocity and ssh        (ssh_nxt routine) 
     33   !                                                      (ssh_swp routine) 
     34   !                                                      (wzv     routine) 
     35   USE domvvl          ! variable vertical scale factors  (dom_vvl_sf_nxt routine) 
     36   !                                                      (dom_vvl_sf_swp routine) 
     37    
     38   USE divhor          ! horizontal divergence            (div_hor routine) 
     39   USE dynadv          ! advection                        (dyn_adv routine) 
     40   USE dynvor          ! vorticity term                   (dyn_vor routine) 
     41   USE dynhpg          ! hydrostatic pressure grad.       (dyn_hpg routine) 
     42   USE dynldf          ! lateral momentum diffusion       (dyn_ldf routine) 
     43   USE dynzdf          ! vertical diffusion               (dyn_zdf routine) 
     44   USE dynspg          ! surface pressure gradient        (dyn_spg routine) 
     45   USE dynatf          ! time-filtering                   (dyn_atf routine) 
    2746 
    2847   USE traqsr          ! solar radiation penetration      (tra_qsr routine) 
    … …  
    4059   USE eosbn2          ! equation of state                (eos_bn2 routine) 
    4160 
    42    USE divhor          ! horizontal divergence            (div_hor routine) 
    43    USE dynadv          ! advection                        (dyn_adv routine) 
    44    USE dynvor          ! vorticity term                   (dyn_vor routine) 
    45    USE dynhpg          ! hydrostatic pressure grad.       (dyn_hpg routine) 
    46    USE dynldf          ! lateral momentum diffusion       (dyn_ldf routine) 
    47    USE dynzdf          ! vertical diffusion               (dyn_zdf routine) 
    48    USE dynspg          ! surface pressure gradient        (dyn_spg routine) 
    49  
    50    USE dynatf          ! time-filtering                   (dyn_atf routine) 
    51  
    5261   USE stopar          ! Stochastic parametrization       (sto_par routine) 
    5362   USE stopts  
    54  
    55    USE bdy_oce  , ONLY : ln_bdy 
    56    USE bdydta          ! open boundary condition data     (bdy_dta routine) 
    57    USE bdytra          ! bdy cond. for tracers            (bdy_tra routine) 
    58    USE bdydyn3d        ! bdy cond. for baroclinic vel.  (bdy_dyn3d routine) 
    59  
    60    USE sshwzv          ! vertical velocity and ssh        (ssh_nxt routine) 
    61    !                                                       (ssh_swp routine) 
    62    !                                                       (wzv     routine) 
    63    USE domvvl          ! variable vertical scale factors  (dom_vvl_sf_nxt routine) 
    64    !                                                       (dom_vvl_sf_swp routine) 
    6563 
    6664   USE ldfslp          ! iso-neutral slopes               (ldf_slp routine) 
    … …  
    6866   USE ldftra          ! lateral eddy diffusive coef.     (ldf_tra routine) 
    6967 
     68   USE zdf_oce         ! ocean vertical physics variables 
    7069   USE zdfphy          ! vertical physics manager      (zdf_phy_init routine) 
    71    USE zdfosm  , ONLY : osm_rst, dyn_osm, tra_osm      ! OSMOSIS routines used in step.F90 
     70   USE zdfdrg   , ONLY : ln_drgimp   ! implicit top/bottom friction 
     71   USE zdfosm   , ONLY : osm_rst, dyn_osm, tra_osm      ! OSMOSIS routines used in step.F90 
    7272   USE zdfmfc          ! Mass FLux Convection routine used in step.F90 
    7373 
    … …  
    8383   USE diahth          ! thermocline depth                (dia_hth routine) 
    8484   USE diahsb          ! heat, salt and volume budgets    (dia_hsb routine) 
    85    USE diacfl 
    86    USE diaobs          ! Observation operator 
     85   USE diacfl          ! CFL diagnostics                  (dia_cfl routine) 
     86   USE diaobs          ! Observation operator             (dia_obs routine) 
    8787   USE diadetide       ! Weights computation for daily detiding of model diagnostics 
    8888   USE diamlr          ! IOM context management for multiple-linear-regression analysis 
    … …  
    9494   USE asminc          ! assimilation increments      (tra_asm_inc routine) 
    9595   !                                                   (dyn_asm_inc routine) 
    96    USE asmbkg 
     96   USE asmbkg          ! writing out state trajectory 
    9797   USE stpctl          ! time stepping control            (stp_ctl routine) 
    9898   USE restart         ! ocean restart                    (rst_wri routine) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/stpctl.F90

    r13616 r14054  
    2626   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2727   USE lib_mpp         ! distributed memory computing 
    28    ! 
    2928   USE netcdf          ! NetCDF library 
     29 
    3030   IMPLICIT NONE 
    3131   PRIVATE 
    … …  
    7171      CHARACTER(len=20)               ::   clname 
    7272      !!---------------------------------------------------------------------- 
     73      ! 
    7374      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
    7475      ! 
    … …  
    179180         END DO 
    180181         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    181       END IF 
     182      ENDIF 
    182183      !                                   !==               error handling               ==! 
    183184      !                                   !==  done by all processes at every time step  ==! 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OFF/dtadyn.F90

    r14049 r14054  
    2323   USE c1d             ! 1D configuration: lk_c1d 
    2424   USE dom_oce         ! ocean domain: variables 
    25 #if ! defined key_qco  
    26    USE domvvl          ! variable volume 
     25#if defined key_qco  
     26   USE domqco          ! variable volume 
    2727#else 
    28    USE domqco 
     28   USE domvvl 
    2929#endif 
    3030   USE zdf_oce         ! ocean vertical physics: variables 
    … …  
    9797   !! * Substitutions 
    9898#  include "do_loop_substitute.h90" 
     99#  include "domzgr_substitute.h90" 
     100    
    99101   !!---------------------------------------------------------------------- 
    100102   !! NEMO/OFF 4.0 , NEMO Consortium (2018) 
    … …  
    388390        gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 
    389391        ! 
    390       ENDIF 
    391392#endif 
     393      ENDIF 
    392394      ! 
    393395      IF( ln_dynrnf .AND. ln_dynrnf_depth ) THEN       ! read depht over which runoffs are distributed 
    … …  
    412414            ENDIF 
    413415         END_2D 
     416         ! 
    414417         DO_2D( 1, 1, 1, 1 )                           ! set the associated depth 
    415418            h_rnf(ji,jj) = 0._wp 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OFF/nemogcm.F90

    r14049 r14054  
    6464   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    6565   USE lbcnfd  , ONLY : isendto, nsndto   ! Setup of north fold exchanges 
    66    USE step, ONLY : Nbb, Nnn, Naa, Nrhs   ! time level indices 
     66#if defined key_qco 
     67   USE stpmlf , ONLY : Nbb, Nnn, Naa, Nrhs   ! time level indices 
     68#else 
     69   USE step    , ONLY : Nbb, Nnn, Naa, Nrhs   ! time level indices 
     70#endif 
    6771   USE halo_mng 
    6872 
    … …  
    143147                                CALL dta_dyn_atf( istp, Nbb, Nnn, Naa )       ! time filter of sea  surface height and vertical scale factors 
    144148# if defined key_qco 
    145                                 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t_f, r3u_f, r3v_f ) 
     149                                CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) 
    146150# endif 
    147151         ENDIF 
    148152                                CALL trc_stp    ( istp, Nbb, Nnn, Nrhs, Naa ) ! time-stepping 
    149153# if defined key_qco 
    150                                 !r3t(:,:,Kmm) = r3t_f(:,:)                     ! update ssh to h0 ratio 
    151                                 !r3u(:,:,Kmm) = r3u_f(:,:) 
    152                                 !r3v(:,:,Kmm) = r3v_f(:,:) 
     154                                !r3t(:,:,Nnn) = r3t_f(:,:)                     ! update ssh to h0 ratio 
     155                                !r3u(:,:,Nnn) = r3u_f(:,:) 
     156                                !r3v(:,:,Nnn) = r3v_f(:,:) 
    153157# endif 
    154158#endif 
    … …  
    160164         ! 
    161165#if ! defined key_qco 
    162 #if ! defined key_sed_off 
     166# if ! defined key_sed_off 
    163167         IF( .NOT.ln_linssh )   CALL dta_dyn_sf_interp( istp, Nnn )  ! calculate now grid parameters 
    164 #endif 
     168# endif 
    165169#endif          
    166170         CALL stp_ctl    ( istp )             ! Time loop: control and print 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SAS/nemogcm.F90

    r14049 r14054  
    3434   USE diu_layers     ! diurnal bulk SST and coolskin 
    3535   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
     36   USE icb_oce        ! icebergs 
    3637   ! 
    3738   USE prtctl         ! Print control 
    … …  
    215216      !!---------------------------------------------------------------------- 
    216217      ! 
    217       IF( lk_oasis ) THEN   ;   cxios_context = 'sas' 
    218       ELSE                  ;   cxios_context = 'nemo' 
     218      IF( lk_oasis ) THEN   ;   cxios_context = 'sas'    ! when coupling SAS to OCE 
     219      ELSE                  ;   cxios_context = 'nemo'   !  
    219220      ENDIF 
    220221      nn_hls = 1 
     222      ! 
     223      l_SAS = .TRUE.   ! used in domain:dom_nam 
    221224      ! 
    222225      !                             !-------------------------------------------------! 
    … …  
    393396      ! ==> 
    394397                           CALL icb_init( rn_Dt, nit000)   ! initialise icebergs instance 
     398 
     399      ! compatibility check 
     400      IF( ln_icebergs .AND. ln_M2016 ) THEN 
     401         IF( lwp ) WRITE(numout,*) '         ==>>>   ln_iceberg and ln_M2016 not compatible with SAS (need 3d data)' 
     402         CALL ctl_stop('ln_iceberg and ln_M2016 not compatible with SAS (need 3d data)') 
     403      END IF 
    395404      ! 
    396405      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SAS/sbcssm.F90

    r13286 r14054  
    2121   USE zpshde         ! z-coord. with partial steps: horizontal derivatives 
    2222   USE closea         ! for ln_closea 
     23   USE icb_oce        ! for icebergs 
    2324   ! 
    2425   USE in_out_manager ! I/O manager 
    … …  
    226227         ln_closea = .false. 
    227228      ENDIF 
    228  
     229      IF( ln_icebergs .AND. ln_M2016 ) THEN 
     230         IF( lwp ) WRITE(numout,*) '         ==>>>   ln_iceberg and ln_M2016 not compatible with SAS (need 3d data)' 
     231         CALL ctl_stop('ln_iceberg and ln_M2016 not compatible with SAS (need 3d data)') 
     232      END IF 
    229233      ! 
    230234      IF( l_sasread ) THEN                       ! store namelist information in an array 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SWE/domzgr_substitute.h90

    r12983 r14054  
    1616#   define  e3v(i,j,k,t)   (e3v_0(i,j,k)*(1._wp+r3v(i,j,t))) 
    1717#   define  e3f(i,j,k)     (e3f_0(i,j,k)*(1._wp+r3f(i,j))) 
     18#   define  e3f_vor(i,j,k) (e3f_0vor(i,j,k)*(1._wp+r3f(i,j))) 
    1819#   define  e3w(i,j,k,t)   (e3w_0(i,j,k)*(1._wp+r3t(i,j,t))) 
    1920#   define  e3uw(i,j,k,t)  (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SWE/nemogcm.F90

    r14049 r14054  
    44   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice) 
    55   !!====================================================================== 
    6    !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code 
    7    !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec) 
    8    !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    9    !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 
    10    !!             -   ! 1992-06  (L.Terray)  coupling implementation 
    11    !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice 
    12    !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    13    !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 
    14    !!            8.1  ! 1997-06  (M. Imbard, G. Madec) 
    15    !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  sea-ice model 
    16    !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
    17    !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    18    !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules 
    19    !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 
    20    !!             -   ! 2004-08  (C. Talandier) New trends organization 
    21    !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility 
    22    !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    23    !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation 
    24    !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization 
    25    !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 
    26    !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp 
    27    !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    28    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    29    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    30    !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    31    !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
    32    !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla) 
    33    !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
     6   !! History :  4.0  !  2020-05  (A. Nasser, G. Madec)  Original code from 4.0.2 
     7   !!             -   !  2020-10  (S. Techene, G. Madec)  cleanning 
    348   !!---------------------------------------------------------------------- 
    359 
    … …  
    4216   !!---------------------------------------------------------------------- 
    4317   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     18   ! 
    4419   USE phycst         ! physical constant                  (par_cst routine) 
    4520   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
    46    USE closea         ! treatment of closed seas (for ln_closea) 
    4721   USE usrdef_nam     ! user defined configuration 
    48    USE tide_mod, ONLY : tide_init ! tidal components initialization   (tide_init routine) 
    49    USE bdy_oce,  ONLY : ln_bdy 
    5022   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
    5123   USE istate         ! initial state setting          (istate_init routine) 
    52    USE ldfdyn         ! lateral viscosity setting      (ldfdyn_init routine) 
    53    USE ldftra         ! lateral diffusivity setting    (ldftra_init routine) 
    54    USE trdini         ! dyn/tra trends initialization     (trd_init routine) 
    55    USE asminc         ! assimilation increments      
    56    USE asmbkg         ! writing out state trajectory 
    57    USE diaptr         ! poleward transports           (dia_ptr_init routine) 
    58    USE diadct         ! sections transports           (dia_dct_init routine) 
    59    USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
    60    USE diacfl         ! CFL diagnostics               (dia_cfl_init routine) 
    61    USE diamlr         ! IOM context management for multiple-linear-regression analysis 
     24   USE trd_oce , ONLY : l_trddyn         ! dynamical trend logical 
    6225#if defined key_RK3 
    63    USE stpRK3 
    64 #elif defined key_qco 
    65    USE stpLF 
     26   USE stprk3         ! NEMO time-stepping               (stp_RK3   routine) 
    6627#else 
    67    USE step           ! NEMO time-stepping                 (stp     routine) 
    68 #endif 
    69    USE isfstp         ! ice shelf                     (isf_stp_init routine) 
    70    USE icbini         ! handle bergs, initialisation 
    71    USE icbstp         ! handle bergs, calving, themodynamics and transport 
    72    USE cpl_oasis3     ! OASIS3 coupling 
    73    USE c1d            ! 1D configuration 
    74    USE step_c1d       ! Time stepping loop for the 1D configuration 
    75    USE dyndmp         ! Momentum damping 
    76    USE stopar         ! Stochastic param.: ??? 
    77    USE stopts         ! Stochastic param.: ??? 
    78    USE diu_layers     ! diurnal bulk SST and coolskin 
    79    USE crsini         ! initialise grid coarsening utility 
    80    USE dia25h         ! 25h mean output 
    81    USE diadetide      ! Weights computation for daily detiding of model diagnostics 
    82    USE sbc_oce , ONLY : lk_oasis 
    83    USE wet_dry        ! Wetting and drying setting   (wad_init routine) 
    84 #if defined key_top 
    85    USE trcini         ! passive tracer initialisation 
    86 #endif 
    87 #if defined key_nemocice_decomp 
    88    USE ice_domain_size, only: nx_global, ny_global 
     28   USE stpmlf         ! NEMO time-stepping               (stp_MLF   routine) 
    8929#endif 
    9030   ! 
    9131   USE lib_mpp        ! distributed memory computing 
    9232   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    93    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
     33   USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges  
    9434   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    95 #if defined key_iomput 
    96    USE xios           ! xIOserver 
    97 #endif 
    98 #if defined key_agrif 
    99    USE agrif_all_update   ! Master Agrif update 
    100 #endif 
     35   USE halo_mng       ! Halo manager 
    10136 
    10237   IMPLICIT NONE 
    … …  
    13974      !!---------------------------------------------------------------------- 
    14075      ! 
    141 #if defined key_agrif 
    142       CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
    143 #endif 
    14476      !                            !-----------------------! 
    14577      CALL nemo_init               !==  Initialisations  ==! 
    14678      !                            !-----------------------! 
    147        
    148 #if defined key_agrif 
    149       Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    150       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    151       CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
    152 # if defined key_top 
    153       CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    154 # endif 
    155 # if defined key_si3 
    156       CALL Agrif_Declare_Var_ice   !  "      "   "   "      "  Sea ice 
    157 # endif 
    158 #endif 
    15979      ! check that all process are still there... If some process have an error, 
    16080      ! they will never enter in step and other processes will wait until the end of the cpu time! 
     81      ! 
     82      !                                 ! SWE case: only with key_qco 
     83#if ! defined key_qco   
     84      CALL ctl_stop( 'nemo_gcm (SWE): shallow water model requires key_qco' ) 
     85#endif 
     86      ! 
    16187      CALL mpp_max( 'nemogcm', nstop ) 
    16288 
    … …  
    174100      ! 
    175101      DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    176  
     102         ! 
    177103         ncom_stp = istp 
    178104         IF( ln_timing ) THEN 
    … …  
    181107            IF ( istp ==         nitend ) elapsed_time = zstptiming - elapsed_time 
    182108         ENDIF 
     109         !  
    183110#if defined key_RK3 
    184111         CALL stp_RK3    ( istp ) 
    185 #elif defined key_qco 
    186          CALL stp_LF     ( istp ) 
    187112#else 
    188          CALL stp        ( istp ) 
     113         CALL stp_MLF     ( istp ) 
    189114#endif 
    190115         istp = istp + 1 
    191  
     116         ! 
    192117         IF( lwp .AND. ln_timing )   WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 
    193  
     118         ! 
    194119      END DO 
    195120      ! 
    … …  
    232157      INTEGER ::   ios, ilocal_comm   ! local integers 
    233158      !! 
    234       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    235          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    236          &             ln_timing, ln_diacfl 
     159      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, nn_isplt, nn_jsplt , nn_ictls,   & 
     160         &                                             nn_ictle, nn_jctls , nn_jctle 
    237161      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    238162      !!---------------------------------------------------------------------- 
    … …  
    246170      ! 
    247171#if defined key_iomput 
    248       IF( Agrif_Root() ) THEN 
    249          IF( lk_oasis ) THEN 
    250             CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis 
    251             CALL xios_initialize( "not used"       , local_comm =ilocal_comm )   ! send nemo communicator to xios 
    252          ELSE 
    253             CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    254          ENDIF 
    255       ENDIF 
     172      CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    256173      CALL mpp_start( ilocal_comm ) 
    257174#else 
    258       IF( lk_oasis ) THEN 
    259          IF( Agrif_Root() ) THEN 
    260             CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis 
    261          ENDIF 
    262          CALL mpp_start( ilocal_comm ) 
    263       ELSE 
    264          CALL mpp_start( ) 
    265       ENDIF 
     175      CALL mpp_start( ) 
    266176#endif 
    267177      ! 
    … …  
    292202      ! 
    293203      ! finalize the definition of namctl variables 
    294       IF( sn_cfctl%l_allon ) THEN 
    295          ! Turn on all options. 
    296          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    297          ! Ensure all processors are active 
    298          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    299       ELSEIF( sn_cfctl%l_config ) THEN 
    300          ! Activate finer control of report outputs 
    301          ! optionally switch off output from selected areas (note this only 
    302          ! applies to output which does not involve global communications) 
    303          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    304            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    305            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    306       ELSE 
    307          ! turn off all options. 
    308          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    309       ENDIF 
     204      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     205         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    310206      ! 
    311207      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    … …  
    336232         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    337233         WRITE(numout,*) 
     234          
     235         ! Print the working precision to ocean.output 
     236         IF (wp == dp) THEN 
     237            WRITE(numout,*) "Working precision = double-precision" 
     238         ELSE 
     239            WRITE(numout,*) "Working precision = single-precision" 
     240         ENDIF 
     241         WRITE(numout,*) 
    338242         ! 
    339243         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
    … …  
    353257      ! 
    354258      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    355          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     259         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    356260      ELSE                              ! user-defined namelist 
    357          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     261         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    358262      ENDIF 
    359263      ! 
    … …  
    365269      CALL mpp_init 
    366270 
     271      CALL halo_mng_init() 
    367272      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    368273      CALL nemo_alloc() 
    369274 
    370275      ! Initialise time level indices 
    371       Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    372  
     276      Nbb = 1   ;   Nnn = 2   ;   Naa = 3   ;  Nrhs = Naa 
     277       
    373278      !                             !-------------------------------! 
    374279      !                             !  NEMO general initialization  ! 
    … …  
    382287      ! 
    383288                           CALL     phy_cst         ! Physical constants 
    384                             
     289      ! 
     290      !                                             ! SWE: Set rho0 and associated variables (eosbn2 not used) 
     291                           rho0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
     292                           rcp         = 3991.86795711963_wp      !: heat capacity     [J/K] 
     293                           rho0_rcp    = rho0 * rcp  
     294                           r1_rho0     = 1._wp / rho0 
     295                           r1_rcp      = 1._wp / rcp 
     296                           r1_rho0_rcp = 1._wp / rho0_rcp  
     297      ! 
    385298                           CALL     dom_init( Nbb, Nnn, Naa ) ! Domain 
    386299 
    … …  
    391304 
    392305      !                                      ! external forcing  
    393                            CALL    tide_init                     ! tidal harmonics 
    394  
    395306                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
    396                             
    397307 
    398308      !                                      ! Ocean physics                                     
    … …  
    400310                           CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    401311                            
    402                             
    403312      !                                      ! Dynamics 
    404313                           CALL dyn_adv_init         ! advection (vector or flux form) 
    405  
    406314                           CALL dyn_vor_init         ! vorticity term including Coriolis 
    407  
    408315                           CALL dyn_ldf_init         ! lateral mixing 
    409316 
    410                            CALL dyn_spg_init         ! surface pressure gradient 
    411  
    412317      !                                      ! Diagnostics 
    413                            CALL     flo_init( Nnn )    ! drifting Floats 
    414                             
    415318      IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics 
    416  
    417                            CALL     trd_init( Nnn )    ! Mixed-layer/Vorticity/Integral constraints trends 
    418  
     319      !                                         ! Trends diag: switched off 
     320                           l_trddyn = .FALSE.        ! No trend diagnostics 
    419321 
    420322      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 
    … …  
    422324      IF( ln_timing    )   CALL timing_stop( 'nemo_init') 
    423325      ! 
    424  
    425326   END SUBROUTINE nemo_init 
    426327 
    … …  
    440341         WRITE(numout,*) '~~~~~~~~' 
    441342         WRITE(numout,*) '   Namelist namctl' 
    442          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    443          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    444          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    445343         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    446344         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
    … …  
    454352         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    455353         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    456          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    457          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    458          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    459          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    460          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    461          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    462          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    463354         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    464355         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    465356      ENDIF 
    466357      ! 
    467       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    468       nictls    = nn_ictls 
    469       nictle    = nn_ictle 
    470       njctls    = nn_jctls 
    471       njctle    = nn_jctle 
    472       isplt     = nn_isplt 
    473       jsplt     = nn_jsplt 
    474  
     358      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    475359      IF(lwp) THEN                  ! control print 
    476360         WRITE(numout,*) 
    … …  
    482366         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
    483367         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    484       ENDIF 
    485       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    486       ! 
    487       !                             ! Parameter control 
    488       ! 
    489       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    490          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    491             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    492          ELSE 
    493             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    494                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    495                   &           ' - the print control will be done over the whole domain' ) 
    496             ENDIF 
    497             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    498          ENDIF 
    499          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    500          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    501          ! 
    502          !                              ! indices used for the SUM control 
    503          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    504             lsp_area = .FALSE. 
    505          ELSE                                             ! print control done over a specific  area 
    506             lsp_area = .TRUE. 
    507             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    508                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    509                nictls = 1 
    510             ENDIF 
    511             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    512                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    513                nictle = jpiglo 
    514             ENDIF 
    515             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    516                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    517                njctls = 1 
    518             ENDIF 
    519             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    520                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    521                njctle = jpjglo 
    522             ENDIF 
    523          ENDIF 
    524368      ENDIF 
    525369      ! 
    … …  
    571415      USE diawri    , ONLY : dia_wri_alloc 
    572416      USE dom_oce   , ONLY : dom_oce_alloc 
    573       USE trc_oce   , ONLY : trc_oce_alloc 
    574       USE bdy_oce   , ONLY : bdy_oce_alloc 
    575417      ! 
    576418      INTEGER :: ierr 
    577419      !!---------------------------------------------------------------------- 
    578420      ! 
    579       ierr =        oce_alloc    ()    ! ocean  
     421      ierr =        oce_SWE_alloc()    ! ocean  
    580422      ierr = ierr + dia_wri_alloc() 
    581423      ierr = ierr + dom_oce_alloc()    ! ocean domain 
    582424      ierr = ierr + zdf_oce_alloc()    ! ocean vertical physics 
    583       ierr = ierr + trc_oce_alloc()    ! shared TRC / TRA arrays 
    584       ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization) 
    585425      ! 
    586426      CALL mpp_sum( 'nemogcm', ierr ) 
    … …  
    590430 
    591431    
    592    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     432   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    593433      !!---------------------------------------------------------------------- 
    594434      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    595435      !! 
    596436      !! ** Purpose :   Set elements of the output control structure to setto. 
    597       !!                for_all should be .false. unless all areas are to be 
    598       !!                treated identically. 
    599437      !! 
    600438      !! ** Method  :   Note this routine can be used to switch on/off some 
    601       !!                types of output for selected areas but any output types 
    602       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    603       !!                should be protected from selective switching by the 
    604       !!                for_all argument 
    605       !!---------------------------------------------------------------------- 
    606       LOGICAL :: setto, for_all 
    607       TYPE(sn_ctl) :: sn_cfctl 
    608       !!---------------------------------------------------------------------- 
    609       IF( for_all ) THEN 
    610          sn_cfctl%l_runstat = setto 
    611          sn_cfctl%l_trcstat = setto 
    612       ENDIF 
     439      !!                types of output for selected areas. 
     440      !!---------------------------------------------------------------------- 
     441      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     442      LOGICAL     , INTENT(in   ) :: setto 
     443      !!---------------------------------------------------------------------- 
     444      sn_cfctl%l_runstat = setto 
     445      sn_cfctl%l_trcstat = setto 
    613446      sn_cfctl%l_oceout  = setto 
    614447      sn_cfctl%l_layout  = setto 
    … …  
    620453   !!====================================================================== 
    621454END MODULE nemogcm 
    622  

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SWE/stpctl.F90

    r13458 r14054  
    33   !!                       ***  MODULE  stpctl  *** 
    44   !! Ocean run control :  gross check of the ocean time stepping 
     5   !!              *** Shallow Water Equation (SWE) case *** 
     6   !!               ( No test on temperature and salinity ) 
    57   !!====================================================================== 
    6    !! History :  OPA  ! 1991-03  (G. Madec) Original code 
    7    !!            6.0  ! 1992-06  (M. Imbard) 
    8    !!            8.0  ! 1997-06  (A.M. Treguier) 
    9    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    10    !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting 
    11    !!            3.7  ! 2016-09  (G. Madec)  Remove solver 
    12    !!            4.0  ! 2017-04  (G. Madec)  regroup global communications 
     8   !! History :  SWE  ! 2020-09  (A. Nasser, S. Techene ) OCE/stpctl adaptated to SWE 
    139   !!---------------------------------------------------------------------- 
    1410 
    … …  
    2117   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
    2218   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
    23    !   
     19   ! 
    2420   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    2521   USE in_out_manager  ! I/O manager 
    2622   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2723   USE lib_mpp         ! distributed memory computing 
    28    ! 
    2924   USE netcdf          ! NetCDF library 
     25 
    3026   IMPLICIT NONE 
    3127   PRIVATE 
    … …  
    3531   INTEGER                ::   nrunid   ! netcdf file id 
    3632   INTEGER, DIMENSION(2)  ::   nvarid   ! netcdf variable id 
     33 
     34#  include "domzgr_substitute.h90" 
    3735   !!---------------------------------------------------------------------- 
    3836   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4947      !! 
    5048      !! ** Method  : - Save the time step in numstp 
     49      !!              - Print it each 50 time steps 
    5150      !!              - Stop the run IF problem encountered by setting nstop > 0 
    52       !!                Problems checked: negative sea surface height  
     51      !!                Problems checked: e3t0+ssh minimum smaller that 0 
    5352      !!                                  |U|   maximum larger than 10 m/s  
     53      !!                                  ( not for SWE : negative sea surface salinity ) 
    5454      !! 
    5555      !! ** Actions :   "time.step" file = last ocean time-step 
    … …  
    6363      INTEGER                         ::   idtime, istatus 
    6464      INTEGER , DIMENSION(3)          ::   iareasum, iareamin, iareamax 
    65       INTEGER , DIMENSION(3,2)        ::   iloc                                  ! min/max loc indices 
     65      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
    6666      REAL(wp)                        ::   zzz                                   ! local real  
    6767      REAL(wp), DIMENSION(3)          ::   zmax, zmaxlocal 
    … …  
    7070      CHARACTER(len=20)               ::   clname 
    7171      !!---------------------------------------------------------------------- 
     72      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     73      ! 
    7274      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
    7375      ! 
    … …  
    109111      !                                   !==            test of local extrema           ==! 
    110112      !                                   !==  done by all processes at every time step  ==! 
    111       ! 
    112       llmsk(   1:Nis1,:,:) = .FALSE.                                              ! exclude halos from the checked region 
    113       llmsk(Nie1: jpi,:,:) = .FALSE. 
    114       llmsk(:,   1:Njs1,:) = .FALSE. 
    115       llmsk(:,Nje1: jpj,:) = .FALSE. 
    116       ! 
     113      zmax(1) = MINVAL( e3t_0(:,:,1)+ssh(:,:,Kmm)  )                              ! e3t_Kmm min 
     114      llmsk(:,:,:) = umask(:,:,:) == 1._wp 
     115      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) ), mask = llmsk )                     ! velocity max (zonal only) 
     116      zmax(3) = REAL( nstop , wp )                                            ! stop indicator 
     117      !                                   !==               get global extrema             ==! 
     118      !                                   !==  done by all processes if writting run.stat  ==! 
    117119      llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
    118120      zmax(1) = MAXVAL(     -e3t(:,:,1,Kmm) ), mask = llmsk(:,:,1) )      ! ssh max 
    … …  
    131133      IF( ll_wrtruns ) THEN 
    132134         WRITE(numrun,9500) kt, zmax(1), zmax(2) 
    133          istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ -zmax(1)/), (/kt/), (/1/) ) 
    134          istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/  zmax(2)/), (/kt/), (/1/) ) 
     135         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     136         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
    135137         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    136       END IF 
     138      ENDIF 
    137139      !                                   !==               error handling               ==! 
    138140      !                                   !==  done by all processes at every time step  ==! 
    139141      ! 
    140       IF(   zmax(1) >  0._wp           .OR.   &               ! negative sea surface height  
    141          &  zmax(2) > 10._wp           .OR.   &               ! too large velocity ( > 10 m/s) 
     142!!SWE specific : start 
     143      IF(   zmax(1) <=   0._wp .OR.           &               ! negative e3t_Kmm 
     144         &  zmax(2) >   10._wp .OR.           &               ! too large velocity ( > 10 m/s) 
    142145         &  ISNAN( zmax(1) + zmax(2) ) .OR.   &               ! NaN encounter in the tests 
    143146         &  ABS(   zmax(1) + zmax(2) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
    … …  
    148151            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
    149152            ! get global loc on the min/max 
    150             llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
    151             CALL mpp_maxloc( 'stpctl',   -e3t(:,:,1,Kmm) , llmsk(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
    152             llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
    153             CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm)), llmsk(:,:,:), zzz, iloc(1:3,2) ) 
     153            CALL mpp_minloc( 'stpctl', e3t_0(:,:,1) + ssh(:,:,Kmm), ssmask(:,:  ), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     154            CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,Kmm))        ,  umask(:,:,:), zzz, iloc(1:3,2) ) 
    154155            ! find which subdomain has the max. 
    155156            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
    … …  
    164165         ELSE                    ! find local min and max locations: 
    165166            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
    166             llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
    167             iloc(1:2,1) = MAXLOC(   -e3t(:,:,1,Kmm) , mask = llmsk(:,:,1) ) 
    168             llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
    169             iloc(1:3,2) = MAXLOC( ABS(uu(:,:,:,Kmm)), mask = llmsk(:,:,:) ) 
    170             DO ji = 1, 2   ! local domain indices ==> global domain indices, excluding halos 
    171                iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
    172             END DO 
     167            iloc(1:2,1) = MINLOC( e3t_0(:,:,1) + ssh(:,:,Kmm), mask = ssmask(:,:  ) == 1._wp ) + (/ nimpp - 1, njmpp - 1    /) 
     168            iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask =  umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    173169            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
    174170         ENDIF 
    175171         ! 
    176          WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
    177          CALL wrt_line( ctmp2, kt, '|e3t| min', -zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
    178          CALL wrt_line( ctmp3, kt, '|U|   max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     172         WRITE(ctmp1,*) ' stp_ctl:  e3t0+ssh < 0 m  or  |U| > 10 m/s  or  NaN encounter in the tests' 
     173         CALL wrt_line( ctmp2, kt, 'e3t0+ssh min',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     174         CALL wrt_line( ctmp3, kt, '|U|   max'   ,  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
    179175         IF( Agrif_Root() ) THEN 
    180176            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
    … …  
    194190         ! 
    195191      ENDIF 
     192!!SWE specific : end 
    196193      ! 
    197194      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
    … …  
    200197      ENDIF 
    201198      ! 
    202 9500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
     1999500  FORMAT(' it :', i8, '      e3t_min: ', D23.16, ' |U|_max: ', D23.16) 
    203200      ! 
    204201   END SUBROUTINE stp_ctl 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/PISCES/SED/oce_sed.F90

    r13237 r14054  
    1313   USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre) 
    1414   USE dom_oce , ONLY :   gphit     =>   gphit          !: latitude  of t-point (degre) 
    15 !!st  
     15  
    1616#if ! defined key_qco 
    1717   USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/PISCES/SED/sedrst.F90

    r14049 r14054  
    9494            CALL iom_init( cw_sedrst_cxt, kdid = numrsw, ld_closedef = .FALSE. ) 
    9595#else 
    96                clinfo = 'Can not use XIOS in trc_rst_opn' 
    97                CALL ctl_stop(TRIM(clinfo)) 
     96            CALL ctl_stop( 'Can not use XIOS in trc_rst_opn' ) 
    9897#endif 
    99             ENDIF 
     98         ENDIF 
    10099 
    101100         lrst_sed = .TRUE. 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/TRP/trcatf.F90

    r13295 r14054  
    3232   USE trdtra 
    3333# if defined key_qco 
    34    USE traatfqco 
     34   USE traatf_qco 
    3535# else 
    3636   USE traatf 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/TRP/trctrp.F90

    r12377 r14054  
    2424   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
    2525   USE trcbc           ! Tracers boundary condtions          ( trc_bc routine) 
     26   USE trcais          ! Antarctic Ice Sheet tracers         (trc_ais routine) 
    2627   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
    2728   USE bdy_oce   , ONLY: ln_bdy 
    … …  
    6566         IF( ln_trcbc .AND. lltrcbc .AND. kt /= nit000 )  & 
    6667                                CALL trc_bc     ( kt,      Kmm, tr, Krhs )      ! tracers: surface and lateral Boundary Conditions  
     68         IF( ln_trcais )        CALL trc_ais    ( kt,      Kmm, tr, Krhs )      ! tracers from Antarctic Ice Sheet (icb, isf)                
    6769         IF( ln_trabbl )        CALL trc_bbl    ( kt, Kbb, Kmm, tr, Krhs )      ! advective (and/or diffusive) bottom boundary layer scheme 
    6870         IF( ln_trcdmp )        CALL trc_dmp    ( kt, Kbb, Kmm, tr, Krhs )      ! internal damping trends 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/trc.F90

    r14049 r14054  
    3838   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  trc_o          !: prescribed tracer concentration in ocean for SBC 
    3939   INTEGER             , PUBLIC                            ::  nn_ice_tr      !: handling of sea ice tracers 
     40   INTEGER             , PUBLIC                            ::  nn_ais_tr      !: handling of Antarctic Ice Sheet tracers 
    4041 
    4142   !! interpolated gradient 
    … …  
    6364   LOGICAL             , PUBLIC ::   ln_trcdta          !: Read inputs data from files 
    6465   LOGICAL             , PUBLIC ::   ln_trcbc           !: Enable surface, lateral or open boundaries conditions 
     66   LOGICAL             , PUBLIC ::   ln_trcais          !: Enable Antarctic Ice Sheet nutrient supply 
    6567   LOGICAL             , PUBLIC ::   ln_trcdmp          !: internal damping flag 
    6668   LOGICAL             , PUBLIC ::   ln_trcdmp_clo      !: internal damping flag on closed seas 
    … …  
    9193      LOGICAL           ::   llcbc     ! read in a file or not 
    9294      LOGICAL           ::   llobc     ! read in a file or not 
     95      LOGICAL           ::   llais     ! read in a file or not 
    9396   END TYPE PTRACER 
    9497   ! 
    … …  
    112115   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ln_trc_sbc    !: Use surface boundary condition data 
    113116   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ln_trc_cbc    !: Use coastal boundary condition data 
     117   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ln_trc_ais    !: Use Antarctic Ice Sheet boundary condition data 
    114118   LOGICAL , PUBLIC                                  ::   ln_rnf_ctl    !: remove runoff dilution on tracers 
    115119   REAL(wp), PUBLIC                                  ::   rn_sbc_time   !: Time scaling factor for SBC data (seconds in a day) 
    … …  
    157161         &      ln_trc_ini(jptra)     ,                                                       & 
    158162         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       & 
     163         &      ln_trc_ais(jptra)     ,                                                       & 
    159164         &      STAT = ierr(1)  ) 
    160165      ! 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/trcini.F90

    r13286 r14054  
    2525   USE trcice          ! tracers in sea ice 
    2626   USE trcbc           ! generalized Boundary Conditions 
     27   USE trcais          ! tracers from Antartic Ice Sheet 
    2728  
    2829   IMPLICIT NONE 
    … …  
    166167         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc 
    167168         ln_trc_obc(jn) =       sn_tracer(jn)%llobc 
     169         ln_trc_ais(jn) =       sn_tracer(jn)%llais 
    168170      END DO 
    169171      ! 
    … …  
    188190         WRITE(numout,*) 'trc_init_sms : Summary for selected passive tracers' 
    189191         WRITE(numout,*) '~~~~~~~~~~~~' 
    190          WRITE(numout,*) '    ID     NAME     INI  SBC  CBC  OBC' 
     192         WRITE(numout,*) '    ID     NAME     INI  SBC  CBC  OBC  AIS' 
    191193         DO jn = 1, jptra 
    192             WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn), ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn) 
     194            WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn),ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn),ln_trc_ais(jn) 
    193195         END DO 
    194196      ENDIF 
    … …  
    197199         WRITE(numout,*) ' Applying tracer boundary conditions ' 
    198200      ENDIF 
     201      ! 
     202      IF( lwp .AND. ln_trcais ) THEN 
     203         WRITE(numout,*) 
     204         WRITE(numout,*) ' Applying tracer from Antarctic Ice Sheet ' 
     205      ENDIF 
    199206      
    200 9001  FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2) 
     2079001  FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2,3x,l2) 
    201208      ! 
    202209   END SUBROUTINE trc_ini_sms 
    … …  
    248255      ENDIF 
    249256      ! 
     257      IF( ln_trcais ) CALL trc_ais_ini   ! set tracers from Antarctic Ice Sheet 
    250258      ! 
    251259      IF( ln_rsttr ) THEN              ! restart from a file 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/trcnam.F90

    r12489 r14054  
    136136      !! 
    137137      NAMELIST/namtrc/jp_bgc, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_sf6, ln_c14, & 
    138          &            sn_tracer, ln_trcdta, ln_trcbc, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d 
     138         &            sn_tracer, ln_trcdta, ln_trcbc, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d, & 
     139         &            ln_trcais 
    139140      !!--------------------------------------------------------------------- 
    140141      ! Dummy settings to fill tracers data structure 
    141       !                  !   name   !   title   !   unit   !   init  !   sbc   !   cbc   !   obc  ! 
    142       sn_tracer = PTRACER( 'NONAME' , 'NOTITLE' , 'NOUNIT' , .false. , .false. , .false. , .false.) 
     142      !                  !   name   !   title   !   unit   !   init  !   sbc   !   cbc   !   obc   !   ais   ! 
     143      sn_tracer = PTRACER( 'NONAME' , 'NOTITLE' , 'NOUNIT' , .false. , .false. , .false. , .false. , .false. ) 
    143144      ! 
    144145      IF(lwp) WRITE(numout,*) 
    … …  
    209210         WRITE(numout,*) '      Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
    210211         WRITE(numout,*) '      Enable surface, lateral or open boundaries conditions (y/n)  ln_trcbc  = ', ln_trcbc 
     212         WRITE(numout,*) '      Enable Antarctic Ice Sheet nutrient supply   ln_trcais     = ', ln_trcais 
    211213         WRITE(numout,*) '      Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp 
    212214         WRITE(numout,*) '      Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/trcrst.F90

    r14049 r14054  
    105105            CALL iom_init( cw_toprst_cxt, kdid = numrtw, ld_closedef = .FALSE. ) 
    106106#else 
    107                clinfo = 'Can not use XIOS in trc_rst_opn' 
    108                CALL ctl_stop(TRIM(clinfo)) 
     107            CALL ctl_stop( 'Can not use XIOS in trc_rst_opn' ) 
    109108#endif 
    110             ENDIF 
     109         ENDIF 
    111110         lrst_trc = .TRUE. 
    112111      ENDIF 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/BENCH/EXPREF/namelist_cfg_orca025_like

    r13461 r14054  
    178178!----------------------------------------------------------------------- 
    179179   ln_dynvor_een = .true. !  energy & enstrophy scheme 
    180       nn_een_e3f = 0          ! =0  e3f = mi(mj(e3t))/4  
    181       !                       ! =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
     180   nn_e3f_typ = 0         ! =0  e3f = mi(mj(e3t))/4  
     181   !                      ! =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
    182182/ 
    183183!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/BENCH/EXPREF/namelist_cfg_orca12_like

    r13461 r14054  
    177177!----------------------------------------------------------------------- 
    178178   ln_dynvor_een = .true. !  energy & enstrophy scheme 
    179       nn_een_e3f = 0          ! =0  e3f = mi(mj(e3t))/4  
     179      nn_e3f_typ = 0          ! =0  e3f = mi(mj(e3t))/4  
    180180      !                       ! =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
    181181/ 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/BENCH/MY_SRC/usrdef_istate.F90

    r13295 r14054  
    2626   PRIVATE 
    2727 
    28    PUBLIC   usr_def_istate   ! called by istate.F90 
     28   PUBLIC   usr_def_istate       ! called by istate.F90 
     29   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2930 
    3031   !! * Substitutions 
    … …  
    3738CONTAINS 
    3839   
    39    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     40   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) !!st, pssh ) 
    4041      !!---------------------------------------------------------------------- 
    4142      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    5253      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    5354      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    54       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
     55!!st      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5556      ! 
    5657      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace 
    … …  
    7980      ! 
    8081      ! sea level: 
    81       pssh(:,:) = z2d(:,:)                                                ! +/- 0.05 m 
     82!!st      pssh(:,:) = z2d(:,:)                                                ! +/- 0.05 m 
    8283      ! 
    8384      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    … …  
    9596      pv( :,:,jpk  ) = 0._wp 
    9697      ! 
    97       CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions 
     98!!st      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions 
    9899      CALL lbc_lnk('usrdef_istate',  pts, 'T',  1. )            ! apply boundary conditions 
    99100      CALL lbc_lnk('usrdef_istate',   pu, 'U', -1. )            ! apply boundary conditions 
    … …  
    102103   END SUBROUTINE usr_def_istate 
    103104 
     105 
     106   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     107      !!---------------------------------------------------------------------- 
     108      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     109      !!  
     110      !! ** Purpose :   Initialization of ssh 
     111      !!                Here BENCH configuration  
     112      !! 
     113      !! ** Method  :   Set ssh 
     114      !!---------------------------------------------------------------------- 
     115      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     116      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     117      ! 
     118      INTEGER  ::   ji, jj 
     119      INTEGER  ::   igloi, igloj   ! to be removed in the future, see usr_def_istate comment  
     120      !!---------------------------------------------------------------------- 
     121      ! 
     122      IF(lwp) WRITE(numout,*) 
     123      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh' 
     124      ! 
     125      igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     126      igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 
     127      ! sea level:  +/- 0.05 m 
     128      DO_2D( 0, 0, 0, 0 ) 
     129         pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 
     130      END_2D 
     131      ! 
     132      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions 
     133      ! 
     134   END SUBROUTINE usr_def_istate_ssh 
     135    
    104136   !!====================================================================== 
    105137END MODULE usrdef_istate 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/CANAL/EXPREF/namelist_cfg

    r13558 r14054  
    235235   ln_dynvor_mix = .false.  !  mixed scheme 
    236236   ln_dynvor_een = .false.  !  energy & enstrophy scheme 
    237    ln_dynvor_enT = .false.  !  energy conserving scheme (T-point) 
     237r_enT = .false.  !  energy conserving scheme (T-point) 
    238238   ln_dynvor_eeT = .true.   !  energy conserving scheme (een using e3t) 
    239       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
     239      nn_e3f_typ = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    240240/ 
    241241!----------------------------------------------------------------------- 
    … …  
    319319!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    320320!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    321 <<<<<<< .working 
    322 !!   namflo       float parameters                                      (default: OFF) 
    323 !!   nam_diadct   transports through some sections                      (default: OFF) 
    324 ||||||| .merge-left.r13465 
    325 !!   namflo       float parameters                                      (default: OFF) 
    326 !!   nam_diaharm  Harmonic analysis of tidal constituents               (default: OFF) 
    327 !!   nam_diadct   transports through some sections                      (default: OFF) 
    328 ======= 
    329321!!   namflo       float parameters                                      ("key_float") 
    330322!!   nam_diaharm  Harmonic analysis of tidal constituents               ("key_diaharm") 
    331323!!   namdct       transports through some sections                      ("key_diadct") 
    332324!!   nam_diatmb   Top Middle Bottom Output                              (default: OFF) 
    333 >>>>>>> .merge-right.r13470 
    334325!!   nam_dia25h   25h Mean Output                                       (default: OFF) 
    335326!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/CANAL/MY_SRC/usrdef_istate.F90

    r13472 r14054  
    2626   PRIVATE 
    2727 
    28    PUBLIC   usr_def_istate   ! called by istate.F90 
     28   PUBLIC   usr_def_istate       ! called by istate.F90 
     29   PUBLIC   usr_def_istate_ssh   ! called by sshwzv.F90 
    2930 
    3031   !! * Substitutions 
    … …  
    3738CONTAINS 
    3839   
    39    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     40   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    4041      !!---------------------------------------------------------------------- 
    4142      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    5253      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    5354      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    54       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5555      ! 
    5656      INTEGER  :: ji, jj, jk, jl  ! dummy loop indices 
    … …  
    8787 
    8888      CASE(0)    ! rest 
    89           
    90          ! sea level: 
    91          pssh(:,:) = 0. 
     89         ! 
    9290         ! temperature: 
    9391         pts(:,:,:,jp_tem) = 10._wp 
    … …  
    9997          
    10098      CASE(1)    ! geostrophic zonal jet from -zjety to +zjety 
    101  
    102          ! sea level: 
    103          SELECT CASE( nn_fcase ) 
    104          CASE(0)    ! f = f0 
    105             ! sea level: ssh = - fuy / g 
    106             WHERE( ABS(gphit) <= zjety ) 
    107                pssh(:,:) = - ff_t(:,:) * rn_uzonal * gphit(:,:) * 1.e3 / grav 
    108             ELSEWHERE 
    109                pssh(:,:) = - ff_t(:,:) * rn_uzonal * SIGN(zjety, gphit(:,:)) * 1.e3 / grav 
    110             END WHERE 
    111          CASE(1)    ! f = f0 + beta*y 
    112             ! sea level: ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 
    113             zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
    114             WHERE( ABS(gphit) <= zjety ) 
    115                pssh(:,:) = - rn_uzonal / grav * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    116             ELSEWHERE 
    117                pssh(:,:) = - rn_uzonal / grav * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3   & 
    118                   &                             + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    119             END WHERE 
    120          END SELECT 
     99         ! 
    121100         ! temperature: 
    122101         pts(:,:,:,jp_tem) = 10._wp 
    … …  
    139118         !                   
    140119      CASE(2)    ! geostrophic zonal current shear 
    141        
    142          ! sea level: 
    143          SELECT CASE( nn_fcase ) 
    144          CASE(0)    ! f = f0 
    145             ! sea level: ssh = - fuy / g 
    146             WHERE( ABS(gphit) <= zjety ) 
    147                pssh(:,:) = - ff_t(:,:) * rn_uzonal * ABS(gphit(:,:)) * 1.e3 / grav 
    148             ELSEWHERE 
    149                pssh(:,:) = - ff_t(:,:) * rn_uzonal * zjety * 1.e3 / grav 
    150             END WHERE 
    151          CASE(1)    ! f = f0 + beta*y 
    152             ! sea level: ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 
    153             zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
    154             WHERE( ABS(gphit) <= zjety ) 
    155                pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    156                   &        * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    157             ELSEWHERE 
    158                pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    159                   &        * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    160             END WHERE 
    161          END SELECT 
     120         ! 
    162121         ! temperature: 
    163122         pts(:,:,:,jp_tem) = 10._wp 
    … …  
    176135         !                   
    177136      CASE(3)    ! gaussian zonal currant 
    178  
     137         ! 
    179138         ! zonal current 
    180139         DO jk=1, jpkm1 
    … …  
    182141            pu(:,:,jk) = rn_uzonal * EXP( - 0.5 * gphit(:,:)**2 / rn_lambda**2 ) 
    183142         END DO 
    184           
    185          ! sea level: 
    186          pssh(:,1) = - ff_t(:,1) / grav * pu(:,1,1) * e2t(:,1) 
    187          DO jl=1, jpnj 
    188             DO_2D( 0, 0, 0, 0 ) 
    189                pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj) 
    190             END_2D 
    191             CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
    192          END DO 
    193           
    194143         ! temperature: 
    195144         pts(:,:,:,jp_tem) = 10._wp 
    … …  
    202151         !             
    203152      CASE(4)    ! geostrophic zonal pulse 
    204     
     153         ! 
    205154         DO_2D( 1, 1, 1, 1 ) 
    206155            IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 
    … …  
    210159            ELSE 
    211160               zdu = 0. 
    212             END IF 
     161            ENDIF 
    213162            IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 
    214                pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 
    215163               pu(ji,jj,:) = zdu 
    216164               pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 
    217165            ELSE 
    218                pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav  
    219166               pu(ji,jj,:) = 0. 
    220167               pts(ji,jj,:,jp_sal) = 1. 
    221             END IF 
    222          END_2D 
    223           
     168            ENDIF 
     169         END_2D 
     170         ! 
    224171         ! temperature: 
    225172         pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:)         
    226173         pv(:,:,:) = 0. 
    227           
    228        CASE(5)    ! vortex 
    229                   ! 
     174         ! 
     175      CASE(5)    ! vortex 
     176         ! 
    230177         zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
    231          zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 
     178         zumax = rn_vtxmax * SIGN(1._wp, zf0)  ! Here Anticyclonic: set zumax=-1 for cyclonic 
    232179         zlambda = SQRT(2._wp)*rn_lambda*1.e3       ! Horizontal scale in meters  
    233180         zn2 = 3.e-3**2 
    … …  
    242189            ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 
    243190            zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 
    244             ! Sea level: 
    245             pssh(ji,jj) = 0. 
    246             DO jl=1,5 
    247                zdt = pssh(ji,jj) 
    248                zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH))   ! F'(z) 
    249                zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 
    250                pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1)   ! ssh = Psurf / (Rho*g) 
    251             END DO 
    252191            ! temperature: 
    253192            DO jk=1,jpk 
    … …  
    299238         !             
    300239      END SELECT 
    301        
     240      ! 
     241      CALL lbc_lnk( 'usrdef_istate', pts , 'T',  1. ) 
     242      CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
     243 
     244   END SUBROUTINE usr_def_istate 
     245 
     246   
     247   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     248      !!---------------------------------------------------------------------- 
     249      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     250      !!  
     251      !! ** Purpose :   Initialization of the dynamics and tracers 
     252      !!                Here CANAL configuration  
     253      !! 
     254      !! ** Method  :   Set ssh  
     255      !!---------------------------------------------------------------------- 
     256      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m] 
     257      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
     258      ! 
     259      INTEGER  :: ji, jj, jk, jl  ! dummy loop indices 
     260      REAL(wp) :: zx, zy, zP0, zumax, zlambda, zr_lambda2, zn2, zf0, zH, zrho1, za, zf, zdzF 
     261      REAL(wp) :: zpsurf, zdyPs, zdxPs 
     262      REAL(wp) :: zdt, zdu, zdv 
     263      REAL(wp) :: zjetx, zjety, zbeta 
     264      REAL(wp), DIMENSION(jpi,jpj)  ::   zrandom 
     265      !!---------------------------------------------------------------------- 
     266      ! 
     267      IF(lwp) WRITE(numout,*) 
     268      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : CANAL configuration, analytical definition of initial state' 
     269      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
     270      ! 
     271      IF (ln_sshnoise) CALL RANDOM_NUMBER(zrandom) 
     272      zjetx = ABS(rn_ujetszx)/2. 
     273      zjety = ABS(rn_ujetszy)/2. 
     274      ! 
     275      SELECT CASE(nn_initcase) 
     276      CASE(0)                      !==   rest  ==! 
     277         ! 
     278         pssh(:,:) = 0. 
     279         ! 
     280      CASE(1)                      !==  geostrophic zonal jet from -zjety to +zjety  ==! 
     281         ! 
     282         SELECT CASE( nn_fcase ) 
     283         CASE(0)                          !* f = f0 : ssh = - fuy / g 
     284            WHERE( ABS(gphit) <= zjety ) 
     285               pssh(:,:) = - ff_t(:,:) * rn_uzonal * gphit(:,:) * 1.e3 / grav 
     286            ELSEWHERE 
     287               pssh(:,:) = - ff_t(:,:) * rn_uzonal * SIGN(zjety, gphit(:,:)) * 1.e3 / grav 
     288            END WHERE 
     289         CASE(1)                          !* f = f0 + beta*y : ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 
     290            zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
     291            WHERE( ABS(gphit) <= zjety ) 
     292               pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     293            ELSEWHERE 
     294               pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3   & 
     295                  &                             + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
     296            END WHERE 
     297         END SELECT 
     298         !                   
     299      CASE(2)                      !==  geostrophic zonal current shear  ==! 
     300         ! 
     301         SELECT CASE( nn_fcase ) 
     302         CASE(0)                          !* f = f0 : ssh = - fuy / g 
     303            WHERE( ABS(gphit) <= zjety ) 
     304               pssh(:,:) = - ff_t(:,:) * rn_uzonal * ABS(gphit(:,:)) * 1.e3 / grav 
     305            ELSEWHERE 
     306               pssh(:,:) = - ff_t(:,:) * rn_uzonal * zjety * 1.e3 / grav 
     307            END WHERE 
     308         CASE(1)                          !* f = f0 + beta*y : ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 
     309            zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
     310            WHERE( ABS(gphit) <= zjety ) 
     311               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
     312                  &        * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     313            ELSEWHERE 
     314               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
     315                  &        * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
     316            END WHERE 
     317         END SELECT 
     318         !                   
     319      CASE(3)                      !==  gaussian zonal currant  ==! 
     320         ! 
     321         pssh(:,1) = - ff_t(:,1) / grav * e2t(:,1) * rn_uzonal * EXP( - 0.5 * gphit(:,1)**2 / rn_lambda**2 ) 
     322         DO jl=1, jpnj 
     323            DO_2D( 0, 0, 0, 0 ) 
     324               pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * rn_uzonal * EXP( - 0.5 * gphit(ji,jj)**2 / rn_lambda**2 ) * e2t(ji,jj) 
     325            END_2D 
     326            CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T',  1. ) 
     327         END DO 
     328         !             
     329      CASE(4)                      !==  geostrophic zonal pulse !!st need to implement a way to separate ssh properly  ==! 
     330         ! 
     331         DO_2D( 1, 1, 1, 1 ) 
     332            IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 
     333               zdu = rn_uzonal 
     334            ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 
     335               zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 
     336            ELSE 
     337               zdu = 0. 
     338            ENDIF 
     339            IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 
     340               pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 
     341            ELSE 
     342               pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav  
     343            ENDIF 
     344         END_2D 
     345         ! 
     346      CASE(5)                    !==  vortex  ==! 
     347         ! 
     348         zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
     349         zumax = rn_vtxmax * SIGN(1._wp, zf0)   ! Here Anticyclonic: set zumax=-1 for cyclonic 
     350         zlambda = SQRT(2._wp)*rn_lambda        ! Horizontal scale in meters  
     351         zn2 = 3.e-3**2 
     352         zH = 0.5_wp * 5000._wp 
     353         ! 
     354         zr_lambda2 = 1._wp / zlambda**2 
     355         zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 
     356         ! 
     357         DO_2D( 1, 1, 1, 1 ) 
     358            zx = glamt(ji,jj) * 1.e3 
     359            zy = gphit(ji,jj) * 1.e3 
     360            !                                   ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 
     361            zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 
     362            pssh(ji,jj) = 0. 
     363            DO jl=1,5 
     364               zdt = pssh(ji,jj) 
     365               zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH))   ! F'(z) 
     366               zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 
     367               pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1)   ! ssh = Psurf / (Rho*g) 
     368            END DO 
     369         END_2D 
     370         !             
     371      END SELECT 
     372      !                          !==  add noise  ==! 
    302373      IF (ln_sshnoise) THEN 
    303374         CALL RANDOM_SEED() 
    304375         CALL RANDOM_NUMBER(zrandom) 
    305376         pssh(:,:) = pssh(:,:) + ( 0.1  * zrandom(:,:) - 0.05 ) 
    306       END IF 
    307       CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
    308       CALL lbc_lnk( 'usrdef_istate', pts , 'T',  1. ) 
    309       CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
    310  
    311    END SUBROUTINE usr_def_istate 
    312  
     377      ENDIF 
     378      CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T',  1. ) 
     379      ! 
     380   END SUBROUTINE usr_def_istate_ssh 
     381    
    313382   !!====================================================================== 
    314383END MODULE usrdef_istate 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/CPL_OASIS/EXPREF/namelist_cfg

    r13558 r14054  
    367367!----------------------------------------------------------------------- 
    368368   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    369       nn_een_e3f = 0          ! =0   e3f = mean masked e3t divided by 4 
    370369/ 
    371370!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/ISOMIP+/MY_SRC/istate.F90

    r13583 r14054  
    117117            CALL dta_tsd( nit000, 'ini', ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000 
    118118            ! 
    119             ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
    120             uu  (:,:,:,Kbb) = 0._wp 
    121             vv  (:,:,:,Kbb) = 0._wp   
     119            uu (:,:,:,Kbb) = 0._wp 
     120            vv (:,:,:,Kbb) = 0._wp 
    122121            ! 
    123             IF( ll_wd ) THEN 
    124                ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
    125                ! 
    126                ! Apply minimum wetdepth criterion 
    127                ! 
    128                DO_2D( 1, 1, 1, 1 ) 
    129                   IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
    130                      ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    131                   ENDIF 
    132                END_2D 
    133             ENDIF  
    134              ! 
    135122         ELSE                                 ! user defined initial T and S 
    136123            DO jk = 1, jpk 
    137124               zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 
    138125            END DO 
    139             CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
     126            CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb)  )          
    140127         ENDIF 
    141128         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    142          ssh (:,:,Kmm)     = ssh(:,:,Kbb)    
    143129         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    144130         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/ISOMIP/MY_SRC/usrdef_istate.F90

    r10074 r14054  
    99   !! History :  NEMO ! 2016-11 (S. Flavoni)             Original code 
    1010   !!                 ! 2017-02 (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case 
     11   !!                 ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    2425   PRIVATE 
    2526 
    26    PUBLIC   usr_def_istate   ! called by istate.F90 
     27   PUBLIC   usr_def_istate       ! called by istate.F90 
     28   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2729 
    2830   !!---------------------------------------------------------------------- 
    … …  
    3335CONTAINS 
    3436   
    35    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     37   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3638      !!---------------------------------------------------------------------- 
    3739      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4850      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    4951      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    50       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    51       ! 
    52       INTEGER  ::   jk     ! dummy loop indices 
    5352      !!---------------------------------------------------------------------- 
    5453      ! 
    … …  
    5857      pu  (:,:,:) = 0._wp        ! ocean at rest 
    5958      pv  (:,:,:) = 0._wp 
    60       pssh(:,:)   = 0._wp 
    61       ! 
    6259      !                          ! T & S profiles 
    6360      pts(:,:,:,jp_tem) = - 1.9 * ptmask(:,:,:)          ! ISOMIP configuration : start from constant T+S fields 
    … …  
    6663   END SUBROUTINE usr_def_istate 
    6764 
     65 
     66   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     67      !!---------------------------------------------------------------------- 
     68      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     69      !!  
     70      !! ** Purpose :   Initialization of ssh 
     71      !!                Here ISOMIP configuration  
     72      !! 
     73      !! ** Method  :   set ssh to 0 
     74      !!---------------------------------------------------------------------- 
     75      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     76      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     77      !!---------------------------------------------------------------------- 
     78      ! 
     79      IF(lwp) WRITE(numout,*) 
     80      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : ISOMIP configuration, analytical definition of initial state' 
     81      ! 
     82      pssh(:,:)   = 0._wp 
     83      ! 
     84   END SUBROUTINE usr_def_istate_ssh 
     85 
    6886   !!====================================================================== 
    6987END MODULE usrdef_istate 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg

    r13558 r14054  
    201201   ln_dynvor_mix = .false. !  mixed scheme 
    202202   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    203       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    204203/ 
    205204!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ens_cfg

    r13476 r14054  
    129129   ln_dynvor_mix = .false. !  mixed scheme 
    130130   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    131       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    132131/ 
    133132!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/LOCK_EXCHANGE/MY_SRC/usrdef_istate.F90

    r12489 r14054  
    88   !!====================================================================== 
    99   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2324   PRIVATE 
    2425 
    25    PUBLIC   usr_def_istate   ! called by istate.F90 
     26   PUBLIC   usr_def_istate       ! called by istate.F90 
     27   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2628 
    2729   !!---------------------------------------------------------------------- 
    … …  
    3234CONTAINS 
    3335   
    34    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     36   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3537      !!---------------------------------------------------------------------- 
    3638      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4749      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    4850      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    49       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5051      ! 
    5152      INTEGER  ::   jk     ! dummy loop indices 
    … …  
    6566      pu  (:,:,:) = 0._wp        ! ocean at rest 
    6667      pv  (:,:,:) = 0._wp 
    67       pssh(:,:)   = 0._wp 
    6868      ! 
    6969      !                          ! T & S profiles 
    … …  
    7878   END SUBROUTINE usr_def_istate 
    7979 
     80 
     81   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     82      !!---------------------------------------------------------------------- 
     83      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     84      !!  
     85      !! ** Purpose :   Initialization of ssh 
     86      !!                Here LOCK_EXCHANGE configuration  
     87      !! 
     88      !! ** Method  :   set ssh to 0 
     89      !!---------------------------------------------------------------------- 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     91      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     92      !!---------------------------------------------------------------------- 
     93      ! 
     94      IF(lwp) WRITE(numout,*) 
     95      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : LOCK_EXCHANGE configuration, analytical definition of initial state' 
     96      ! 
     97      pssh(:,:)   = 0._wp 
     98      ! 
     99   END SUBROUTINE usr_def_istate_ssh 
     100 
    80101   !!====================================================================== 
    81102END MODULE usrdef_istate 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_cen-ahm1000_cfg

    r13558 r14054  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_ubs_cfg

    r13558 r14054  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_cen-ahm1000_cfg

    r13558 r14054  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_ubs_cfg

    r13558 r14054  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_zps_FCT2_flux_ubs_cfg

    r13558 r14054  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_flux_ubs_cfg

    r13558 r14054  
    201201   ln_dynvor_mix = .false. !  mixed scheme 
    202202   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    203       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    204203/ 
    205204!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_vect_een_cfg

    r13558 r14054  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .true. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/MY_SRC/usrdef_istate.F90

    r12489 r14054  
    88   !!============================================================================== 
    99   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2324   PRIVATE 
    2425 
    25    PUBLIC   usr_def_istate   ! called by istate.F90 
    26  
     26   PUBLIC   usr_def_istate       ! called by istate.F90 
     27   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
     28    
    2729   !!---------------------------------------------------------------------- 
    2830   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    3234CONTAINS 
    3335   
    34    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     36   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3537      !!---------------------------------------------------------------------- 
    3638      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4749      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    4850      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    49       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5051      ! 
    5152      INTEGER  ::   jk     ! dummy loop indices 
    … …  
    6566      pu  (:,:,:) = 0._wp        ! ocean at rest 
    6667      pv  (:,:,:) = 0._wp 
    67       pssh(:,:)   = 0._wp 
    6868      ! 
    6969      !                          ! T & S profiles 
    … …  
    7878   END SUBROUTINE usr_def_istate 
    7979 
     80 
     81   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     82      !!---------------------------------------------------------------------- 
     83      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     84      !!  
     85      !! ** Purpose :   Initialization of the ssh 
     86      !!                Here  OVERFLOW configuration  
     87      !! 
     88      !! ** Method  :   set ssh to 0 
     89      !!---------------------------------------------------------------------- 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     91      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     92      !!---------------------------------------------------------------------- 
     93      ! 
     94      IF(lwp) WRITE(numout,*) 
     95      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : OVERFLOW configuration, analytical definition of initial state' 
     96      ! 
     97      pssh(:,:)   = 0._wp 
     98      ! 
     99   END SUBROUTINE usr_def_istate_ssh 
     100 
    80101   !!====================================================================== 
    81102END MODULE usrdef_istate 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90

    r13295 r14054  
    193193            pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
    194194            pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) 
     195            pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1)            ! st caution ik > 1 
    195196         END_2D          
    196197         !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/VORTEX/EXPREF/1_namelist_cfg

    r13558 r14054  
    195195   ln_dynvor_mix = .false. !  mixed scheme 
    196196   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    197       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    198197/ 
    199198!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/VORTEX/EXPREF/namelist_cfg

    r13558 r14054  
    188188   ln_dynvor_mix = .false. !  mixed scheme 
    189189   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    190       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    191190/ 
    192191!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/VORTEX/MY_SRC/usrdef_istate.F90

    r13295 r14054  
    88   !!====================================================================== 
    99   !! History :  NEMO ! 2017-11  (J. Chanut) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2627   PRIVATE 
    2728 
    28    PUBLIC   usr_def_istate   ! called by istate.F90 
     29   PUBLIC   usr_def_istate       ! called by istate.F90 
     30   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2931 
    3032   !! * Substitutions 
    … …  
    3739CONTAINS 
    3840   
    39    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     41   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    4042      !!---------------------------------------------------------------------- 
    4143      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    5254      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    5355      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    54       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5556      ! 
    5657      INTEGER  :: ji, jj, jk  ! dummy loop indices 
    … …  
    6768      zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
    6869      zumax = 1._wp * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 
    69       zlambda = SQRT(2._wp)*60.e3      ! Horizontal scale in meters  
     70      zlambda = SQRT(2._wp)*60.e3      ! Horizontal scale in meters 
    7071      zn2 = 3.e-3**2 
    7172      zH = 0.5_wp * 5000._wp 
    7273      ! 
    7374      zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 
    74       ! 
    75       ! Sea level: 
    76       za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH))) 
    77       DO_2D( 1, 1, 1, 1 ) 
    78          zx = glamt(ji,jj) * 1.e3 
    79          zy = gphit(ji,jj) * 1.e3 
    80          zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 
    81          pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 
    82       END_2D 
    8375      ! 
    8476      ! temperature:          
    … …  
    134126   END SUBROUTINE usr_def_istate 
    135127 
     128 
     129   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     130      !!---------------------------------------------------------------------- 
     131      !!                   ***  ROUTINE usr_def_istate  *** 
     132      !!  
     133      !! ** Purpose :   Initialization of ssh 
     134      !!                Here VORTEX configuration  
     135      !! 
     136      !! ** Method  :   Set ssh according to a gaussian anomaly of pressure and associated 
     137      !!                geostrophic velocities 
     138      !!---------------------------------------------------------------------- 
     139      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     140      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     141      ! 
     142      INTEGER  :: ji, jj ! dummy loop indices 
     143      REAL(wp) :: zx, zy, zP0, zumax, zlambda, zf0, zH, zrho1, za 
     144      !!---------------------------------------------------------------------- 
     145      ! 
     146      IF(lwp) WRITE(numout,*) 
     147      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : VORTEX configuration, analytical definition of initial state' 
     148      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
     149      ! 
     150      ! 
     151      ! 
     152      zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
     153      zumax = 1._wp * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 
     154      zlambda = SQRT(2._wp)*60.e3      ! Horizontal scale in meters  
     155      zH = 0.5_wp * 5000._wp 
     156      ! 
     157      zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 
     158      ! 
     159      ! Sea level: 
     160      za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH))) 
     161      DO_2D( 1, 1, 1, 1 ) 
     162         zx = glamt(ji,jj) * 1.e3 
     163         zy = gphit(ji,jj) * 1.e3 
     164         zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 
     165         pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 
     166      END_2D 
     167       
     168   END SUBROUTINE usr_def_istate_ssh 
     169 
    136170   !!====================================================================== 
    137171END MODULE usrdef_istate 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/VORTEX/cpp_VORTEX.fcm

    r12208 r14054  
    1  bld::tool::fppkeys key_iomput key_mpp_mpi key_agrif 
     1 bld::tool::fppkeys key_iomput key_mpp_mpi key_agrif  

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/WAD/EXPREF/namelist_cfg

    r13558 r14054  
    330330   ln_dynvor_mix = .false. !  mixed scheme 
    331331   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    332       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    333332/ 
    334333!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/WAD/MY_SRC/usrdef_istate.F90

    r13295 r14054  
    77   !! User defined : set the initial state of a user configuration 
    88   !!====================================================================== 
    9    !! History :  4.0 ! 2016-03  (S. Flavoni) Original code 
     9   !! History :  4.0  ! 2016-03  (S. Flavoni) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2425   PRIVATE 
    2526 
    26    PUBLIC   usr_def_istate   ! called in istate.F90 
     27   PUBLIC   usr_def_istate       ! called in istate.F90 
     28   PUBLIC   usr_def_istate_ssh   ! called in sshwzv.F90 
    2729 
    2830   !! * Substitutions 
    … …  
    3436   !!---------------------------------------------------------------------- 
    3537CONTAINS 
    36    
    37    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     38 
     39 
     40   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3841      !!---------------------------------------------------------------------- 
    3942      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4245      !!                Here WAD_TEST_CASES configuration  
    4346      !! 
    44       !! ** Method  : - set temprature field 
     47q      !! ** Method  : - set temprature field 
    4548      !!              - set salinity   field 
    4649      !!---------------------------------------------------------------------- 
    … …  
    5053      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    5154      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    52       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5355      INTEGER  ::   ji, jj            ! dummy loop indices 
    5456      REAL(wp) ::   zi, zj 
    … …  
    6668      pu  (:,:,:) = 0._wp        ! ocean at rest 
    6769      pv  (:,:,:) = 0._wp 
    68       pssh(:,:)   = 0._wp 
    69       ! 
    7070      !                          ! T & S profiles 
    7171      pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:) 
    … …  
    8383         CASE ( 1 )                               ! WAD 1 configuration 
    8484            !                                     ! ==================== 
    85             ! 
    8685            IF(lwp) WRITE(numout,*) 
    8786            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 
    8887            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    89             ! 
    90             do ji = 1,jpi 
    91              pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
    92             end do 
    9388            !                                     ! ==================== 
    9489         CASE ( 2, 8 )                            ! WAD 2 configuration 
    9590            !                                     ! ==================== 
    96             ! 
    9791            IF(lwp) WRITE(numout,*) 
    9892            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 
    9993            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    100             ! 
    101             do ji = 1,jpi 
    102              pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
    103             end do 
    10494            !                                     ! ==================== 
    10595         CASE ( 3 )                               ! WAD 3 configuration 
    10696            !                                     ! ==================== 
    107             ! 
    10897            IF(lwp) WRITE(numout,*) 
    10998            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope'  
    11099            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    111             ! 
    112             do ji = 1,jpi 
    113              pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
    114             end do 
     100            !                                     ! ==================== 
     101         CASE ( 4 )                               ! WAD 4 configuration 
     102            !                                     ! ==================== 
     103            IF(lwp) WRITE(numout,*) 
     104            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic bowl, mid-range initial ssh slope'  
     105            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     106            !                                    ! =========================== 
     107         CASE ( 5, 7 )                           ! WAD 5 and 7 configurations 
     108            !                                    ! =========================== 
     109            IF(lwp) WRITE(numout,*) 
     110            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Double slope with shelf' 
     111            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     112            !                                     ! ==================== 
     113         CASE ( 6 )                               ! WAD 6 configuration 
     114            !                                     ! ==================== 
     115            IF(lwp) WRITE(numout,*) 
     116            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge'  
     117            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     118            ! 
     119            DO ji = mi0(jpiglo/2), mi0(jpiglo) 
     120               pts(ji,:,:,jp_sal) = 30._wp 
     121            END DO 
     122            ! 
     123            ! 
     124            !                                    ! =========================== 
     125         CASE DEFAULT                            ! NONE existing configuration 
     126            !                                    ! =========================== 
     127            WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded' 
     128            ! 
     129            CALL ctl_stop( ctmp1 ) 
     130            ! 
     131      END SELECT 
     132      ! 
     133   END SUBROUTINE usr_def_istate 
     134 
     135      
     136   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     137      !!---------------------------------------------------------------------- 
     138      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     139      !!  
     140      !! ** Purpose :   Initialization of the dynamics and tracers 
     141      !!                Here WAD_TEST_CASES configuration  
     142      !! 
     143      !! ** Method  : - set ssh 
     144      !!---------------------------------------------------------------------- 
     145      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m] 
     146      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
     147      INTEGER  ::   ji, jj            ! dummy loop indices 
     148      REAL(wp) ::   zi, zj 
     149      ! 
     150      INTEGER  ::   jk     ! dummy loop indices 
     151      REAL(wp) ::   zdam   ! location of dam [Km] 
     152      !!---------------------------------------------------------------------- 
     153      ! 
     154      ! 
     155      SELECT CASE ( nn_cfg )  
     156         !                                        ! ==================== 
     157         CASE ( 1 )                               ! WAD 1 configuration 
     158            !                                     ! ==================== 
     159            ! 
     160            IF(lwp) WRITE(numout,*) 
     161            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 
     162            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     163            ! 
     164            DO ji = 1,jpi 
     165               pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
     166            END DO 
     167            !                                     ! ==================== 
     168         CASE ( 2, 8 )                            ! WAD 2 configuration 
     169            !                                     ! ==================== 
     170            ! 
     171            IF(lwp) WRITE(numout,*) 
     172            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 
     173            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     174            ! 
     175            DO ji = 1,jpi 
     176               pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
     177            END DO 
     178            !                                     ! ==================== 
     179         CASE ( 3 )                               ! WAD 3 configuration 
     180            !                                     ! ==================== 
     181            ! 
     182            IF(lwp) WRITE(numout,*) 
     183            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope'  
     184            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     185            ! 
     186            DO ji = 1,jpi 
     187               pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
     188            END DO 
    115189 
    116190            ! 
    … …  
    140214            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    141215            ! 
    142             do ji = 1,jpi 
    143              pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
    144             end do 
     216            DO ji = 1,jpi 
     217               pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
     218            END DO 
    145219 
    146220            ! 
    … …  
    153227            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    154228            ! 
    155             do ji = 1,jpi 
    156              pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 
    157             end do 
    158             ! 
    159             do ji = mi0(jpiglo/2), mi0(jpiglo) 
    160              pts(ji,:,:,jp_sal) = 30._wp 
    161              pssh(ji,:) = -0.1*ptmask(ji,:,1) 
    162             end do 
     229            DO ji = 1,jpi 
     230               pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 
     231            END DO 
     232            ! 
     233            DO ji = mi0(jpiglo/2), mi0(jpiglo) 
     234               pssh(ji,:) = -0.1*ptmask(ji,:,1) 
     235            END DO 
    163236            ! 
    164237            ! 
    … …  
    182255      END_2D 
    183256      ! 
    184    END SUBROUTINE usr_def_istate 
     257   END SUBROUTINE usr_def_istate_ssh 
    185258 
    186259   !!====================================================================== 

  • NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/demo_cfgs.txt

    r14049 r14054  
    1212STATION_ASF OCE 
    1313CPL_OASIS  OCE TOP ICE NST 
     14SWG OCE SWE 
    1415C1D_ASICS OCE 
    1516ICE_RHEO OCE SAS ICE 
Note: See TracChangeset for help on using the changeset viewer.