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

Changeset 14050


Ignore:
Timestamp:
2020-12-03T13:51:53+01:00 (3 years ago)
Author:
techene
Message:

#2385 branch updated with trunk 14033 sette test ok except ORCA2_ICE_OBS + changes the results

Location:
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3
Files:
68 edited
7 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3

    • Property svn:externals

      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette_MPI3_LoopFusion@13943         sette 
         10^/utils/CI/sette_wave@13990         sette 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r13998 r14050  
    9090   !                       !    =2 annual global mean of e-p-r set to zero 
    9191   ln_wave     = .false.   !  Activate coupling with wave  (T => fill namsbc_wave) 
    92    ln_cdgw     = .false.   !  Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave) 
    93    ln_sdw      = .false.   !  Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave)  
    94    nn_sdrift   =  0        !  Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift 
    95       !                    !   = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 
    96       !                    !   = 1 Phillips:                      v_z=v_o*[exp(2*k*z)-beta*sqrt(-2*k*pi*z)*erfc(sqrt(-2*k*z))] 
    97       !                    !   = 2 Phillips as (1) but using the wave frequency from a wave model 
    98    ln_tauwoc   = .false.   !  Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave) 
    99    ln_tauw     = .false.   !  Activate ocean stress components from wave model 
    100    ln_stcor    = .false.   !  Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave) 
    10192/ 
    10293!----------------------------------------------------------------------- 
    … …  
    167158&namsbc_wave   ! External fields from wave model                        (ln_wave=T) 
    168159!----------------------------------------------------------------------- 
     160   ln_sdw      = .false.    !  get the 2D Surf Stokes Drift & Compute the 3D stokes drift 
     161   ln_stcor    = .false.    !  add Stokes Coriolis and tracer advection terms 
     162   ln_cdgw     = .false.    !  Neutral drag coefficient read from wave model 
     163   ln_tauoc    = .false.    !  ocean stress is modified by wave induced stress 
     164   ln_wave_test= .false.    !  Test case with constant wave fields 
     165! 
     166   ln_charn    = .false.     !  Charnock coefficient read from wave model (IFS only) 
     167   ln_taw      = .false.     !  ocean stress is modified by wave induced stress (coupled mode) 
     168   ln_phioc    = .false.     !  TKE flux from wave model 
     169   ln_bern_srfc= .false.     ! wave induced pressure. Bernoulli head J term 
     170   ln_breivikFV_2016 = .false. ! breivik 2016 vertical stokes profile 
     171   ln_vortex_force = .false. 
     172! 
     173   cn_dir      = './'      !  root directory for the waves data location 
     174   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
     175   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
     176   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
     177   sn_cdg      =  'sdw_ecwaves_orca2'    ,        6.         , 'drag_coeff' ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     178   sn_usd      =  'sdw_ecwaves_orca2'    ,        6.         , 'u_sd2d'     ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     179   sn_vsd      =  'sdw_ecwaves_orca2'    ,        6.         , 'v_sd2d'     ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     180   sn_hsw      =  'sdw_ecwaves_orca2'    ,        6.         , 'hs'         ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     181   sn_wmp      =  'sdw_ecwaves_orca2'    ,        6.         , 'wmp'        ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     182   sn_wnum     =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_num'   ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    169183/ 
    170184!----------------------------------------------------------------------- 
    … …  
    377391      !                       !        = 2 add a tke source just at the base of the ML 
    378392      !                       !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
     393      ln_mxhsw    = .false.   !  surface mixing length scale = F(wave height) 
    379394/ 
    380395!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_top_cfg

    r12845 r14050  
    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_r13327_KERNEL-06_2_techene_e3/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_top_cfg

    r12845 r14050  
    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_r13327_KERNEL-06_2_techene_e3/cfgs/SHARED/field_def_nemo-ice.xml

    r13998 r14050  
    5151          <field id="icehlid"      long_name="melt pond lid depth"                                     standard_name="sea_ice_meltpondlid_depth"                 unit="m" />  
    5252          <field id="icevlid"      long_name="melt pond lid volume"                                    standard_name="sea_ice_meltpondlid_volume"                unit="m" />  
     53          <field id="dvpn_mlt"     long_name="pond volume tendency due to surface melt"                standard_name="sea_ice_pondvolume_tendency_melt"          unit="kg/m2/s" /> 
     54          <field id="dvpn_lid"     long_name="pond volume tendency due to exchanges with lid"          standard_name="sea_ice_pondvolume_tendency_lids"          unit="kg/m2/s" /> 
     55          <field id="dvpn_rnf"     long_name="pond volume tendency due to runoff"                      standard_name="sea_ice_pondvolume_tendency_runoff"        unit="kg/m2/s" /> 
     56          <field id="dvpn_drn"     long_name="pond volume tendency due to drainage"                    standard_name="sea_ice_pondvolume_tendency_drainage"      unit="kg/m2/s" />   
    5357      
    5458     <!-- heat --> 
    … …  
    7781          <field id="sig1_pnorm"   long_name="P-normalized 1st principal stress component"                                                                       unit=""     /> 
    7882          <field id="sig2_pnorm"   long_name="P-normalized 2nd principal stress component"                                                                       unit=""     /> 
     83          <field id="icedlt"       long_name="delta"                                                   standard_name="delta"                                     unit=""     /> 
    7984          <field id="normstr"      long_name="Average normal stress in sea ice"                        standard_name="average_normal_stress"                     unit="N/m"  /> 
    8085          <field id="sheastr"      long_name="Maximum shear stress in sea ice"                         standard_name="maximum_shear_stress"                      unit="N/m"  /> 
    … …  
    8287          <field id="icediv"       long_name="Divergence of the sea-ice velocity field"                standard_name="divergence_of_sea_ice_velocity"            unit="s-1"  /> 
    8388          <field id="iceshe"       long_name="Maximum shear of sea-ice velocity field"                 standard_name="maximum_shear_of_sea_ice_velocity"         unit="s-1"  /> 
     89          <field id="aniso"        long_name="anisotropy of sea ice floe orientation (0.5 - 1)"        standard_name="anisotropy"                                unit=""     /> 
     90          <field id="yield11"      long_name="yield surface tensor component 11"                       standard_name="yield11"                                   unit="N/m"  /> 
     91          <field id="yield22"      long_name="yield surface tensor component 22"                       standard_name="yield22"                                   unit="N/m"  /> 
     92          <field id="yield12"      long_name="yield surface tensor component 12"                       standard_name="yield12"                                   unit="N/m"  /> 
    8493          <field id="beta_evp"     long_name="Relaxation parameter of ice rheology (beta)"             standard_name="relaxation_parameter_of_ice_rheology"      unit=""  />    
    8594  
    … …  
    297306          <field id="snwtemp_cat"  long_name="Snow temperature per category"                     unit="degC"    detect_missing_value="true" /> 
    298307          <field id="icettop_cat"  long_name="Ice/snow surface temperature per category"         unit="degC"    detect_missing_value="true" /> 
    299           <field id="iceapnd_cat"  long_name="Ice melt pond concentration per category"          unit=""        />  
     308          <field id="iceapnd_cat"  long_name="Ice melt pond grid fraction per category"          unit=""        />  
     309          <field id="icevpnd_cat"  long_name="Ice melt pond volume per grid area per category"   unit="m"       />   
    300310          <field id="icehpnd_cat"  long_name="Ice melt pond thickness per category"              unit="m"       detect_missing_value="true" />  
    301311          <field id="icehlid_cat"  long_name="Ice melt pond lid thickness per category"          unit="m"       detect_missing_value="true" />  
    302           <field id="iceafpnd_cat" long_name="Ice melt pond fraction per category"               unit=""        />  
     312          <field id="iceafpnd_cat" long_name="Ice melt pond ice fraction per category"           unit=""        />  
    303313          <field id="iceaepnd_cat" long_name="Ice melt pond effective fraction per category"     unit=""        />  
    304314          <field id="icemask_cat"  long_name="Fraction of time step with sea ice (per category)" unit=""        /> 
    … …  
    405415     <field field_ref="sig1_pnorm"       name="sig1_pnorm"/> 
    406416     <field field_ref="sig2_pnorm"       name="sig2_pnorm"/> 
     417     <field field_ref="icedlt"           name="sidelta" /> 
    407418      
    408419     <!-- heat fluxes --> 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/cfgs/SHARED/field_def_nemo-oce.xml

    r13998 r14050  
    235235        <field id="cfl_cw"       long_name="w-courant number"   unit="#" /> 
    236236 
     237        <!-- variables available with ln_zdfmfc=.true. --> 
     238         <field id="mf_Tp"       long_name="plume_temperature"      standard_name="plume_temperature"     unit="degC"   grid_ref="grid_T_3D" /> 
     239         <field id="mf_Sp"       long_name="plume_salinity"         standard_name="plume_salinity"        unit="1e-3"   grid_ref="grid_T_3D" /> 
     240         <field id="mf_mf"       long_name="mass flux"              standard_name="mf_mass_flux"          unit="m"      grid_ref="grid_T_3D" /> 
     241 
    237242      </field_group> <!-- grid_T --> 
    238243 
    … …  
    652657   <field id="avm_evd"      long_name="convective enhancement of vertical viscosity"   standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" /> 
    653658 
     659        <!-- mf_app and mf_wp: available with ln_zdfmfc --> 
     660         <field id="mf_app"      long_name="convective area"        standard_name="mf_convective_area"    unit="%"      grid_ref="grid_W_3D" /> 
     661         <field id="mf_wp"       long_name="convective velocity"    standard_name="mf_convective_velo"    unit="m/s"    grid_ref="grid_W_3D" /> 
     662 
     663 
    654664        <!-- avt_tide: available with ln_zdfiwm=T --> 
    655665        <field id="av_ratio"     long_name="S over T diffusivity ratio"                     standard_name="salinity_over_temperature_diffusivity_ratio"                     unit="1"    /> 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/cfgs/SHARED/namelist_ice_ref

    r13998 r14050  
    2424   jpl              =   5             !  number of ice  categories 
    2525   nlay_i           =   2             !  number of ice  layers 
    26    nlay_s           =   1             !  number of snow layers (only 1 is working) 
     26   nlay_s           =   2             !  number of snow layers 
    2727   ln_virtual_itd   =   .false.       !  virtual ITD mono-category parameterization (jpl=1 only) 
    2828                                      !     i.e. enhanced thermal conductivity & virtual thin ice melting 
    … …  
    6262      rn_lf_relax   =   1.e-5         !        relaxation time scale to reach static friction [s-1] 
    6363      rn_lf_tensile =   0.05          !        isotropic tensile strength [0-0.5??] 
     64 
     65   cn_dir           = './'      !  root directory for the grounded icebergs mask data location 
     66   !___________!________________!___________________!___________!_____________!________!___________!__________!__________!_______________! 
     67   !           !  file name     ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     68   !           !                !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' ! filename ! pairing  !    filename   ! 
     69   sn_icbmsk       = 'NOT USED' ,       -12.        , 'icb_mask',   .false.   , .true. , 'yearly'  , ''       , ''       , '' 
    6470/ 
    6571!------------------------------------------------------------------------------ 
    … …  
    9298!------------------------------------------------------------------------------ 
    9399   ln_rhg_EVP       = .true.          !  EVP rheology 
     100   ln_rhg_EAP       = .false.         !  EAP rheology 
    94101      ln_aEVP       = .true.          !     adaptive rheology (Kimmritz et al. 2016 & 2017) 
    95102      rn_creepl     =   2.0e-9        !     creep limit [1/s] 
    … …  
    98105      rn_relast     =   0.333         !     ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
    99106                                      !        advised value: 1/3 (nn_nevp=100) or 1/9 (nn_nevp=300) 
    100    nn_rhg_chkcvg    =   0             !  check convergence of rheology 
     107      nn_rhg_chkcvg =   0             !     check convergence of rheology 
    101108                                      !     = 0  no check 
    102109                                      !     = 1  check at the main time step (output xml: uice_cvg) 
    103110                                      !     = 2  check at both main and rheology time steps (additional output: ice_cvg.nc) 
    104111                                      !          this option 2 asks a lot of communications between cpu 
     112   ln_rhg_VP        = .false.         !  VP rheology 
     113      nn_vp_nout    = 10              !     number of outer iterations 
     114      nn_vp_ninn    = 1500            !     number of inner iterations 
     115      nn_vp_chkcvg  = 5               !     iteration step for convergence check 
    105116/ 
    106117!------------------------------------------------------------------------------ 
    … …  
    195206!------------------------------------------------------------------------------ 
    196207   ln_pnd            = .true.         !  activate melt ponds or not 
    197       ln_pnd_LEV     = .true.         !  level ice melt ponds (from Flocco et al 2007,2010 & Holland et al 2012) 
    198          rn_apnd_min =   0.15         !     minimum ice fraction that contributes to melt pond. range: 0.0 -- 0.15 ?? 
    199          rn_apnd_max =   0.85         !     maximum ice fraction that contributes to melt pond. range: 0.7 -- 0.85 ?? 
     208      ln_pnd_TOPO    = .false.        !  topographic melt ponds 
     209      ln_pnd_LEV     = .true.         !  level ice melt ponds 
     210         rn_apnd_min =   0.15         !     minimum meltwater fraction contributing to pond growth (TOPO and LEV) 
     211         rn_apnd_max =   0.85         !     maximum meltwater fraction contributing to pond growth (TOPO and LEV) 
     212         rn_pnd_flush=   0.01         !     pond flushing efficiency (tuning parameter) (LEV) 
    200213      ln_pnd_CST     = .false.        !  constant  melt ponds 
    201214         rn_apnd     =   0.2          !     prescribed pond fraction, at Tsu=0 degC 
    … …  
    261274   ln_icediachk     = .false.         !  check online heat, mass & salt budgets 
    262275      !                               !   rate of ice spuriously gained/lost at each time step => rn_icechk=1 <=> 1.e-6 m/hour 
    263       rn_icechk_cel =  100.           !     check at each gridcell          (1.e-4m/h)=> stops the code if violated (and writes a file) 
    264       rn_icechk_glo =  1.             !     check over the entire ice cover (1.e-6m/h)=> only prints warnings 
     276      rn_icechk_cel =  1.             !     check at each gridcell          (1.e-06m/h)=> stops the code if violated (and writes a file) 
     277      rn_icechk_glo =  1.e-04         !     check over the entire ice cover (1.e-10m/h)=> only prints warnings 
    265278   ln_icediahsb     = .false.         !  output the heat, mass & salt budgets (T) or not (F) 
    266279   ln_icectl        = .false.         !  ice points output for debug (T or F) 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/cfgs/SHARED/namelist_ref

    r14023 r14050  
    237237   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    238238   ln_wave     = .false.   !  Activate coupling with wave  (T => fill namsbc_wave) 
    239    ln_cdgw     = .false.   !  Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave) 
    240    ln_sdw      = .false.   !  Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave) 
    241    nn_sdrift   =  0        !  Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift 
    242       !                    !   = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 
    243       !                    !   = 1 Phillips:                      v_z=v_o*[exp(2*k*z)-beta*sqrt(-2*k*pi*z)*erfc(sqrt(-2*k*z))] 
    244       !                    !   = 2 Phillips as (1) but using the wave frequency from a wave model 
    245    ln_tauwoc   = .false.   !  Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave) 
    246    ln_tauw     = .false.   !  Activate ocean stress components from wave model 
    247    ln_stcor    = .false.   !  Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave) 
    248239   nn_lsm      = 0         !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 
    249240                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 
    … …  
    376367   sn_rcv_cal    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    377368   sn_rcv_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    378    sn_rcv_hsig   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    379369   sn_rcv_iceflx =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    380370   sn_rcv_mslp   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    381    sn_rcv_phioc  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    382    sn_rcv_sdrfx  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    383    sn_rcv_sdrfy  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    384    sn_rcv_wper   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    385    sn_rcv_wnum   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    386    sn_rcv_wfreq  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    387    sn_rcv_wdrag  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    388371   sn_rcv_ts_ice =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    389372   sn_rcv_isf    =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    390373   sn_rcv_icb    =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    391    sn_rcv_tauwoc =   'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
    392    sn_rcv_tauw   =   'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
    393    sn_rcv_wdrag  =   'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
     374   sn_rcv_hsig   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     375   sn_rcv_phioc  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   'T' 
     376   sn_rcv_sdrfx  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   'T' 
     377   sn_rcv_sdrfy  =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     378   sn_rcv_wper   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     379   sn_rcv_wnum   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     380   sn_rcv_wstrf  =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     381   sn_rcv_wdrag  =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     382   sn_rcv_charn  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   'T' 
     383   sn_rcv_taw    =   'none'                 ,    'no'    ,     ''      ,         ''           ,   'U,V' 
     384   sn_rcv_bhd    =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     385   sn_rcv_tusd   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     386   sn_rcv_tvsd   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
    394387/ 
    395388!----------------------------------------------------------------------- 
    … …  
    571564&namsbc_wave   ! External fields from wave model                        (ln_wave=T) 
    572565!----------------------------------------------------------------------- 
     566   ln_sdw      = .false.       !  get the 2D Surf Stokes Drift & Compute the 3D stokes drift 
     567   ln_stcor    = .false.       !  add Stokes Coriolis and tracer advection terms 
     568   ln_cdgw     = .false.       !  Neutral drag coefficient read from wave model 
     569   ln_tauoc    = .false.       !  ocean stress is modified by wave induced stress 
     570   ln_wave_test= .false.       !  Test case with constant wave fields 
     571! 
     572   ln_charn    = .false.       !  Charnock coefficient read from wave model (IFS only) 
     573   ln_taw      = .false.       !  ocean stress is modified by wave induced stress (coupled mode) 
     574   ln_phioc    = .false.       !  TKE flux from wave model 
     575   ln_bern_srfc= .false.       !  wave induced pressure. Bernoulli head J term 
     576   ln_breivikFV_2016 = .false. !  breivik 2016 vertical stokes profile 
     577   ln_vortex_force = .false.   !  Vortex Force term  
     578   ln_stshear  = .false.       !  include stokes shear in EKE computation 
     579! 
    573580   cn_dir      = './'      !  root directory for the waves data location 
    574581   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    … …  
    580587   sn_hsw      =  'sdw_ecwaves_orca2'    ,        6.         , 'hs'         ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    581588   sn_wmp      =  'sdw_ecwaves_orca2'    ,        6.         , 'wmp'        ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    582    sn_wfr      =  'sdw_ecwaves_orca2'    ,        6.         , 'wfr'        ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    583589   sn_wnum     =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_num'   ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    584    sn_tauwoc   =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_stress',  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    585    sn_tauwx    =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_stress',  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    586    sn_tauwy    =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_stress',  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     590   sn_tauoc    =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_stress',  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    587591/ 
    588592!----------------------------------------------------------------------- 
    … …  
    625629   ln_use_calving          = .false. ! Use calving data even when nn_test_icebergs > 0 
    626630   rn_speed_limit          = 0.      ! CFL speed limit for a berg 
    627  
     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   ! 
    628635   cn_dir      = './'      !  root directory for the calving data location 
    629636   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    … …  
    11141121      nn_npc      =    1         ! frequency of application of npc 
    11151122      nn_npcp     =  365         ! npc control print frequency 
     1123   ln_zdfmfc   = .false.      !  Mass Flux Convection 
    11161124   ! 
    11171125   ln_zdfddm   = .false.   ! double diffusive mixing 
    … …  
    11641172      rn_mxlice   = 10.       ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    11651173   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value 
     1174   ln_mxhsw    = .false.   !  surface mixing length scale = F(wave height) 
    11661175   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002) 
    11671176      rn_lc       =   0.15    !  coef. associated to Langmuir cells 
    … …  
    11791188   !                       !           = 2 weighted by 1-fr_i 
    11801189   !                       !           = 3 weighted by 1-MIN(1,4*fr_i)    
     1190   nn_bc_surf   =     1    !  surface condition (0/1=Dir/Neum) ! Only applicable for wave coupling (ln_cplwave=1) 
     1191   nn_bc_bot    =     1    !  bottom condition (0/1=Dir/Neum) ! Only applicable for wave coupling (ln_cplwave=1) 
    11811192/ 
    11821193!----------------------------------------------------------------------- 
    … …  
    12231234      !                        !  = 1: Pierson Moskowitz wave spectrum 
    12241235      !                        !  = 0: Constant La# = 0.3 
     1236/ 
     1237!----------------------------------------------------------------------- 
     1238&namzdf_mfc     !   Mass Flux Convection 
     1239!----------------------------------------------------------------------- 
     1240   ln_edmfuv  = .false.        ! Activate on velocity fields (Not available yet) 
     1241   rn_cemf    =  1.            ! entrain/detrain coef. (<0 => cte; >0 % depending on dW/dz 
     1242   rn_cwmf    = -0.            ! entrain/detrain coef. (<0 => cte; >0 % depending on dW/dz 
     1243   rn_cent    = 2.e-5          ! entrain of convective area 
     1244   rn_cdet    = 3.e-5          ! detrain of convective area  
     1245   rn_cap     = 0.9            ! Coef. for CAP estimation 
     1246   App_max    = 0.1            ! Maximum convection area (% of the cell) 
    12251247/ 
    12261248!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/cfgs/SHARED/namelist_top_ref

    r12377 r14050  
    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_r13327_KERNEL-06_2_techene_e3/doc/namelists/namdyn_rhg

    r13998 r14050  
    33!------------------------------------------------------------------------------ 
    44   ln_rhg_EVP       = .true.          !  EVP rheology 
     5   ln_rhg_EAP       = .false.          !  EAP rheology 
    56      ln_aEVP       = .false.         !     adaptive rheology (Kimmritz et al. 2016 & 2017) 
    67      rn_creepl     =   2.0e-9        !     creep limit [1/s] 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/ice.F90

    r13998 r14050  
    150150   ! 
    151151   !                                     !!** ice-rheology namelist (namdyn_rhg) ** 
     152   ! -- evp 
     153   LOGICAL , PUBLIC ::   ln_rhg_EVP       ! EVP rheology switch, used for rdgrft and rheology 
     154   LOGICAL , PUBLIC ::   ln_rhg_EAP       ! EAP rheology switch, used for rdgrft and rheology 
    152155   LOGICAL , PUBLIC ::   ln_aEVP          !: using adaptive EVP (T or F)  
    153    REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9 
     156   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit (has to be low enough, circa 10-9 m/s, depending on rheology) 
    154157   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve 
    155158   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
    156159   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rDt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
    157160   INTEGER , PUBLIC ::   nn_rhg_chkcvg    !: check ice rheology convergence  
     161   ! -- vp 
     162   LOGICAL , PUBLIC ::   ln_rhg_VP        !: VP rheology 
     163   INTEGER , PUBLIC ::   nn_vp_nout       !: Number of outer iterations 
     164   INTEGER , PUBLIC ::   nn_vp_ninn       !: Number of inner iterations (linear system solver) 
     165   INTEGER , PUBLIC ::   nn_vp_chkcvg     !: Number of iterations every each convergence is checked 
    158166   ! 
    159167   !                                     !!** ice-advection namelist (namdyn_adv) ** 
    … …  
    208216   !                                     !!** ice-ponds namelist (namthd_pnd) 
    209217   LOGICAL , PUBLIC ::   ln_pnd           !: Melt ponds (T) or not (F) 
    210    LOGICAL , PUBLIC ::   ln_pnd_LEV       !: Melt ponds scheme from Holland et al (2012), Flocco et al (2007, 2010) 
    211    REAL(wp), PUBLIC ::   rn_apnd_min      !: Minimum ice fraction that contributes to melt ponds 
    212    REAL(wp), PUBLIC ::   rn_apnd_max      !: Maximum ice fraction that contributes to melt ponds 
     218   LOGICAL , PUBLIC ::   ln_pnd_TOPO      !: Topographic Melt ponds scheme (Flocco et al 2007, 2010) 
     219   LOGICAL , PUBLIC ::   ln_pnd_LEV       !: Simple melt pond scheme 
     220   REAL(wp), PUBLIC ::   rn_apnd_min      !: Minimum fraction of melt water contributing to ponds 
     221   REAL(wp), PUBLIC ::   rn_apnd_max      !: Maximum fraction of melt water contributing to ponds 
     222   REAL(wp), PUBLIC ::   rn_pnd_flush     !: Pond flushing efficiency (tuning parameter) 
    213223   LOGICAL , PUBLIC ::   ln_pnd_CST       !: Melt ponds scheme with constant fraction and depth 
    214224   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1) 
    … …  
    246256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   divu_i          !: Divergence of the velocity field             [s-1] 
    247257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   shear_i         !: Shear of the velocity field                  [s-1] 
     258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   aniso_11, aniso_12   !: structure tensor elements 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdg_conv 
    248260   ! 
    249261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   t_bo            !: Sea-Ice bottom temperature [Kelvin]      
    … …  
    341353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   om_i          !: mean ice age over all categories                        (s) 
    342354   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tau_icebfr    !: ice friction on ocean bottom (landfast param activated) 
     355   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   icb_mask      !: mask of grounded icebergs if landfast [0-1] 
    343356 
    344357   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s           !: Snow temperatures     [K] 
    … …  
    362375   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_il         !: total melt pond lid volume per gridcell area [m] 
    363376 
     377   ! meltwater arrays to save for melt ponds (mv - could be grouped in a single meltwater volume array) 
     378   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   dh_i_sum_2d   !: surface melt (2d arrays for ponds)       [m] 
     379   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   dh_s_mlt_2d   !: snow surf melt (2d arrays for ponds)     [m] 
     380 
    364381   !!---------------------------------------------------------------------- 
    365382   !! * Global variables at before time step 
    366383   !!---------------------------------------------------------------------- 
    367384   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b !: snow and ice volumes/thickness 
     385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_ip_b, v_il_b             !: ponds and lids volumes 
    368386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b              !: 
    369387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content 
    … …  
    392410   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw         !: snw volume variation   [m/s]  
    393411   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_aice         !: ice conc.  variation   [s-1]  
     412   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vpnd         !: pond volume variation  [m/s]  
    394413   ! 
    395414   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_adv_mass     !: advection of mass (kg/m2/s) 
    … …  
    436455      ALLOCATE( u_oce    (jpi,jpj) , v_oce    (jpi,jpj) , ht_i_new  (jpi,jpj) , strength(jpi,jpj) ,  & 
    437456         &      stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,                      & 
    438          &      delta_i  (jpi,jpj) , divu_i   (jpi,jpj) , shear_i   (jpi,jpj) , STAT=ierr(ii) ) 
     457         &      delta_i  (jpi,jpj) , divu_i   (jpi,jpj) , shear_i   (jpi,jpj) ,                      & 
     458         &      aniso_11 (jpi,jpj) , aniso_12 (jpi,jpj) , rdg_conv  (jpi,jpj) , STAT=ierr(ii) ) 
    439459 
    440460      ii = ii + 1 
    … …  
    468488         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s(jpi,jpj) ,  & 
    469489         &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) ,  & 
    470          &      om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj)            , STAT=ierr(ii) ) 
     490         &      om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj), icb_mask(jpi,jpj), STAT=ierr(ii) ) 
    471491 
    472492      ii = ii + 1 
    … …  
    478498      ii = ii + 1 
    479499      ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl),  & 
    480          &      v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , STAT = ierr(ii) ) 
     500         &      v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) ,                     & 
     501         &      dh_i_sum_2d(jpi,jpj,jpl) , dh_s_mlt_2d(jpi,jpj,jpl) , STAT = ierr(ii) ) 
    481502 
    482503      ii = ii + 1 
    … …  
    486507      ii = ii + 1 
    487508      ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl)        , h_i_b(jpi,jpj,jpl),         & 
     509         &      v_ip_b(jpi,jpj,jpl) , v_il_b(jpi,jpj,jpl) ,                                                         & 
    488510         &      a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 
    489511         &      STAT=ierr(ii) ) 
    … …  
    500522      ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),                      &  
    501523         &      diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat  (jpi,jpj),                      & 
    502          &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), diag_aice(jpi,jpj), & 
     524         &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), diag_aice(jpi,jpj), diag_vpnd(jpi,jpj), & 
    503525         &      diag_adv_mass(jpi,jpj), diag_adv_salt(jpi,jpj), diag_adv_heat(jpi,jpj), STAT=ierr(ii) ) 
    504526 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icectl.F90

    r13998 r14050  
    8585      !! 
    8686      REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat, & 
    87          &          zdiag_vmin, zdiag_amin, zdiag_amax, zdiag_eimin, zdiag_esmin, zdiag_smin 
     87         &          zdiag_vimin, zdiag_vsmin, zdiag_vpmin, zdiag_vlmin, zdiag_aimin, zdiag_aimax, & 
     88         &          zdiag_eimin, zdiag_esmin, zdiag_simin 
    8889      REAL(wp) ::   zvtrp, zetrp 
    8990      REAL(wp) ::   zarea 
    … …  
    9293      IF( icount == 0 ) THEN 
    9394 
    94          pdiag_v = glob_sum( 'icectl',   SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) 
     95         pdiag_v = glob_sum( 'icectl',   SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t ) 
    9596         pdiag_s = glob_sum( 'icectl',   SUM( sv_i * rhoi            , dim=3 ) * e1e2t ) 
    9697         pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ) 
    … …  
    112113 
    113114         ! -- mass diag -- ! 
    114          zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_Dt_ice       & 
     115         zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t )      & 
     116            &            - pdiag_v ) * r1_Dt_ice                                                                          & 
    115117            &         + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn +       & 
    116118            &                                 wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & 
    … …  
    132134 
    133135         ! -- min/max diag -- ! 
    134          zdiag_amax  = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 
    135          zdiag_vmin  = glob_min( 'icectl', v_i ) 
    136          zdiag_amin  = glob_min( 'icectl', a_i ) 
    137          zdiag_smin  = glob_min( 'icectl', sv_i ) 
     136         zdiag_aimax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 
     137         zdiag_vimin = glob_min( 'icectl', v_i  ) 
     138         zdiag_vsmin = glob_min( 'icectl', v_s  ) 
     139         zdiag_vpmin = glob_min( 'icectl', v_ip ) 
     140         zdiag_vlmin = glob_min( 'icectl', v_il ) 
     141         zdiag_aimin = glob_min( 'icectl', a_i  ) 
     142         zdiag_simin = glob_min( 'icectl', sv_i ) 
    138143         zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 
    139144         zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 
    … …  
    155160               &                   WRITE(numout,*)   cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice 
    156161            ! check negative values 
    157             IF( zdiag_vmin  < 0. ) WRITE(numout,*)   cd_routine,' : violation v_i < 0         = ',zdiag_vmin 
    158             IF( zdiag_amin  < 0. ) WRITE(numout,*)   cd_routine,' : violation a_i < 0         = ',zdiag_amin 
    159             IF( zdiag_smin  < 0. ) WRITE(numout,*)   cd_routine,' : violation s_i < 0         = ',zdiag_smin 
    160             IF( zdiag_eimin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_i < 0         = ',zdiag_eimin 
    161             IF( zdiag_esmin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_s < 0         = ',zdiag_esmin 
     162            IF( zdiag_vimin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_i  < 0        = ',zdiag_vimin 
     163            IF( zdiag_vsmin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_s  < 0        = ',zdiag_vsmin 
     164            IF( zdiag_vpmin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_ip < 0        = ',zdiag_vpmin 
     165            IF( zdiag_vlmin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_il < 0        = ',zdiag_vlmin 
     166            IF( zdiag_aimin < 0. ) WRITE(numout,*)   cd_routine,' : violation a_i  < 0        = ',zdiag_aimin 
     167            IF( zdiag_simin < 0. ) WRITE(numout,*)   cd_routine,' : violation s_i  < 0        = ',zdiag_simin 
     168            IF( zdiag_eimin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_i  < 0        = ',zdiag_eimin 
     169            IF( zdiag_esmin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_s  < 0        = ',zdiag_esmin 
    162170            ! check maximum ice concentration 
    163             IF( zdiag_amax > MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 
    164                &                   WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zdiag_amax 
     171            IF( zdiag_aimax>MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 
     172               &                   WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zdiag_aimax 
    165173            ! check if advection scheme is conservative 
    166174            IF( ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
    167                &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice 
     175               &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rDt_ice 
    168176            IF( ABS(zetrp) > zchk_t * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
    169                &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [J]  = ',zetrp * rdt_ice 
     177               &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [J]  = ',zetrp * rDt_ice 
    170178         ENDIF 
    171179         ! 
    … …  
    193201      ! water flux 
    194202      ! -- mass diag -- ! 
    195       zdiag_mass = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr + wfx_sub & 
    196          &                              + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) 
     203      zdiag_mass = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr   + wfx_sub + wfx_pnd & 
     204         &                              + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ) 
    197205 
    198206      ! -- salt diag -- ! 
    … …  
    200208 
    201209      ! -- heat diag -- ! 
    202       zdiag_heat  = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
     210      zdiag_heat = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
    203211      ! equivalent to this: 
    204212      !!zdiag_heat = glob_sum( 'icectl', ( -diag_heat + hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 
    … …  
    245253      IF( icount == 0 ) THEN 
    246254 
    247          pdiag_v = SUM( v_i  * rhoi + v_s * rhos, dim=3 ) 
    248          pdiag_s = SUM( sv_i * rhoi             , dim=3 ) 
     255         pdiag_v = SUM( v_i  * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) 
     256         pdiag_s = SUM( sv_i * rhoi , dim=3 ) 
    249257         pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) 
    250258 
    … …  
    261269 
    262270         ! -- mass diag -- ! 
    263          zdiag_mass =   ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_Dt_ice                             & 
     271         zdiag_mass =   ( SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) - pdiag_v ) * r1_Dt_ice    & 
    264272            &         + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 
    265273            &             wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr )           & 
    … …  
    352360      CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 )    !  
    353361      CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 )    !  
     362      ! mean state 
     363      CALL iom_rstput( 0, 0, inum, 'icecon'    , SUM(a_i ,dim=3) , ktype = jp_r8 )    ! 
     364      CALL iom_rstput( 0, 0, inum, 'icevol'    , SUM(v_i ,dim=3) , ktype = jp_r8 )    ! 
     365      CALL iom_rstput( 0, 0, inum, 'snwvol'    , SUM(v_s ,dim=3) , ktype = jp_r8 )    ! 
     366      CALL iom_rstput( 0, 0, inum, 'pndvol'    , SUM(v_ip,dim=3) , ktype = jp_r8 )    ! 
     367      CALL iom_rstput( 0, 0, inum, 'lidvol'    , SUM(v_il,dim=3) , ktype = jp_r8 )    ! 
    354368       
    355369      CALL iom_close( inum ) 
    … …  
    776790      ! -- mass diag -- ! 
    777791      zdiag_mass     = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr + wfx_sub & 
    778          &                                  + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * rdt_ice 
     792         &                                  + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * rDt_ice 
    779793      zdiag_adv_mass = glob_sum( 'icectl', diag_adv_mass * e1e2t ) * rDt_ice 
    780794 
    781795      ! -- salt diag -- ! 
    782       zdiag_salt     = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) * rdt_ice * 1.e-3 
     796      zdiag_salt     = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) * rDt_ice * 1.e-3 
    783797      zdiag_adv_salt = glob_sum( 'icectl', diag_adv_salt * e1e2t ) * rDt_ice * 1.e-3 
    784798 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icedyn.F90

    r13998 r14050  
    2929   USE lbclnk         ! lateral boundary conditions (or mpp links) 
    3030   USE timing         ! Timing 
     31   USE fldread        ! read input fields 
    3132 
    3233   IMPLICIT NONE 
    … …  
    5152   REAL(wp) ::   rn_vice          !    prescribed v-vel (case np_dynADV1D & np_dynADV2D) 
    5253    
     54   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_icbmsk   ! structure of input grounded icebergs mask (file informations, fields read) 
     55 
    5356   !! * Substitutions 
    5457#  include "do_loop_substitute.h90" 
    … …  
    8184      ! 
    8285      ! controls 
    83       IF( ln_timing )   CALL timing_start('icedyn') 
     86      IF( ln_timing )   CALL timing_start('ice_dyn') 
    8487      ! 
    8588      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    106109      END WHERE 
    107110      ! 
     111      IF( ln_landfast_L16 ) THEN 
     112         CALL fld_read( kt, 1, sf_icbmsk ) 
     113         icb_mask(:,:) = sf_icbmsk(1)%fnow(:,:,1) 
     114      ENDIF 
    108115      ! 
    109116      SELECT CASE( nice_dyn )          !-- Set which dynamics is running 
    … …  
    172179      ! 
    173180      ! controls 
    174       IF( ln_timing )   CALL timing_stop ('icedyn') 
     181      IF( ln_timing )   CALL timing_stop ('ice_dyn') 
    175182      ! 
    176183   END SUBROUTINE ice_dyn 
    … …  
    216223      !! ** input   :   Namelist namdyn 
    217224      !!------------------------------------------------------------------- 
    218       INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
     225      INTEGER ::   ios, ioptio, ierror   ! Local integer output status for namelist read 
     226      ! 
     227      CHARACTER(len=256) ::   cn_dir     ! Root directory for location of ice files 
     228      TYPE(FLD_N)        ::   sn_icbmsk  ! informations about the grounded icebergs field to be read 
    219229      !! 
    220230      NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice,  & 
    221231         &             rn_ishlat ,                                                           & 
    222          &             ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile 
     232         &             ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile, & 
     233         &             sn_icbmsk, cn_dir 
    223234      !!------------------------------------------------------------------- 
    224235      ! 
    … …  
    269280      IF( .NOT.ln_landfast_L16 )   tau_icebfr(:,:) = 0._wp 
    270281      ! 
     282      !                                      !--- allocate and fill structure for grounded icebergs mask 
     283      IF( ln_landfast_L16 ) THEN 
     284         ALLOCATE( sf_icbmsk(1), STAT=ierror ) 
     285         IF( ierror > 0 ) THEN 
     286            CALL ctl_stop( 'ice_dyn_init: unable to allocate sf_icbmsk structure' ) ; RETURN 
     287         ENDIF 
     288         ! 
     289         CALL fld_fill( sf_icbmsk, (/ sn_icbmsk /), cn_dir, 'ice_dyn_init',   & 
     290            &                                               'landfast ice is a function of read grounded icebergs', 'icedyn' ) 
     291         ! 
     292         ALLOCATE( sf_icbmsk(1)%fnow(jpi,jpj,1) ) 
     293         IF( sf_icbmsk(1)%ln_tint )   ALLOCATE( sf_icbmsk(1)%fdta(jpi,jpj,1,2) ) 
     294         IF( TRIM(sf_icbmsk(1)%clrootname) == 'NOT USED' ) sf_icbmsk(1)%fnow(:,:,1) = 0._wp   ! not used field  (set to 0)          
     295      ELSE 
     296         icb_mask(:,:) = 0._wp 
     297      ENDIF 
     298      !                                      !--- other init  
    271299      CALL ice_dyn_rdgrft_init          ! set ice ridging/rafting parameters 
    272300      CALL ice_dyn_rhg_init             ! set ice rheology parameters 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icedyn_adv_pra.F90

    r14018 r14050  
    156156 
    157157         ! diagnostics 
    158          zdiag_adv_mass(:,:) =   SUM(  pv_i(:,:,:) , dim=3 ) * rhoi + SUM(  pv_s(:,:,:) , dim=3 ) * rhos 
     158         zdiag_adv_mass(:,:) =   SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 
     159            &                  + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow 
    159160         zdiag_adv_salt(:,:) =   SUM( psv_i(:,:,:) , dim=3 ) * rhoi 
    160161         zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & 
    … …  
    178179               z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content 
    179180            END DO 
    180             IF ( ln_pnd_LEV ) THEN 
     181            IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    181182               z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond fraction 
    182183               z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond volume 
    … …  
    214215            END DO 
    215216            ! 
    216             IF ( ln_pnd_LEV ) THEN 
     217            IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    217218               CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    218219               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )  
    … …  
    249250                  &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 
    250251            END DO 
    251             IF ( ln_pnd_LEV ) THEN 
     252            IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    252253               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    253254               CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
    … …  
    278279         CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ei  , 'T', 1._wp, sxe   , 'T', -1._wp, sye   , 'T', -1._wp  & ! ice enthalpy 
    279280            &                                , sxxe  , 'T', 1._wp, syye  , 'T',  1._wp, sxye  , 'T',  1._wp  ) 
    280          IF ( ln_pnd_LEV ) THEN 
     281         IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    281282            CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
    282283               &                                , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
    … …  
    302303               pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    303304            END DO 
    304             IF ( ln_pnd_LEV ) THEN 
     305            IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    305306               pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    306307               pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    … …  
    320321         ! 
    321322         ! --- diagnostics --- ! 
    322          diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos & 
     323         diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 
     324            &                                        + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow & 
    323325            &                                        - zdiag_adv_mass(:,:) ) * z1_dt 
    324326         diag_adv_salt(:,:) = diag_adv_salt(:,:) + (   SUM( psv_i(:,:,:) , dim=3 ) * rhoi & 
    … …  
    769771               !                               ! -- check h_ip -- ! 
    770772               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    771                IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     773               IF( ln_pnd_LEV .OR. ln_pnd_TOPO .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    772774                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    773775                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
    … …  
    10151017            END DO 
    10161018            ! 
    1017             IF( ln_pnd_LEV ) THEN                                    ! melt pond fraction 
     1019            IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN                                    ! melt pond fraction 
    10181020               IF( iom_varid( numrir, 'sxap', ldstop = .FALSE. ) > 0 ) THEN 
    10191021                  CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap , psgn = -1._wp ) 
    … …  
    10571059            sxc0  = 0._wp   ;   syc0  = 0._wp   ;   sxxc0  = 0._wp   ;   syyc0  = 0._wp   ;   sxyc0  = 0._wp      ! snow layers heat content 
    10581060            sxe   = 0._wp   ;   sye   = 0._wp   ;   sxxe   = 0._wp   ;   syye   = 0._wp   ;   sxye   = 0._wp      ! ice layers heat content 
    1059             IF( ln_pnd_LEV ) THEN 
     1061            IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    10601062               sxap = 0._wp ;   syap = 0._wp    ;   sxxap = 0._wp    ;   syyap = 0._wp    ;   sxyap = 0._wp       ! melt pond fraction 
    10611063               sxvp = 0._wp ;   syvp = 0._wp    ;   sxxvp = 0._wp    ;   syyvp = 0._wp    ;   sxyvp = 0._wp       ! melt pond volume 
    … …  
    11351137         END DO 
    11361138         ! 
    1137          IF( ln_pnd_LEV ) THEN                                       ! melt pond fraction 
     1139         IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN                                       ! melt pond fraction 
    11381140            CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap  ) 
    11391141            CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap  ) 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icedyn_adv_umx.F90

    r13998 r14050  
    182182 
    183183         ! diagnostics 
    184          zdiag_adv_mass(:,:) =   SUM(  pv_i(:,:,:) , dim=3 ) * rhoi + SUM(  pv_s(:,:,:) , dim=3 ) * rhos 
     184         zdiag_adv_mass(:,:) =   SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 
     185            &                  + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow 
    185186         zdiag_adv_salt(:,:) =   SUM( psv_i(:,:,:) , dim=3 ) * rhoi 
    186187         zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & 
    … …  
    338339         ! 
    339340         !== melt ponds ==! 
    340          IF ( ln_pnd_LEV ) THEN 
     341         IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    341342            ! concentration 
    342343            zamsk = 1._wp 
    … …  
    358359 
    359360         ! --- Lateral boundary conditions --- ! 
    360          IF    ( ln_pnd_LEV .AND. ln_pnd_lids ) THEN 
     361         IF    ( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. ln_pnd_lids ) THEN 
    361362            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 
    362363               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp, pv_il,'T',1._wp ) 
    363          ELSEIF( ln_pnd_LEV .AND. .NOT.ln_pnd_lids ) THEN 
     364         ELSEIF( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. .NOT.ln_pnd_lids ) THEN 
    364365            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 
    365366               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp ) 
    … …  
    379380         ! 
    380381         ! --- diagnostics --- ! 
    381          diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos & 
     382         diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 
     383            &                                        + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow & 
    382384            &                                        - zdiag_adv_mass(:,:) ) * z1_dt 
    383385         diag_adv_salt(:,:) = diag_adv_salt(:,:) + (   SUM( psv_i(:,:,:) , dim=3 ) * rhoi & 
    … …  
    14971499               !                               ! -- check h_ip -- ! 
    14981500               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    1499                IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     1501               IF( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    15001502                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    15011503                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icedyn_rdgrft.F90

    r13998 r14050  
    140140      INTEGER , DIMENSION(jpij) ::   iptidx        ! compute ridge/raft or not 
    141141      REAL(wp), DIMENSION(jpij) ::   zdivu, zdelt  ! 1D divu_i & delta_i 
     142      REAL(wp), DIMENSION(jpij) ::   zconv         ! 1D rdg_conv (if EAP rheology) 
    142143      ! 
    143144      INTEGER, PARAMETER ::   jp_itermax = 20     
    … …  
    175176         ! just needed here 
    176177         CALL tab_2d_1d( npti, nptidx(1:npti), zdelt   (1:npti)      , delta_i ) 
     178         CALL tab_2d_1d( npti, nptidx(1:npti), zconv   (1:npti)      , rdg_conv ) 
    177179         ! needed here and in the iteration loop 
    178180         CALL tab_2d_1d( npti, nptidx(1:npti), zdivu   (1:npti)      , divu_i) ! zdivu is used as a work array here (no change in divu_i) 
    … …  
    184186            ! closing_net = rate at which open water area is removed + ice area removed by ridging  
    185187            !                                                        - ice area added in new ridges 
    186             closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 
     188            IF( ln_rhg_EVP .OR. ln_rhg_VP ) &  
     189               &               closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 
     190            IF( ln_rhg_EAP )   closing_net(ji) = zconv(ji) 
    187191            ! 
    188192            IF( zdivu(ji) < 0._wp )   closing_net(ji) = MAX( closing_net(ji), -zdivu(ji) )   ! make sure the closing rate is large enough 
    … …  
    575579               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft  
    576580 
    577                IF ( ln_pnd_LEV ) THEN 
     581               IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    578582                  aprdg1     = a_ip_2d(ji,jl1) * afrdg 
    579583                  aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) 
    … …  
    612616               sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1    - sirft(ji) 
    613617               oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1    - oirft1 
    614                IF ( ln_pnd_LEV ) THEN 
     618               IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    615619                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1    - aprft1 
    616620                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 
    … …  
    709713                  v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji)  +  & 
    710714                     &                                  vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 
    711                   IF ( ln_pnd_LEV ) THEN 
     715                  IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    712716                     v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + (   vprdg (ji) * rn_fpndrdg * fvol   (ji)   & 
    713717                        &                                   + vprft (ji) * rn_fpndrft * zswitch(ji)   ) 
    … …  
    776780      !                              !--------------------------------------------------! 
    777781         strength(:,:) = rn_pstar * SUM( v_i(:,:,:), dim=3 ) * EXP( -rn_crhg * ( 1._wp - SUM( a_i(:,:,:), dim=3 ) ) ) 
    778          ismooth = 1 
     782         ismooth = 1    ! original code 
     783!        ismooth = 0    ! try for EAP stability 
    779784         !                           !--------------------------------------------------! 
    780785      ELSE                           ! Zero strength                                    ! 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icedyn_rhg.F90

    r13998 r14050  
    1717   USE ice            ! sea-ice: variables 
    1818   USE icedyn_rhg_evp ! sea-ice: EVP rheology 
     19   USE icedyn_rhg_eap ! sea-ice: EAP rheology 
     20   USE icedyn_rhg_vp  ! sea-ice: VP  rheology 
    1921   USE icectl         ! sea-ice: control prints 
    2022   ! 
    … …  
    3335   !                                        ! associated indices: 
    3436   INTEGER, PARAMETER ::   np_rhgEVP = 1   ! EVP rheology 
    35 !! INTEGER, PARAMETER ::   np_rhgEAP = 2   ! EAP rheology 
     37   INTEGER, PARAMETER ::   np_rhgEAP = 2   ! EAP rheology 
     38   INTEGER, PARAMETER ::   np_rhgVP  = 3   ! VP rheology 
    3639 
    37    ! ** namelist (namrhg) ** 
    38    LOGICAL ::   ln_rhg_EVP       ! EVP rheology 
    3940   ! 
    4041   !!---------------------------------------------------------------------- 
    … …  
    7778         !                             !------------------------! 
    7879         CALL ice_dyn_rhg_evp( kt, Kmm, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i ) 
    79          !          
     80         !         
     81         !                             !------------------------! 
     82      CASE( np_rhgVP  )                ! Viscous-Plastic        ! 
     83         !                             !------------------------! 
     84         CALL ice_dyn_rhg_vp ( kt, shear_i, divu_i, delta_i ) 
     85         ! 
     86         !                             !----------------------------! 
     87      CASE( np_rhgEAP )                ! Elasto-Anisotropic-Plastic ! 
     88         !                             !----------------------------! 
     89         CALL ice_dyn_rhg_eap( kt, Kmm, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i, aniso_11, aniso_12, rdg_conv ) 
    8090      END SELECT 
    8191      ! 
    82       IF( lrst_ice ) THEN                       !* write EVP fields in the restart file 
    83          IF( ln_rhg_EVP )   CALL rhg_evp_rst( 'WRITE', kt ) 
     92      IF( lrst_ice ) THEN 
     93         IF( ln_rhg_EVP )   CALL rhg_evp_rst( 'WRITE', kt ) !* write EVP fields in the restart file 
     94         IF( ln_rhg_EAP )   CALL rhg_eap_rst( 'WRITE', kt ) !* write EAP fields in the restart file 
     95         ! MV note: no restart needed for VP as there is no time equation for stress tensor 
    8496      ENDIF 
    8597      ! 
    … …  
    108120      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
    109121      !! 
    110       NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast, nn_rhg_chkcvg 
     122      NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, ln_rhg_EAP, rn_creepl, rn_ecc , nn_nevp, rn_relast, nn_rhg_chkcvg, &  !-- evp 
     123         &                  ln_rhg_VP, nn_vp_nout, nn_vp_ninn, nn_vp_chkcvg                                            !-- vp  
    111124      !!------------------------------------------------------------------- 
    112125      ! 
    … …  
    124137         WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP    = ', ln_rhg_EVP 
    125138         WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP       = ', ln_aEVP 
    126          WRITE(numout,*) '         creep limit                                       rn_creepl     = ', rn_creepl 
    127          WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc        = ', rn_ecc 
     139         WRITE(numout,*) '         creep limit                                       rn_creepl     = ', rn_creepl ! also used by vp 
     140         WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc        = ', rn_ecc    ! also used by vp 
    128141         WRITE(numout,*) '         number of iterations for subcycling               nn_nevp       = ', nn_nevp 
    129142         WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast     = ', rn_relast 
    130          WRITE(numout,*) '      check convergence of rheology                        nn_rhg_chkcvg = ', nn_rhg_chkcvg 
    131          IF    ( nn_rhg_chkcvg == 0 ) THEN   ;   WRITE(numout,*) '         no check' 
    132          ELSEIF( nn_rhg_chkcvg == 1 ) THEN   ;   WRITE(numout,*) '         check cvg at the main time step' 
    133          ELSEIF( nn_rhg_chkcvg == 2 ) THEN   ;   WRITE(numout,*) '         check cvg at both main and rheology time steps' 
     143         WRITE(numout,*) '         check convergence of rheology                     nn_rhg_chkcvg = ', nn_rhg_chkcvg 
     144         WRITE(numout,*) '      rheology VP   (icedyn_rhg_VP)                        ln_rhg_VP     = ', ln_rhg_VP 
     145         WRITE(numout,*) '         number of outer iterations                        nn_vp_nout    = ', nn_vp_nout 
     146         WRITE(numout,*) '         number of inner iterations                        nn_vp_ninn    = ', nn_vp_ninn 
     147         WRITE(numout,*) '         iteration step for convergence check              nn_vp_chkcvg  = ', nn_vp_chkcvg 
     148         IF( ln_rhg_EVP ) THEN 
     149            IF    ( nn_rhg_chkcvg == 0 ) THEN   ;   WRITE(numout,*) '         no check cvg' 
     150            ELSEIF( nn_rhg_chkcvg == 1 ) THEN   ;   WRITE(numout,*) '         check cvg at the main time step' 
     151            ELSEIF( nn_rhg_chkcvg == 2 ) THEN   ;   WRITE(numout,*) '         check cvg at both main and rheology time steps' 
     152            ENDIF 
    134153         ENDIF 
     154         WRITE(numout,*) '      rheology EAP (icedyn_rhg_eap)                        ln_rhg_EAP = ', ln_rhg_EAP 
    135155      ENDIF 
    136156      ! 
    … …  
    138158      ioptio = 0  
    139159      IF( ln_rhg_EVP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEVP    ;   ENDIF 
    140 !!    IF( ln_rhg_EAP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEAP    ;   ENDIF 
     160      IF( ln_rhg_EAP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEAP    ;   ENDIF 
     161      IF( ln_rhg_VP  ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgVP     ;   ENDIF  
    141162      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_dyn_rhg_init: choose one and only one ice rheology' ) 
    142163      ! 
    143164      IF( ln_rhg_EVP  )   CALL rhg_evp_rst( 'READ' )  !* read or initialize all required files 
     165      IF( ln_rhg_EAP  )   CALL rhg_eap_rst( 'READ' )  !* read or initialize all required files 
     166      ! no restart for VP as there is no explicit time dependency in the equation 
    144167      ! 
    145168   END SUBROUTINE ice_dyn_rhg_init 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icedyn_rhg_evp.F90

    r14023 r14050  
    326326            zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    327327            ! ice-bottom stress at U points 
    328             zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) 
     328            zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0 
    329329            ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
    330330            ! ice-bottom stress at V points 
    331             zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) 
     331            zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0 
    332332            ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
    333333            ! ice_bottom stress at T points 
    334             zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) 
     334            zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) * ( 1._wp - icb_mask(ji,jj) )    ! if grounded icebergs are read: ocean depth = 0 
    335335            tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    336336         END_2D 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/iceistate.F90

    r13998 r14050  
    430430      ! 4) Snow-ice mass (case ice is fully embedded) 
    431431      !---------------------------------------------- 
    432       snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3  )   ! snow+ice mass 
     432      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s + rhoi * v_i + rhow * ( v_ip + v_il ), dim=3  )   ! snow+ice mass 
    433433      snwice_mass_b(:,:) = snwice_mass(:,:) 
    434434      ! 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/iceitd.F90

    r13998 r14050  
    2929   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    3030   USE prtctl         ! Print control 
     31   USE timing         ! Timing 
    3132 
    3233   IMPLICIT NONE 
    … …  
    8788      REAL(wp), DIMENSION(jpij,0:jpl) ::   zhbnew          ! new boundaries of ice categories 
    8889      !!------------------------------------------------------------------ 
     90      IF( ln_timing )   CALL timing_start('iceitd_rem') 
    8991 
    9092      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_rem: remapping ice thickness distribution'  
    … …  
    315317            IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 
    316318               a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin  
    317                IF( ln_pnd_LEV )   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
     319               IF( ln_pnd_LEV .OR. ln_pnd_TOPO )   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
    318320               h_i_1d(ji) = rn_himin 
    319321            ENDIF 
    … …  
    328330      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
    329331      IF( ln_icediachk )   CALL ice_cons2D  (1, 'iceitd_rem',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
     332      IF( ln_timing    )   CALL timing_stop ('iceitd_rem') 
    330333      ! 
    331334   END SUBROUTINE ice_itd_rem 
    … …  
    486489               zaTsfn(ji,jl2)  = zaTsfn(ji,jl2) + ztrans 
    487490               !   
    488                IF ( ln_pnd_LEV ) THEN 
     491               IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    489492                  ztrans          = a_ip_2d(ji,jl1) * zworka(ji)     ! Pond fraction 
    490493                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans 
    491494                  a_ip_2d(ji,jl2) = a_ip_2d(ji,jl2) + ztrans 
    492495                  !                                               
    493                   ztrans          = v_ip_2d(ji,jl1) * zworka(ji)     ! Pond volume (also proportional to da/a) 
     496                  ztrans          = v_ip_2d(ji,jl1) * zworkv(ji)     ! Pond volume 
    494497                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 
    495498                  v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 
    496499                  ! 
    497500                  IF ( ln_pnd_lids ) THEN                            ! Pond lid volume 
    498                      ztrans          = v_il_2d(ji,jl1) * zworka(ji) 
     501                     ztrans          = v_il_2d(ji,jl1) * zworkv(ji) 
    499502                     v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 
    500503                     v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans 
    … …  
    606609      REAL(wp), DIMENSION(jpij,jpl-1) ::   zdaice, zdvice   ! ice area and volume transferred 
    607610      !!------------------------------------------------------------------ 
     611      IF( ln_timing )   CALL timing_start('iceitd_reb') 
    608612      ! 
    609613      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution'  
    … …  
    635639               jdonor(ji,jl)  = jl  
    636640               ! how much of a_i you send in cat sup is somewhat arbitrary 
    637                !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 
    638                !!          zdaice(ji,jl)  = a_i_1d(ji) * ( h_i_1d(ji) - hi_max(jl) + epsi10 ) / h_i_1d(ji)   
    639                !!          zdvice(ji,jl)  = v_i_1d(ji) - ( a_i_1d(ji) - zdaice(ji,jl) ) * ( hi_max(jl) - epsi10 ) 
    640                !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 
    641                !!          zdaice(ji,jl)  = a_i_1d(ji) 
    642                !!          zdvice(ji,jl)  = v_i_1d(ji) 
    643                !!clem: these are from UCL and work ok 
    644                zdaice(ji,jl)  = a_i_1d(ji) * 0.5_wp 
    645                zdvice(ji,jl)  = v_i_1d(ji) - zdaice(ji,jl) * ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 
     641               ! these are from CICE => transfer everything 
     642               !!zdaice(ji,jl)  = a_i_1d(ji) 
     643               !!zdvice(ji,jl)  = v_i_1d(ji) 
     644               ! these are from LLN => transfer only half of the category 
     645               zdaice(ji,jl)  =                       0.5_wp  * a_i_1d(ji) 
     646               zdvice(ji,jl)  = v_i_1d(ji) - (1._wp - 0.5_wp) * a_i_1d(ji) * hi_mean(jl) 
    646647            END DO 
    647648            ! 
    … …  
    686687      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
    687688      IF( ln_icediachk )   CALL ice_cons2D  (1, 'iceitd_reb',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
     689      IF( ln_timing    )   CALL timing_stop ('iceitd_reb') 
    688690      ! 
    689691   END SUBROUTINE ice_itd_reb 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icesbc.F90

    r13998 r14050  
    6262      !!------------------------------------------------------------------- 
    6363      ! 
    64       IF( ln_timing )   CALL timing_start('ice_sbc') 
     64      IF( ln_timing )   CALL timing_start('icesbc') 
    6565      ! 
    6666      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    8989      ENDIF 
    9090      ! 
    91       IF( ln_timing )   CALL timing_stop('ice_sbc') 
     91      IF( ln_timing )   CALL timing_stop('icesbc') 
    9292      ! 
    9393   END SUBROUTINE ice_sbc_tau 
    … …  
    122122      !!-------------------------------------------------------------------- 
    123123      ! 
    124       IF( ln_timing )   CALL timing_start('ice_sbc_flx') 
     124      IF( ln_timing )   CALL timing_start('icesbc') 
    125125 
    126126      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    176176      ENDIF 
    177177      ! 
    178       IF( ln_timing )   CALL timing_stop('ice_sbc_flx') 
     178      IF( ln_timing )   CALL timing_stop('icesbc') 
    179179      ! 
    180180   END SUBROUTINE ice_sbc_flx 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icestp.F90

    r14018 r14050  
    121121      !!---------------------------------------------------------------------- 
    122122      ! 
    123       IF( ln_timing )   CALL timing_start('ice_stp') 
     123      IF( ln_timing )   CALL timing_start('icestp') 
    124124      ! 
    125125      !                                      !-----------------------! 
    … …  
    215215!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    216216      ! 
    217       IF( ln_timing )   CALL timing_stop('ice_stp') 
     217      IF( ln_timing )   CALL timing_stop('icestp') 
    218218      ! 
    219219   END SUBROUTINE ice_stp 
    … …  
    373373      v_i_b (:,:,:)   = v_i (:,:,:)     ! ice volume 
    374374      v_s_b (:,:,:)   = v_s (:,:,:)     ! snow volume 
     375      v_ip_b(:,:,:)   = v_ip(:,:,:)     ! pond volume 
     376      v_il_b(:,:,:)   = v_il(:,:,:)     ! pond lid volume 
    375377      sv_i_b(:,:,:)   = sv_i(:,:,:)     ! salt content 
    376378      e_s_b (:,:,:,:) = e_s (:,:,:,:)   ! snow thermal energy 
    … …  
    432434         diag_heat(ji,jj) = 0._wp ;   diag_sice(ji,jj) = 0._wp 
    433435         diag_vice(ji,jj) = 0._wp ;   diag_vsnw(ji,jj) = 0._wp 
     436         diag_aice(ji,jj) = 0._wp ;   diag_vpnd(ji,jj) = 0._wp 
    434437 
    435438         tau_icebfr (ji,jj) = 0._wp   ! landfast ice param only (clem: important to keep the init here) 
    … …  
    457460            qcn_ice    (ji,jj,jl) = 0._wp   ! conductive flux (ln_cndflx=T & ln_cndemule=T) 
    458461            qtr_ice_bot(ji,jj,jl) = 0._wp   ! part of solar radiation transmitted through the ice needed at least for outputs 
     462            ! Melt pond surface melt diagnostics (mv - more efficient: grouped into one water volume flux) 
     463            dh_i_sum_2d(ji,jj,jl) = 0._wp 
     464            dh_s_mlt_2d(ji,jj,jl) = 0._wp 
    459465         END_2D 
    460466      ENDDO 
    … …  
    485491         diag_vsnw(:,:) = diag_vsnw(:,:) & 
    486492            &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhos 
     493         diag_vpnd(:,:) = diag_vpnd(:,:) & 
     494            &             + SUM(     v_ip + v_il          - v_ip_b - v_il_b                , dim=3 ) * r1_Dt_ice * rhow 
    487495         ! 
    488496         IF( kn == 2 )    CALL iom_put ( 'hfxdhc' , diag_heat )   ! output of heat trend 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icethd.F90

    r13998 r14050  
    166166         qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ) 
    167167 
     168         ! If conditions are always supercooled (such as at the mouth of ice-shelves), then ice grows continuously 
     169         ! ==> stop ice formation by artificially setting up the turbulent fluxes to 0 when volume > 20m (arbitrary) 
     170         IF( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) > 0._wp .AND. vt_i(ji,jj) >= 20._wp ) THEN 
     171            zqfr               = 0._wp 
     172            zqfr_pos           = 0._wp 
     173            qsb_ice_bot(ji,jj) = 0._wp 
     174         ENDIF 
     175         ! 
    168176         ! --- Energy Budget of the leads (qlead, J.m-2) --- ! 
    169177         !     qlead is the energy received from the atm. in the leads. 
    … …  
    239247            IF( ln_icedH ) THEN                                     ! --- Growing/Melting --- ! 
    240248                              CALL ice_thd_dh                           ! Ice-Snow thickness    
    241                               CALL ice_thd_pnd                          ! Melt ponds formation 
    242249                              CALL ice_thd_ent( e_i_1d(1:npti,:) )      ! Ice enthalpy remapping 
    243250            ENDIF 
    … …  
    260267      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icethd',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
    261268      !                    
     269      IF ( ln_pnd .AND. ln_icedH ) & 
     270         &                    CALL ice_thd_pnd                      ! --- Melt ponds  
     271      ! 
    262272      IF( jpl > 1  )          CALL ice_itd_rem( kt )                ! --- Transport ice between thickness categories --- ! 
    263273      ! 
    … …  
    266276                              CALL ice_cor( kt , 2 )                ! --- Corrections --- ! 
    267277      ! 
    268       oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice              ! ice natural aging incrementation      
     278      oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice              ! ice natural aging incrementation      
    269279      ! 
    270280      ! convergence tests 
    … …  
    377387            CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl)  ) 
    378388         END DO 
    379          CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    380          CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    381          CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    382389         ! 
    383390         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d  (1:npti), qprec_ice            ) 
    … …  
    409416         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_spr_1d (1:npti), wfx_spr          ) 
    410417         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_lam_1d (1:npti), wfx_lam          ) 
    411          CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d (1:npti), wfx_pnd          ) 
    412418         ! 
    413419         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_bog_1d (1:npti), sfx_bog          ) 
    … …  
    464470         v_s_1d (1:npti) = h_s_1d (1:npti) * a_i_1d (1:npti) 
    465471         sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 
    466          v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 
    467          v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti) 
    468472         oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 
    469473          
    … …  
    483487            CALL tab_1d_2d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl)  ) 
    484488         END DO 
    485          CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    486          CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    487          CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    488489         ! 
    489490         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) 
    … …  
    501502         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_spr_1d (1:npti), wfx_spr        ) 
    502503         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_lam_1d (1:npti), wfx_lam        ) 
    503          CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d (1:npti), wfx_pnd        ) 
    504504         ! 
    505505         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_bog_1d (1:npti), sfx_bog        ) 
    … …  
    529529         CALL tab_1d_2d( npti, nptidx(1:npti), cnd_ice_1d(1:npti), cnd_ice(:,:,kl) ) 
    530530         CALL tab_1d_2d( npti, nptidx(1:npti), t1_ice_1d (1:npti), t1_ice (:,:,kl) ) 
     531         ! Melt ponds 
     532         CALL tab_1d_2d( npti, nptidx(1:npti), dh_i_sum  (1:npti) , dh_i_sum_2d(:,:,kl) ) 
     533         CALL tab_1d_2d( npti, nptidx(1:npti), dh_s_mlt  (1:npti) , dh_s_mlt_2d(:,:,kl) ) 
    531534         ! SIMIP diagnostics          
    532535         CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d       (1:npti), t_si       (:,:,kl) ) 
    … …  
    537540         CALL tab_1d_2d( npti, nptidx(1:npti), v_s_1d (1:npti), v_s (:,:,kl) ) 
    538541         CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 
    539          CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 
    540          CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 
    541542         CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 
    542543         ! check convergence of heat diffusion scheme 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icethd_dh.F90

    r13998 r14050  
    5555      !!                - Snow ice formation 
    5656      !! 
     57      !! ** Note     :  h=max(0,h+dh) are often used to ensure positivity of h. 
     58      !!                very small negative values can occur otherwise (e.g. -1.e-20) 
     59      !! 
    5760      !! References : Bitz and Lipscomb, 1999, J. Geophys. Res. 
    5861      !!              Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646    
    … …  
    7982      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean 
    8083 
    81       REAL(wp), DIMENSION(jpij) ::   zqprec      ! energy of fallen snow                       (J.m-3) 
    8284      REAL(wp), DIMENSION(jpij) ::   zq_top      ! heat for surface ablation                   (J.m-2) 
    8385      REAL(wp), DIMENSION(jpij) ::   zq_bot      ! heat for bottom ablation                    (J.m-2) 
    … …  
    8587      REAL(wp), DIMENSION(jpij) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2) 
    8688      REAL(wp), DIMENSION(jpij) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2) 
    87  
    88       REAL(wp), DIMENSION(jpij) ::   zdh_s_mel   ! snow melt  
    89       REAL(wp), DIMENSION(jpij) ::   zdh_s_pre   ! snow precipitation  
    90       REAL(wp), DIMENSION(jpij) ::   zdh_s_sub   ! snow sublimation 
    91  
    92       REAL(wp), DIMENSION(jpij,nlay_s) ::   zh_s      ! snw layer thickness 
    93       REAL(wp), DIMENSION(jpij,nlay_i) ::   zh_i      ! ice layer thickness 
    94       REAL(wp), DIMENSION(jpij,nlay_i) ::   zdeltah 
    95       INTEGER , DIMENSION(jpij,nlay_i) ::   icount    ! number of layers vanished by melting  
    96  
     89      REAL(wp), DIMENSION(jpij) ::   zdeltah      
    9790      REAL(wp), DIMENSION(jpij) ::   zsnw        ! distribution of snow after wind blowing 
     91 
     92      INTEGER , DIMENSION(jpij,nlay_i)     ::   icount    ! number of layers vanishing by melting  
     93      REAL(wp), DIMENSION(jpij,0:nlay_i+1) ::   zh_i      ! ice layer thickness (m) 
     94      REAL(wp), DIMENSION(jpij,0:nlay_s  ) ::   zh_s      ! snw layer thickness (m) 
     95      REAL(wp), DIMENSION(jpij,0:nlay_s  ) ::   ze_s      ! snw layer enthalpy (J.m-3) 
    9896 
    9997      REAL(wp) ::   zswitch_sal 
    … …  
    108106      END SELECT 
    109107 
    110       ! initialize layer thicknesses and enthalpies 
     108      ! initialize ice layer thicknesses and enthalpies 
     109      eh_i_old(1:npti,0:nlay_i+1) = 0._wp 
    111110      h_i_old (1:npti,0:nlay_i+1) = 0._wp 
    112       eh_i_old(1:npti,0:nlay_i+1) = 0._wp 
     111      zh_i    (1:npti,0:nlay_i+1) = 0._wp 
    113112      DO jk = 1, nlay_i 
    114113         DO ji = 1, npti 
     114            eh_i_old(ji,jk) = h_i_1d(ji) * r1_nlay_i * e_i_1d(ji,jk) 
    115115            h_i_old (ji,jk) = h_i_1d(ji) * r1_nlay_i 
    116             eh_i_old(ji,jk) = e_i_1d(ji,jk) * h_i_old(ji,jk) 
     116            zh_i    (ji,jk) = h_i_1d(ji) * r1_nlay_i 
     117         END DO 
     118      END DO 
     119      ! 
     120      ! initialize snw layer thicknesses and enthalpies 
     121      zh_s(1:npti,0) = 0._wp 
     122      ze_s(1:npti,0) = 0._wp 
     123      DO jk = 1, nlay_s 
     124         DO ji = 1, npti 
     125            zh_s(ji,jk) = h_s_1d(ji) * r1_nlay_s 
     126            ze_s(ji,jk) = e_s_1d(ji,jk) 
    117127         END DO 
    118128      END DO 
    … …  
    141151         zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) + qtr_ice_bot_1d(ji) * frq_m_1d(ji)  
    142152         zq_bot(ji)        = MAX( 0._wp, zf_tt(ji) * rDt_ice ) 
    143       END DO 
    144  
    145       ! Ice and snow layer thicknesses 
    146       !------------------------------- 
    147       DO jk = 1, nlay_i 
    148          DO ji = 1, npti 
    149             zh_i(ji,jk) = h_i_1d(ji) * r1_nlay_i 
    150          END DO 
    151       END DO 
    152  
    153       DO jk = 1, nlay_s 
    154          DO ji = 1, npti 
    155             zh_s(ji,jk) = h_s_1d(ji) * r1_nlay_s 
    156          END DO 
    157153      END DO 
    158154 
    … …  
    167163         DO ji = 1, npti 
    168164            IF( t_s_1d(ji,jk) > rt0 ) THEN 
    169                hfx_res_1d    (ji) = hfx_res_1d    (ji) + e_s_1d(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! heat flux to the ocean [W.m-2], < 0 
    170                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos          * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! mass flux 
     165               hfx_res_1d    (ji) = hfx_res_1d    (ji) - ze_s(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! heat flux to the ocean [W.m-2], < 0 
     166               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos        * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! mass flux 
    171167               ! updates 
    172                dh_s_mlt(ji)    = dh_s_mlt(ji) - zh_s(ji,jk) 
    173                h_s_1d  (ji)    = h_s_1d(ji) - zh_s(ji,jk) 
     168               dh_s_mlt(ji)    =             dh_s_mlt(ji) - zh_s(ji,jk) 
     169               h_s_1d  (ji)    = MAX( 0._wp, h_s_1d  (ji) - zh_s(ji,jk) ) 
    174170               zh_s    (ji,jk) = 0._wp 
    175                e_s_1d  (ji,jk) = 0._wp 
    176                t_s_1d  (ji,jk) = rt0 
     171               ze_s    (ji,jk) = 0._wp 
    177172            END IF 
    178173         END DO 
    … …  
    181176      ! Snow precipitation 
    182177      !------------------- 
    183       CALL ice_var_snwblow( 1.0_wp - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
    184  
    185       zdeltah(1:npti,:) = 0._wp 
     178      CALL ice_var_snwblow( 1._wp - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
     179 
    186180      DO ji = 1, npti 
    187181         IF( sprecip_1d(ji) > 0._wp ) THEN 
     182            zh_s(ji,0) = zsnw(ji) * sprecip_1d(ji) * rDt_ice * r1_rhos / at_i_1d(ji)   ! thickness of precip 
     183            ze_s(ji,0) = MAX( 0._wp, - qprec_ice_1d(ji) )                              ! enthalpy of the precip (>0, J.m-3) 
    188184            ! 
    189             ! --- precipitation --- 
    190             zdh_s_pre (ji) = zsnw(ji) * sprecip_1d(ji) * rDt_ice * r1_rhos / at_i_1d(ji)   ! thickness change 
    191             zqprec    (ji) = - qprec_ice_1d(ji)                                             ! enthalpy of the precip (>0, J.m-3) 
     185            hfx_spr_1d(ji) = hfx_spr_1d(ji) + ze_s(ji,0) * zh_s(ji,0) * a_i_1d(ji) * r1_Dt_ice   ! heat flux from snow precip (>0, W.m-2) 
     186            wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhos       * zh_s(ji,0) * a_i_1d(ji) * r1_Dt_ice   ! mass flux, <0 
    192187            ! 
    193             hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji)    * r1_Dt_ice   ! heat flux from snow precip (>0, W.m-2) 
    194             wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhos          * a_i_1d(ji) * zdh_s_pre(ji) * r1_Dt_ice   ! mass flux, <0 
    195              
    196             ! --- melt of falling snow --- 
    197             rswitch              = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) ) 
    198             zdeltah       (ji,1) = - rswitch * zq_top(ji) / MAX( zqprec(ji) , epsi20 )   ! thickness change 
    199             zdeltah       (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) )                 ! bound melting  
    200             hfx_snw_1d    (ji)   = hfx_snw_1d    (ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji)    * r1_Dt_ice   ! heat used to melt snow (W.m-2, >0) 
    201             wfx_snw_sum_1d(ji)   = wfx_snw_sum_1d(ji) - rhos          * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice   ! snow melting only = water into the ocean (then without snow precip), >0 
    202              
    203             ! updates available heat + precipitations after melting 
    204             dh_s_mlt (ji) = dh_s_mlt(ji) + zdeltah(ji,1) 
    205             zq_top   (ji) = MAX( 0._wp , zq_top (ji) + zdeltah(ji,1) * zqprec(ji) )       
    206             zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
    207              
    208188            ! update thickness 
    209             h_s_1d(ji) = MAX( 0._wp , h_s_1d(ji) + zdh_s_pre(ji) ) 
    210             ! 
    211          ELSE 
    212             ! 
    213             zdh_s_pre(ji) = 0._wp 
    214             zqprec   (ji) = 0._wp 
    215             ! 
     189            h_s_1d(ji) = h_s_1d(ji) + zh_s(ji,0) 
    216190         ENDIF 
    217       END DO 
    218  
    219       ! recalculate snow layers 
    220       DO jk = 1, nlay_s 
    221          DO ji = 1, npti 
    222             zh_s(ji,jk) = h_s_1d(ji) * r1_nlay_s 
    223          END DO 
    224191      END DO 
    225192 
    226193      ! Snow melting 
    227194      ! ------------ 
    228       ! If heat still available (zq_top > 0), then melt more snow 
    229       zdeltah(1:npti,:) = 0._wp 
    230       zdh_s_mel(1:npti) = 0._wp 
    231       DO jk = 1, nlay_s 
     195      ! If heat still available (zq_top > 0) 
     196      ! then all snw precip has been melted and we need to melt more snow 
     197      DO jk = 0, nlay_s 
    232198         DO ji = 1, npti 
    233199            IF( zh_s(ji,jk) > 0._wp .AND. zq_top(ji) > 0._wp ) THEN 
    234200               ! 
    235                rswitch          = MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,jk) - epsi20 ) ) 
    236                zdeltah  (ji,jk) = - rswitch * zq_top(ji) / MAX( e_s_1d(ji,jk), epsi20 )   ! thickness change 
    237                zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji,jk) )                   ! bound melting 
    238                zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk) 
    239                 
    240                hfx_snw_1d(ji)     = hfx_snw_1d(ji)     - zdeltah(ji,jk) * a_i_1d(ji) * e_s_1d (ji,jk) * r1_Dt_ice   ! heat used to melt snow(W.m-2, >0) 
    241                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos           * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice   ! snow melting only = water into the ocean (then without snow precip) 
     201               rswitch = MAX( 0._wp , SIGN( 1._wp , ze_s(ji,jk) - epsi20 ) ) 
     202               zdum    = - rswitch * zq_top(ji) / MAX( ze_s(ji,jk), epsi20 )   ! thickness change 
     203               zdum    = MAX( zdum , - zh_s(ji,jk) )                           ! bound melting 
     204                
     205               hfx_snw_1d    (ji) = hfx_snw_1d    (ji) - ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice   ! heat used to melt snow(W.m-2, >0) 
     206               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos        * zdum * a_i_1d(ji) * r1_Dt_ice   ! snow melting only = water into the ocean 
    242207                
    243208               ! updates available heat + thickness 
    244                dh_s_mlt(ji)    = dh_s_mlt(ji) + zdeltah(ji,jk) 
    245                zq_top  (ji)    = MAX( 0._wp , zq_top(ji) + zdeltah(ji,jk) * e_s_1d(ji,jk) ) 
    246                h_s_1d  (ji)    = MAX( 0._wp , h_s_1d(ji) + zdeltah(ji,jk) ) 
    247                zh_s    (ji,jk) = MAX( 0._wp , zh_s(ji,jk) + zdeltah(ji,jk) ) 
     209               dh_s_mlt(ji)    =              dh_s_mlt(ji)    + zdum 
     210               zq_top  (ji)    = MAX( 0._wp , zq_top  (ji)    + zdum * ze_s(ji,jk) ) 
     211               h_s_1d  (ji)    = MAX( 0._wp , h_s_1d  (ji)    + zdum ) 
     212               zh_s    (ji,jk) = MAX( 0._wp , zh_s    (ji,jk) + zdum ) 
     213!!$               IF( zh_s(ji,jk) == 0._wp )   ze_s(ji,jk) = 0._wp 
    248214               ! 
    249215            ENDIF 
    … …  
    255221      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
    256222      !    comment: not counted in mass/heat exchange in iceupdate.F90 since this is an exchange with atm. (not ocean) 
    257       zdeltah(1:npti,:) = 0._wp 
     223      zdeltah   (1:npti) = 0._wp ! total snow thickness that sublimates, < 0 
     224      zevap_rema(1:npti) = 0._wp 
    258225      DO ji = 1, npti 
    259226         IF( evap_ice_1d(ji) > 0._wp ) THEN 
     227            zdeltah   (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0             
     228            zevap_rema(ji) = MAX( 0._wp, evap_ice_1d(ji) * rDt_ice + zdeltah(ji) * rhos ) ! remaining evap in kg.m-2 (used for ice sublimation later on) 
     229         ENDIF 
     230      END DO 
     231       
     232      DO jk = 0, nlay_s 
     233         DO ji = 1, npti 
     234            zdum = MAX( -zh_s(ji,jk), zdeltah(ji) ) ! snow layer thickness that sublimates, < 0 
    260235            ! 
    261             zdh_s_sub (ji)   = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhos * rDt_ice ) 
    262             zevap_rema(ji)   = evap_ice_1d(ji) * rDt_ice + zdh_s_sub(ji) * rhos   ! remaining evap in kg.m-2 (used for ice melting later on) 
    263             zdeltah   (ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 
    264              
    265             hfx_sub_1d    (ji) = hfx_sub_1d(ji) + &   ! Heat flux by sublimation [W.m-2], < 0 (sublimate snow that had fallen, then pre-existing snow) 
    266                &                 ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * e_s_1d(ji,1) )  & 
    267                &                 * a_i_1d(ji) * r1_Dt_ice 
    268             wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos * a_i_1d(ji) * zdh_s_sub(ji) * r1_Dt_ice   ! Mass flux by sublimation 
    269              
    270             ! new snow thickness 
    271             h_s_1d(ji)    =  MAX( 0._wp , h_s_1d(ji) + zdh_s_sub(ji) ) 
    272             ! update precipitations after sublimation and correct sublimation 
    273             zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
    274             zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 
    275             ! 
    276          ELSE 
    277             ! 
    278             zdh_s_sub (ji) = 0._wp 
    279             zevap_rema(ji) = 0._wp 
    280             ! 
    281          ENDIF 
    282       END DO 
    283        
    284       ! --- Update snow diags --- ! 
    285       DO ji = 1, npti 
    286          dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
    287       END DO 
    288  
    289       ! Update temperature, energy 
    290       !--------------------------- 
    291       ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 
    292       DO jk = 1, nlay_s 
    293          DO ji = 1,npti 
    294             rswitch       = MAX( 0._wp , SIGN( 1._wp, h_s_1d(ji) - epsi20 ) ) 
    295             e_s_1d(ji,jk) = rswitch / MAX( h_s_1d(ji), epsi20 ) *            & 
    296               &             ( ( zdh_s_pre(ji)              ) * zqprec(ji) +  & 
    297               &               ( h_s_1d(ji) - zdh_s_pre(ji) ) * rhos * ( rcpi * ( rt0 - t_s_1d(ji,jk) ) + rLfus ) ) 
    298          END DO 
    299       END DO 
    300        
     236            hfx_sub_1d    (ji) = hfx_sub_1d    (ji) + ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice  ! Heat flux of snw that sublimates [W.m-2], < 0 
     237            wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos        * zdum * a_i_1d(ji) * r1_Dt_ice  ! Mass flux by sublimation 
     238 
     239            ! update thickness 
     240            h_s_1d(ji)    = MAX( 0._wp , h_s_1d(ji)    + zdum ) 
     241            zh_s  (ji,jk) = MAX( 0._wp , zh_s  (ji,jk) + zdum ) 
     242!!$            IF( zh_s(ji,jk) == 0._wp )   ze_s(ji,jk) = 0._wp 
     243 
     244            ! update sublimation left 
     245            zdeltah(ji) = MIN( zdeltah(ji) - zdum, 0._wp ) 
     246         END DO 
     247      END DO 
     248 
     249      !       
    301250      !                       ! ============ ! 
    302251      !                       !     Ice      ! 
    … …  
    305254      ! Surface ice melting  
    306255      !-------------------- 
    307       zdeltah(1:npti,:) = 0._wp ! important 
    308256      DO jk = 1, nlay_i 
    309257         DO ji = 1, npti 
    … …  
    313261 
    314262               zEi            = - e_i_1d(ji,jk) * r1_rhoi             ! Specific enthalpy of layer k [J/kg, <0]        
    315                zdE            = 0._wp                                 ! Specific enthalpy difference (J/kg, <0) 
    316                                                                       ! set up at 0 since no energy is needed to melt water...(it is already melted) 
    317                zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing      
    318                                                                       ! this should normally not happen, but sometimes, heat diffusion leads to this 
    319                zfmdt          = - zdeltah(ji,jk) * rhoi               ! Mass flux x time step > 0 
    320                           
    321                dh_i_itm(ji)   = dh_i_itm(ji) + zdeltah(ji,jk)         ! Cumulate internal melting 
    322                 
    323                zfmdt          = - rhoi * zdeltah(ji,jk)               ! Recompute mass flux [kg/m2, >0] 
    324  
    325                hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0 
    326                !                                                                                                  ice enthalpy zEi is "sent" to the ocean 
    327                sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice    ! Salt flux 
    328                !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok 
    329                wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux 
    330  
     263               zdE            =   0._wp                               ! Specific enthalpy difference (J/kg, <0) 
     264               !                                                          set up at 0 since no energy is needed to melt water...(it is already melted) 
     265               zdum           = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing      
     266               !                                                          this should normally not happen, but sometimes, heat diffusion leads to this 
     267               zfmdt          = - zdum * rhoi                         ! Recompute mass flux [kg/m2, >0] 
     268               ! 
     269               dh_i_itm(ji)   = dh_i_itm(ji) + zdum                   ! Cumulate internal melting 
     270               ! 
     271               hfx_res_1d(ji) = hfx_res_1d(ji) + zEi  * zfmdt             * a_i_1d(ji) * r1_Dt_ice    ! Heat flux to the ocean [W.m-2], <0 
     272               !                                                                                          ice enthalpy zEi is "sent" to the ocean 
     273               wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice    ! Mass flux 
     274               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice    ! Salt flux 
     275               !                                                                                          using s_i_1d and not sz_i_1d(jk) is ok 
    331276            ELSE                                        !-- Surface melting 
    332277                
    … …  
    337282               zfmdt          = - zq_top(ji) / zdE                    ! Mass flux to the ocean [kg/m2, >0] 
    338283                
    339                zdeltah(ji,jk) = - zfmdt * r1_rhoi                     ! Melt of layer jk [m, <0] 
    340                 
    341                zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
    342                 
    343                zq_top(ji)      = MAX( 0._wp , zq_top(ji) - zdeltah(ji,jk) * rhoi * zdE ) ! update available heat 
    344                 
    345                dh_i_sum(ji)   = dh_i_sum(ji) + zdeltah(ji,jk)         ! Cumulate surface melt 
    346                 
    347                zfmdt          = - rhoi * zdeltah(ji,jk)               ! Recompute mass flux [kg/m2, >0] 
     284               zdum          = - zfmdt * r1_rhoi                     ! Melt of layer jk [m, <0] 
     285                
     286               zdum           = MIN( 0._wp , MAX( zdum , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
     287 
     288               zq_top(ji)     = MAX( 0._wp , zq_top(ji) - zdum * rhoi * zdE ) ! update available heat 
     289                
     290               dh_i_sum(ji)   = dh_i_sum(ji) + zdum                   ! Cumulate surface melt 
     291                
     292               zfmdt          = - rhoi * zdum                         ! Recompute mass flux [kg/m2, >0] 
    348293                
    349294               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
    350295                
    351                sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice    ! Salt flux >0 
    352                !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok) 
    353                hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux [W.m-2], < 0 
    354                hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat flux used in this process [W.m-2], > 0   
    355                !  
    356                wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux 
    357                 
     296               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt             * a_i_1d(ji) * r1_Dt_ice    ! Heat flux [W.m-2], < 0 
     297               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zdE  * zfmdt             * a_i_1d(ji) * r1_Dt_ice    ! Heat flux used in this process [W.m-2], > 0   
     298               wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice    ! Mass flux 
     299               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice    ! Salt flux >0 
     300               !                                                                                          using s_i_1d and not sz_i_1d(jk) is ok)  
    358301            END IF 
    359              
     302            ! update thickness 
     303            zh_i(ji,jk) = MAX( 0._wp, zh_i(ji,jk) + zdum ) 
     304            h_i_1d(ji)  = MAX( 0._wp, h_i_1d(ji)  + zdum ) 
     305            ! 
     306            ! update heat content (J.m-2) and layer thickness 
     307            eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdum * e_i_1d(ji,jk) 
     308            h_i_old (ji,jk) = h_i_old (ji,jk) + zdum 
     309            ! 
     310            ! 
    360311            ! Ice sublimation 
    361312            ! --------------- 
    362             zdum            = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoi ) 
    363             zdeltah (ji,jk) = zdeltah (ji,jk) + zdum 
    364             dh_i_sub(ji)    = dh_i_sub(ji)    + zdum 
    365              
    366             sfx_sub_1d(ji)     = sfx_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_Dt_ice  ! Salt flux >0 
    367             !                                                                                          clem: flux is sent to the ocean for simplicity 
    368             !                                                                                                but salt should remain in the ice except 
    369             !                                                                                                if all ice is melted. => must be corrected 
    370             hfx_sub_1d(ji)     = hfx_sub_1d(ji) + zdum * e_i_1d(ji,jk) * a_i_1d(ji) * r1_Dt_ice      ! Heat flux [W.m-2], < 0 
    371  
    372             wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * r1_Dt_ice           ! Mass flux > 0 
    373  
    374             ! update remaining mass flux 
    375             zevap_rema(ji)  = zevap_rema(ji) + zdum * rhoi 
    376              
     313            zdum               = MAX( - zh_i(ji,jk) , - zevap_rema(ji) * r1_rhoi ) 
     314            ! 
     315            hfx_sub_1d(ji)     = hfx_sub_1d(ji)     + e_i_1d(ji,jk) * zdum              * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0 
     316            wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi          * zdum              * a_i_1d(ji) * r1_Dt_ice ! Mass flux > 0 
     317            sfx_sub_1d(ji)     = sfx_sub_1d(ji)     - rhoi          * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0 
     318            !                                                                                                      clem: flux is sent to the ocean for simplicity 
     319            !                                                                                                            but salt should remain in the ice except 
     320            !                                                                                                            if all ice is melted. => must be corrected 
     321            ! update remaining mass flux and thickness 
     322            zevap_rema(ji) = zevap_rema(ji) + zdum * rhoi             
     323            zh_i(ji,jk)    = MAX( 0._wp, zh_i(ji,jk) + zdum ) 
     324            h_i_1d(ji)     = MAX( 0._wp, h_i_1d(ji)  + zdum ) 
     325            dh_i_sub(ji)   = dh_i_sub(ji) + zdum 
     326 
     327            ! update heat content (J.m-2) and layer thickness 
     328            eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdum * e_i_1d(ji,jk) 
     329            h_i_old (ji,jk) = h_i_old (ji,jk) + zdum 
     330 
    377331            ! record which layers have disappeared (for bottom melting)  
    378332            !    => icount=0 : no layer has vanished 
    379333            !    => icount=5 : 5 layers have vanished 
    380             rswitch       = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )  
     334            rswitch       = MAX( 0._wp , SIGN( 1._wp , - zh_i(ji,jk) ) )  
    381335            icount(ji,jk) = NINT( rswitch ) 
    382             zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 
    383336                         
    384             ! update heat content (J.m-2) and layer thickness 
    385             eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk) 
    386             h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    387          END DO 
    388       END DO 
    389        
    390       ! update ice thickness 
    391       DO ji = 1, npti 
    392          h_i_1d(ji) =  MAX( 0._wp , h_i_1d(ji) + dh_i_sum(ji) + dh_i_itm(ji) + dh_i_sub(ji) ) 
    393       END DO 
    394  
     337         END DO 
     338      END DO 
     339       
    395340      ! remaining "potential" evap is sent to ocean 
    396341      DO ji = 1, npti 
    … …  
    430375                  &          + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  , 0.5 ) 
    431376 
    432                s_i_new(ji)   = zswitch_sal * zfracs * sss_1d(ji) + ( 1. - zswitch_sal ) * s_i_1d(ji)  ! New ice salinity 
    433  
    434                ztmelts       = - rTmlt * s_i_new(ji)                                                  ! New ice melting point (C) 
    435  
    436                zt_i_new      = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
    437                 
    438                zEi           = rcpi * ( zt_i_new - (ztmelts+rt0) ) &                                  ! Specific enthalpy of forming ice (J/kg, <0) 
    439                   &            - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts 
    440  
    441                zEw           = rcp  * ( t_bo_1d(ji) - rt0 )                                           ! Specific enthalpy of seawater (J/kg, < 0) 
    442  
    443                zdE           = zEi - zEw                                                              ! Specific enthalpy difference (J/kg, <0) 
    444  
    445                dh_i_bog(ji)  = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) ) 
     377               s_i_new(ji)    = zswitch_sal * zfracs * sss_1d(ji) + ( 1. - zswitch_sal ) * s_i_1d(ji)  ! New ice salinity 
     378 
     379               ztmelts        = - rTmlt * s_i_new(ji)                                                  ! New ice melting point (C) 
     380 
     381               zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
     382                
     383               zEi            = rcpi * ( zt_i_new - (ztmelts+rt0) ) &                                  ! Specific enthalpy of forming ice (J/kg, <0) 
     384                  &             - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts 
     385 
     386               zEw            = rcp  * ( t_bo_1d(ji) - rt0 )                                           ! Specific enthalpy of seawater (J/kg, < 0) 
     387 
     388               zdE            = zEi - zEw                                                              ! Specific enthalpy difference (J/kg, <0) 
     389 
     390               dh_i_bog(ji)   = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) ) 
    446391                
    447392            END DO 
    448393            ! Contribution to Energy and Salt Fluxes                                     
    449             zfmdt          = - rhoi * dh_i_bog(ji)                                                   ! Mass flux x time step (kg/m2, < 0) 
     394            zfmdt = - rhoi * dh_i_bog(ji)                                                              ! Mass flux x time step (kg/m2, < 0) 
    450395             
    451             hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], >0 
    452             hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat flux used in this process [W.m-2], <0 
    453              
    454             sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * s_i_new(ji) * r1_Dt_ice     ! Salt flux, <0 
    455  
    456             wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * r1_Dt_ice                   ! Mass flux, <0 
     396            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt                      * a_i_1d(ji) * r1_Dt_ice   ! Heat flux to the ocean [W.m-2], >0 
     397            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zdE  * zfmdt                      * a_i_1d(ji) * r1_Dt_ice   ! Heat flux used in this process [W.m-2], <0           
     398            wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * dh_i_bog(ji)               * a_i_1d(ji) * r1_Dt_ice   ! Mass flux, <0 
     399            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * s_i_new(ji) * a_i_1d(ji) * r1_Dt_ice   ! Salt flux, <0 
     400 
     401            ! update thickness 
     402            zh_i(ji,nlay_i+1) = zh_i(ji,nlay_i+1) + dh_i_bog(ji) 
     403            h_i_1d(ji)        = h_i_1d(ji)        + dh_i_bog(ji) 
    457404 
    458405            ! update heat content (J.m-2) and layer thickness 
    … …  
    466413      ! Ice Basal melt 
    467414      !--------------- 
    468       zdeltah(1:npti,:) = 0._wp ! important 
    469415      DO jk = nlay_i, 1, -1 
    470416         DO ji = 1, npti 
    … …  
    475421               IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN   !-- Internal melting 
    476422 
    477                   zEi               = - e_i_1d(ji,jk) * r1_rhoi     ! Specific enthalpy of melting ice (J/kg, <0) 
    478                   zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
    479                                                                     !    set up at 0 since no energy is needed to melt water...(it is already melted) 
    480                   zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing      
    481                                                                     ! this should normally not happen, but sometimes, heat diffusion leads to this 
    482  
    483                   dh_i_itm (ji)     = dh_i_itm(ji) + zdeltah(ji,jk) 
    484  
    485                   zfmdt             = - zdeltah(ji,jk) * rhoi      ! Mass flux x time step > 0 
    486  
    487                   hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0 
    488                   !                                                                                                  ice enthalpy zEi is "sent" to the ocean 
    489                   sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice    ! Salt flux 
    490                   !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok 
    491                   wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux 
    492  
    493                   ! update heat content (J.m-2) and layer thickness 
    494                   eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk) 
    495                   h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    496  
     423                  zEi            = - e_i_1d(ji,jk) * r1_rhoi     ! Specific enthalpy of melting ice (J/kg, <0) 
     424                  zdE            = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
     425                  !                                                  set up at 0 since no energy is needed to melt water...(it is already melted) 
     426                  zdum           = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing      
     427                  !                                                  this should normally not happen, but sometimes, heat diffusion leads to this 
     428                  dh_i_itm (ji)  = dh_i_itm(ji) + zdum 
     429                  ! 
     430                  zfmdt          = - zdum * rhoi                 ! Mass flux x time step > 0 
     431                  ! 
     432                  hfx_res_1d(ji) = hfx_res_1d(ji) + zEi  * zfmdt             * a_i_1d(ji) * r1_Dt_ice   ! Heat flux to the ocean [W.m-2], <0 
     433                  !                                                                                         ice enthalpy zEi is "sent" to the ocean 
     434                  wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice   ! Mass flux 
     435                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice   ! Salt flux 
     436                  !                                                                                         using s_i_1d and not sz_i_1d(jk) is ok 
    497437               ELSE                                        !-- Basal melting 
    498438 
    499                   zEi             = - e_i_1d(ji,jk) * r1_rhoi                                 ! Specific enthalpy of melting ice (J/kg, <0) 
    500                   zEw             = rcp * ztmelts                                             ! Specific enthalpy of meltwater (J/kg, <0) 
    501                   zdE             = zEi - zEw                                                 ! Specific enthalpy difference   (J/kg, <0) 
    502  
    503                   zfmdt           = - zq_bot(ji) / zdE                                        ! Mass flux x time step (kg/m2, >0) 
    504  
    505                   zdeltah(ji,jk)  = - zfmdt * r1_rhoi                                         ! Gross thickness change 
    506  
    507                   zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) )       ! bound thickness change 
     439                  zEi            = - e_i_1d(ji,jk) * r1_rhoi                       ! Specific enthalpy of melting ice (J/kg, <0) 
     440                  zEw            = rcp * ztmelts                                   ! Specific enthalpy of meltwater (J/kg, <0) 
     441                  zdE            = zEi - zEw                                       ! Specific enthalpy difference   (J/kg, <0) 
     442 
     443                  zfmdt          = - zq_bot(ji) / zdE                              ! Mass flux x time step (kg/m2, >0) 
     444 
     445                  zdum           = - zfmdt * r1_rhoi                               ! Gross thickness change 
     446 
     447                  zdum           = MIN( 0._wp , MAX( zdum, - zh_i(ji,jk) ) )       ! bound thickness change 
    508448                   
    509                   zq_bot(ji)      = MAX( 0._wp , zq_bot(ji) - zdeltah(ji,jk) * rhoi * zdE )   ! update available heat. MAX is necessary for roundup errors 
    510  
    511                   dh_i_bom(ji)    = dh_i_bom(ji) + zdeltah(ji,jk)                             ! Update basal melt 
    512  
    513                   zfmdt           = - zdeltah(ji,jk) * rhoi                                   ! Mass flux x time step > 0 
    514  
    515                   zQm             = zfmdt * zEw                                               ! Heat exchanged with ocean 
    516  
    517                   hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0   
    518                   hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat used in this process [W.m-2], >0   
    519  
    520                   sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoi *  a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice   ! Salt flux 
    521                   !                                                                                                   using s_i_1d and not sz_i_1d(jk) is ok 
    522                    
    523                   wfx_bom_1d(ji)  = wfx_bom_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux 
    524  
    525                   ! update heat content (J.m-2) and layer thickness 
    526                   eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk) 
    527                   h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
     449                  zq_bot(ji)     = MAX( 0._wp , zq_bot(ji) - zdum * rhoi * zdE )   ! update available heat. MAX is necessary for roundup errors 
     450 
     451                  dh_i_bom(ji)   = dh_i_bom(ji) + zdum                             ! Update basal melt 
     452 
     453                  zfmdt          = - zdum * rhoi                                   ! Mass flux x time step > 0 
     454 
     455                  zQm            = zfmdt * zEw                                     ! Heat exchanged with ocean 
     456 
     457                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt             * a_i_1d(ji) * r1_Dt_ice   ! Heat flux to the ocean [W.m-2], <0   
     458                  hfx_bom_1d(ji) = hfx_bom_1d(ji) - zdE  * zfmdt             * a_i_1d(ji) * r1_Dt_ice   ! Heat used in this process [W.m-2], >0 
     459                  wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice   ! Mass flux 
     460                  sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice   ! Salt flux 
     461                  !                                                                                         using s_i_1d and not sz_i_1d(jk) is ok 
    528462               ENDIF 
    529             
     463               ! update thickness 
     464               zh_i(ji,jk) = MAX( 0._wp, zh_i(ji,jk) + zdum ) 
     465               h_i_1d(ji)  = MAX( 0._wp, h_i_1d(ji)  + zdum ) 
     466               ! 
     467               ! update heat content (J.m-2) and layer thickness 
     468               eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdum * e_i_1d(ji,jk) 
     469               h_i_old (ji,jk) = h_i_old (ji,jk) + zdum 
    530470            ENDIF 
    531471         END DO 
    532472      END DO 
    533473 
    534       ! Update temperature, energy 
    535       ! -------------------------- 
    536       DO ji = 1, npti 
    537          h_i_1d(ji) = MAX( 0._wp , h_i_1d(ji) + dh_i_bog(ji) + dh_i_bom(ji) ) 
    538       END DO   
    539  
    540       ! If heat still available then melt more snow 
    541       !------------------------------------------- 
    542       zdeltah(1:npti,:) = 0._wp ! important 
    543       DO ji = 1, npti 
    544          zq_rema (ji)   = zq_top(ji) + zq_bot(ji)  
    545          rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) )   ! =1 if snow 
    546          rswitch        = rswitch * MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,1) - epsi20 ) ) 
    547          zdeltah (ji,1) = - rswitch * zq_rema(ji) / MAX( e_s_1d(ji,1), epsi20 ) 
    548          zdeltah (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - h_s_1d(ji) ) ) ! bound melting 
    549          dh_s_tot(ji)   = dh_s_tot(ji) + zdeltah(ji,1) 
    550          h_s_1d  (ji)   = h_s_1d  (ji) + zdeltah(ji,1) 
    551          
    552          zq_rema(ji)        = zq_rema(ji) + zdeltah(ji,1) * e_s_1d(ji,1)                               ! update available heat (J.m-2) 
    553          hfx_snw_1d(ji)     = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * e_s_1d(ji,1) * r1_Dt_ice   ! Heat used to melt snow, W.m-2 (>0) 
    554          wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice       ! Mass flux 
    555          dh_s_mlt(ji)       = dh_s_mlt(ji) + zdeltah(ji,1) 
    556          !     
    557          ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 
    558          !!hfx_res_1d(ji) = hfx_res_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_Dt_ice 
    559  
    560          IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
    561       END DO 
    562  
    563       ! 
     474      ! Remove snow if ice has melted entirely 
     475      ! -------------------------------------- 
     476      DO jk = 0, nlay_s 
     477         DO ji = 1,npti 
     478            IF( h_i_1d(ji) == 0._wp ) THEN 
     479               ! mass & energy loss to the ocean 
     480               hfx_res_1d(ji) = hfx_res_1d(ji) - ze_s(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice  ! heat flux to the ocean [W.m-2], < 0 
     481               wfx_res_1d(ji) = wfx_res_1d(ji) + rhos        * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice  ! mass flux 
     482 
     483               ! update thickness and energy 
     484               h_s_1d(ji)    = 0._wp 
     485               ze_s  (ji,jk) = 0._wp 
     486               zh_s  (ji,jk) = 0._wp 
     487            ENDIF 
     488         END DO 
     489      END DO 
     490       
     491      ! Snow load on ice 
     492      ! ----------------- 
     493      ! When snow load exceeds Archimede's limit and sst is positive, 
     494      ! snow-ice formation (next bloc) can lead to negative ice enthalpy. 
     495      ! Therefore we consider here that this excess of snow falls into the ocean 
     496      zdeltah(1:npti) = h_s_1d(1:npti) + h_i_1d(1:npti) * (rhoi-rho0) * r1_rhos 
     497      DO jk = 0, nlay_s 
     498         DO ji = 1, npti 
     499            IF( zdeltah(ji) > 0._wp .AND. sst_1d(ji) > 0._wp ) THEN 
     500               ! snow layer thickness that falls into the ocean 
     501               zdum = MIN( zdeltah(ji) , zh_s(ji,jk) ) 
     502               ! mass & energy loss to the ocean 
     503               hfx_res_1d(ji) = hfx_res_1d(ji) - ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice  ! heat flux to the ocean [W.m-2], < 0 
     504               wfx_res_1d(ji) = wfx_res_1d(ji) + rhos        * zdum * a_i_1d(ji) * r1_Dt_ice  ! mass flux 
     505               ! update thickness and energy 
     506               h_s_1d(ji)    = MAX( 0._wp, h_s_1d(ji)  - zdum ) 
     507               zh_s  (ji,jk) = MAX( 0._wp, zh_s(ji,jk) - zdum ) 
     508               ! update snow thickness that still has to fall 
     509               zdeltah(ji)   = MAX( 0._wp, zdeltah(ji) - zdum ) 
     510            ENDIF 
     511         END DO 
     512      END DO 
     513       
    564514      ! Snow-Ice formation 
    565515      ! ------------------ 
    566       ! When snow load excesses Archimede's limit, snow-ice interface goes down under sea-level,  
    567       ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice 
     516      ! When snow load exceeds Archimede's limit, snow-ice interface goes down under sea-level,  
     517      ! flooding of seawater transforms snow into ice. Thickness that is transformed is dh_snowice (positive for the ice) 
    568518      z1_rho = 1._wp / ( rhos+rho0-rhoi ) 
     519      zdeltah(1:npti) = 0._wp 
    569520      DO ji = 1, npti 
    570521         ! 
    571          dh_snowice(ji) = MAX(  0._wp , ( rhos * h_s_1d(ji) + (rhoi-rho0) * h_i_1d(ji) ) * z1_rho ) 
     522         dh_snowice(ji) = MAX( 0._wp , ( rhos * h_s_1d(ji) + (rhoi-rho0) * h_i_1d(ji) ) * z1_rho ) 
    572523 
    573524         h_i_1d(ji)    = h_i_1d(ji) + dh_snowice(ji) 
    … …  
    579530         zQm            = zfmdt * zEw  
    580531          
    581          hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice ! Heat flux 
    582  
    583          sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_Dt_ice ! Salt flux 
     532         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw        * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux 
     533         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Salt flux 
    584534 
    585535         ! Case constant salinity in time: virtual salt flux to keep salinity constant 
    586536         IF( nn_icesal /= 2 )  THEN 
    587             sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d (ji) * a_i_1d(ji) * zfmdt                  * r1_Dt_ice  & ! put back sss_m     into the ocean 
    588                &                            - s_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice     ! and get  rn_icesal from the ocean  
     537            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d(ji) * zfmdt                 * a_i_1d(ji) * r1_Dt_ice  & ! put back sss_m     into the ocean 
     538               &                            - s_i_1d(ji) * dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice     ! and get  rn_icesal from the ocean  
    589539         ENDIF 
    590540 
    591541         ! Mass flux: All snow is thrown in the ocean, and seawater is taken to replace the volume 
    592          wfx_sni_1d(ji)     = wfx_sni_1d(ji)     - a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice 
    593          wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhos * r1_Dt_ice 
     542         wfx_sni_1d    (ji) = wfx_sni_1d    (ji) - dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice 
     543         wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + dh_snowice(ji) * rhos * a_i_1d(ji) * r1_Dt_ice 
     544 
     545         ! update thickness 
     546         zh_i(ji,0)  = zh_i(ji,0) + dh_snowice(ji) 
     547         zdeltah(ji) =              dh_snowice(ji) 
    594548 
    595549         ! update heat content (J.m-2) and layer thickness 
    596          eh_i_old(ji,0) = eh_i_old(ji,0) + dh_snowice(ji) * e_s_1d(ji,1) + zfmdt * zEw 
    597550         h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 
    598           
    599       END DO 
    600  
    601       ! 
    602       ! Update temperature, energy 
    603       ! -------------------------- 
    604       DO ji = 1, npti 
    605          rswitch     = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) )  
    606          t_su_1d(ji) = rswitch * t_su_1d(ji) + ( 1._wp - rswitch ) * rt0 
    607       END DO 
    608  
     551         eh_i_old(ji,0) = eh_i_old(ji,0) + zfmdt * zEw           ! 1st part (sea water enthalpy) 
     552 
     553      END DO 
     554      ! 
     555      DO jk = nlay_s, 0, -1   ! flooding of snow starts from the base 
     556         DO ji = 1, npti 
     557            zdum           = MIN( zdeltah(ji), zh_s(ji,jk) )     ! amount of snw that floods, > 0 
     558            zh_s(ji,jk)    = MAX( 0._wp, zh_s(ji,jk) - zdum )    ! remove some snow thickness 
     559            eh_i_old(ji,0) = eh_i_old(ji,0) + zdum * ze_s(ji,jk) ! 2nd part (snow enthalpy) 
     560            ! update dh_snowice 
     561            zdeltah(ji)    = MAX( 0._wp, zdeltah(ji) - zdum ) 
     562         END DO 
     563      END DO 
     564      ! 
     565      ! 
     566!!$      ! --- Update snow diags --- ! 
     567!!$      !!clem: this is wrong. dh_s_tot is not used anyway 
     568!!$      DO ji = 1, npti 
     569!!$         dh_s_tot(ji) = dh_s_tot(ji) + dh_s_mlt(ji) + zdeltah(ji) + zdh_s_sub(ji) - dh_snowice(ji) 
     570!!$      END DO 
     571      ! 
     572      ! 
     573      ! Remapping of snw enthalpy on a regular grid 
     574      !-------------------------------------------- 
     575      CALL snw_ent( zh_s, ze_s, e_s_1d ) 
     576       
     577      ! recalculate t_s_1d from e_s_1d 
    609578      DO jk = 1, nlay_s 
    610579         DO ji = 1,npti 
    611             ! where there is no ice or no snow 
    612             rswitch = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) ) ) * ( 1._wp - MAX( 0._wp, SIGN(1._wp, - h_i_1d(ji) ) ) ) 
    613             ! mass & energy loss to the ocean 
    614             hfx_res_1d(ji) = hfx_res_1d(ji) + ( 1._wp - rswitch ) * & 
    615                &                              ( e_s_1d(ji,jk) * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_Dt_ice )  ! heat flux to the ocean [W.m-2], < 0 
    616             wfx_res_1d(ji) = wfx_res_1d(ji) + ( 1._wp - rswitch ) * & 
    617                &                              ( rhos          * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_Dt_ice )  ! mass flux 
    618             ! update energy (mass is updated in the next loop) 
    619             e_s_1d(ji,jk) = rswitch * e_s_1d(ji,jk) 
    620             ! recalculate t_s_1d from e_s_1d 
    621             t_s_1d(ji,jk) = rt0 + rswitch * ( - e_s_1d(ji,jk) * r1_rhos * r1_rcpi + rLfus * r1_rcpi ) 
    622          END DO 
    623       END DO 
     580            IF( h_s_1d(ji) > 0._wp ) THEN 
     581               t_s_1d(ji,jk) = rt0 + ( - e_s_1d(ji,jk) * r1_rhos * r1_rcpi + rLfus * r1_rcpi ) 
     582            ELSE 
     583               t_s_1d(ji,jk) = rt0 
     584            ENDIF 
     585         END DO 
     586      END DO 
     587 
     588      ! Note: remapping of ice enthalpy is done in icethd.F90 
    624589 
    625590      ! --- ensure that a_i = 0 & h_s = 0 where h_i = 0 --- 
    626591      WHERE( h_i_1d(1:npti) == 0._wp )    
    627          a_i_1d(1:npti) = 0._wp 
    628          h_s_1d(1:npti) = 0._wp 
     592         a_i_1d (1:npti) = 0._wp 
     593         h_s_1d (1:npti) = 0._wp 
     594         t_su_1d(1:npti) = rt0 
    629595      END WHERE 
    630       ! 
     596       
    631597   END SUBROUTINE ice_thd_dh 
    632598 
     599   SUBROUTINE snw_ent( ph_old, pe_old, pe_new ) 
     600      !!------------------------------------------------------------------- 
     601      !!               ***   ROUTINE snw_ent  *** 
     602      !! 
     603      !! ** Purpose : 
     604      !!           This routine computes new vertical grids in the snow,  
     605      !!           and consistently redistributes temperatures.  
     606      !!           Redistribution is made so as to ensure to energy conservation 
     607      !! 
     608      !! 
     609      !! ** Method  : linear conservative remapping 
     610      !!            
     611      !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses 
     612      !!            2) linear remapping on the new layers 
     613      !! 
     614      !! ------------ cum0(0)                        ------------- cum1(0) 
     615      !!                                    NEW      ------------- 
     616      !! ------------ cum0(1)               ==>      ------------- 
     617      !!     ...                                     ------------- 
     618      !! ------------                                ------------- 
     619      !! ------------ cum0(nlay_s+1)                 ------------- cum1(nlay_s) 
     620      !! 
     621      !! 
     622      !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 
     623      !!------------------------------------------------------------------- 
     624      REAL(wp), DIMENSION(jpij,0:nlay_s), INTENT(in   ) ::   ph_old             ! old thicknesses (m) 
     625      REAL(wp), DIMENSION(jpij,0:nlay_s), INTENT(in   ) ::   pe_old             ! old enthlapies (J.m-3) 
     626      REAL(wp), DIMENSION(jpij,1:nlay_s), INTENT(inout) ::   pe_new             ! new enthlapies (J.m-3, remapped) 
     627      ! 
     628      INTEGER  :: ji         !  dummy loop indices 
     629      INTEGER  :: jk0, jk1   !  old/new layer indices 
     630      ! 
     631      REAL(wp), DIMENSION(jpij,0:nlay_s+1) ::   zeh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces 
     632      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zeh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces 
     633      REAL(wp), DIMENSION(jpij)            ::   zhnew               ! new layers thicknesses 
     634      !!------------------------------------------------------------------- 
     635 
     636      !-------------------------------------------------------------------------- 
     637      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces 
     638      !-------------------------------------------------------------------------- 
     639      zeh_cum0(1:npti,0) = 0._wp  
     640      zh_cum0 (1:npti,0) = 0._wp 
     641      DO jk0 = 1, nlay_s+1 
     642         DO ji = 1, npti 
     643            zeh_cum0(ji,jk0) = zeh_cum0(ji,jk0-1) + pe_old(ji,jk0-1) * ph_old(ji,jk0-1) 
     644            zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + ph_old(ji,jk0-1) 
     645         END DO 
     646      END DO 
     647 
     648      !------------------------------------ 
     649      !  2) Interpolation on the new layers 
     650      !------------------------------------ 
     651      ! new layer thickesses 
     652      DO ji = 1, npti 
     653         zhnew(ji) = SUM( ph_old(ji,0:nlay_s) ) * r1_nlay_s   
     654      END DO 
     655 
     656      ! new layers interfaces 
     657      zh_cum1(1:npti,0) = 0._wp 
     658      DO jk1 = 1, nlay_s 
     659         DO ji = 1, npti 
     660            zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji) 
     661         END DO 
     662      END DO 
     663 
     664      zeh_cum1(1:npti,0:nlay_s) = 0._wp  
     665      ! new cumulative q*h => linear interpolation 
     666      DO jk0 = 1, nlay_s+1 
     667         DO jk1 = 1, nlay_s-1 
     668            DO ji = 1, npti 
     669               IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN 
     670                  zeh_cum1(ji,jk1) = ( zeh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1  ) ) +  & 
     671                     &                 zeh_cum0(ji,jk0  ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) )  & 
     672                     &             / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) ) 
     673               ENDIF 
     674            END DO 
     675         END DO 
     676      END DO 
     677      ! to ensure that total heat content is strictly conserved, set: 
     678      zeh_cum1(1:npti,nlay_s) = zeh_cum0(1:npti,nlay_s+1)  
     679 
     680      ! new enthalpies 
     681      DO jk1 = 1, nlay_s 
     682         DO ji = 1, npti 
     683            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) )  
     684            pe_new(ji,jk1) = rswitch * ( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) 
     685         END DO 
     686      END DO 
     687       
     688   END SUBROUTINE snw_ent 
     689 
     690    
    633691#else 
    634692   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icethd_pnd.F90

    r13998 r14050  
    2020   USE ice1D          ! sea-ice: thermodynamics variables 
    2121   USE icetab         ! sea-ice: 1D <==> 2D transformation 
     22   USE sbc_ice        ! surface energy budget 
    2223   ! 
    2324   USE in_out_manager ! I/O manager 
     25   USE iom            ! I/O manager library 
    2426   USE lib_mpp        ! MPP library 
    2527   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    … …  
    3436   INTEGER ::              nice_pnd    ! choice of the type of pond scheme 
    3537   !                                   ! associated indices: 
    36    INTEGER, PARAMETER ::   np_pndNO  = 0   ! No pond scheme 
    37    INTEGER, PARAMETER ::   np_pndCST = 1   ! Constant ice pond scheme 
    38    INTEGER, PARAMETER ::   np_pndLEV = 2   ! Level ice pond scheme 
    39  
     38   INTEGER, PARAMETER ::   np_pndNO   = 0   ! No pond scheme 
     39   INTEGER, PARAMETER ::   np_pndCST  = 1   ! Constant ice pond scheme 
     40   INTEGER, PARAMETER ::   np_pndLEV  = 2   ! Level ice pond scheme 
     41   INTEGER, PARAMETER ::   np_pndTOPO = 3   ! Level ice pond scheme 
     42 
     43   !--------------------------------------------------------------------------  
     44   ! Diagnostics for pond volume per area 
     45   ! 
     46   ! dV/dt = mlt + drn + lid + rnf 
     47   ! mlt   = input from surface melting 
     48   ! drn   = drainage through brine network 
     49   ! lid   = lid growth & melt 
     50   ! rnf   = runoff (water directly removed out of surface melting + overflow) 
     51   ! 
     52   ! In topo mode, the pond water lost because it is in the snow is not included in the budget 
     53   ! In level mode, all terms are incorporated 
     54   ! 
     55   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_mlt       ! meltwater pond volume input      [kg/m2/s] 
     56   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_drn       ! pond volume lost by drainage     [-] 
     57   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_lid       ! exchange with lid / refreezing   [-] 
     58   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_rnf       ! meltwater pond lost to runoff    [-]       
     59   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_mlt_1d    ! meltwater pond volume input      [-] 
     60   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_drn_1d    ! pond volume lost by drainage     [-] 
     61   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_lid_1d    ! exchange with lid / refreezing   [-] 
     62   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_rnf_1d    ! meltwater pond lost to runoff    [-] 
     63 
     64   !! * Substitutions 
     65#  include "do_loop_substitute.h90" 
    4066   !!---------------------------------------------------------------------- 
    4167   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    4672 
    4773   SUBROUTINE ice_thd_pnd 
     74 
    4875      !!------------------------------------------------------------------- 
    4976      !!               ***  ROUTINE ice_thd_pnd   *** 
    5077      !!                
    5178      !! ** Purpose :   change melt pond fraction and thickness 
    52       !!                 
     79      !! 
     80      !! ** Note    : Melt ponds affect only radiative transfer for now 
     81      !!              No heat, no salt. 
     82      !!              The current diagnostics lacks a contribution from drainage 
    5383      !!------------------------------------------------------------------- 
     84      INTEGER ::   ji, jj, jl        ! loop indices 
     85      !!------------------------------------------------------------------- 
     86       
     87      ALLOCATE( diag_dvpn_mlt(jpi,jpj), diag_dvpn_lid(jpi,jpj), diag_dvpn_drn(jpi,jpj), diag_dvpn_rnf(jpi,jpj) ) 
     88      ALLOCATE( diag_dvpn_mlt_1d(jpij), diag_dvpn_lid_1d(jpij), diag_dvpn_drn_1d(jpij), diag_dvpn_rnf_1d(jpij) ) 
    5489      ! 
    55       SELECT CASE ( nice_pnd ) 
     90      diag_dvpn_mlt (:,:) = 0._wp   ;   diag_dvpn_drn (:,:) = 0._wp 
     91      diag_dvpn_lid (:,:) = 0._wp   ;   diag_dvpn_rnf (:,:) = 0._wp 
     92      diag_dvpn_mlt_1d(:) = 0._wp   ;   diag_dvpn_drn_1d(:) = 0._wp 
     93      diag_dvpn_lid_1d(:) = 0._wp   ;   diag_dvpn_rnf_1d(:) = 0._wp 
     94 
     95      !------------------------------------- 
     96      !  Remove ponds where ice has vanished 
     97      !------------------------------------- 
     98      at_i(:,:) = SUM( a_i, dim=3 ) 
    5699      ! 
    57       CASE (np_pndCST)   ;   CALL pnd_CST    !==  Constant melt ponds  ==! 
    58          ! 
    59       CASE (np_pndLEV)   ;   CALL pnd_LEV    !==  Level ice melt ponds  ==! 
    60          ! 
    61       END SELECT 
     100      DO jl = 1, jpl 
     101         DO_2D( 1, 1, 1, 1 ) 
     102            IF( v_i(ji,jj,jl) < epsi10 .OR. at_i(ji,jj) < epsi10 ) THEN 
     103               wfx_pnd  (ji,jj)    = wfx_pnd(ji,jj) + ( v_ip(ji,jj,jl) + v_il(ji,jj,jl) ) * rhow * r1_Dt_ice 
     104               a_ip     (ji,jj,jl) = 0._wp 
     105               v_ip     (ji,jj,jl) = 0._wp 
     106               v_il     (ji,jj,jl) = 0._wp 
     107               h_ip     (ji,jj,jl) = 0._wp 
     108               h_il     (ji,jj,jl) = 0._wp 
     109               a_ip_frac(ji,jj,jl) = 0._wp 
     110            ENDIF 
     111         END_2D 
     112      END DO 
     113       
     114      !------------------------------ 
     115      !  Identify grid cells with ice 
     116      !------------------------------ 
     117      npti = 0   ;   nptidx(:) = 0 
     118      DO_2D( 1, 1, 1, 1 ) 
     119         IF( at_i(ji,jj) >= epsi10 ) THEN 
     120            npti = npti + 1 
     121            nptidx( npti ) = (jj - 1) * jpi + ji 
     122         ENDIF 
     123      END_2D 
     124 
     125      !------------------------------------ 
     126      !  Select melt pond scheme to be used 
     127      !------------------------------------ 
     128      IF( npti > 0 ) THEN 
     129         SELECT CASE ( nice_pnd ) 
     130            ! 
     131         CASE (np_pndCST)   ;   CALL pnd_CST                              !==  Constant melt ponds  ==! 
     132            ! 
     133         CASE (np_pndLEV)   ;   CALL pnd_LEV                              !==  Level ice melt ponds  ==! 
     134            ! 
     135         CASE (np_pndTOPO)  ;   CALL pnd_TOPO                             !==  Topographic melt ponds  ==! 
     136            ! 
     137         END SELECT 
     138      ENDIF 
     139 
     140      !------------------------------------ 
     141      !  Diagnostics 
     142      !------------------------------------ 
     143      CALL iom_put( 'dvpn_mlt', diag_dvpn_mlt ) ! input from melting 
     144      CALL iom_put( 'dvpn_lid', diag_dvpn_lid ) ! exchanges with lid 
     145      CALL iom_put( 'dvpn_drn', diag_dvpn_drn ) ! vertical drainage 
     146      CALL iom_put( 'dvpn_rnf', diag_dvpn_rnf ) ! runoff + overflow 
    62147      ! 
     148      DEALLOCATE( diag_dvpn_mlt   , diag_dvpn_lid   , diag_dvpn_drn   , diag_dvpn_rnf    ) 
     149      DEALLOCATE( diag_dvpn_mlt_1d, diag_dvpn_lid_1d, diag_dvpn_drn_1d, diag_dvpn_rnf_1d ) 
     150       
    63151   END SUBROUTINE ice_thd_pnd  
    64152 
    … …  
    80168      !! ** References : Bush, G.W., and Trump, D.J. (2017) 
    81169      !!------------------------------------------------------------------- 
    82       INTEGER  ::   ji        ! loop indices 
     170      INTEGER  ::   ji, jl    ! loop indices 
     171      REAL(wp) ::   zdv_pnd   ! Amount of water going into the ponds & lids 
    83172      !!------------------------------------------------------------------- 
    84       DO ji = 1, npti 
    85          ! 
    86          IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 
    87             h_ip_1d(ji)      = rn_hpnd     
    88             a_ip_1d(ji)      = rn_apnd * a_i_1d(ji) 
    89             h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever 
    90          ELSE 
    91             h_ip_1d(ji)      = 0._wp     
    92             a_ip_1d(ji)      = 0._wp 
    93             h_il_1d(ji)      = 0._wp 
    94          ENDIF 
    95          ! 
     173      DO jl = 1, jpl 
     174          
     175         CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d    (1:npti), a_i    (:,:,jl) ) 
     176         CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d   (1:npti), t_su   (:,:,jl) ) 
     177         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d   (1:npti), a_ip   (:,:,jl) ) 
     178         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d   (1:npti), h_ip   (:,:,jl) ) 
     179         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d   (1:npti), h_il   (:,:,jl) ) 
     180         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:)    ) 
     181 
     182         DO ji = 1, npti 
     183            ! 
     184            zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) 
     185            ! 
     186            IF( a_i_1d(ji) >= 0.01_wp .AND. t_su_1d(ji) >= rt0 ) THEN 
     187               h_ip_1d(ji)      = rn_hpnd     
     188               a_ip_1d(ji)      = rn_apnd * a_i_1d(ji) 
     189               h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever 
     190            ELSE 
     191               h_ip_1d(ji)      = 0._wp     
     192               a_ip_1d(ji)      = 0._wp 
     193               h_il_1d(ji)      = 0._wp 
     194            ENDIF 
     195            ! 
     196            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) 
     197            v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
     198            ! 
     199            zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) - zdv_pnd 
     200            wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zdv_pnd * rhow * r1_Dt_ice 
     201            ! 
     202         END DO 
     203 
     204         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d   (1:npti), a_ip   (:,:,jl) ) 
     205         CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d   (1:npti), h_ip   (:,:,jl) ) 
     206         CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d   (1:npti), h_il   (:,:,jl) ) 
     207         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d   (1:npti), v_ip   (:,:,jl) ) 
     208         CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d   (1:npti), v_il   (:,:,jl) ) 
     209         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:)    ) 
     210 
    96211      END DO 
    97212      ! 
    … …  
    132247      !!                    if no lids:   Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp)                      --- from Holland et al 2012 --- 
    133248      !! 
    134       !!              - Flushing:         w = -perm/visc * rho_oce * grav * Hp / Hi                 --- from Flocco et al 2007 --- 
    135       !!                                     perm = permability of sea-ice 
     249      !!              - Flushing:         w = -perm/visc * rho_oce * grav * Hp / Hi * flush         --- from Flocco et al 2007 --- 
     250      !!                                     perm = permability of sea-ice                              + correction from Hunke et al 2012 (flush) 
    136251      !!                                     visc = water viscosity 
    137252      !!                                     Hp   = height of top of the pond above sea-level 
    138253      !!                                     Hi   = ice thickness thru which there is flushing 
     254      !!                                     flush= correction otherwise flushing is excessive 
    139255      !! 
    140256      !!              - Corrections:      remove melt ponds when lid thickness is 10 times the pond thickness 
    … …  
    143259      !!                                  a_ip/a_i = a_ip_frac = h_ip / zaspect 
    144260      !! 
    145       !! ** Tunable parameters : ln_pnd_lids, rn_apnd_max, rn_apnd_min 
     261      !! ** Tunable parameters : rn_apnd_max, rn_apnd_min, rn_pnd_flush 
    146262      !!  
    147       !! ** Note       :   mostly stolen from CICE 
     263      !! ** Note       :   Mostly stolen from CICE but not only. These are between level-ice ponds and CESM ponds.  
    148264      !! 
    149265      !! ** References :   Flocco and Feltham (JGR, 2007) 
    150266      !!                   Flocco et al       (JGR, 2010) 
    151267      !!                   Holland et al      (J. Clim, 2012) 
    152       !!------------------------------------------------------------------- 
     268      !!                   Hunke et al        (OM 2012) 
     269      !!-------------------------------------------------------------------   
    153270      REAL(wp), DIMENSION(nlay_i) ::   ztmp           ! temporary array 
    154271      !! 
    … …  
    157274      REAL(wp), PARAMETER ::   zvisc   =  1.79e-3_wp  ! water viscosity 
    158275      !! 
    159       REAL(wp) ::   zfr_mlt, zdv_mlt                  ! fraction and volume of available meltwater retained for melt ponding 
     276      REAL(wp) ::   zfr_mlt, zdv_mlt, zdv_avail       ! fraction and volume of available meltwater retained for melt ponding 
    160277      REAL(wp) ::   zdv_frz, zdv_flush                ! Amount of melt pond that freezes, flushes 
     278      REAL(wp) ::   zdv_pnd                           ! Amount of water going into the ponds & lids 
    161279      REAL(wp) ::   zhp                               ! heigh of top of pond lid wrt ssh 
    162280      REAL(wp) ::   zv_ip_max                         ! max pond volume allowed 
    163281      REAL(wp) ::   zdT                               ! zTp-t_su 
    164       REAL(wp) ::   zsbr                              ! Brine salinity 
     282      REAL(wp) ::   zsbr, ztmelts                     ! Brine salinity 
    165283      REAL(wp) ::   zperm                             ! permeability of sea ice 
    166284      REAL(wp) ::   zfac, zdum                        ! temporary arrays 
    167285      REAL(wp) ::   z1_rhow, z1_aspect, z1_Tp         ! inverse 
    168286      !! 
    169       INTEGER  ::   ji, jk                            ! loop indices 
     287      INTEGER  ::   ji, jk, jl                        ! loop indices 
    170288      !!------------------------------------------------------------------- 
    171289      z1_rhow   = 1._wp / rhow  
    172290      z1_aspect = 1._wp / zaspect 
    173291      z1_Tp     = 1._wp / zTp  
    174  
    175       DO ji = 1, npti 
    176          !                                                            !----------------------------------------------------! 
    177          IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < epsi10 ) THEN    ! Case ice thickness < rn_himin or tiny ice fraction ! 
    178             !                                                         !----------------------------------------------------! 
    179             !--- Remove ponds on thin ice or tiny ice fractions 
    180             a_ip_1d(ji)      = 0._wp 
    181             h_ip_1d(ji)      = 0._wp 
    182             h_il_1d(ji)      = 0._wp 
    183             !                                                         !--------------------------------! 
    184          ELSE                                                         ! Case ice thickness >= rn_himin ! 
    185             !                                                         !--------------------------------! 
    186             v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! retrieve volume from thickness 
     292       
     293      CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d          (1:npti), at_i          ) 
     294      CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d       (1:npti), wfx_pnd       ) 
     295       
     296      CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_mlt_1d (1:npti), diag_dvpn_mlt ) 
     297      CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_drn_1d (1:npti), diag_dvpn_drn ) 
     298      CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_lid_1d (1:npti), diag_dvpn_lid ) 
     299      CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_rnf_1d (1:npti), diag_dvpn_rnf ) 
     300 
     301      DO jl = 1, jpl 
     302 
     303         CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d  (1:npti), a_i (:,:,jl) ) 
     304         CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d  (1:npti), h_i (:,:,jl) ) 
     305         CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d (1:npti), t_su(:,:,jl) ) 
     306         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip(:,:,jl) ) 
     307         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip(:,:,jl) ) 
     308         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il(:,:,jl) ) 
     309 
     310         CALL tab_2d_1d( npti, nptidx(1:npti), dh_i_sum(1:npti), dh_i_sum_2d(:,:,jl) ) 
     311         CALL tab_2d_1d( npti, nptidx(1:npti), dh_s_mlt(1:npti), dh_s_mlt_2d(:,:,jl) ) 
     312 
     313         DO jk = 1, nlay_i 
     314            CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,jl) ) 
     315            CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,jl) ) 
     316         END DO 
     317          
     318         !----------------------- 
     319         ! Melt pond calculations 
     320         !----------------------- 
     321         DO ji = 1, npti 
     322            ! 
     323            zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) 
     324            !                                                            !----------------------------------------------------! 
     325            IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < 0.01_wp ) THEN   ! Case ice thickness < rn_himin or tiny ice fraction ! 
     326               !                                                         !----------------------------------------------------! 
     327               !--- Remove ponds on thin ice or tiny ice fractions 
     328               a_ip_1d(ji) = 0._wp 
     329               h_ip_1d(ji) = 0._wp 
     330               h_il_1d(ji) = 0._wp 
     331               !                                                         !--------------------------------! 
     332            ELSE                                                         ! Case ice thickness >= rn_himin ! 
     333               !                                                         !--------------------------------! 
     334               v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! retrieve volume from thickness 
     335               v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
     336               ! 
     337               !------------------! 
     338               ! case ice melting ! 
     339               !------------------! 
     340               ! 
     341               !--- available meltwater for melt ponding (zdv_avail) ---! 
     342               zdv_avail = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) ! > 0 
     343               zfr_mlt   = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) !  = ( 1 - r ) = fraction of melt water that is not flushed 
     344               zdv_mlt   = MAX( 0._wp, zfr_mlt * zdv_avail ) ! max for roundoff errors?  
     345               ! 
     346               !--- overflow ---! 
     347               ! 
     348               ! area driven overflow 
     349               !    If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 
     350               !       a_ip_max = zfr_mlt * a_i 
     351               !       => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     352               zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 
     353               zdv_mlt   = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     354 
     355               ! depth driven overflow 
     356               !    If pond depth exceeds half the ice thickness then reduce the pond volume 
     357               !       h_ip_max = 0.5 * h_i 
     358               !       => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     359               zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 
     360               zdv_mlt   = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     361 
     362               !--- Pond growing ---! 
     363               v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 
     364               ! 
     365               !--- Lid melting ---! 
     366               IF( ln_pnd_lids )   v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 
     367               ! 
     368               !-------------------! 
     369               ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 
     370               !-------------------! 
     371               ! 
     372               zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 
     373               ! 
     374               !--- Pond contraction (due to refreezing) ---! 
     375               IF( ln_pnd_lids ) THEN 
     376                  ! 
     377                  !--- Lid growing and subsequent pond shrinking ---!  
     378                  zdv_frz = - 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 
     379                     &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rDt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 
     380 
     381                  ! Lid growing 
     382                  v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_frz ) 
     383 
     384                  ! Pond shrinking 
     385                  v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zdv_frz ) 
     386 
     387               ELSE 
     388                  zdv_frz = v_ip_1d(ji) * ( EXP( 0.01_wp * zdT * z1_Tp ) - 1._wp )  ! Holland 2012 (eq. 6)  
     389                  ! Pond shrinking 
     390                  v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zdv_frz ) 
     391               ENDIF 
     392               ! 
     393               !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     394               ! v_ip     = h_ip * a_ip 
     395               ! a_ip/a_i = a_ip_frac = h_ip / zaspect (cf Holland 2012, fitting SHEBA so that knowing v_ip we can distribute it to a_ip and h_ip) 
     396               a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
     397               h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     398               ! 
     399 
     400               !------------------------------------------------!             
     401               ! Pond drainage through brine network (flushing) ! 
     402               !------------------------------------------------! 
     403               ! height of top of the pond above sea-level 
     404               zhp = ( h_i_1d(ji) * ( rho0 - rhoi ) + h_ip_1d(ji) * ( rho0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rho0 
     405 
     406               ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 
     407               DO jk = 1, nlay_i 
     408                  ! MV Assur is inconsistent with SI3 
     409                  !!zsbr = - 1.2_wp                                  & 
     410                  !!   &   - 21.8_wp    * ( t_i_1d(ji,jk) - rt0 )    & 
     411                  !!   &   - 0.919_wp   * ( t_i_1d(ji,jk) - rt0 )**2 & 
     412                  !!   &   - 0.0178_wp  * ( t_i_1d(ji,jk) - rt0 )**3 
     413                  !!ztmp(jk) = sz_i_1d(ji,jk) / zsbr 
     414                  ! MV linear expression more consistent & simpler: zsbr = - ( t_i_1d(ji,jk) - rt0 ) / rTmlt 
     415                  ztmelts  = -rTmlt * sz_i_1d(ji,jk) 
     416                  ztmp(jk) = ztmelts / MIN( ztmelts, t_i_1d(ji,jk) - rt0 ) 
     417               END DO 
     418               zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 
     419 
     420               ! Do the drainage using Darcy's law 
     421               zdv_flush   = -zperm * rho0 * grav * zhp * rDt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) * rn_pnd_flush ! zflush comes from Hunke et al. (2012) 
     422               zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) ! < 0  
     423               v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 
     424 
     425               !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     426               a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
     427               h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     428 
     429               !--- Corrections and lid thickness ---! 
     430               IF( ln_pnd_lids ) THEN 
     431                  !--- retrieve lid thickness from volume ---! 
     432                  IF( a_ip_1d(ji) > 0.01_wp ) THEN   ;   h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 
     433                  ELSE                               ;   h_il_1d(ji) = 0._wp 
     434                  ENDIF 
     435                  !--- remove ponds if lids are much larger than ponds ---! 
     436                  IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 
     437                     a_ip_1d(ji) = 0._wp 
     438                     h_ip_1d(ji) = 0._wp 
     439                     h_il_1d(ji) = 0._wp 
     440                  ENDIF 
     441               ENDIF 
     442 
     443               ! diagnostics: dvpnd = mlt+rnf+lid+drn 
     444               diag_dvpn_mlt_1d(ji) = diag_dvpn_mlt_1d(ji) + rhow *   zdv_avail             * r1_Dt_ice   ! > 0, surface melt input 
     445               diag_dvpn_rnf_1d(ji) = diag_dvpn_rnf_1d(ji) + rhow * ( zdv_mlt - zdv_avail ) * r1_Dt_ice   ! < 0, runoff 
     446               diag_dvpn_lid_1d(ji) = diag_dvpn_lid_1d(ji) + rhow *   zdv_frz               * r1_Dt_ice   ! < 0, shrinking 
     447               diag_dvpn_drn_1d(ji) = diag_dvpn_drn_1d(ji) + rhow *   zdv_flush             * r1_Dt_ice   ! < 0, drainage 
     448               ! 
     449            ENDIF 
     450            ! 
     451            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) 
    187452            v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
    188453            ! 
    189             !------------------! 
    190             ! case ice melting ! 
    191             !------------------! 
     454            zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) - zdv_pnd 
     455            wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zdv_pnd * rhow * r1_Dt_ice 
    192456            ! 
    193             !--- available meltwater for melt ponding ---! 
    194             zdum    = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 
    195             zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) !  = ( 1 - r ) = fraction of melt water that is not flushed 
    196             zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! max for roundoff errors?  
    197             ! 
    198             !--- overflow ---! 
    199             ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 
    200             !    a_ip_max = zfr_mlt * a_i 
    201             !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
    202             zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 
    203             zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
    204  
    205             ! If pond depth exceeds half the ice thickness then reduce the pond volume 
    206             !    h_ip_max = 0.5 * h_i 
    207             !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
    208             zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 
    209             zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
    210              
    211             !--- Pond growing ---! 
    212             v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 
    213             ! 
    214             !--- Lid melting ---! 
    215             IF( ln_pnd_lids )   v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 
    216             ! 
    217             !--- mass flux ---! 
    218             IF( zdv_mlt > 0._wp ) THEN 
    219                zfac = zdv_mlt * rhow * r1_Dt_ice                        ! melt pond mass flux < 0 [kg.m-2.s-1] 
    220                wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 
    221                ! 
    222                zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) )    ! adjust ice/snow melting flux > 0 to balance melt pond flux 
    223                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum) 
    224                wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum) 
    225             ENDIF 
    226  
    227             !-------------------! 
    228             ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 
    229             !-------------------! 
    230             ! 
    231             zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 
    232             ! 
    233             !--- Pond contraction (due to refreezing) ---! 
    234             IF( ln_pnd_lids ) THEN 
    235                ! 
    236                !--- Lid growing and subsequent pond shrinking ---!  
    237                zdv_frz = 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 
    238                   &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rdt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 
    239                 
    240                ! Lid growing 
    241                v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) + zdv_frz ) 
    242                 
    243                ! Pond shrinking 
    244                v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) - zdv_frz ) 
    245  
    246             ELSE 
    247                ! Pond shrinking 
    248                v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * zdT * z1_Tp ) ! Holland 2012 (eq. 6) 
    249             ENDIF 
    250             ! 
    251             !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
    252             ! v_ip     = h_ip * a_ip 
    253             ! a_ip/a_i = a_ip_frac = h_ip / zaspect (cf Holland 2012, fitting SHEBA so that knowing v_ip we can distribute it to a_ip and h_ip) 
    254             a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
    255             h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
    256  
    257             !---------------!             
    258             ! Pond flushing ! 
    259             !---------------! 
    260             ! height of top of the pond above sea-level 
    261             zhp = ( h_i_1d(ji) * ( rho0 - rhoi ) + h_ip_1d(ji) * ( rho0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rho0 
    262              
    263             ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 
    264             DO jk = 1, nlay_i 
    265                zsbr = - 1.2_wp                                  & 
    266                   &   - 21.8_wp    * ( t_i_1d(ji,jk) - rt0 )    & 
    267                   &   - 0.919_wp   * ( t_i_1d(ji,jk) - rt0 )**2 & 
    268                   &   - 0.0178_wp  * ( t_i_1d(ji,jk) - rt0 )**3 
    269                ztmp(jk) = sz_i_1d(ji,jk) / zsbr 
    270             END DO 
    271             zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 
    272              
    273             ! Do the drainage using Darcy's law 
    274             zdv_flush   = -zperm * rho0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 
    275             zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) 
    276             v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 
    277              
    278             !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
    279             a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
    280             h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
    281  
    282             !--- Corrections and lid thickness ---! 
    283             IF( ln_pnd_lids ) THEN 
    284                !--- retrieve lid thickness from volume ---! 
    285                IF( a_ip_1d(ji) > epsi10 ) THEN   ;   h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 
    286                ELSE                              ;   h_il_1d(ji) = 0._wp 
    287                ENDIF 
    288                !--- remove ponds if lids are much larger than ponds ---! 
    289                IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 
    290                   a_ip_1d(ji)      = 0._wp 
    291                   h_ip_1d(ji)      = 0._wp 
    292                   h_il_1d(ji)      = 0._wp 
    293                ENDIF 
    294             ENDIF 
    295             ! 
    296          ENDIF 
    297           
     457         END DO 
     458 
     459         !-------------------------------------------------------------------- 
     460         ! Retrieve 2D arrays 
     461         !-------------------------------------------------------------------- 
     462         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d(1:npti), a_ip(:,:,jl) ) 
     463         CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d(1:npti), h_ip(:,:,jl) ) 
     464         CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d(1:npti), h_il(:,:,jl) ) 
     465         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,jl) ) 
     466         CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,jl) ) 
     467         ! 
    298468      END DO 
    299469      ! 
     470      CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd ) 
     471      ! 
     472      CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_mlt_1d (1:npti), diag_dvpn_mlt        ) 
     473      CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_drn_1d (1:npti), diag_dvpn_drn        ) 
     474      CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_lid_1d (1:npti), diag_dvpn_lid        ) 
     475      CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_rnf_1d (1:npti), diag_dvpn_rnf        ) 
     476      ! 
    300477   END SUBROUTINE pnd_LEV 
    301478 
     479 
     480 
     481   SUBROUTINE pnd_TOPO     
     482                                          
     483      !!------------------------------------------------------------------- 
     484      !!                ***  ROUTINE pnd_TOPO  *** 
     485      !! 
     486      !! ** Purpose :   Compute melt pond evolution based on the ice 
     487      !!                topography inferred from the ice thickness distribution 
     488      !! 
     489      !! ** Method  :   This code is initially based on Flocco and Feltham 
     490      !!                (2007) and Flocco et al. (2010).  
     491      !! 
     492      !!                - Calculate available pond water base on surface meltwater 
     493      !!                - Redistribute water as a function of topography, drain water 
     494      !!                - Exchange water with the lid 
     495      !! 
     496      !! ** Tunable parameters : 
     497      !! 
     498      !! ** Note : 
     499      !! 
     500      !! ** References 
     501      !! 
     502      !!    Flocco, D. and D. L. Feltham, 2007.  A continuum model of melt pond 
     503      !!    evolution on Arctic sea ice.  J. Geophys. Res. 112, C08016, doi: 
     504      !!    10.1029/2006JC003836. 
     505      !! 
     506      !!    Flocco, D., D. L. Feltham and A. K. Turner, 2010.  Incorporation of 
     507      !!    a physically based melt pond scheme into the sea ice component of a 
     508      !!    climate model.  J. Geophys. Res. 115, C08012, 
     509      !!    doi: 10.1029/2009JC005568. 
     510      !! 
     511      !!------------------------------------------------------------------- 
     512      REAL(wp), PARAMETER :: &   ! shared parameters for topographic melt ponds 
     513         zTd     = 0.15_wp       , & ! temperature difference for freeze-up (C) 
     514         zvp_min = 1.e-4_wp          ! minimum pond volume (m) 
     515 
     516 
     517      ! local variables 
     518      REAL(wp) :: & 
     519         zdHui,   &      ! change in thickness of ice lid (m) 
     520         zomega,  &      ! conduction 
     521         zdTice,  &      ! temperature difference across ice lid (C) 
     522         zdvice,  &      ! change in ice volume (m) 
     523         zTavg,   &      ! mean surface temperature across categories (C) 
     524         zfsurf,  &      ! net heat flux, excluding conduction and transmitted radiation (W/m2) 
     525         zTp,     &      ! pond freezing temperature (C) 
     526         zrhoi_L, &      ! volumetric latent heat of sea ice (J/m^3) 
     527         zfr_mlt, &      ! fraction and volume of available meltwater retained for melt ponding 
     528         z1_rhow, &      ! inverse water density 
     529         zv_pnd  , &     ! volume of meltwater contributing to ponds 
     530         zv_mlt          ! total amount of meltwater produced 
     531 
     532      REAL(wp), DIMENSION(jpi,jpj) ::   zvolp, &     !! total melt pond water available before redistribution and drainage 
     533                                        zvolp_res    !! remaining melt pond water available after drainage 
     534                                         
     535      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i 
     536 
     537      INTEGER  ::   ji, jj, jk, jl                    ! loop indices 
     538 
     539      INTEGER  ::   i_test 
     540 
     541      ! Note 
     542      ! equivalent for CICE translation 
     543      ! a_ip      -> apond 
     544      ! a_ip_frac -> apnd 
     545 
     546      CALL ctl_stop( 'STOP', 'icethd_pnd : topographic melt ponds are still an ongoing work' ) 
     547       
     548      !--------------------------------------------------------------- 
     549      ! Initialise 
     550      !--------------------------------------------------------------- 
     551 
     552      ! Parameters & constants (move to parameters) 
     553      zrhoi_L   = rhoi * rLfus      ! volumetric latent heat (J/m^3) 
     554      zTp       = rt0 - 0.15_wp          ! pond freezing point, slightly below 0C (ponds are bid saline) 
     555      z1_rhow   = 1._wp / rhow  
     556 
     557      ! Set required ice variables (hard-coded here for now) 
     558!      zfpond(:,:) = 0._wp          ! contributing freshwater flux (?)  
     559       
     560      at_i (:,:) = SUM( a_i (:,:,:), dim=3 ) ! ice fraction 
     561      vt_i (:,:) = SUM( v_i (:,:,:), dim=3 ) ! volume per grid area 
     562      vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) ! pond volume per grid area 
     563      vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) ! lid volume per grid area 
     564       
     565      ! thickness 
     566      WHERE( a_i(:,:,:) > epsi20 )   ;   z1_a_i(:,:,:) = 1._wp / a_i(:,:,:) 
     567      ELSEWHERE                      ;   z1_a_i(:,:,:) = 0._wp 
     568      END WHERE 
     569      h_i(:,:,:) = v_i (:,:,:) * z1_a_i(:,:,:) 
     570       
     571      !--------------------------------------------------------------- 
     572      ! Change 2D to 1D 
     573      !--------------------------------------------------------------- 
     574      ! MV  
     575      ! a less computing-intensive version would have 2D-1D passage here 
     576      ! use what we have in iceitd.F90 (incremental remapping) 
     577 
     578      !-------------------------------------------------------------- 
     579      ! Collect total available pond water volume 
     580      !-------------------------------------------------------------- 
     581      ! Assuming that meltwater (+rain in principle) runsoff the surface 
     582      ! Holland et al (2012) suggest that the fraction of runoff decreases with total ice fraction 
     583      ! I cite her words, they are very talkative 
     584      ! "grid cells with very little ice cover (and hence more open water area)  
     585      ! have a higher runoff fraction to rep- resent the greater proximity of ice to open water." 
     586      ! "This results in the same runoff fraction r for each ice category within a grid cell" 
     587       
     588      zvolp(:,:) = 0._wp 
     589 
     590      DO jl = 1, jpl 
     591         DO_2D( 1, 1, 1, 1 ) 
     592                  
     593               IF ( a_i(ji,jj,jl) > epsi10 ) THEN 
     594             
     595                  !--- Available and contributing meltwater for melt ponding ---! 
     596                  zv_mlt  = - ( dh_i_sum_2d(ji,jj,jl) * rhoi + dh_s_mlt_2d(ji,jj,jl) * rhos ) &        ! available volume of surface melt water per grid area 
     597                     &    * z1_rhow * a_i(ji,jj,jl) 
     598                      ! MV -> could move this directly in ice_thd_dh and get an array (ji,jj,jl) for surface melt water volume per grid area 
     599                  zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i(ji,jj)                  ! fraction of surface meltwater going to ponds 
     600                  zv_pnd  = zfr_mlt * zv_mlt                                                           ! contributing meltwater volume for category jl 
     601 
     602                  diag_dvpn_mlt(ji,jj) = diag_dvpn_mlt(ji,jj) + zv_mlt * r1_Dt_ice                     ! diags 
     603                  diag_dvpn_rnf(ji,jj) = diag_dvpn_rnf(ji,jj) + ( 1. - zfr_mlt ) * zv_mlt * r1_Dt_ice    
     604 
     605                  !--- Create possible new ponds 
     606                  ! if pond does not exist, create new pond over full ice area 
     607                  !IF ( a_ip_frac(ji,jj,jl) < epsi10 ) THEN 
     608                  IF ( a_ip(ji,jj,jl) < epsi10 ) THEN 
     609                     a_ip(ji,jj,jl)       = a_i(ji,jj,jl) 
     610                     a_ip_frac(ji,jj,jl)  = 1.0_wp    ! pond fraction of sea ice (apnd for CICE) 
     611                  ENDIF 
     612                   
     613                  !--- Deepen existing ponds with no change in pond fraction, before redistribution and drainage 
     614                  v_ip(ji,jj,jl) = v_ip(ji,jj,jl) +  zv_pnd                                            ! use pond water to increase thickness 
     615                  h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 
     616                   
     617                  !--- Total available pond water volume (pre-existing + newly produced)j 
     618                  zvolp(ji,jj)   = zvolp(ji,jj)   + v_ip(ji,jj,jl)  
     619!                 zfpond(ji,jj) = zfpond(ji,jj) + zpond * a_ip_frac(ji,jj,jl) ! useless for now 
     620                    
     621               ENDIF ! a_i 
     622 
     623         END_2D 
     624      END DO ! ji 
     625                   
     626      !-------------------------------------------------------------- 
     627      ! Redistribute and drain water from ponds 
     628      !--------------------------------------------------------------    
     629      CALL ice_thd_pnd_area( zvolp, zvolp_res ) 
     630                                    
     631      !-------------------------------------------------------------- 
     632      ! Melt pond lid growth and melt 
     633      !--------------------------------------------------------------    
     634       
     635      IF( ln_pnd_lids ) THEN 
     636 
     637         DO_2D( 1, 1, 1, 1 ) 
     638 
     639            IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. vt_ip(ji,jj) > zvp_min * at_i(ji,jj) ) THEN 
     640                   
     641               !-------------------------- 
     642               ! Pond lid growth and melt 
     643               !-------------------------- 
     644               ! Mean surface temperature 
     645               zTavg = 0._wp 
     646               DO jl = 1, jpl 
     647                  zTavg = zTavg + t_su(ji,jj,jl)*a_i(ji,jj,jl) 
     648               END DO 
     649               zTavg = zTavg / a_i(ji,jj,jl) !!! could get a division by zero here 
     650          
     651               DO jl = 1, jpl-1 
     652             
     653                  IF ( v_il(ji,jj,jl) > epsi10 ) THEN 
     654                
     655                     !---------------------------------------------------------------- 
     656                     ! Lid melting: floating upper ice layer melts in whole or part 
     657                     !---------------------------------------------------------------- 
     658                     ! Use Tsfc for each category 
     659                     IF ( t_su(ji,jj,jl) > zTp ) THEN 
     660 
     661                        zdvice = MIN( dh_i_sum_2d(ji,jj,jl)*a_ip(ji,jj,jl), v_il(ji,jj,jl) ) 
     662                         
     663                        IF ( zdvice > epsi10 ) THEN 
     664                         
     665                           v_il (ji,jj,jl) = v_il (ji,jj,jl)   - zdvice 
     666                           v_ip(ji,jj,jl)  = v_ip(ji,jj,jl)    + zdvice ! MV: not sure i understand dh_i_sum seems counted twice -  
     667                                                                        ! as it is already counted in surface melt 
     668!                          zvolp(ji,jj)     = zvolp(ji,jj)     + zdvice ! pointless to calculate total volume (done in icevar) 
     669!                          zfpond(ji,jj)    = fpond(ji,jj)     + zdvice ! pointless to follow fw budget (ponds have no fw) 
     670                      
     671                           IF ( v_il(ji,jj,jl) < epsi10 .AND. v_ip(ji,jj,jl) > epsi10) THEN 
     672                           ! ice lid melted and category is pond covered 
     673                              v_ip(ji,jj,jl)  = v_ip(ji,jj,jl)  + v_il(ji,jj,jl)  
     674!                             zfpond(ji,jj)    = zfpond (ji,jj)    + v_il(ji,jj,jl)  
     675                              v_il(ji,jj,jl)   = 0._wp 
     676                           ENDIF 
     677                           h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) !!! could get a division by zero here 
     678                            
     679                           diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) + zdvice   ! diag 
     680                            
     681                        ENDIF 
     682                         
     683                     !---------------------------------------------------------------- 
     684                     ! Freeze pre-existing lid  
     685                     !---------------------------------------------------------------- 
     686 
     687                     ELSE IF ( v_ip(ji,jj,jl) > epsi10 ) THEN ! Tsfcn(i,j,n) <= Tp 
     688 
     689                        ! differential growth of base of surface floating ice layer 
     690                        zdTice = MAX( - t_su(ji,jj,jl) - zTd , 0._wp ) ! > 0    
     691                        zomega = rcnd_i * zdTice / zrhoi_L 
     692                        zdHui  = SQRT( 2._wp * zomega * rDt_ice + ( v_il(ji,jj,jl) / a_i(ji,jj,jl) )**2 ) & 
     693                               - v_il(ji,jj,jl) / a_i(ji,jj,jl) 
     694                        zdvice = min( zdHui*a_ip(ji,jj,jl) , v_ip(ji,jj,jl) ) 
     695                   
     696                        IF ( zdvice > epsi10 ) THEN 
     697                           v_il (ji,jj,jl)  = v_il(ji,jj,jl)   + zdvice 
     698                           v_ip(ji,jj,jl)   = v_ip(ji,jj,jl)   - zdvice 
     699!                          zvolp(ji,jj)    = zvolp(ji,jj)     - zdvice 
     700!                          zfpond(ji,jj)   = zfpond(ji,jj)    - zdvice 
     701                           h_ip(ji,jj,jl)   = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 
     702                            
     703                           diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) - zdvice    ! diag 
     704                            
     705                        ENDIF 
     706                   
     707                     ENDIF ! Tsfcn(i,j,n) 
     708 
     709                  !---------------------------------------------------------------- 
     710                  ! Freeze new lids 
     711                  !---------------------------------------------------------------- 
     712                  !  upper ice layer begins to form 
     713                  ! note: albedo does not change 
     714 
     715                  ELSE ! v_il < epsi10 
     716                     
     717                     ! thickness of newly formed ice 
     718                     ! the surface temperature of a meltpond is the same as that 
     719                     ! of the ice underneath (0C), and the thermodynamic surface  
     720                     ! flux is the same 
     721                      
     722                     !!! we need net surface energy flux, excluding conduction 
     723                     !!! fsurf is summed over categories in CICE 
     724                     !!! we have the category-dependent flux, let us use it ? 
     725                     zfsurf = qns_ice(ji,jj,jl) + qsr_ice(ji,jj,jl)                      
     726                     zdHui  = MAX ( -zfsurf * rDt_ice/zrhoi_L , 0._wp ) 
     727                     zdvice = MIN ( zdHui * a_ip(ji,jj,jl) , v_ip(ji,jj,jl) ) 
     728                     IF ( zdvice > epsi10 ) THEN 
     729                        v_il (ji,jj,jl)  = v_il(ji,jj,jl)   + zdvice 
     730                        v_ip(ji,jj,jl)   = v_ip(ji,jj,jl)   - zdvice 
     731                         
     732                        diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) - zdvice      ! diag 
     733!                       zvolp(ji,jj)     = zvolp(ji,jj)     - zdvice 
     734!                       zfpond(ji,jj)    = zfpond(ji,jj)    - zdvice 
     735                        h_ip(ji,jj,jl)   = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) ! MV - in principle, this is useless as h_ip is computed in icevar 
     736                     ENDIF 
     737                
     738                  ENDIF  ! v_il 
     739             
     740               END DO ! jl 
     741 
     742            ELSE  ! remove ponds on thin ice 
     743 
     744               v_ip(ji,jj,:) = 0._wp 
     745               v_il(ji,jj,:) = 0._wp 
     746!              zfpond(ji,jj) = zfpond(ji,jj)- zvolp(ji,jj) 
     747!                 zvolp(ji,jj)    = 0._wp          
     748 
     749            ENDIF 
     750 
     751         END_2D 
     752 
     753      ENDIF ! ln_pnd_lids 
     754 
     755      !--------------------------------------------------------------- 
     756      ! Clean-up variables (probably duplicates what icevar would do) 
     757      !--------------------------------------------------------------- 
     758      ! MV comment 
     759      ! In the ideal world, the lines above should update only v_ip, a_ip, v_il 
     760      ! icevar should recompute all other variables (if needed at all) 
     761 
     762      DO jl = 1, jpl 
     763 
     764         DO_2D( 1, 1, 1, 1 ) 
     765 
     766!              ! zap lids on small ponds 
     767!              IF ( a_i(ji,jj,jl) > epsi10 .AND. v_ip(ji,jj,jl) < epsi10 & 
     768!                                          .AND. v_il(ji,jj,jl) > epsi10) THEN 
     769!                 v_il(ji,jj,jl) = 0._wp ! probably uselesss now since we get zap_small 
     770!              ENDIF 
     771       
     772               ! recalculate equivalent pond variables 
     773               IF ( a_ip(ji,jj,jl) > epsi10) THEN 
     774                  h_ip(ji,jj,jl)      = v_ip(ji,jj,jl) / a_i(ji,jj,jl) 
     775                  a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i(ji,jj,jl) ! MV in principle, useless as computed in icevar 
     776                  h_il(ji,jj,jl) = v_il(ji,jj,jl) / a_ip(ji,jj,jl) ! MV in principle, useless as computed in icevar 
     777               ENDIF 
     778!                 h_ip(ji,jj,jl)      = 0._wp ! MV in principle, useless as computed in icevar 
     779!                 h_il(ji,jj,jl)      = 0._wp ! MV in principle, useless as omputed in icevar 
     780!              ENDIF 
     781                
     782         END_2D 
     783 
     784      END DO   ! jl 
     785 
     786 
     787   END SUBROUTINE pnd_TOPO 
     788 
     789    
     790   SUBROUTINE ice_thd_pnd_area( zvolp , zdvolp ) 
     791 
     792       !!------------------------------------------------------------------- 
     793       !!                ***  ROUTINE ice_thd_pnd_area *** 
     794       !! 
     795       !! ** Purpose : Given the total volume of available pond water,  
     796       !!              redistribute and drain water 
     797       !! 
     798       !! ** Method 
     799       !! 
     800       !-----------| 
     801       !           | 
     802       !           |-----------| 
     803       !___________|___________|______________________________________sea-level 
     804       !           |           | 
     805       !           |           |---^--------| 
     806       !           |           |   |        | 
     807       !           |           |   |        |-----------|              |------- 
     808       !           |           |   | alfan  |           |              | 
     809       !           |           |   |        |           |--------------| 
     810       !           |           |   |        |           |              | 
     811       !---------------------------v------------------------------------------- 
     812       !           |           |   ^        |           |              | 
     813       !           |           |   |        |           |--------------| 
     814       !           |           |   | betan  |           |              | 
     815       !           |           |   |        |-----------|              |------- 
     816       !           |           |   |        | 
     817       !           |           |---v------- | 
     818       !           |           | 
     819       !           |-----------| 
     820       !           | 
     821       !-----------| 
     822       ! 
     823       !! 
     824       !!------------------------------------------------------------------ 
     825        
     826       REAL (wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: & 
     827          zvolp,                                       &  ! total available pond water 
     828          zdvolp                                          ! remaining meltwater after redistribution 
     829 
     830       INTEGER ::  & 
     831          ns,      & 
     832          m_index, & 
     833          permflag 
     834 
     835       REAL (wp), DIMENSION(jpl) :: & 
     836          hicen, & 
     837          hsnon, & 
     838          asnon, & 
     839          alfan, & 
     840          betan, & 
     841          cum_max_vol, & 
     842          reduced_aicen 
     843 
     844       REAL (wp), DIMENSION(0:jpl) :: & 
     845          cum_max_vol_tmp 
     846 
     847       REAL (wp) :: & 
     848          hpond, & 
     849          drain, & 
     850          floe_weight, & 
     851          pressure_head, & 
     852          hsl_rel, & 
     853          deltah, & 
     854          perm, & 
     855          msno 
     856 
     857       REAL (wp), parameter :: & 
     858          viscosity = 1.79e-3_wp     ! kinematic water viscosity in kg/m/s 
     859 
     860      REAL(wp), PARAMETER :: &   ! shared parameters for topographic melt ponds 
     861         zvp_min = 1.e-4_wp          ! minimum pond volume (m) 
     862 
     863      INTEGER  ::   ji, jj, jk, jl                    ! loop indices 
     864 
     865       a_ip(:,:,:) = 0._wp 
     866       h_ip(:,:,:) = 0._wp 
     867  
     868       DO_2D( 1, 1, 1, 1 ) 
     869  
     870             IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp(ji,jj) > zvp_min * at_i(ji,jj) ) THEN 
     871  
     872        !------------------------------------------------------------------- 
     873        ! initialize 
     874        !------------------------------------------------------------------- 
     875  
     876        DO jl = 1, jpl 
     877  
     878           !---------------------------------------- 
     879           ! compute the effective snow fraction 
     880           !---------------------------------------- 
     881  
     882           IF (a_i(ji,jj,jl) < epsi10)  THEN 
     883              hicen(jl) =  0._wp 
     884              hsnon(jl) =  0._wp 
     885              reduced_aicen(jl) = 0._wp 
     886              asnon(jl) = 0._wp         !js: in CICE 5.1.2: make sense as the compiler may not initiate the variables 
     887           ELSE 
     888              hicen(jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     889              hsnon(jl) = v_s(ji,jj,jl) / a_i(ji,jj,jl) 
     890              reduced_aicen(jl) = 1._wp ! n=jpl 
     891  
     892              !js: initial code in NEMO_DEV 
     893              !IF (n < jpl) reduced_aicen(jl) = aicen(jl) & 
     894              !                     * (-0.024_wp*hicen(jl) + 0.832_wp) 
     895  
     896              !js: from CICE 5.1.2: this limit reduced_aicen to 0.2 when hicen is too large 
     897              IF (jl < jpl) reduced_aicen(jl) = a_i(ji,jj,jl) &  
     898                                   * max(0.2_wp,(-0.024_wp*hicen(jl) + 0.832_wp)) 
     899  
     900              asnon(jl) = reduced_aicen(jl)  ! effective snow fraction (empirical) 
     901              ! MV should check whether this makes sense to have the same effective snow fraction in here 
     902              ! OLI: it probably doesn't 
     903           END IF 
     904  
     905  ! This choice for alfa and beta ignores hydrostatic equilibium of categories. 
     906  ! Hydrostatic equilibium of the entire ITD is accounted for below, assuming 
     907  ! a surface topography implied by alfa=0.6 and beta=0.4, and rigidity across all 
     908  ! categories.  alfa and beta partition the ITD - they are areas not thicknesses! 
     909  ! Multiplying by hicen, alfan and betan (below) are thus volumes per unit area. 
     910  ! Here, alfa = 60% of the ice area (and since hice is constant in a category, 
     911  ! alfan = 60% of the ice volume) in each category lies above the reference line, 
     912  ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required. 
     913  
     914  ! MV: 
     915  ! Note that this choice is not in the original FF07 paper and has been adopted in CICE 
     916  ! No reason why is explained in the doc, but I guess there is a reason. I'll try to investigate, maybe 
     917  
     918  ! Where does that choice come from ? => OLI : Coz' Chuck Norris said so... 
     919  
     920           alfan(jl) = 0.6 * hicen(jl) 
     921           betan(jl) = 0.4 * hicen(jl) 
     922  
     923           cum_max_vol(jl)     = 0._wp 
     924           cum_max_vol_tmp(jl) = 0._wp 
     925  
     926        END DO ! jpl 
     927  
     928        cum_max_vol_tmp(0) = 0._wp 
     929        drain = 0._wp 
     930        zdvolp(ji,jj) = 0._wp 
     931  
     932        !---------------------------------------------------------- 
     933        ! Drain overflow water, update pond fraction and volume 
     934        !---------------------------------------------------------- 
     935  
     936        !-------------------------------------------------------------------------- 
     937        ! the maximum amount of water that can be contained up to each ice category 
     938        !-------------------------------------------------------------------------- 
     939        ! If melt ponds are too deep to be sustainable given the ITD (OVERFLOW) 
     940        ! Then the excess volume cum_max_vol(jl) drains out of the system 
     941        ! It should be added to wfx_pnd_out 
     942  
     943        DO jl = 1, jpl-1 ! last category can not hold any volume 
     944  
     945           IF (alfan(jl+1) >= alfan(jl) .AND. alfan(jl+1) > 0._wp ) THEN 
     946  
     947              ! total volume in level including snow 
     948              cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl-1) + & 
     949                 (alfan(jl+1) - alfan(jl)) * sum(reduced_aicen(1:jl)) 
     950  
     951              ! subtract snow solid volumes from lower categories in current level 
     952              DO ns = 1, jl 
     953                 cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl) & 
     954                    - rhos/rhow * &     ! free air fraction that can be filled by water 
     955                      asnon(ns)  * &    ! effective areal fraction of snow in that category 
     956                      max(min(hsnon(ns)+alfan(ns)-alfan(jl), alfan(jl+1)-alfan(jl)), 0._wp) 
     957              END DO 
     958  
     959           ELSE ! assume higher categories unoccupied 
     960              cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl-1) 
     961           END IF 
     962           !IF (cum_max_vol_tmp(jl) < z0) THEN 
     963           !   CALL abort_ice('negative melt pond volume') 
     964           !END IF 
     965        END DO 
     966        cum_max_vol_tmp(jpl) = cum_max_vol_tmp(jpl-1)  ! last category holds no volume 
     967        cum_max_vol  (1:jpl) = cum_max_vol_tmp(1:jpl) 
     968  
     969        !---------------------------------------------------------------- 
     970        ! is there more meltwater than can be held in the floe? 
     971        !---------------------------------------------------------------- 
     972        IF (zvolp(ji,jj) >= cum_max_vol(jpl)) THEN 
     973           drain = zvolp(ji,jj) - cum_max_vol(jpl) + epsi10 
     974           zvolp(ji,jj) = zvolp(ji,jj) - drain ! update meltwater volume available 
     975  
     976           diag_dvpn_rnf(ji,jj) = - drain      ! diag - overflow counted in the runoff part (arbitrary choice) 
     977            
     978           zdvolp(ji,jj) = drain         ! this is the drained water 
     979           IF (zvolp(ji,jj) < epsi10) THEN 
     980              zdvolp(ji,jj) = zdvolp(ji,jj) + zvolp(ji,jj) 
     981              zvolp(ji,jj) = 0._wp 
     982           END IF 
     983        END IF 
     984  
     985        ! height and area corresponding to the remaining volume 
     986        ! routine leaves zvolp unchanged 
     987        CALL ice_thd_pnd_depth(reduced_aicen, asnon, hsnon, alfan, zvolp(ji,jj), cum_max_vol, hpond, m_index) 
     988  
     989        DO jl = 1, m_index 
     990           !h_ip(jl) = hpond - alfan(jl) + alfan(1) ! here oui choulde update 
     991           !                                         !  volume instead, no ? 
     992           h_ip(ji,jj,jl) = max((hpond - alfan(jl) + alfan(1)), 0._wp)      !js: from CICE 5.1.2 
     993           a_ip(ji,jj,jl) = reduced_aicen(jl) 
     994           ! in practise, pond fraction depends on the empirical snow fraction 
     995           ! so in turn on ice thickness 
     996        END DO 
     997        !zapond = sum(a_ip(1:m_index))     !js: from CICE 5.1.2; not in Icepack1.1.0-6-gac6195d 
     998  
     999        !------------------------------------------------------------------------ 
     1000        ! Drainage through brine network (permeability) 
     1001        !------------------------------------------------------------------------ 
     1002        !!! drainage due to ice permeability - Darcy's law 
     1003  
     1004        ! sea water level 
     1005        msno = 0._wp  
     1006        DO jl = 1 , jpl 
     1007          msno = msno + v_s(ji,jj,jl) * rhos 
     1008        END DO 
     1009        floe_weight = ( msno + rhoi*vt_i(ji,jj) + rho0*zvolp(ji,jj) ) / at_i(ji,jj) 
     1010        hsl_rel = floe_weight / rho0 & 
     1011                - ( ( sum(betan(:)*a_i(ji,jj,:)) / at_i(ji,jj) ) + alfan(1) ) 
     1012  
     1013        deltah = hpond - hsl_rel 
     1014        pressure_head = grav * rho0 * max(deltah, 0._wp) 
     1015  
     1016        ! drain if ice is permeable 
     1017        permflag = 0 
     1018  
     1019        IF (pressure_head > 0._wp) THEN 
     1020           DO jl = 1, jpl-1 
     1021              IF ( hicen(jl) /= 0._wp ) THEN 
     1022  
     1023              !IF (hicen(jl) > 0._wp) THEN           !js: from CICE 5.1.2 
     1024  
     1025                 perm = 0._wp ! MV ugly dummy patch 
     1026                 CALL ice_thd_pnd_perm(t_i(ji,jj,:,jl),  sz_i(ji,jj,:,jl), perm) ! bof  
     1027                 IF (perm > 0._wp) permflag = 1 
     1028  
     1029                 drain = perm*a_ip(ji,jj,jl)*pressure_head*rDt_ice / & 
     1030                                          (viscosity*hicen(jl)) 
     1031                 zdvolp(ji,jj) = zdvolp(ji,jj) + min(drain, zvolp(ji,jj)) 
     1032                 zvolp(ji,jj) = max(zvolp(ji,jj) - drain, 0._wp) 
     1033  
     1034                 diag_dvpn_drn(ji,jj) = - drain ! diag (could be better coded) 
     1035                  
     1036                 IF (zvolp(ji,jj) < epsi10) THEN 
     1037                    zdvolp(ji,jj) = zdvolp(ji,jj) + zvolp(ji,jj) 
     1038                    zvolp(ji,jj) = 0._wp 
     1039                 END IF 
     1040             END IF 
     1041          END DO 
     1042  
     1043           ! adjust melt pond dimensions 
     1044           IF (permflag > 0) THEN 
     1045              ! recompute pond depth 
     1046             CALL ice_thd_pnd_depth(reduced_aicen, asnon, hsnon, alfan, zvolp(ji,jj), cum_max_vol, hpond, m_index) 
     1047              DO jl = 1, m_index 
     1048                 h_ip(ji,jj,jl) = hpond - alfan(jl) + alfan(1) 
     1049                 a_ip(ji,jj,jl) = reduced_aicen(jl) 
     1050              END DO 
     1051              !zapond = sum(a_ip(1:m_index))       !js: from CICE 5.1.2; not in Icepack1.1.0-6-gac6195d 
     1052           END IF 
     1053        END IF ! pressure_head 
     1054  
     1055        !------------------------------- 
     1056        ! remove water from the snow 
     1057        !------------------------------- 
     1058        !------------------------------------------------------------------------ 
     1059        ! total melt pond volume in category does not include snow volume 
     1060        ! snow in melt ponds is not melted 
     1061        !------------------------------------------------------------------------ 
     1062         
     1063        ! MV here, it seems that we remove some meltwater from the ponds, but I can't really tell 
     1064        ! how much, so I did not diagnose it 
     1065        ! so if there is a problem here, nobody is going to see it... 
     1066         
     1067  
     1068        ! Calculate pond volume for lower categories 
     1069        DO jl = 1,m_index-1 
     1070           v_ip(ji,jj,jl) = a_ip(ji,jj,jl) * h_ip(ji,jj,jl) & ! what is not in the snow 
     1071                          - (rhos/rhow) * asnon(jl) * min(hsnon(jl), h_ip(ji,jj,jl)) 
     1072        END DO 
     1073  
     1074        ! Calculate pond volume for highest category = remaining pond volume 
     1075  
     1076        ! The following is completely unclear to Martin at least 
     1077        ! Could we redefine properly and recode in a more readable way ? 
     1078  
     1079        ! m_index = last category with melt pond 
     1080  
     1081        IF (m_index == 1) v_ip(ji,jj,m_index) = zvolp(ji,jj) ! volume of mw in 1st category is the total volume of melt water 
     1082  
     1083        IF (m_index > 1) THEN 
     1084          IF (zvolp(ji,jj) > sum( v_ip(ji,jj,1:m_index-1))) THEN 
     1085             v_ip(ji,jj,m_index) = zvolp(ji,jj) - sum(v_ip(ji,jj,1:m_index-1)) 
     1086          ELSE 
     1087             v_ip(ji,jj,m_index) = 0._wp  
     1088             h_ip(ji,jj,m_index) = 0._wp 
     1089             a_ip(ji,jj,m_index) = 0._wp 
     1090             ! If remaining pond volume is negative reduce pond volume of 
     1091             ! lower category 
     1092             IF ( zvolp(ji,jj) + epsi10 < SUM(v_ip(ji,jj,1:m_index-1))) & 
     1093              v_ip(ji,jj,m_index-1) = v_ip(ji,jj,m_index-1) - sum(v_ip(ji,jj,1:m_index-1)) + zvolp(ji,jj) 
     1094          END IF 
     1095        END IF 
     1096  
     1097        DO jl = 1,m_index 
     1098           IF (a_ip(ji,jj,jl) > epsi10) THEN 
     1099               h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 
     1100           ELSE 
     1101              zdvolp(ji,jj) = zdvolp(ji,jj) + v_ip(ji,jj,jl) 
     1102              h_ip(ji,jj,jl) = 0._wp  
     1103              v_ip(ji,jj,jl)  = 0._wp 
     1104              a_ip(ji,jj,jl) = 0._wp 
     1105           END IF 
     1106        END DO 
     1107        DO jl = m_index+1, jpl 
     1108           h_ip(ji,jj,jl) = 0._wp  
     1109           a_ip(ji,jj,jl) = 0._wp  
     1110           v_ip(ji,jj,jl) = 0._wp  
     1111        END DO 
     1112         
     1113           ENDIF 
     1114 
     1115     END_2D 
     1116 
     1117    END SUBROUTINE ice_thd_pnd_area 
     1118 
     1119 
     1120    SUBROUTINE ice_thd_pnd_depth(aicen, asnon, hsnon, alfan, zvolp, cum_max_vol, hpond, m_index) 
     1121       !!------------------------------------------------------------------- 
     1122       !!                ***  ROUTINE ice_thd_pnd_depth  *** 
     1123       !! 
     1124       !! ** Purpose :   Compute melt pond depth 
     1125       !!------------------------------------------------------------------- 
     1126 
     1127       REAL (wp), DIMENSION(jpl), INTENT(IN) :: & 
     1128          aicen, & 
     1129          asnon, & 
     1130          hsnon, & 
     1131          alfan, & 
     1132          cum_max_vol 
     1133 
     1134       REAL (wp), INTENT(IN) :: & 
     1135          zvolp 
     1136 
     1137       REAL (wp), INTENT(OUT) :: & 
     1138          hpond 
     1139 
     1140       INTEGER, INTENT(OUT) :: & 
     1141          m_index 
     1142 
     1143       INTEGER :: n, ns 
     1144 
     1145       REAL (wp), DIMENSION(0:jpl+1) :: & 
     1146          hitl, & 
     1147          aicetl 
     1148 
     1149       REAL (wp) :: & 
     1150          rem_vol, & 
     1151          area, & 
     1152          vol, & 
     1153          tmp, & 
     1154          z0   = 0.0_wp 
     1155 
     1156       !---------------------------------------------------------------- 
     1157       ! hpond is zero if zvolp is zero - have we fully drained? 
     1158       !---------------------------------------------------------------- 
     1159 
     1160       IF (zvolp < epsi10) THEN 
     1161        hpond = z0 
     1162        m_index = 0 
     1163       ELSE 
     1164 
     1165        !---------------------------------------------------------------- 
     1166        ! Calculate the category where water fills up to 
     1167        !---------------------------------------------------------------- 
     1168 
     1169        !----------| 
     1170        !          | 
     1171        !          | 
     1172        !          |----------|                                     -- -- 
     1173        !__________|__________|_________________________________________ ^ 
     1174        !          |          |             rem_vol     ^                | Semi-filled 
     1175        !          |          |----------|-- -- -- - ---|-- ---- -- -- --v layer 
     1176        !          |          |          |              | 
     1177        !          |          |          |              |hpond 
     1178        !          |          |          |----------|   |     |------- 
     1179        !          |          |          |          |   |     | 
     1180        !          |          |          |          |---v-----| 
     1181        !          |          | m_index  |          |         | 
     1182        !------------------------------------------------------------- 
     1183 
     1184        m_index = 0  ! 1:m_index categories have water in them 
     1185        DO n = 1, jpl 
     1186           IF (zvolp <= cum_max_vol(n)) THEN 
     1187              m_index = n 
     1188              IF (n == 1) THEN 
     1189                 rem_vol = zvolp 
     1190              ELSE 
     1191                 rem_vol = zvolp - cum_max_vol(n-1) 
     1192              END IF 
     1193              exit ! to break out of the loop 
     1194           END IF 
     1195        END DO 
     1196        m_index = min(jpl-1, m_index) 
     1197 
     1198        !---------------------------------------------------------------- 
     1199        ! semi-filled layer may have m_index different snow in it 
     1200        !---------------------------------------------------------------- 
     1201 
     1202        !-----------------------------------------------------------  ^ 
     1203        !                                                             |  alfan(m_index+1) 
     1204        !                                                             | 
     1205        !hitl(3)-->                             |----------|          | 
     1206        !hitl(2)-->                |------------| * * * * *|          | 
     1207        !hitl(1)-->     |----------|* * * * * * |* * * * * |          | 
     1208        !hitl(0)-->-------------------------------------------------  |  ^ 
     1209        !                various snow from lower categories          |  |alfa(m_index) 
     1210 
     1211        ! hitl - heights of the snow layers from thinner and current categories 
     1212        ! aicetl - area of each snow depth in this layer 
     1213 
     1214        hitl(:) = z0 
     1215        aicetl(:) = z0 
     1216        DO n = 1, m_index 
     1217           hitl(n)   = max(min(hsnon(n) + alfan(n) - alfan(m_index), & 
     1218                                  alfan(m_index+1) - alfan(m_index)), z0) 
     1219           aicetl(n) = asnon(n) 
     1220 
     1221           aicetl(0) = aicetl(0) + (aicen(n) - asnon(n)) 
     1222        END DO 
     1223 
     1224        hitl(m_index+1) = alfan(m_index+1) - alfan(m_index) 
     1225        aicetl(m_index+1) = z0 
     1226 
     1227        !---------------------------------------------------------------- 
     1228        ! reorder array according to hitl 
     1229        ! snow heights not necessarily in height order 
     1230        !---------------------------------------------------------------- 
     1231 
     1232        DO ns = 1, m_index+1 
     1233           DO n = 0, m_index - ns + 1 
     1234              IF (hitl(n) > hitl(n+1)) THEN ! swap order 
     1235                 tmp = hitl(n) 
     1236                 hitl(n) = hitl(n+1) 
     1237                 hitl(n+1) = tmp 
     1238                 tmp = aicetl(n) 
     1239                 aicetl(n) = aicetl(n+1) 
     1240                 aicetl(n+1) = tmp 
     1241              END IF 
     1242           END DO 
     1243        END DO 
     1244 
     1245        !---------------------------------------------------------------- 
     1246        ! divide semi-filled layer into set of sublayers each vertically homogenous 
     1247        !---------------------------------------------------------------- 
     1248 
     1249        !hitl(3)---------------------------------------------------------------- 
     1250        !                                                       | * * * * * * * * 
     1251        !                                                       |* * * * * * * * * 
     1252        !hitl(2)---------------------------------------------------------------- 
     1253        !                                    | * * * * * * * *  | * * * * * * * * 
     1254        !                                    |* * * * * * * * * |* * * * * * * * * 
     1255        !hitl(1)---------------------------------------------------------------- 
     1256        !                 | * * * * * * * *  | * * * * * * * *  | * * * * * * * * 
     1257        !                 |* * * * * * * * * |* * * * * * * * * |* * * * * * * * * 
     1258        !hitl(0)---------------------------------------------------------------- 
     1259        !    aicetl(0)         aicetl(1)           aicetl(2)          aicetl(3) 
     1260 
     1261        ! move up over layers incrementing volume 
     1262        DO n = 1, m_index+1 
     1263 
     1264           area = sum(aicetl(:)) - &                 ! total area of sub-layer 
     1265                (rhos/rho0) * sum(aicetl(n:jpl+1)) ! area of sub-layer occupied by snow 
     1266 
     1267           vol = (hitl(n) - hitl(n-1)) * area      ! thickness of sub-layer times area 
     1268 
     1269           IF (vol >= rem_vol) THEN  ! have reached the sub-layer with the depth within 
     1270              hpond = rem_vol / area + hitl(n-1) + alfan(m_index) - alfan(1) 
     1271 
     1272              exit 
     1273           ELSE  ! still in sub-layer below the sub-layer with the depth 
     1274              rem_vol = rem_vol - vol 
     1275           END IF 
     1276 
     1277        END DO 
     1278 
     1279       END IF 
     1280 
     1281    END SUBROUTINE ice_thd_pnd_depth 
     1282 
     1283 
     1284    SUBROUTINE ice_thd_pnd_perm(ticen, salin, perm) 
     1285       !!------------------------------------------------------------------- 
     1286       !!                ***  ROUTINE ice_thd_pnd_perm *** 
     1287       !! 
     1288       !! ** Purpose :   Determine the liquid fraction of brine in the ice 
     1289       !!                and its permeability 
     1290       !!------------------------------------------------------------------- 
     1291 
     1292       REAL (wp), DIMENSION(nlay_i), INTENT(IN) :: & 
     1293          ticen,  &     ! internal ice temperature (K) 
     1294          salin         ! salinity (ppt)     !js: ppt according to cice 
     1295 
     1296       REAL (wp), INTENT(OUT) :: & 
     1297          perm      ! permeability 
     1298 
     1299       REAL (wp) ::   & 
     1300          Sbr       ! brine salinity 
     1301 
     1302       REAL (wp), DIMENSION(nlay_i) ::   & 
     1303          Tin, &    ! ice temperature 
     1304          phi       ! liquid fraction 
     1305 
     1306       INTEGER :: k 
     1307 
     1308       !----------------------------------------------------------------- 
     1309       ! Compute ice temperatures from enthalpies using quadratic formula 
     1310       !----------------------------------------------------------------- 
     1311 
     1312       DO k = 1,nlay_i 
     1313          Tin(k) = ticen(k) - rt0   !js: from K to degC 
     1314       END DO 
     1315 
     1316       !----------------------------------------------------------------- 
     1317       ! brine salinity and liquid fraction 
     1318       !----------------------------------------------------------------- 
     1319 
     1320       DO k = 1, nlay_i 
     1321        
     1322          Sbr    = - Tin(k) / rTmlt ! Consistent expression with SI3 (linear liquidus) 
     1323          ! Best expression to date is that one (Vancoppenolle et al JGR 2019) 
     1324          ! Sbr  = - 18.7 * Tin(k) - 0.519 * Tin(k)**2 - 0.00535 * Tin(k) **3 
     1325          phi(k) = salin(k) / Sbr 
     1326           
     1327       END DO 
     1328 
     1329       !----------------------------------------------------------------- 
     1330       ! permeability 
     1331       !----------------------------------------------------------------- 
     1332 
     1333       perm = 3.0e-08_wp * (minval(phi))**3 ! Golden et al. (2007) 
     1334 
     1335   END SUBROUTINE ice_thd_pnd_perm 
    3021336 
    3031337   SUBROUTINE ice_thd_pnd_init  
    … …  
    3151349      INTEGER  ::   ios, ioptio   ! Local integer 
    3161350      !! 
    317       NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, & 
     1351      NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, rn_pnd_flush, & 
    3181352         &                          ln_pnd_CST , rn_apnd, rn_hpnd,         & 
     1353         &                          ln_pnd_TOPO,                           & 
    3191354         &                          ln_pnd_lids, ln_pnd_alb 
    3201355      !!------------------------------------------------------------------- 
    … …  
    3321367         WRITE(numout,*) '   Namelist namicethd_pnd:' 
    3331368         WRITE(numout,*) '      Melt ponds activated or not                                 ln_pnd       = ', ln_pnd 
     1369         WRITE(numout,*) '         Topographic melt pond scheme                             ln_pnd_TOPO  = ', ln_pnd_TOPO 
    3341370         WRITE(numout,*) '         Level ice melt pond scheme                               ln_pnd_LEV   = ', ln_pnd_LEV 
    3351371         WRITE(numout,*) '            Minimum ice fraction that contributes to melt ponds   rn_apnd_min  = ', rn_apnd_min 
    3361372         WRITE(numout,*) '            Maximum ice fraction that contributes to melt ponds   rn_apnd_max  = ', rn_apnd_max 
     1373         WRITE(numout,*) '            Pond flushing efficiency                              rn_pnd_flush = ', rn_pnd_flush 
    3371374         WRITE(numout,*) '         Constant ice melt pond scheme                            ln_pnd_CST   = ', ln_pnd_CST 
    3381375         WRITE(numout,*) '            Prescribed pond fraction                              rn_apnd      = ', rn_apnd 
    … …  
    3471384      IF( ln_pnd_CST  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndCST    ;   ENDIF 
    3481385      IF( ln_pnd_LEV  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndLEV    ;   ENDIF 
     1386      IF( ln_pnd_TOPO ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndTOPO   ;   ENDIF 
    3491387      IF( ioptio /= 1 )   & 
    350          & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV or ln_pnd_CST)' ) 
     1388         & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV, ln_pnd_CST or ln_pnd_TOPO)' ) 
    3511389      ! 
    3521390      SELECT CASE( nice_pnd ) 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icethd_zdf_bl99.F90

    r13998 r14050  
    109109      REAL(wp), DIMENSION(jpij) ::   zdqns_ice_b  ! derivative of the surface flux function 
    110110      ! 
    111       REAL(wp), DIMENSION(jpij       )     ::   ztsuold     ! Old surface temperature in the ice 
    112       REAL(wp), DIMENSION(jpij,nlay_i)     ::   ztiold      ! Old temperature in the ice 
    113       REAL(wp), DIMENSION(jpij,nlay_s)     ::   ztsold      ! Old temperature in the snow 
    114       REAL(wp), DIMENSION(jpij,nlay_i)     ::   ztib        ! Temporary temperature in the ice to check the convergence 
    115       REAL(wp), DIMENSION(jpij,nlay_s)     ::   ztsb        ! Temporary temperature in the snow to check the convergence 
    116       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   ztcond_i    ! Ice thermal conductivity 
    117       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   ztcond_i_cp ! copy 
    118       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zradtr_i    ! Radiation transmitted through the ice 
    119       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zradab_i    ! Radiation absorbed in the ice 
    120       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zkappa_i    ! Kappa factor in the ice 
    121       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zeta_i      ! Eta factor in the ice 
    122       REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zradtr_s    ! Radiation transmited through the snow 
    123       REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zradab_s    ! Radiation absorbed in the snow 
    124       REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zkappa_s    ! Kappa factor in the snow 
    125       REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zeta_s      ! Eta factor in the snow 
    126       REAL(wp), DIMENSION(jpij)            ::   zkappa_comb ! Combined snow and ice surface conductivity 
    127       REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindterm    ! 'Ind'ependent term 
    128       REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindtbis    ! Temporary 'ind'ependent term 
    129       REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zdiagbis    ! Temporary 'dia'gonal term 
    130       REAL(wp), DIMENSION(jpij,nlay_i+3,3) ::   ztrid       ! Tridiagonal system terms 
    131       REAL(wp), DIMENSION(jpij)            ::   zq_ini      ! diag errors on heat 
    132       REAL(wp), DIMENSION(jpij)            ::   zghe        ! G(he), th. conduct enhancement factor, mono-cat 
    133       REAL(wp), DIMENSION(jpij)            ::   za_s_fra    ! ice fraction covered by snow  
    134       REAL(wp), DIMENSION(jpij)            ::   isnow       ! snow presence (1) or not (0)  
    135       REAL(wp), DIMENSION(jpij)            ::   isnow_comb  ! snow presence for met-office  
     111      REAL(wp), DIMENSION(jpij       )   ::   ztsuold     ! Old surface temperature in the ice 
     112      REAL(wp), DIMENSION(jpij,nlay_i)   ::   ztiold      ! Old temperature in the ice 
     113      REAL(wp), DIMENSION(jpij,nlay_s)   ::   ztsold      ! Old temperature in the snow 
     114      REAL(wp), DIMENSION(jpij,nlay_i)   ::   ztib        ! Temporary temperature in the ice to check the convergence 
     115      REAL(wp), DIMENSION(jpij,nlay_s)   ::   ztsb        ! Temporary temperature in the snow to check the convergence 
     116      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   ztcond_i    ! Ice thermal conductivity 
     117      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   ztcond_i_cp ! copy 
     118      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   zradtr_i    ! Radiation transmitted through the ice 
     119      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   zradab_i    ! Radiation absorbed in the ice 
     120      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   zkappa_i    ! Kappa factor in the ice 
     121      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   zeta_i      ! Eta factor in the ice 
     122      REAL(wp), DIMENSION(jpij,0:nlay_s) ::   zradtr_s    ! Radiation transmited through the snow 
     123      REAL(wp), DIMENSION(jpij,0:nlay_s) ::   zradab_s    ! Radiation absorbed in the snow 
     124      REAL(wp), DIMENSION(jpij,0:nlay_s) ::   zkappa_s    ! Kappa factor in the snow 
     125      REAL(wp), DIMENSION(jpij,0:nlay_s) ::   zeta_s      ! Eta factor in the snow 
     126      REAL(wp), DIMENSION(jpij)          ::   zkappa_comb ! Combined snow and ice surface conductivity 
     127      REAL(wp), DIMENSION(jpij)          ::   zq_ini      ! diag errors on heat 
     128      REAL(wp), DIMENSION(jpij)          ::   zghe        ! G(he), th. conduct enhancement factor, mono-cat 
     129      REAL(wp), DIMENSION(jpij)          ::   za_s_fra    ! ice fraction covered by snow  
     130      REAL(wp), DIMENSION(jpij)          ::   isnow       ! snow presence (1) or not (0)  
     131      REAL(wp), DIMENSION(jpij)          ::   isnow_comb  ! snow presence for met-office  
     132      REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1)   ::   zindterm    ! 'Ind'ependent term 
     133      REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1)   ::   zindtbis    ! Temporary 'ind'ependent term 
     134      REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1)   ::   zdiagbis    ! Temporary 'dia'gonal term 
     135      REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1,3) ::   ztrid       ! Tridiagonal system terms 
    136136      ! 
    137137      ! Mono-category 
    … …  
    533533            ! Solve the tridiagonal system with Gauss elimination method. 
    534534            ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON, McGraw-Hill 1984 
    535             jm_maxt = 0 
    536             jm_mint = nlay_i+5 
    537             DO ji = 1, npti 
    538                jm_mint = MIN(jm_min(ji),jm_mint) 
    539                jm_maxt = MAX(jm_max(ji),jm_maxt) 
    540             END DO 
    541  
    542             DO jk = jm_mint+1, jm_maxt 
    543                DO ji = 1, npti 
    544                   jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 
     535!!$            jm_maxt = 0 
     536!!$            jm_mint = nlay_i+5 
     537!!$            DO ji = 1, npti 
     538!!$               jm_mint = MIN(jm_min(ji),jm_mint) 
     539!!$               jm_maxt = MAX(jm_max(ji),jm_maxt) 
     540!!$            END DO 
     541!!$            !!clem SNWLAY => check why LIM1D does not get this loop. Is nlay_i+5 correct? 
     542!!$             
     543!!$            DO jk = jm_mint+1, jm_maxt 
     544!!$               DO ji = 1, npti 
     545!!$                  jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 
     546!!$                  zdiagbis(ji,jm) = ztrid   (ji,jm,2) - ztrid(ji,jm,1) * ztrid   (ji,jm-1,3) / zdiagbis(ji,jm-1) 
     547!!$                  zindtbis(ji,jm) = zindterm(ji,jm  ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1  ) / zdiagbis(ji,jm-1) 
     548!!$               END DO 
     549!!$            END DO 
     550            ! clem: maybe one should find a way to reverse this loop for mpi performance 
     551            DO ji = 1, npti 
     552               jm_mint = jm_min(ji) 
     553               jm_maxt = jm_max(ji) 
     554               DO jm = jm_mint+1, jm_maxt 
    545555                  zdiagbis(ji,jm) = ztrid   (ji,jm,2) - ztrid(ji,jm,1) * ztrid   (ji,jm-1,3) / zdiagbis(ji,jm-1) 
    546556                  zindtbis(ji,jm) = zindterm(ji,jm  ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1  ) / zdiagbis(ji,jm-1) 
    … …  
    564574            END DO 
    565575 
     576            ! snow temperatures       
    566577            DO ji = 1, npti 
    567578               ! Variables used after iterations 
    568579               ! Value must be frozen after convergence for MPP independance reason 
    569                IF ( .NOT. l_T_converged(ji) ) THEN 
    570                   ! snow temperatures       
    571                   IF( h_s_1d(ji) > 0._wp ) THEN 
    572                      t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 
    573                   ENDIF 
    574                   ! surface temperature 
     580               IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 
     581                  &   t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 
     582            END DO 
     583            !!clem SNWLAY 
     584            DO jm = nlay_s, 2, -1 
     585               DO ji = 1, npti 
     586                  jk = jm - 1 
     587                  IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 
     588                     &   t_s_1d(ji,jk) = ( zindtbis(ji,jm) - ztrid(ji,jm,3) * t_s_1d(ji,jk+1) ) / zdiagbis(ji,jm) 
     589               END DO 
     590            END DO 
     591             
     592            ! surface temperature 
     593            DO ji = 1, npti 
     594               IF( .NOT. l_T_converged(ji) ) THEN 
    575595                  ztsub(ji) = t_su_1d(ji) 
    576596                  IF( t_su_1d(ji) < rt0 ) THEN 
    577                      t_su_1d(ji) = (  zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) *  & 
    578                         &           ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji)) 
     597                     t_su_1d(ji) = ( zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) *  & 
     598                        &          ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji)) 
    579599                  ENDIF 
    580600               ENDIF 
    581601            END DO 
    582             !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1) 
    583602            ! 
    584603            !-------------------------------------------------------------- 
    … …  
    727746            ! Solve the tridiagonal system with Gauss elimination method. 
    728747            ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON, McGraw-Hill 1984 
    729             jm_maxt = 0 
    730             jm_mint = nlay_i+5 
    731             DO ji = 1, npti 
    732                jm_mint = MIN(jm_min(ji),jm_mint) 
    733                jm_maxt = MAX(jm_max(ji),jm_maxt) 
    734             END DO 
    735              
    736             DO jk = jm_mint+1, jm_maxt 
    737                DO ji = 1, npti 
    738                   jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 
     748!!$            jm_maxt = 0 
     749!!$            jm_mint = nlay_i+5 
     750!!$            DO ji = 1, npti 
     751!!$               jm_mint = MIN(jm_min(ji),jm_mint) 
     752!!$               jm_maxt = MAX(jm_max(ji),jm_maxt) 
     753!!$            END DO 
     754!!$             
     755!!$            DO jk = jm_mint+1, jm_maxt 
     756!!$               DO ji = 1, npti 
     757!!$                  jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 
     758!!$                  zdiagbis(ji,jm) = ztrid   (ji,jm,2) - ztrid(ji,jm,1) * ztrid   (ji,jm-1,3) / zdiagbis(ji,jm-1) 
     759!!$                  zindtbis(ji,jm) = zindterm(ji,jm)   - ztrid(ji,jm,1) * zindtbis(ji,jm-1)   / zdiagbis(ji,jm-1) 
     760!!$               END DO 
     761!!$            END DO 
     762            ! clem: maybe one should find a way to reverse this loop for mpi performance 
     763            DO ji = 1, npti 
     764               jm_mint = jm_min(ji) 
     765               jm_maxt = jm_max(ji) 
     766               DO jm = jm_mint+1, jm_maxt 
    739767                  zdiagbis(ji,jm) = ztrid   (ji,jm,2) - ztrid(ji,jm,1) * ztrid   (ji,jm-1,3) / zdiagbis(ji,jm-1) 
    740                   zindtbis(ji,jm) = zindterm(ji,jm)   - ztrid(ji,jm,1) * zindtbis(ji,jm-1)  / zdiagbis(ji,jm-1) 
     768                  zindtbis(ji,jm) = zindterm(ji,jm  ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1  ) / zdiagbis(ji,jm-1) 
    741769               END DO 
    742770            END DO 
    743              
     771 
    744772            ! ice temperatures 
    745773            DO ji = 1, npti 
    … …  
    761789            ! snow temperatures       
    762790            DO ji = 1, npti 
    763                ! Variable used after iterations 
     791               ! Variables used after iterations 
    764792               ! Value must be frozen after convergence for MPP independance reason 
    765                IF ( .NOT. l_T_converged(ji) ) THEN 
    766                   IF( h_s_1d(ji) > 0._wp ) THEN 
    767                      t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 
    768                   ENDIF 
    769                ENDIF 
    770             END DO 
    771             !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1) 
     793               IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 
     794                  &   t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 
     795            END DO 
     796            !!clem SNWLAY 
     797            DO jm = nlay_s, 2, -1 
     798               DO ji = 1, npti 
     799                  jk = jm - 1 
     800                  IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 
     801                     &   t_s_1d(ji,jk) = ( zindtbis(ji,jm) - ztrid(ji,jm,3) * t_s_1d(ji,jk+1) ) / zdiagbis(ji,jm) 
     802               END DO 
     803            END DO 
    772804            ! 
    773805            !-------------------------------------------------------------- 
    … …  
    923955         !--- Snow-ice interfacial temperature (diagnostic SIMIP) 
    924956         IF( h_s_1d(ji) >= zhs_ssl ) THEN 
    925             t_si_1d(ji) = (   rn_cnd_s       * h_i_1d(ji) * r1_nlay_i * t_s_1d(ji,1)   & 
    926                &            + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s * t_i_1d(ji,1) ) & 
     957            t_si_1d(ji) = (   rn_cnd_s       * h_i_1d(ji) * r1_nlay_i * t_s_1d(ji,nlay_s)   & 
     958               &            + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s * t_i_1d(ji,1)      ) & 
    927959               &          / ( rn_cnd_s       * h_i_1d(ji) * r1_nlay_i & 
    928960               &            + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s ) 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/iceupdate.F90

    r13998 r14050  
    9494      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                  ! 2D workspace 
    9595      !!--------------------------------------------------------------------- 
    96       IF( ln_timing )   CALL timing_start('ice_update') 
     96      IF( ln_timing )   CALL timing_start('iceupdate') 
    9797 
    9898      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    154154         ! ice-ocean  mass flux 
    155155         wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    156             &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) 
     156            &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 
    157157          
    158158         ! snw-ocean mass flux 
    … …  
    160160          
    161161         ! total mass flux at the ocean/ice interface 
    162          fmmflx(ji,jj) =                - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! ice-ocean mass flux saved at least for biogeochemical model 
    163          emp   (ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! atm-ocean + ice-ocean mass flux 
     162         fmmflx(ji,jj) =                - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_pnd(ji,jj) - wfx_err_sub(ji,jj)   ! ice-ocean mass flux saved at least for biogeochemical model 
     163         emp   (ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_pnd(ji,jj) - wfx_err_sub(ji,jj)   ! atm-ocean + ice-ocean mass flux 
    164164 
    165165         ! Salt flux at the ocean surface       
    … …  
    172172         snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step 
    173173         !                                               ! new mass per unit area 
    174          snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) )  
     174         snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) )  
    175175         !                                               ! time evolution of snow+ice mass 
    176176         snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_Dt_ice 
    … …  
    286286      IF( ln_icectl         )   CALL ice_prt       (kt, iiceprt, jiceprt, 3, 'Final state ice_update') ! prints 
    287287      IF( sn_cfctl%l_prtctl )   CALL ice_prt3D     ('iceupdate')                                       ! prints 
    288       IF( ln_timing         )   CALL timing_stop   ('ice_update')                                      ! timing 
     288      IF( ln_timing         )   CALL timing_stop   ('iceupdate')                                       ! timing 
    289289      ! 
    290290   END SUBROUTINE ice_update_flx 
    … …  
    324324      REAL(wp) ::   zflagi                          !   -      - 
    325325      !!--------------------------------------------------------------------- 
    326       IF( ln_timing )   CALL timing_start('ice_update_tau') 
     326      IF( ln_timing )   CALL timing_start('ice_update') 
    327327 
    328328      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    376376      CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp )   ! lateral boundary condition 
    377377      ! 
    378       IF( ln_timing )   CALL timing_stop('ice_update_tau') 
     378      IF( ln_timing )   CALL timing_stop('ice_update') 
    379379      !   
    380380   END SUBROUTINE ice_update_tau 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icevar.F90

    r13998 r14050  
    236236      z1_zhmax =  1._wp / hi_max(jpl)                
    237237      WHERE( h_i(:,:,jpl) > zhmax )   ! bound h_i by hi_max (i.e. 99 m) with associated update of ice area 
    238          h_i  (:,:,jpl) = zhmax 
     238         h_i   (:,:,jpl) = zhmax 
    239239         a_i   (:,:,jpl) = v_i(:,:,jpl) * z1_zhmax  
    240240         z1_a_i(:,:,jpl) = zhmax * z1_v_i(:,:,jpl) 
    … …  
    252252      ELSEWHERE( h_il(:,:,:) >= zhl_max )  ;   a_ip_eff(:,:,:) = 0._wp                  ! lid is very thick. Cover all the pond up with ice and snow 
    253253      ELSEWHERE                            ;   a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * &   ! lid is in between. Expose part of the pond 
    254          &                                                       ( h_il(:,:,:) - zhl_min ) / ( zhl_max - zhl_min ) 
     254         &                                                       ( zhl_max - h_il(:,:,:) ) / ( zhl_max - zhl_min ) 
    255255      END WHERE 
    256256      ! 
    … …  
    534534         DO_2D( 1, 1, 1, 1 ) 
    535535            ! update exchanges with ocean 
    536             sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_Dt_ice 
    537             wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_Dt_ice 
    538             wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_Dt_ice 
     536            sfx_res(ji,jj)  = sfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_Dt_ice 
     537            wfx_res(ji,jj)  = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_Dt_ice 
     538            wfx_res(ji,jj)  = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_Dt_ice 
     539            wfx_pnd(ji,jj)  = wfx_pnd(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * ( v_ip(ji,jj,jl)+v_il(ji,jj,jl) ) * rhow * r1_Dt_ice 
    539540            ! 
    540541            a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) 
    … …  
    551552            v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
    552553            v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 
     554            h_ip (ji,jj,jl) = h_ip (ji,jj,jl) * zswitch(ji,jj) 
     555            h_il (ji,jj,jl) = h_il (ji,jj,jl) * zswitch(ji,jj) 
    553556            ! 
    554557         END_2D 
    … …  
    635638               psv_i  (ji,jj,jl) = 0._wp 
    636639            ENDIF 
     640            IF( pv_ip(ji,jj,jl) < 0._wp .OR. pv_il(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN 
     641               wfx_pnd(ji,jj)    = wfx_pnd(ji,jj) + pv_il(ji,jj,jl) * rhow * z1_dt 
     642               pv_il  (ji,jj,jl) = 0._wp 
     643            ENDIF 
     644            IF( pv_ip(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN 
     645               wfx_pnd(ji,jj)    = wfx_pnd(ji,jj) + pv_ip(ji,jj,jl) * rhow * z1_dt 
     646               pv_ip  (ji,jj,jl) = 0._wp 
     647            ENDIF 
    637648         END_2D 
    638649         ! 
    … …  
    643654      WHERE( pa_i  (:,:,:) < 0._wp )   pa_i  (:,:,:) = 0._wp 
    644655      WHERE( pa_ip (:,:,:) < 0._wp )   pa_ip (:,:,:) = 0._wp 
    645       WHERE( pv_ip (:,:,:) < 0._wp )   pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+) 
    646       WHERE( pv_il (:,:,:) < 0._wp )   pv_il (:,:,:) = 0._wp !    but it does not change conservation, so keep it this way is ok 
    647656      ! 
    648657   END SUBROUTINE ice_var_zapneg 
    … …  
    675684      WHERE( pe_i (1:npti,:,:) < 0._wp )   pe_i (1:npti,:,:) = 0._wp   !  e_i must be >= 0 
    676685      WHERE( pe_s (1:npti,:,:) < 0._wp )   pe_s (1:npti,:,:) = 0._wp   !  e_s must be >= 0 
    677       IF( ln_pnd_LEV ) THEN 
     686      IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    678687         WHERE( pa_ip(1:npti,:) < 0._wp )    pa_ip(1:npti,:)   = 0._wp   ! a_ip must be >= 0 
    679688         WHERE( pv_ip(1:npti,:) < 0._wp )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icewri.F90

    r13998 r14050  
    160160      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( 'icebrv_cat'  ,   bv_i * 100.  * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 
    161161      IF( iom_use('iceapnd_cat' ) )   CALL iom_put( 'iceapnd_cat' ,   a_ip         * zmsk00l                                   ) ! melt pond frac for categories 
     162      IF( iom_use('icevpnd_cat' ) )   CALL iom_put( 'icevpnd_cat' ,   v_ip         * zmsk00l                                   ) ! melt pond volume for categories 
    162163      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories 
    163164      IF( iom_use('icehlid_cat' ) )   CALL iom_put( 'icehlid_cat' ,   h_il         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories 
    164       IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac for categories 
     165      IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac per ice area for categories 
    165166      IF( iom_use('iceaepnd_cat') )   CALL iom_put( 'iceaepnd_cat',   a_ip_eff     * zmsk00l                                   ) ! melt pond effective frac for categories 
    166167      IF( iom_use('icealb_cat'  ) )   CALL iom_put( 'icealb_cat'  ,   alb_ice      * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/C1D/step_c1d.F90

    r14018 r14050  
    104104      IF( ln_tradmp )   CALL tra_dmp( kstp, Nbb, Nnn, ts, Nrhs  )  ! internal damping trends- tracers 
    105105      IF(.NOT.ln_linssh)CALL tra_adv( kstp, Nbb, Nnn, ts, Nrhs  )  ! horizontal & vertical advection 
     106      IF( ln_zdfmfc  )  CALL tra_mfc( kstp, Nbb     , ts, Nrhs  )  ! Mass Flux Convection 
    106107      IF( ln_zdfosm  )  CALL tra_osm( kstp, Nnn     , ts, Nrhs  )  ! OSMOSIS non-local tracer fluxes 
    107108                        CALL tra_zdf( kstp, Nbb, Nnn, Nrhs, ts, Naa   )         ! vertical mixing 
    … …  
    122123                        CALL dyn_atf    ( kstp, Nbb, Nnn, Naa , uu, vv, e3t, e3u, e3v )  ! time filtering of "now" fields 
    123124      IF(.NOT.ln_linssh)CALL ssh_atf    ( kstp, Nbb, Nnn, Naa , ssh )                    ! time filtering of "now" sea surface height 
    124       IF( kstp == nit000 .AND. ln_linssh) THEN 
    125          ssh(:,:,Naa) = ssh(:,:,Nnn)  ! init ssh after in ln_linssh case 
     125      IF( kstp == nit000 .AND. ln_linssh) THEN  
     126         ssh(:,:,Naa) = ssh(:,:,Nnn)  ! init ssh after in ln_linssh case  
    126127      ENDIF 
    127128      ! 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynspg.F90

    r13998 r14050  
    66   !! History :  1.0  ! 2005-12  (C. Talandier, G. Madec, V. Garnier)  Original code 
    77   !!            3.2  ! 2009-07  (R. Benshila)  Suppression of rigid-lid option 
     8   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) add Bernoulli Head for 
     9   !!                            wave coupling 
    810   !!---------------------------------------------------------------------- 
    911 
    … …  
    1921   USE sbc_ice , ONLY : snwice_mass, snwice_mass_b 
    2022   USE sbcapr         ! surface boundary condition: atmospheric pressure 
     23   USE sbcwave,  ONLY : bhd_wave 
    2124   USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine) 
    2225   USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine) 
    … …  
    143146         ENDIF 
    144147         ! 
     148         IF( ln_wave .and. ln_bern_srfc ) THEN          !== Add J terms: depth-independent Bernoulli head 
     149            DO_2D( 0, 0, 0, 0 ) 
     150               spgu(ji,jj) = spgu(ji,jj) + ( bhd_wave(ji+1,jj) - bhd_wave(ji,jj) ) / e1u(ji,jj)   !++ bhd_wave from wave model in m2/s2 [BHD parameters in WW3] 
     151               spgv(ji,jj) = spgv(ji,jj) + ( bhd_wave(ji,jj+1) - bhd_wave(ji,jj) ) / e2v(ji,jj) 
     152            END_2D 
     153         ENDIF 
     154         ! 
    145155         DO_3D( 0, 0, 0, 0, 1, jpkm1 )       !== Add all terms to the general trend 
    146156            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynvor.F90

    r13998 r14050  
    2222   !!             -   ! 2018-04  (G. Madec)  add pre-computed gradient for metric term calculation 
    2323   !!            4.x  ! 2020-03  (G. Madec, A. Nasser)  make ln_dynvor_msk truly efficient on relative vorticity 
     24   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) add vortex force trends (ln_vortex_force=T) 
    2425   !!---------------------------------------------------------------------- 
    2526 
    … …  
    4041   USE trddyn         ! trend manager: dynamics 
    4142   USE sbcwave        ! Surface Waves (add Stokes-Coriolis force) 
    42    USE sbc_oce , ONLY : ln_stcor    ! use Stoke-Coriolis force 
     43   USE sbc_oce,  ONLY : ln_stcor, ln_vortex_force   ! use Stoke-Coriolis force 
    4344   ! 
    4445   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    … …  
    126127         ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) ) 
    127128         ! 
    128          ztrdu(:,:,:) = puu(:,:,:,Krhs)            !* planetary vorticity trend (including Stokes-Coriolis force) 
     129         ztrdu(:,:,:) = puu(:,:,:,Krhs)            !* planetary vorticity trend 
    129130         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
    130131         SELECT CASE( nvor_scheme ) 
    131132         CASE( np_ENS )           ;   CALL vor_ens( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! enstrophy conserving scheme 
    132             IF( ln_stcor )            CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    133133         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme 
    134             IF( ln_stcor )            CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    135134         CASE( np_ENT )           ;   CALL vor_enT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (T-pts) 
    136             IF( ln_stcor )            CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    137135         CASE( np_EET )           ;   CALL vor_eeT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (een with e3t) 
    138             IF( ln_stcor )            CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    139136         CASE( np_EEN )           ;   CALL vor_een( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy & enstrophy scheme 
    140             IF( ln_stcor )            CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    141137         END SELECT 
    142138         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
    … …  
    166162         CASE( np_ENT )                        !* energy conserving scheme  (T-pts) 
    167163                             CALL vor_enT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    168             IF( ln_stcor )   CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     164            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     165                             CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend  
     166            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     167                             CALL vor_enT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
     168            ENDIF 
    169169         CASE( np_EET )                        !* energy conserving scheme (een scheme using e3t) 
    170170                             CALL vor_eeT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    171             IF( ln_stcor )   CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     171            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     172                             CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     173            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     174                             CALL vor_eeT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
     175            ENDIF 
    172176         CASE( np_ENE )                        !* energy conserving scheme 
    173177                             CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    174             IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     178            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     179                             CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     180            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     181                             CALL vor_ene( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
     182            ENDIF 
    175183         CASE( np_ENS )                        !* enstrophy conserving scheme 
    176184                             CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! total vorticity trend 
    177             IF( ln_stcor )   CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend 
     185 
     186            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     187                             CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend 
     188            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     189                             CALL vor_ens( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend and vortex force 
     190            ENDIF 
    178191         CASE( np_MIX )                        !* mixed ene-ens scheme 
    179192                             CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! relative vorticity or metric trend (ens) 
    180193                             CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! planetary vorticity trend (ene) 
    181             IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     194            IF( ln_stcor )        CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )        ! add the Stokes-Coriolis trend 
     195            IF( ln_vortex_force ) CALL vor_ens( kt, Kmm, nrvm, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add vortex force 
    182196         CASE( np_EEN )                        !* energy and enstrophy conserving scheme 
    183197                             CALL vor_een( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    184             IF( ln_stcor )   CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     198            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     199                             CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     200            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     201                             CALL vor_een( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
     202            ENDIF 
    185203         END SELECT 
    186204         ! 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/dynzad.F90

    r13998 r14050  
    1616   USE trd_oce        ! trends: ocean variables 
    1717   USE trddyn         ! trend manager: dynamics 
     18   USE sbcwave, ONLY: wsd   ! Surface Waves (add vertical Stokes-drift) 
    1819   ! 
    1920   USE in_out_manager ! I/O manager 
    … …  
    7980      DO jk = 2, jpkm1                ! Vertical momentum advection at level w and u- and v- vertical 
    8081         DO_2D( 0, 1, 0, 1 )              ! vertical fluxes 
     82          IF( ln_vortex_force ) THEN 
     83            zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) ) 
     84          ELSE 
    8185            zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
     86          ENDIF 
    8287         END_2D 
    8388         DO_2D( 0, 0, 0, 0 )              ! vertical momentum advection at w-point 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/ICB/icb_oce.F90

    r13286 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/OCE/ICB/icbclv.F90

    r13295 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/OCE/ICB/icbdyn.F90

    r13281 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/OCE/ICB/icbini.F90

    r13295 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/OCE/ICB/icbstp.F90

    r11536 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/OCE/ICB/icbthm.F90

    r13281 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/OCE/ICB/icbtrj.F90

    r13998 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/OCE/ICB/icbutl.F90

    r13281 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/OCE/SBC/cpl_oasis3.F90

    r13998 r14050  
    6666   INTEGER                    ::   nsnd         ! total number of fields sent  
    6767   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    68    INTEGER, PUBLIC, PARAMETER ::   nmaxfld=60   ! Maximum number of coupling fields 
     68   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=62   ! Maximum number of coupling fields 
    6969   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
    7070   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/SBC/sbc_oce.F90

    r13998 r14050  
    1212   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk) 
    1313   !!            4.0  ! 2019-03  (F. Lemarié, G. Samson) add compatibility with ABL mode 
     14   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) modified wave parameters in namelist 
    1415   !!---------------------------------------------------------------------- 
    1516 
    … …  
    3637   LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation 
    3738   LOGICAL , PUBLIC ::   ln_abl         !: Atmospheric boundary layer model 
     39   LOGICAL , PUBLIC ::   ln_wave        !: wave in the system (forced or coupled) 
    3840#if defined key_oasis3 
    3941   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used 
    … …  
    5658   !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step 
    5759   !                                             !:  = 2 annual global mean of e-p-r set to zero 
    58    LOGICAL , PUBLIC ::   ln_wave        !: true if some coupling with wave model 
    59    LOGICAL , PUBLIC ::   ln_cdgw        !: true if neutral drag coefficient from wave model 
    60    LOGICAL , PUBLIC ::   ln_sdw         !: true if 3d stokes drift from wave model 
    61    LOGICAL , PUBLIC ::   ln_tauwoc       !: true if normalized stress from wave is used 
    62    LOGICAL , PUBLIC ::   ln_tauw        !: true if ocean stress components from wave is used 
    63    LOGICAL , PUBLIC ::   ln_stcor       !: true if Stokes-Coriolis term is used 
    64    ! 
    65    INTEGER , PUBLIC ::   nn_sdrift      ! type of parameterization to calculate vertical Stokes drift 
    66    ! 
    6760   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs 
    6861   ! 
    … …  
    7164   !                                   !!* namsbc_cpl namelist * 
    7265   INTEGER , PUBLIC ::   nn_cats_cpl    !: Number of sea ice categories over which the coupling is carried out 
    73  
     66   ! 
     67   !                                   !!* namsbc_wave namelist * 
     68   LOGICAL , PUBLIC ::   ln_sdw         !: =T 3d stokes drift from wave model 
     69   LOGICAL , PUBLIC ::   ln_stcor       !: =T if Stokes-Coriolis and tracer advection terms are used 
     70   LOGICAL , PUBLIC ::   ln_cdgw        !: =T neutral drag coefficient from wave model 
     71   LOGICAL , PUBLIC ::   ln_tauoc       !: =T if normalized stress from wave is used 
     72   LOGICAL , PUBLIC ::   ln_wave_test   !: =T wave test case (constant Stokes drift) 
     73   LOGICAL , PUBLIC ::   ln_charn       !: =T Chranock coefficient from wave model 
     74   LOGICAL , PUBLIC ::   ln_taw         !: =T wind stress corrected by wave intake 
     75   LOGICAL , PUBLIC ::   ln_phioc       !: =T TKE surface BC from wave model  
     76   LOGICAL , PUBLIC ::   ln_bern_srfc   !: Bernoulli head, waves' inuced pressure 
     77   LOGICAL , PUBLIC ::   ln_breivikFV_2016 !: Breivik 2016 profile 
     78   LOGICAL , PUBLIC ::   ln_vortex_force !: vortex force activation 
     79   LOGICAL , PUBLIC ::   ln_stshear     !: Stoked Drift shear contribution in zdftke 
     80   ! 
    7481   !!---------------------------------------------------------------------- 
    7582   !!           switch definition (improve readability) 
    … …  
    8188   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation 
    8289   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 6        !: for OPA when doing coupling via SAS module 
    83  
    84    !!---------------------------------------------------------------------- 
    85    !!           Stokes drift parametrization definition 
    86    !!---------------------------------------------------------------------- 
    87    INTEGER , PUBLIC, PARAMETER ::   jp_breivik_2014 = 0     !: Breivik  2014: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 
    88    INTEGER , PUBLIC, PARAMETER ::   jp_li_2017      = 1     !: Li et al 2017: Stokes drift based on Phillips spectrum (Breivik 2016) 
    89    !  with depth averaged profile 
    90    INTEGER , PUBLIC, PARAMETER ::   jp_peakfr       = 2     !: Li et al 2017: using the peak wave number read from wave model instead 
    91    !  of the inverse depth scale 
    92    LOGICAL , PUBLIC            ::   ll_st_bv2014  = .FALSE. !  logical indicator, .true. if Breivik 2014 parameterisation is active. 
    93    LOGICAL , PUBLIC            ::   ll_st_li2017  = .FALSE. !  logical indicator, .true. if Li 2017 parameterisation is active. 
    94    LOGICAL , PUBLIC            ::   ll_st_bv_li   = .FALSE. !  logical indicator, .true. if either Breivik or Li parameterisation is active. 
    95    LOGICAL , PUBLIC            ::   ll_st_peakfr  = .FALSE. !  logical indicator, .true. if using Li 2017 with peak wave number 
    96  
     90   ! 
    9791   !!---------------------------------------------------------------------- 
    9892   !!           component definition 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/SBC/sbcblk.F90

    r13998 r14050  
    314314         ENDIF 
    315315      END DO 
    316       ! 
    317       IF( ln_wave ) THEN 
    318          !Activated wave module but neither drag nor stokes drift activated 
    319          IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN 
    320             CALL ctl_stop( 'STOP',  'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' ) 
    321             !drag coefficient read from wave model definable only with mfs bulk formulae and core 
    322          ELSEIF(ln_cdgw .AND. .NOT. ln_NCAR )       THEN 
    323             CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 
    324          ELSEIF(ln_stcor .AND. .NOT. ln_sdw)                             THEN 
    325             CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
    326          ENDIF 
    327       ELSE 
    328          IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                & 
    329             &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    & 
    330             &                  'with drag coefficient (ln_cdgw =T) '  ,                        & 
    331             &                  'or Stokes Drift (ln_sdw=T) ' ,                                 & 
    332             &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      & 
    333             &                  'or Stokes-Coriolis term (ln_stcori=T)'  ) 
    334       ENDIF 
    335316      ! 
    336317      IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r13998 r14050  
    1717   !!---------------------------------------------------------------------- 
    1818   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
     19   !!            4.2  !  2020-12  (G. Madec, E. Clementi) Charnock coeff from wave model 
    1920   !!---------------------------------------------------------------------- 
    2021 
    … …  
    3132   USE in_out_manager  ! I/O manager 
    3233   USE prtctl          ! Print control 
    33    USE sbcwave, ONLY   :  cdn_wave ! wave module 
     34   USE sbcwave, ONLY   : charn ! wave module 
    3435#if defined key_si3 || defined key_cice 
    3536   USE sbc_ice         ! Surface boundary condition: ice fields 
    … …  
    233234      u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
    234235 
    235       z0     = charn0*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     236      IF (ln_charn)  THEN          !  Charnock value if wave coupling 
     237         z0     = charn*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     238      ELSE 
     239         z0     = charn0*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     240      ENDIF 
     241 
    236242      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    237243 
    … …  
    302308         ztmp2  = u_star*u_star 
    303309         ztmp1  = znu_a/u_star 
    304          z0     = MIN( ABS( alpha_M*ztmp1 + charn0*ztmp2/grav ) , 0.001_wp) 
     310         IF (ln_charn) THEN     ! Charnock value if wave coupling 
     311            z0  = MIN( ABS( alpha_M*ztmp1 + charn*ztmp2/grav ) , 0.001_wp)          
     312         ELSE 
     313            z0     = MIN( ABS( alpha_M*ztmp1 + charn0*ztmp2/grav ) , 0.001_wp) 
     314         ENDIF 
    305315         z0t    = MIN( ABS( alpha_H*ztmp1                     ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1 
    306316         z0q    = MIN( ABS( alpha_Q*ztmp1                     ) , 0.001_wp) 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/SBC/sbccpl.F90

    r13998 r14050  
    88   !!            3.1  ! 2009_02  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface 
    99   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields 
     10   !!            4.2  ! 2020-12  (G. Madec, E. Clementi)  wave coupling updates 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    106107   INTEGER, PARAMETER ::   jpr_fraqsr = 42   ! fraction of solar net radiation absorbed in the first ocean level 
    107108   INTEGER, PARAMETER ::   jpr_mslp   = 43   ! mean sea level pressure  
    108    INTEGER, PARAMETER ::   jpr_hsig   = 44   ! Hsig  
    109    INTEGER, PARAMETER ::   jpr_phioc  = 45   ! Wave=>ocean energy flux  
    110    INTEGER, PARAMETER ::   jpr_sdrftx = 46   ! Stokes drift on grid 1  
    111    INTEGER, PARAMETER ::   jpr_sdrfty = 47   ! Stokes drift on grid 2  
     109   !**  surface wave coupling  ** 
     110   INTEGER, PARAMETER ::   jpr_hsig   = 44   ! Hsig 
     111   INTEGER, PARAMETER ::   jpr_phioc  = 45   ! Wave=>ocean energy flux 
     112   INTEGER, PARAMETER ::   jpr_sdrftx = 46   ! Stokes drift on grid 1 
     113   INTEGER, PARAMETER ::   jpr_sdrfty = 47   ! Stokes drift on grid 2 
    112114   INTEGER, PARAMETER ::   jpr_wper   = 48   ! Mean wave period 
    113115   INTEGER, PARAMETER ::   jpr_wnum   = 49   ! Mean wavenumber 
    114    INTEGER, PARAMETER ::   jpr_tauwoc = 50   ! Stress fraction adsorbed by waves 
     116   INTEGER, PARAMETER ::   jpr_wstrf = 50   ! Stress fraction adsorbed by waves 
    115117   INTEGER, PARAMETER ::   jpr_wdrag  = 51   ! Neutral surface drag coefficient 
    116    INTEGER, PARAMETER ::   jpr_isf    = 52 
    117    INTEGER, PARAMETER ::   jpr_icb    = 53 
    118    INTEGER, PARAMETER ::   jpr_wfreq  = 54   ! Wave peak frequency 
    119    INTEGER, PARAMETER ::   jpr_tauwx  = 55   ! x component of the ocean stress from waves 
    120    INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves 
    121    INTEGER, PARAMETER ::   jpr_ts_ice = 57   ! Sea ice surface temp 
    122  
    123    INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received   
     118   INTEGER, PARAMETER ::   jpr_charn  = 52   ! Chranock coefficient 
     119   INTEGER, PARAMETER ::   jpr_twox   = 53   ! wave to ocean momentum flux 
     120   INTEGER, PARAMETER ::   jpr_twoy   = 54   ! wave to ocean momentum flux 
     121   INTEGER, PARAMETER ::   jpr_tawx   = 55   ! net wave-supported stress 
     122   INTEGER, PARAMETER ::   jpr_tawy   = 56   ! net wave-supported stress 
     123   INTEGER, PARAMETER ::   jpr_bhd    = 57   ! Bernoulli head. waves' induced surface pressure 
     124   INTEGER, PARAMETER ::   jpr_tusd   = 58   ! zonal stokes transport 
     125   INTEGER, PARAMETER ::   jpr_tvsd   = 59   ! meridional stokes tranmport 
     126   INTEGER, PARAMETER ::   jpr_isf    = 60 
     127   INTEGER, PARAMETER ::   jpr_icb    = 61 
     128   INTEGER, PARAMETER ::   jpr_ts_ice = 62   ! Sea ice surface temp 
     129 
     130   INTEGER, PARAMETER ::   jprcv      = 62   ! total number of fields received   
    124131 
    125132   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
    … …  
    184191      &             sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr 
    185192   !                                   ! Received from the atmosphere 
    186    TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_tauw, sn_rcv_dqnsdt, sn_rcv_qsr,  & 
     193   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr,  & 
    187194      &             sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf, sn_rcv_ts_ice 
    188195   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 
    189    ! Send to waves  
     196   !                                   ! Send to waves  
    190197   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev  
    191    ! Received from waves  
    192    TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc, & 
    193                     sn_rcv_wdrag, sn_rcv_wfreq 
     198   !                                   ! Received from waves  
     199   TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, & 
     200      &             sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd 
    194201   !                                   ! Other namelist parameters 
    195202   INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    … …  
    274281         &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  &  
    275282         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  &  
    276          &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  & 
    277          &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  & 
    278          &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                & 
    279          &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq, sn_rcv_tauw  ,                 & 
    280          &                  sn_rcv_ts_ice 
     283         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_wstrf ,  & 
     284         &                  sn_rcv_charn , sn_rcv_taw   , sn_rcv_bhd  , sn_rcv_tusd  , sn_rcv_tvsd,    & 
     285         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal  ,   & 
     286         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_icb  , sn_rcv_isf   , sn_rcv_ts_ice  
     287 
    281288      !!--------------------------------------------------------------------- 
    282289      ! 
    … …  
    319326         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    320327         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
     328         WRITE(numout,*)'      Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 
     329         WRITE(numout,*)'      surface waves:' 
    321330         WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')'  
    322331         WRITE(numout,*)'      wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')'  
    … …  
    325334         WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')'  
    326335         WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')'  
    327          WRITE(numout,*)'      Wave peak frequency             = ', TRIM(sn_rcv_wfreq%cldes ), ' (', TRIM(sn_rcv_wfreq%clcat ), ')' 
    328          WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_tauwoc%cldes), ' (', TRIM(sn_rcv_tauwoc%clcat ), ')'  
    329          WRITE(numout,*)'      Stress components by waves      = ', TRIM(sn_rcv_tauw%cldes  ), ' (', TRIM(sn_rcv_tauw%clcat  ), ')' 
     336         WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 
    330337         WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')'  
    331          WRITE(numout,*)'      Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')'  
     338         WRITE(numout,*)'      Charnock coefficient            = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')' 
    332339         WRITE(numout,*)'  sent fields (multiple ice categories)' 
    333340         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')' 
    … …  
    351358         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd  
    352359      ENDIF 
    353  
     360      IF( lwp .AND. ln_wave) THEN                        ! control print 
     361      WRITE(numout,*)'      surface waves:' 
     362         WRITE(numout,*)'      Significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')' 
     363         WRITE(numout,*)'      Wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 
     364         WRITE(numout,*)'      Surface Stokes drift grid u     = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 
     365         WRITE(numout,*)'      Surface Stokes drift grid v     = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 
     366         WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')' 
     367         WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')' 
     368         WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 
     369         WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 
     370         WRITE(numout,*)'      Charnock coefficient            = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')' 
     371         WRITE(numout,*)' Transport associated to Stokes drift grid u = ', TRIM(sn_rcv_tusd%cldes ), ' (', TRIM(sn_rcv_tusd%clcat ), ')' 
     372         WRITE(numout,*)' Transport associated to Stokes drift grid v = ', TRIM(sn_rcv_tvsd%cldes ), ' (', TRIM(sn_rcv_tvsd%clcat ), ')' 
     373         WRITE(numout,*)'      Bernouilli pressure head        = ', TRIM(sn_rcv_bhd%cldes   ), ' (', TRIM(sn_rcv_bhd%clcat  ), ')' 
     374         WRITE(numout,*)'Wave to ocean momentum flux and Net wave-supported stress = ', TRIM(sn_rcv_taw%cldes ), ' (', TRIM(sn_rcv_taw%clcat ), ')' 
     375         WRITE(numout,*)'      Surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')' 
     376         WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref 
     377         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor 
     378         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd 
     379      ENDIF 
    354380      !                                   ! allocate sbccpl arrays 
    355381      IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    … …  
    629655         cpl_wper = .TRUE. 
    630656      ENDIF 
    631       srcv(jpr_wfreq)%clname = 'O_WFreq'     ! wave peak frequency  
    632       IF( TRIM(sn_rcv_wfreq%cldes ) == 'coupled' )  THEN 
    633          srcv(jpr_wfreq)%laction = .TRUE. 
    634          cpl_wfreq = .TRUE. 
    635       ENDIF 
    636657      srcv(jpr_wnum)%clname = 'O_WNum'       ! mean wave number 
    637658      IF( TRIM(sn_rcv_wnum%cldes ) == 'coupled' )  THEN 
    … …  
    639660         cpl_wnum = .TRUE. 
    640661      ENDIF 
    641       srcv(jpr_tauwoc)%clname = 'O_TauOce'   ! stress fraction adsorbed by the wave 
    642       IF( TRIM(sn_rcv_tauwoc%cldes ) == 'coupled' )  THEN 
    643          srcv(jpr_tauwoc)%laction = .TRUE. 
    644          cpl_tauwoc = .TRUE. 
    645       ENDIF 
    646       srcv(jpr_tauwx)%clname = 'O_Tauwx'      ! ocean stress from wave in the x direction 
    647       srcv(jpr_tauwy)%clname = 'O_Tauwy'      ! ocean stress from wave in the y direction 
    648       IF( TRIM(sn_rcv_tauw%cldes ) == 'coupled' )  THEN 
    649          srcv(jpr_tauwx)%laction = .TRUE. 
    650          srcv(jpr_tauwy)%laction = .TRUE. 
    651          cpl_tauw = .TRUE. 
     662      srcv(jpr_wstrf)%clname = 'O_WStrf'     ! stress fraction adsorbed by the wave 
     663      IF( TRIM(sn_rcv_wstrf%cldes ) == 'coupled' )  THEN 
     664         srcv(jpr_wstrf)%laction = .TRUE. 
     665         cpl_wstrf = .TRUE. 
    652666      ENDIF 
    653667      srcv(jpr_wdrag)%clname = 'O_WDrag'     ! neutral surface drag coefficient 
    … …  
    656670         cpl_wdrag = .TRUE. 
    657671      ENDIF 
    658       IF( srcv(jpr_tauwoc)%laction .AND. srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction ) & 
    659             CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', & 
    660                                      '(sn_rcv_tauwoc=coupled and sn_rcv_tauw=coupled)' ) 
     672      srcv(jpr_charn)%clname = 'O_Charn'     ! Chranock coefficient 
     673      IF( TRIM(sn_rcv_charn%cldes ) == 'coupled' )  THEN 
     674         srcv(jpr_charn)%laction = .TRUE. 
     675         cpl_charn = .TRUE. 
     676      ENDIF 
     677      srcv(jpr_bhd)%clname = 'O_Bhd'     ! Bernoulli head. waves' induced surface pressure 
     678      IF( TRIM(sn_rcv_bhd%cldes ) == 'coupled' )  THEN 
     679         srcv(jpr_bhd)%laction = .TRUE. 
     680         cpl_bhd = .TRUE. 
     681      ENDIF 
     682      srcv(jpr_tusd)%clname = 'O_Tusd'     ! zonal stokes transport 
     683      IF( TRIM(sn_rcv_tusd%cldes ) == 'coupled' )  THEN 
     684         srcv(jpr_tusd)%laction = .TRUE. 
     685         cpl_tusd = .TRUE. 
     686      ENDIF 
     687      srcv(jpr_tvsd)%clname = 'O_Tvsd'     ! meridional stokes tranmport 
     688      IF( TRIM(sn_rcv_tvsd%cldes ) == 'coupled' )  THEN 
     689         srcv(jpr_tvsd)%laction = .TRUE. 
     690         cpl_tvsd = .TRUE. 
     691      ENDIF 
     692 
     693      srcv(jpr_twox)%clname = 'O_Twox'     ! wave to ocean momentum flux in the u direction 
     694      srcv(jpr_twoy)%clname = 'O_Twoy'     ! wave to ocean momentum flux in the v direction 
     695      srcv(jpr_tawx)%clname = 'O_Tawx'     ! Net wave-supported stress in the u direction 
     696      srcv(jpr_tawy)%clname = 'O_Tawy'     ! Net wave-supported stress in the v direction 
     697      IF( TRIM(sn_rcv_taw%cldes ) == 'coupled' )  THEN 
     698         srcv(jpr_twox)%laction = .TRUE. 
     699         srcv(jpr_twoy)%laction = .TRUE. 
     700         srcv(jpr_tawx)%laction = .TRUE. 
     701         srcv(jpr_tawy)%laction = .TRUE. 
     702         cpl_taw = .TRUE. 
     703      ENDIF 
    661704      ! 
    662705      !                                                      ! ------------------------------- ! 
    … …  
    10581101      !   initialisation of the coupler  ! 
    10591102      ! ================================ ! 
    1060  
    10611103      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
    10621104       
    … …  
    10711113      ENDIF 
    10721114      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 
     1115      ! 
    10731116      ! 
    10741117   END SUBROUTINE sbc_cpl_init 
    … …  
    11461189         IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 
    11471190          
     1191         IF ( ln_wave .AND. nn_components == 0 ) THEN 
     1192            ncpl_qsr_freq = 1; 
     1193            WRITE(numout,*) 'ncpl_qsr_freq is set to 1 when coupling NEMO with wave (without SAS) ' 
     1194         ENDIF 
    11481195      ENDIF 
    11491196      ! 
    … …  
    13201367         IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1) 
    13211368      !  
    1322       !                                                      ! ========================= !   
    1323       !                                                      !    Wave peak frequency    !  
    1324       !                                                      ! ========================= !   
    1325          IF( srcv(jpr_wfreq)%laction ) wfreq(:,:) = frcv(jpr_wfreq)%z3(:,:,1) 
    1326       ! 
    13271369      !                                                      ! ========================= !  
    13281370      !                                                      !    Vertical mixing Qiao   ! 
    … …  
    13311373 
    13321374         ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode 
    1333          IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 
    1334                                       .OR. srcv(jpr_hsig)%laction   .OR. srcv(jpr_wfreq)%laction) THEN 
     1375         IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. & 
     1376             srcv(jpr_wper)%laction .OR. srcv(jpr_hsig)%laction )  THEN 
    13351377            CALL sbc_stokes( Kmm ) 
    13361378         ENDIF 
    … …  
    13391381      !                                                      ! Stress adsorbed by waves  ! 
    13401382      !                                                      ! ========================= !  
    1341       IF( srcv(jpr_tauwoc)%laction .AND. ln_tauwoc ) tauoc_wave(:,:) = frcv(jpr_tauwoc)%z3(:,:,1) 
    1342  
    1343       !                                                      ! ========================= !   
    1344       !                                                      ! Stress component by waves !  
    1345       !                                                      ! ========================= !   
    1346       IF( srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction .AND. ln_tauw ) THEN 
    1347          tauw_x(:,:) = frcv(jpr_tauwx)%z3(:,:,1) 
    1348          tauw_y(:,:) = frcv(jpr_tauwy)%z3(:,:,1) 
    1349       ENDIF 
    1350  
     1383      IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc )  tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1) 
     1384      ! 
    13511385      !                                                      ! ========================= !  
    13521386      !                                                      !   Wave drag coefficient   ! 
    13531387      !                                                      ! ========================= !  
    13541388      IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw )   cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 
    1355  
     1389      ! 
     1390      !                                                      ! ========================= ! 
     1391      !                                                      !   Chranock coefficient    ! 
     1392      !                                                      ! ========================= ! 
     1393      IF( srcv(jpr_charn)%laction .AND. ln_charn )  charn(:,:) = frcv(jpr_charn)%z3(:,:,1) 
     1394      ! 
     1395      !                                                      ! ========================= ! 
     1396      !                                                      ! net wave-supported stress ! 
     1397      !                                                      ! ========================= ! 
     1398      IF( srcv(jpr_tawx)%laction .AND. ln_taw )     tawx(:,:) = frcv(jpr_tawx)%z3(:,:,1) 
     1399      IF( srcv(jpr_tawy)%laction .AND. ln_taw )     tawy(:,:) = frcv(jpr_tawy)%z3(:,:,1) 
     1400      ! 
     1401      !                                                      ! ========================= ! 
     1402      !                                                      !wave to ocean momentum flux! 
     1403      !                                                      ! ========================= ! 
     1404      IF( srcv(jpr_twox)%laction .AND. ln_taw )     twox(:,:) = frcv(jpr_twox)%z3(:,:,1) 
     1405      IF( srcv(jpr_twoy)%laction .AND. ln_taw )     twoy(:,:) = frcv(jpr_twoy)%z3(:,:,1) 
     1406      !                                                       
     1407      !                                                      ! ========================= ! 
     1408      !                                                      !    wave TKE flux at sfc   ! 
     1409      !                                                      ! ========================= ! 
     1410      IF( srcv(jpr_phioc)%laction .AND. ln_phioc )     phioc(:,:) = frcv(jpr_phioc)%z3(:,:,1) 
     1411      ! 
     1412      !                                                      ! ========================= ! 
     1413      !                                                      !      Bernoulli head       ! 
     1414      !                                                      ! ========================= ! 
     1415      IF( srcv(jpr_bhd)%laction .AND. ln_bern_srfc )   bhd_wave(:,:) = frcv(jpr_bhd)%z3(:,:,1) 
     1416      ! 
     1417      !                                                      ! ========================= ! 
     1418      !                                                      !   Stokes transport u dir  ! 
     1419      !                                                      ! ========================= ! 
     1420      IF( srcv(jpr_tusd)%laction .AND. ln_breivikFV_2016 )    tusd(:,:) = frcv(jpr_tusd)%z3(:,:,1) 
     1421      ! 
     1422      !                                                      ! ========================= ! 
     1423      !                                                      !   Stokes transport v dir  ! 
     1424      !                                                      ! ========================= ! 
     1425      IF( srcv(jpr_tvsd)%laction .AND. ln_breivikFV_2016 )     tvsd(:,:) = frcv(jpr_tvsd)%z3(:,:,1) 
     1426      ! 
    13561427      !  Fields received by SAS when OASIS coupling 
    13571428      !  (arrays no more filled at sbcssm stage) 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/SBC/sbcmod.F90

    r14018 r14050  
    1616   !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation 
    1717   !!            4.0  ! 2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE) 
     18   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) modified wave forcing and coupling   
    1819   !!---------------------------------------------------------------------- 
    1920 
    … …  
    5455   USE usrdef_sbc     ! user defined: surface boundary condition 
    5556   USE closea         ! closed sea 
     57   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    5658   ! 
    5759   USE prtctl         ! Print control                    (prt_ctl routine) 
    … …  
    7072 
    7173   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations) 
    72  
     74   !! * Substitutions 
     75#  include "do_loop_substitute.h90" 
    7376   !!---------------------------------------------------------------------- 
    7477   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    99102         &             nn_ice   , ln_ice_embd,                                       & 
    100103         &             ln_traqsr, ln_dm2dc ,                                         & 
    101          &             ln_rnf   , nn_fwb   , ln_ssr   , ln_apr_dyn,                  & 
    102          &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc , ln_stcor  ,      & 
    103          &             ln_tauw  , nn_lsm, nn_sdrift 
     104         &             ln_rnf   , nn_fwb     , ln_ssr   , ln_apr_dyn,                & 
     105         &             ln_wave  , nn_lsm 
    104106      !!---------------------------------------------------------------------- 
    105107      ! 
    … …  
    133135         WRITE(numout,*) '         bulk         formulation                   ln_blk        = ', ln_blk 
    134136         WRITE(numout,*) '         ABL          formulation                   ln_abl        = ', ln_abl 
     137         WRITE(numout,*) '         Surface wave (forced or coupled)           ln_wave       = ', ln_wave 
    135138         WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : ' 
    136139         WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
    … …  
    150153         WRITE(numout,*) '         runoff / runoff mouths                     ln_rnf        = ', ln_rnf 
    151154         WRITE(numout,*) '         nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm 
    152          WRITE(numout,*) '         surface wave                               ln_wave       = ', ln_wave 
    153          WRITE(numout,*) '               Stokes drift corr. to vert. velocity ln_sdw        = ', ln_sdw 
    154          WRITE(numout,*) '                  vertical parametrization          nn_sdrift     = ', nn_sdrift 
    155          WRITE(numout,*) '               wave modified ocean stress           ln_tauwoc     = ', ln_tauwoc 
    156          WRITE(numout,*) '               wave modified ocean stress component ln_tauw       = ', ln_tauw 
    157          WRITE(numout,*) '               Stokes coriolis term                 ln_stcor      = ', ln_stcor 
    158          WRITE(numout,*) '               neutral drag coefficient (CORE,NCAR) ln_cdgw       = ', ln_cdgw 
    159       ENDIF 
    160       ! 
    161       IF( .NOT.ln_wave ) THEN 
    162          ln_sdw = .false. ; ln_cdgw = .false. ; ln_tauwoc = .false. ; ln_tauw = .false. ; ln_stcor = .false. 
    163       ENDIF  
    164       IF( ln_sdw ) THEN 
    165          IF( .NOT.(nn_sdrift==jp_breivik_2014 .OR. nn_sdrift==jp_li_2017 .OR. nn_sdrift==jp_peakfr) ) & 
    166             CALL ctl_stop( 'The chosen nn_sdrift for Stokes drift vertical velocity must be 0, 1, or 2' ) 
    167       ENDIF 
    168       ll_st_bv2014  = ( nn_sdrift==jp_breivik_2014 ) 
    169       ll_st_li2017  = ( nn_sdrift==jp_li_2017 ) 
    170       ll_st_bv_li   = ( ll_st_bv2014 .OR. ll_st_li2017 ) 
    171       ll_st_peakfr  = ( nn_sdrift==jp_peakfr ) 
    172       IF( ln_tauwoc .AND. ln_tauw ) & 
    173          CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', & 
    174                                   '(ln_tauwoc=.true. and ln_tauw=.true.)' ) 
    175       IF( ln_tauwoc ) & 
    176          CALL ctl_warn( 'You are subtracting the wave stress to the ocean (ln_tauwoc=.true.)' ) 
    177       IF( ln_tauw ) & 
    178          CALL ctl_warn( 'The wave modified ocean stress components are used (ln_tauw=.true.) ', & 
    179                               'This will override any other specification of the ocean stress' ) 
     155      ENDIF 
    180156      ! 
    181157      IF( .NOT.ln_usr ) THEN     ! the model calendar needs some specificities (except in user defined case) 
    … …  
    357333      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc, Kbb, Kmm )   ! CICE initialization 
    358334      ! 
    359       IF( ln_wave     )   CALL sbc_wave_init                     ! surface wave initialisation 
     335      IF( ln_wave     ) THEN 
     336                          CALL sbc_wave_init                     ! surface wave initialisation 
     337      ELSE 
     338                          IF(lwp) WRITE(numout,*) 
     339                          IF(lwp) WRITE(numout,*) '   No surface waves : all wave related logical set to false' 
     340                          ln_sdw       = .false. 
     341                          ln_stcor     = .false. 
     342                          ln_cdgw      = .false. 
     343                          ln_tauoc     = .false. 
     344                          ln_wave_test = .false. 
     345                          ln_charn     = .false. 
     346                          ln_taw       = .false. 
     347                          ln_phioc     = .false. 
     348                          ln_bern_srfc = .false. 
     349                          ln_breivikFV_2016 = .false. 
     350                          ln_vortex_force = .false. 
     351                          ln_stshear  = .false. 
     352      ENDIF 
    360353      ! 
    361354   END SUBROUTINE sbc_init 
    … …  
    380373      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    381374      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     375      INTEGER  ::   jj, ji          ! dummy loop argument 
    382376      ! 
    383377      LOGICAL ::   ll_sas, ll_opa   ! local logical 
    … …  
    412406      ! 
    413407      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt, Kbb, Kmm )  ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    414       IF( ln_wave     )   CALL sbc_wave( kt, Kmm )       ! surface waves 
    415  
    416408      ! 
    417409      !                                            !==  sbc formulation  ==! 
    418410      !                                                    
     411      ! 
    419412      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    420413      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    … …  
    423416      CASE( jp_blk     ) 
    424417         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA 
     418!!!!!!!!!!! ATTENTION:ln_wave is not only used for oasis coupling !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     419         IF( ln_wave )   THEN 
     420             IF ( lk_oasis )  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-wave coupling 
     421             CALL sbc_wave ( kt, Kmm ) 
     422         ENDIF 
    425423                               CALL sbc_blk       ( kt )                    ! bulk formulation for the ocean 
    426424                               ! 
    … …  
    436434      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! forced-coupled mixed formulation after forcing 
    437435      ! 
    438       IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )              ! Wind stress provided by waves  
     436      IF( ln_wave .AND. ln_tauoc )  THEN            ! Wave stress reduction 
     437         DO_2D( 0, 0, 0, 0) 
     438            utau(ji,jj) = utau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji-1,jj) ) * 0.5_wp 
     439            vtau(ji,jj) = vtau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji,jj-1) ) * 0.5_wp 
     440         END_2D 
     441         ! 
     442         CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 
     443         CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 
     444         ! 
     445         taum(:,:) = taum(:,:)*tauoc_wave(:,:) 
     446         ! 
     447         IF( kt == nit000 )   CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.',   & 
     448            &                                'If not requested select ln_tauoc=.false.' ) 
     449         ! 
     450      ELSEIF( ln_wave .AND. ln_taw ) THEN                  ! Wave stress reduction 
     451         utau(:,:) = utau(:,:) - tawx(:,:) + twox(:,:) 
     452         vtau(:,:) = vtau(:,:) - tawy(:,:) + twoy(:,:) 
     453         CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 
     454         CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 
     455         ! 
     456         DO_2D( 0, 0, 0, 0) 
     457             taum(ji,jj) = sqrt((.5*(utau(ji-1,jj)+utau(ji,jj)))**2 + (.5*(vtau(ji,jj-1)+vtau(ji,jj)))**2) 
     458         END_2D 
     459         ! 
     460         IF( kt == nit000 )   CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.',   & 
     461            &                                'If not requested select ln_taw=.false.' ) 
     462         ! 
     463      ENDIF 
     464      CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1. ) 
    439465      ! 
    440466      !                                            !==  Misc. Options  ==! 
    … …  
    449475 
    450476      IF( ln_icebergs    )   THEN 
    451                                      CALL icb_stp( kt )           ! compute icebergs 
     477                                     CALL icb_stp( kt, Kmm )           ! compute icebergs 
    452478         ! Icebergs do not melt over the haloes.  
    453479         ! So emp values over the haloes are no more consistent with the inner domain values.  

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/SBC/sbcrnf.F90

    r14018 r14050  
    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 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/SBC/sbcwave.F90

    r13998 r14050  
    99   !!             -   !  2016-12  (G. Madec, E. Clementi) update Stoke drift computation 
    1010   !!                                                    + add sbc_wave_ini routine 
     11   !!            4.2  !  2020-12  (G. Madec, E. Clementi) updates, new Stoke drift computation  
     12   !!                                                    according to Couvelard et al.,2019 
    1113   !!---------------------------------------------------------------------- 
    1214 
    1315   !!---------------------------------------------------------------------- 
    1416   !!   sbc_stokes    : calculate 3D Stokes-drift velocities 
    15    !!   sbc_wave      : wave data from wave model in netcdf files  
     17   !!   sbc_wave      : wave data from wave model: forced (netcdf files) or coupled mode 
    1618   !!   sbc_wave_init : initialisation fo surface waves  
    1719   !!---------------------------------------------------------------------- 
    18    USE phycst         ! physical constants  
     20   USE phycst         ! physical constants 
    1921   USE oce            ! ocean variables 
    20    USE sbc_oce        ! Surface boundary condition: ocean fields 
    21    USE zdf_oce,  ONLY : ln_zdfswm 
     22   USE dom_oce        ! ocean domain variables 
     23   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2224   USE bdy_oce        ! open boundary condition variables 
    2325   USE domvvl         ! domain: variable volume layers 
    … …  
    2628   USE in_out_manager ! I/O manager 
    2729   USE lib_mpp        ! distribued memory computing library 
    28    USE fldread        ! read input fields 
     30   USE fldread        ! read input fields 
    2931 
    3032   IMPLICIT NONE 
    … …  
    3234 
    3335   PUBLIC   sbc_stokes      ! routine called in sbccpl 
    34    PUBLIC   sbc_wstress     ! routine called in sbcmod  
    3536   PUBLIC   sbc_wave        ! routine called in sbcmod 
    3637   PUBLIC   sbc_wave_init   ! routine called in sbcmod 
    3738    
    3839   ! Variables checking if the wave parameters are coupled (if not, they are read from file) 
    39    LOGICAL, PUBLIC ::   cpl_hsig   = .FALSE. 
    40    LOGICAL, PUBLIC ::   cpl_phioc  = .FALSE. 
    41    LOGICAL, PUBLIC ::   cpl_sdrftx = .FALSE. 
    42    LOGICAL, PUBLIC ::   cpl_sdrfty = .FALSE. 
    43    LOGICAL, PUBLIC ::   cpl_wper   = .FALSE. 
    44    LOGICAL, PUBLIC ::   cpl_wfreq  = .FALSE. 
    45    LOGICAL, PUBLIC ::   cpl_wnum   = .FALSE. 
    46    LOGICAL, PUBLIC ::   cpl_tauwoc = .FALSE. 
    47    LOGICAL, PUBLIC ::   cpl_tauw   = .FALSE. 
    48    LOGICAL, PUBLIC ::   cpl_wdrag  = .FALSE. 
     40   LOGICAL, PUBLIC ::   cpl_hsig          = .FALSE. 
     41   LOGICAL, PUBLIC ::   cpl_phioc         = .FALSE. 
     42   LOGICAL, PUBLIC ::   cpl_sdrftx        = .FALSE. 
     43   LOGICAL, PUBLIC ::   cpl_sdrfty        = .FALSE. 
     44   LOGICAL, PUBLIC ::   cpl_wper          = .FALSE. 
     45   LOGICAL, PUBLIC ::   cpl_wnum          = .FALSE. 
     46   LOGICAL, PUBLIC ::   cpl_wstrf         = .FALSE. 
     47   LOGICAL, PUBLIC ::   cpl_wdrag         = .FALSE. 
     48   LOGICAL, PUBLIC ::   cpl_charn         = .FALSE. 
     49   LOGICAL, PUBLIC ::   cpl_taw           = .FALSE. 
     50   LOGICAL, PUBLIC ::   cpl_bhd           = .FALSE. 
     51   LOGICAL, PUBLIC ::   cpl_tusd          = .FALSE. 
     52   LOGICAL, PUBLIC ::   cpl_tvsd          = .FALSE. 
    4953 
    5054   INTEGER ::   jpfld    ! number of files to read for stokes drift 
    … …  
    5357   INTEGER ::   jp_hsw   ! index of significant wave hight      (m)      at T-point 
    5458   INTEGER ::   jp_wmp   ! index of mean wave period            (s)      at T-point 
    55    INTEGER ::   jp_wfr   ! index of wave peak frequency         (1/s)    at T-point 
    5659 
    5760   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_cd      ! structure of input fields (file informations, fields read) Drag Coefficient 
    5861   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sd      ! structure of input fields (file informations, fields read) Stokes Drift 
    5962   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_wn      ! structure of input fields (file informations, fields read) wave number for Qiao 
    60    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tauwoc  ! structure of input fields (file informations, fields read) normalized wave stress into the ocean 
    61    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tauw    ! structure of input fields (file informations, fields read) ocean stress components from wave model 
    62  
    63    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   cdn_wave            !: 
    64    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   hsw, wmp, wnum      !:  
    65    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   wfreq               !:  
    66    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauoc_wave          !:   
    67    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauw_x, tauw_y      !:   
    68    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tsd2d               !:  
    69    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   div_sd              !: barotropic stokes drift divergence 
    70    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   ut0sd, vt0sd        !: surface Stokes drift velocities at t-point 
    71    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   usd  , vsd  , wsd   !: Stokes drift velocities at u-, v- & w-points, resp. 
    72  
     63   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tauoc   ! structure of input fields (file informations, fields read) normalized wave stress into the ocean 
     64 
     65   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   cdn_wave        !: Neutral drag coefficient at t-point 
     66   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   hsw             !: Significant Wave Height at t-point 
     67   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   wmp             !: Wave Mean Period at t-point 
     68   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   wnum            !: Wave Number at t-point 
     69   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauoc_wave      !: stress reduction factor  at t-point 
     70   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tsd2d           !: Surface Stokes Drift module at t-point 
     71   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   div_sd          !: barotropic stokes drift divergence 
     72   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   ut0sd, vt0sd    !: surface Stokes drift velocities at t-point 
     73   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   usd, vsd, wsd   !: Stokes drift velocities at u-, v- & w-points, resp.u 
     74! 
     75   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   charn           !: charnock coefficient at t-point 
     76   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tawx            !: Net wave-supported stress, u 
     77   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tawy            !: Net wave-supported stress, v 
     78   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   twox            !: wave-ocean momentum flux, u 
     79   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   twoy            !: wave-ocean momentum flux, v 
     80   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauoc_wavex     !: stress reduction factor  at, u component 
     81   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauoc_wavey     !: stress reduction factor  at, v component 
     82   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   phioc           !: tke flux from wave model 
     83   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   KZN2            !: Kz*N2 
     84   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   bhd_wave        !: Bernoulli head. wave induce pression 
     85   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tusd, tvsd      !: Stokes drift transport 
     86   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   ZMX             !: Kz*N2 
    7387   !! * Substitutions 
    7488#  include "do_loop_substitute.h90" 
    … …  
    88102      !!                2014 (DOI: 10.1175/JPO-D-14-0020.1) 
    89103      !! 
    90       !! ** Method  : - Calculate Stokes transport speed  
    91       !!              - Calculate horizontal divergence  
    92       !!              - Integrate the horizontal divergenze from the bottom  
    93       !! ** action   
     104      !! ** Method  : - Calculate the horizontal Stokes drift velocity (Breivik et al. 2014) 
     105      !!              - Calculate its horizontal divergence 
     106      !!              - Calculate the vertical Stokes drift velocity 
     107      !!              - Calculate the barotropic Stokes drift divergence 
     108      !! 
     109      !! ** action  : - tsd2d         : module of the surface Stokes drift velocity 
     110      !!              - usd, vsd, wsd : 3 components of the Stokes drift velocity 
     111      !!              - div_sd        : barotropic Stokes drift divergence 
    94112      !!--------------------------------------------------------------------- 
    95113      INTEGER, INTENT(in) :: Kmm ! ocean time level index 
    96114      INTEGER  ::   jj, ji, jk   ! dummy loop argument 
    97115      INTEGER  ::   ik           ! local integer  
    98       REAL(wp) ::  ztransp, zfac, zsp0 
    99       REAL(wp) ::  zdepth, zsqrt_depth,  zexp_depth, z_two_thirds, zsqrtpi !sqrt of pi 
    100       REAL(wp) ::  zbot_u, zbot_v, zkb_u, zkb_v, zke3_u, zke3_v, zda_u, zda_v 
    101       REAL(wp) ::  zstokes_psi_u_bot, zstokes_psi_v_bot 
    102       REAL(wp) ::  zdep_u, zdep_v, zkh_u, zkh_v 
    103       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   zk_t, zk_u, zk_v, zu0_sd, zv0_sd     ! 2D workspace 
    104       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   zstokes_psi_u_top, zstokes_psi_v_top ! 2D workspace 
    105       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3divh                              ! 3D workspace 
    106       !!--------------------------------------------------------------------- 
    107       ! 
    108       ALLOCATE( ze3divh(jpi,jpj,jpkm1) )   ! jpkm1 -> avoid lbc_lnk on jpk that is not defined 
     116      REAL(wp) ::  ztransp, zfac, ztemp, zsp0, zsqrt, zbreiv16_w 
     117      REAL(wp) ::  zdep_u, zdep_v, zkh_u, zkh_v, zda_u, zda_v, sdtrp 
     118      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   zk_t, zk_u, zk_v, zu0_sd, zv0_sd ! 2D workspace 
     119      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3divh, zInt_w                  ! 3D workspace 
     120      !!--------------------------------------------------------------------- 
     121      ! 
     122      ALLOCATE( ze3divh(jpi,jpj,jpkm1) ) ! jpkm1 -> avoid lbc_lnk on jpk that is not defined 
     123      ALLOCATE( zInt_w(jpi,jpj,jpk) ) 
    109124      ALLOCATE( zk_t(jpi,jpj), zk_u(jpi,jpj), zk_v(jpi,jpj), zu0_sd(jpi,jpj), zv0_sd(jpi,jpj) ) 
     125      zk_t    (:,:) = 0._wp 
     126      zk_u    (:,:) = 0._wp 
     127      zk_v    (:,:) = 0._wp 
     128      zu0_sd  (:,:) = 0._wp 
     129      zv0_sd  (:,:) = 0._wp 
     130      ze3divh (:,:,:) = 0._wp 
     131 
    110132      ! 
    111133      ! select parameterization for the calculation of vertical Stokes drift 
    112134      ! exp. wave number at t-point 
    113       IF( ll_st_bv_li ) THEN   ! (Eq. (19) in Breivik et al. (2014) ) 
     135      IF( ln_breivikFV_2016 ) THEN 
     136      ! Assumptions :  ut0sd and vt0sd are surface Stokes drift at T-points 
     137      !                sdtrp is the norm of Stokes transport 
     138      ! 
     139         zfac = 0.166666666667_wp 
     140         DO_2D( 1, 1, 1, 1 ) ! In the deep-water limit we have ke = ||ust0||/( 6 * ||transport|| ) 
     141            zsp0          = SQRT( ut0sd(ji,jj)*ut0sd(ji,jj) + vt0sd(ji,jj)*vt0sd(ji,jj) ) !<-- norm of Surface Stokes drift 
     142            tsd2d(ji,jj)  = zsp0 
     143            IF( cpl_tusd .AND. cpl_tvsd ) THEN  !stokes transport is provided in coupled mode 
     144               sdtrp      = SQRT( tusd(ji,jj)*tusd(ji,jj) + tvsd(ji,jj)*tvsd(ji,jj) )  !<-- norm of Surface Stokes drift transport 
     145            ELSE  
     146               ! Stokes drift transport estimated from Hs and Tmean  
     147               sdtrp      = 2.0_wp * rpi / 16.0_wp *                             & 
     148                   &        hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp ) 
     149            ENDIF 
     150            zk_t (ji,jj)  = zfac * zsp0 / MAX ( sdtrp, 0.0000001_wp ) !<-- ke = ||ust0||/( 6 * ||transport|| ) 
     151         END_2D 
     152      !# define zInt_w ze3divh 
     153         DO_3D( 1, 1, 1, 1, 1, jpk ) ! Compute the primitive of Breivik 2016 function at W-points 
     154            zfac             = - 2._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm)  !<-- zfac should be negative definite 
     155            ztemp            = EXP ( zfac ) 
     156            zsqrt            = SQRT( -zfac ) 
     157            zbreiv16_w       = ztemp - SQRT(rpi)*zsqrt*ERFC(zsqrt) !Eq. 16 Breivik 2016 
     158            zInt_w(ji,jj,jk) = ztemp - 4._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) * zbreiv16_w 
     159         END_3D 
     160! 
     161         DO jk = 1, jpkm1 
     162            zfac = 0.166666666667_wp 
     163            DO_2D( 1, 1, 1, 1 ) !++ Compute the FV Breivik 2016 function at T-points 
     164               zsp0          = zfac / MAX(zk_t (ji,jj),0.0000001_wp) 
     165               ztemp         = zInt_w(ji,jj,jk) - zInt_w(ji,jj,jk+1) 
     166               zu0_sd(ji,jj) = ut0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk) 
     167               zv0_sd(ji,jj) = vt0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk) 
     168            END_2D 
     169            DO_2D( 1, 0, 1, 0 ) ! ++ Interpolate at U/V points 
     170               zfac          =  1.0_wp / e3u(ji  ,jj,jk,Kmm) 
     171               usd(ji,jj,jk) =  0.5_wp * zfac * ( zu0_sd(ji,jj)+zu0_sd(ji+1,jj) ) * umask(ji,jj,jk) 
     172               zfac          =  1.0_wp / e3v(ji  ,jj,jk,Kmm) 
     173               vsd(ji,jj,jk) =  0.5_wp * zfac * ( zv0_sd(ji,jj)+zv0_sd(ji,jj+1) ) * vmask(ji,jj,jk) 
     174            END_2D 
     175         ENDDO 
     176      !# undef zInt_w 
     177      ! 
     178      ELSE 
    114179         zfac = 2.0_wp * rpi / 16.0_wp 
    115180         DO_2D( 1, 1, 1, 1 ) 
    … …  
    128193            zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) ) 
    129194         END_2D 
    130       ELSE IF( ll_st_peakfr ) THEN    ! peak wave number calculated from the peak frequency received by the wave model 
    131          DO_2D( 1, 1, 1, 1 ) 
    132             zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav 
    133          END_2D 
    134          DO_2D( 1, 0, 1, 0 ) 
    135             zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 
    136             zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) 
    137             ! 
    138             zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) ) 
    139             zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) ) 
    140          END_2D 
    141       ENDIF 
    142       ! 
     195 
    143196      !                       !==  horizontal Stokes Drift 3D velocity  ==! 
    144       IF( ll_st_bv2014 ) THEN 
     197 
    145198         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    146199            zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) ) 
    147200            zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) ) 
    148             !                           
     201            ! 
    149202            zkh_u = zk_u(ji,jj) * zdep_u     ! k * depth 
    150203            zkh_v = zk_v(ji,jj) * zdep_v 
    … …  
    156209            vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk) 
    157210         END_3D 
    158       ELSE IF( ll_st_li2017 .OR. ll_st_peakfr ) THEN 
    159          ALLOCATE( zstokes_psi_u_top(jpi,jpj), zstokes_psi_v_top(jpi,jpj) ) 
    160          DO_2D( 1, 0, 1, 0 ) 
    161             zstokes_psi_u_top(ji,jj) = 0._wp 
    162             zstokes_psi_v_top(ji,jj) = 0._wp 
    163          END_2D 
    164          zsqrtpi = SQRT(rpi) 
    165          z_two_thirds = 2.0_wp / 3.0_wp 
    166          DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! exp. wave number & Stokes drift velocity at u- & v-points 
    167             zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) )  ! 2 * bottom depth 
    168             zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) )  ! 2 * bottom depth 
    169             zkb_u  = zk_u(ji,jj) * zbot_u                             ! 2 * k * bottom depth 
    170             zkb_v  = zk_v(ji,jj) * zbot_v                             ! 2 * k * bottom depth 
    171             ! 
    172             zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u(ji,jj,jk,Kmm))     ! 2k * thickness 
    173             zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v(ji,jj,jk,Kmm))     ! 2k * thickness 
    174  
    175             ! Depth attenuation .... do u component first.. 
    176             zdepth      = zkb_u 
    177             zsqrt_depth = SQRT(zdepth) 
    178             zexp_depth  = EXP(-zdepth) 
    179             zstokes_psi_u_bot = 1.0_wp - zexp_depth  & 
    180                  &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) & 
    181                  &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth ) 
    182             zda_u                    = ( zstokes_psi_u_bot - zstokes_psi_u_top(ji,jj) ) / zke3_u 
    183             zstokes_psi_u_top(ji,jj) =   zstokes_psi_u_bot 
    184  
    185             !         ... and then v component 
    186             zdepth      =zkb_v 
    187             zsqrt_depth = SQRT(zdepth) 
    188             zexp_depth  = EXP(-zdepth) 
    189             zstokes_psi_v_bot = 1.0_wp - zexp_depth  & 
    190                  &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) & 
    191                  &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth ) 
    192             zda_v                    = ( zstokes_psi_v_bot - zstokes_psi_v_top(ji,jj) ) / zke3_v 
    193             zstokes_psi_v_top(ji,jj) =   zstokes_psi_v_bot 
    194             ! 
    195             usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk) 
    196             vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk) 
    197          END_3D 
    198          DEALLOCATE( zstokes_psi_u_top, zstokes_psi_v_top ) 
    199211      ENDIF 
    200212 
    … …  
    235247      CALL iom_put( "vstokes",  vsd  ) 
    236248      CALL iom_put( "wstokes",  wsd  ) 
    237       ! 
    238       DEALLOCATE( ze3divh ) 
     249!      ! 
     250      DEALLOCATE( ze3divh, zInt_w ) 
    239251      DEALLOCATE( zk_t, zk_u, zk_v, zu0_sd, zv0_sd ) 
    240252      ! 
    241253   END SUBROUTINE sbc_stokes 
    242  
    243  
    244    SUBROUTINE sbc_wstress( ) 
    245       !!--------------------------------------------------------------------- 
    246       !!                     ***  ROUTINE sbc_wstress  *** 
    247       !! 
    248       !! ** Purpose :   Updates the ocean momentum modified by waves 
    249       !! 
    250       !! ** Method  : - Calculate u,v components of stress depending on stress 
    251       !!                model  
    252       !!              - Calculate the stress module 
    253       !!              - The wind module is not modified by waves  
    254       !! ** action   
    255       !!--------------------------------------------------------------------- 
    256       INTEGER  ::   jj, ji   ! dummy loop argument 
    257       ! 
    258       IF( ln_tauwoc ) THEN 
    259          utau(:,:) = utau(:,:)*tauoc_wave(:,:) 
    260          vtau(:,:) = vtau(:,:)*tauoc_wave(:,:) 
    261          taum(:,:) = taum(:,:)*tauoc_wave(:,:) 
    262       ENDIF 
    263       ! 
    264       IF( ln_tauw ) THEN 
    265          DO_2D( 1, 0, 1, 0 ) 
    266             ! Stress components at u- & v-points 
    267             utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) ) 
    268             vtau(ji,jj) = 0.5_wp * ( tauw_y(ji,jj) + tauw_y(ji,jj+1) ) 
    269             ! 
    270             ! Stress module at t points 
    271             taum(ji,jj) = SQRT( tauw_x(ji,jj)*tauw_x(ji,jj) + tauw_y(ji,jj)*tauw_y(ji,jj) ) 
    272          END_2D 
    273          CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1.0_wp , vtau(:,:), 'V', -1.0_wp , taum(:,:) , 'T', -1.0_wp ) 
    274       ENDIF 
    275       ! 
    276    END SUBROUTINE sbc_wstress 
    277  
    278  
     254! 
     255! 
    279256   SUBROUTINE sbc_wave( kt, Kmm ) 
    280257      !!--------------------------------------------------------------------- 
    281258      !!                     ***  ROUTINE sbc_wave  *** 
    282259      !! 
    283       !! ** Purpose :   read wave parameters from wave model  in netcdf files. 
    284       !! 
    285       !! ** Method  : - Read namelist namsbc_wave 
    286       !!              - Read Cd_n10 fields in netcdf files  
    287       !!              - Read stokes drift 2d in netcdf files  
    288       !!              - Read wave number in netcdf files  
    289       !!              - Compute 3d stokes drift using Breivik et al.,2014 
    290       !!                formulation 
    291       !! ** action   
     260      !! ** Purpose :   read wave parameters from wave model in netcdf files 
     261      !!                or from a coupled wave mdoel 
     262      !! 
    292263      !!--------------------------------------------------------------------- 
    293264      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
    294265      INTEGER, INTENT(in   ) ::   Kmm  ! ocean time index 
    295266      !!--------------------------------------------------------------------- 
     267      ! 
     268      IF( kt == nit000 .AND. lwp ) THEN 
     269         WRITE(numout,*) 
     270         WRITE(numout,*) 'sbc_wave : update the read waves fields' 
     271         WRITE(numout,*) '~~~~~~~~ ' 
     272      ENDIF 
    296273      ! 
    297274      IF( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN     !==  Neutral drag coefficient  ==! 
    … …  
    300277      ENDIF 
    301278 
    302       IF( ln_tauwoc .AND. .NOT. cpl_tauwoc ) THEN  !==  Wave induced stress  ==! 
    303          CALL fld_read( kt, nn_fsbc, sf_tauwoc )         ! read wave norm stress from external forcing 
    304          tauoc_wave(:,:) = sf_tauwoc(1)%fnow(:,:,1) * tmask(:,:,1) 
    305       ENDIF 
    306  
    307       IF( ln_tauw .AND. .NOT. cpl_tauw ) THEN      !==  Wave induced stress  ==! 
    308          CALL fld_read( kt, nn_fsbc, sf_tauw )           ! read ocean stress components from external forcing (T grid) 
    309          tauw_x(:,:) = sf_tauw(1)%fnow(:,:,1) * tmask(:,:,1) 
    310          tauw_y(:,:) = sf_tauw(2)%fnow(:,:,1) * tmask(:,:,1) 
    311       ENDIF 
    312  
    313       IF( ln_sdw )  THEN                           !==  Computation of the 3d Stokes Drift  ==!  
     279      IF( ln_tauoc .AND. .NOT. cpl_wstrf ) THEN    !==  Wave induced stress  ==! 
     280         CALL fld_read( kt, nn_fsbc, sf_tauoc )          ! read stress reduction factor due to wave from external forcing 
     281         tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) * tmask(:,:,1) 
     282      ELSEIF ( ln_taw .AND. cpl_taw ) THEN 
     283         IF (kt < 1) THEN ! The first fields gave by OASIS have very high erroneous values .... 
     284            twox(:,:)=0._wp 
     285            twoy(:,:)=0._wp 
     286            tawx(:,:)=0._wp 
     287            tawy(:,:)=0._wp 
     288            tauoc_wavex(:,:) = 1._wp 
     289            tauoc_wavey(:,:) = 1._wp 
     290         ELSE 
     291            tauoc_wavex(:,:) = abs(twox(:,:)/tawx(:,:)) 
     292            tauoc_wavey(:,:) = abs(twoy(:,:)/tawy(:,:)) 
     293         ENDIF 
     294      ENDIF 
     295 
     296      IF ( ln_phioc .and. cpl_phioc .and.  kt == nit000 ) THEN 
     297         WRITE(numout,*) 
     298         WRITE(numout,*) 'sbc_wave : PHIOC from wave model' 
     299         WRITE(numout,*) '~~~~~~~~ ' 
     300      ENDIF 
     301 
     302      IF( ln_sdw .AND. .NOT. cpl_sdrftx)  THEN       !==  Computation of the 3d Stokes Drift  ==!  
    314303         ! 
    315304         IF( jpfld > 0 ) THEN                            ! Read from file only if the field is not coupled 
    316305            CALL fld_read( kt, nn_fsbc, sf_sd )          ! read wave parameters from external forcing 
     306            !                                            ! NB: test case mode, not read as jpfld=0 
    317307            IF( jp_hsw > 0 )   hsw  (:,:) = sf_sd(jp_hsw)%fnow(:,:,1) * tmask(:,:,1)  ! significant wave height 
    318308            IF( jp_wmp > 0 )   wmp  (:,:) = sf_sd(jp_wmp)%fnow(:,:,1) * tmask(:,:,1)  ! wave mean period 
    319             IF( jp_wfr > 0 )   wfreq(:,:) = sf_sd(jp_wfr)%fnow(:,:,1) * tmask(:,:,1)  ! Peak wave frequency 
    320309            IF( jp_usd > 0 )   ut0sd(:,:) = sf_sd(jp_usd)%fnow(:,:,1) * tmask(:,:,1)  ! 2D zonal Stokes Drift at T point 
    321310            IF( jp_vsd > 0 )   vt0sd(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) * tmask(:,:,1)  ! 2D meridional Stokes Drift at T point 
    322311         ENDIF 
    323312         ! 
    324          ! Read also wave number if needed, so that it is available in coupling routines 
    325          IF( ln_zdfswm .AND. .NOT.cpl_wnum ) THEN 
    326             CALL fld_read( kt, nn_fsbc, sf_wn )          ! read wave parameters from external forcing 
    327             wnum(:,:) = sf_wn(1)%fnow(:,:,1) * tmask(:,:,1) 
    328          ENDIF 
    329             
    330          ! Calculate only if required fields have been read 
    331          ! In coupled wave model-NEMO case the call is done after coupling 
     313         IF( jpfld == 4 .OR. ln_wave_test )   & 
     314            &      CALL sbc_stokes( Kmm )                 ! Calculate only if all required fields are read 
     315            !                                            ! or in wave test case 
     316         !  !                                            ! In coupled case the call is done after (in sbc_cpl) 
     317      ENDIF 
    332318         ! 
    333          IF( ( ll_st_bv_li   .AND. jp_hsw>0 .AND. jp_wmp>0 .AND. jp_usd>0 .AND. jp_vsd>0 ) .OR. & 
    334            & ( ll_st_peakfr  .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0                ) ) CALL sbc_stokes( Kmm ) 
    335          ! 
    336       ENDIF 
    337       ! 
    338319   END SUBROUTINE sbc_wave 
    339320 
    … …  
    343324      !!                     ***  ROUTINE sbc_wave_init  *** 
    344325      !! 
    345       !! ** Purpose :   read wave parameters from wave model  in netcdf files. 
     326      !! ** Purpose :   Initialisation fo surface waves 
    346327      !! 
    347328      !! ** Method  : - Read namelist namsbc_wave 
    348       !!              - Read Cd_n10 fields in netcdf files  
    349       !!              - Read stokes drift 2d in netcdf files  
    350       !!              - Read wave number in netcdf files  
    351       !!              - Compute 3d stokes drift using Breivik et al.,2014 
    352       !!                formulation 
     329      !!              - create the structure used to read required wave fields 
     330      !!                (its size depends on namelist options) 
    353331      !! ** action   
    354332      !!--------------------------------------------------------------------- 
    … …  
    357335      !! 
    358336      CHARACTER(len=100)     ::  cn_dir                            ! Root directory for location of drag coefficient files 
    359       TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i, slf_j     ! array of namelist informations on the fields to read 
     337      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i            ! array of namelist informations on the fields to read 
    360338      TYPE(FLD_N)            ::  sn_cdg, sn_usd, sn_vsd,  & 
    361                              &   sn_hsw, sn_wmp, sn_wfr, sn_wnum, & 
    362                              &   sn_tauwoc, sn_tauwx, sn_tauwy     ! informations about the fields to be read 
    363       ! 
    364       NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_hsw, sn_wmp, sn_wfr, & 
    365                              sn_wnum, sn_tauwoc, sn_tauwx, sn_tauwy 
    366       !!--------------------------------------------------------------------- 
     339                             &   sn_hsw, sn_wmp, sn_wnum, sn_tauoc    ! informations about the fields to be read 
     340      ! 
     341      NAMELIST/namsbc_wave/ cn_dir, sn_cdg, sn_usd, sn_vsd, sn_hsw, sn_wmp, sn_wnum, sn_tauoc,   & 
     342         &                  ln_cdgw, ln_sdw, ln_tauoc, ln_stcor, ln_charn, ln_taw, ln_phioc,     & 
     343         &                  ln_wave_test, ln_bern_srfc, ln_breivikFV_2016, ln_vortex_force, ln_stshear 
     344      !!--------------------------------------------------------------------- 
     345      IF(lwp) THEN 
     346         WRITE(numout,*) 
     347         WRITE(numout,*) 'sbc_wave_init : surface waves in the system' 
     348         WRITE(numout,*) '~~~~~~~~~~~~~ ' 
     349      ENDIF 
    367350      ! 
    368351      READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901) 
    369 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_wave in reference namelist' ) 
    370           
     352901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_wave in reference namelist') 
     353 
    371354      READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 ) 
    372355902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist' ) 
    373356      IF(lwm) WRITE ( numond, namsbc_wave ) 
    374357      ! 
    375       IF( ln_cdgw ) THEN 
    376          IF( .NOT. cpl_wdrag ) THEN 
    377             ALLOCATE( sf_cd(1), STAT=ierror )               !* allocate and fill sf_wave with sn_cdg 
    378             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
     358      IF(lwp) THEN 
     359         WRITE(numout,*) '   Namelist namsbc_wave' 
     360         WRITE(numout,*) '      Stokes drift                                  ln_sdw = ', ln_sdw 
     361         WRITE(numout,*) '      Breivik 2016                       ln_breivikFV_2016 = ', ln_breivikFV_2016 
     362         WRITE(numout,*) '      Stokes Coriolis & tracer advection terms    ln_stcor = ', ln_stcor 
     363         WRITE(numout,*) '      Vortex Force                         ln_vortex_force = ', ln_vortex_force 
     364         WRITE(numout,*) '      Bernouilli Head Pressure                ln_bern_srfc = ', ln_bern_srfc 
     365         WRITE(numout,*) '      wave modified ocean stress                  ln_tauoc = ', ln_tauoc 
     366         WRITE(numout,*) '      neutral drag coefficient (CORE bulk only)    ln_cdgw = ', ln_cdgw 
     367         WRITE(numout,*) '      charnock coefficient                        ln_charn = ', ln_charn 
     368         WRITE(numout,*) '      Stress modificated by wave                    ln_taw = ', ln_taw 
     369         WRITE(numout,*) '      TKE flux from wave                          ln_phioc = ', ln_phioc 
     370         WRITE(numout,*) '      Surface shear with Stokes drift           ln_stshear = ', ln_stshear 
     371         WRITE(numout,*) '      Test with constant wave fields          ln_wave_test = ', ln_wave_test 
     372      ENDIF 
     373 
     374      !                                ! option check 
     375      IF( .NOT.( ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor .OR. ln_charn) )   & 
     376         &     CALL ctl_warn( 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauoc=F, ln_stcor=F') 
     377      IF( ln_cdgw .AND. ln_blk )   & 
     378         &     CALL ctl_stop( 'drag coefficient read from wave model NOT available yet with aerobulk package') 
     379      IF( ln_stcor .AND. .NOT.ln_sdw )   & 
     380         &     CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
     381 
     382      !                             !==  Allocate wave arrays  ==! 
     383      ALLOCATE( ut0sd (jpi,jpj)    , vt0sd (jpi,jpj) ) 
     384      ALLOCATE( hsw   (jpi,jpj)    , wmp   (jpi,jpj) ) 
     385      ALLOCATE( wnum  (jpi,jpj) ) 
     386      ALLOCATE( tsd2d (jpi,jpj)    , div_sd(jpi,jpj)    , bhd_wave(jpi,jpj)     ) 
     387      ALLOCATE( usd   (jpi,jpj,jpk), vsd   (jpi,jpj,jpk), wsd     (jpi,jpj,jpk) ) 
     388      ALLOCATE( tusd  (jpi,jpj)    , tvsd  (jpi,jpj)    , ZMX     (jpi,jpj,jpk) ) 
     389      usd   (:,:,:) = 0._wp 
     390      vsd   (:,:,:) = 0._wp 
     391      wsd   (:,:,:) = 0._wp 
     392      hsw     (:,:) = 0._wp 
     393      wmp     (:,:) = 0._wp 
     394      ut0sd   (:,:) = 0._wp 
     395      vt0sd   (:,:) = 0._wp 
     396      tusd    (:,:) = 0._wp 
     397      tvsd    (:,:) = 0._wp 
     398      bhd_wave(:,:) = 0._wp 
     399      ZMX   (:,:,:) = 0._wp 
     400! 
     401      IF( ln_wave_test ) THEN       !==  Wave TEST case  ==!   set uniform waves fields 
     402         jpfld    = 0                   ! No field read 
     403         ln_cdgw  = .FALSE.             ! No neutral wave drag input 
     404         ln_tauoc = .FALSE.             ! No wave induced drag reduction factor 
     405         ut0sd(:,:) = 0.13_wp * tmask(:,:,1)   ! m/s 
     406         vt0sd(:,:) = 0.00_wp                  ! m/s 
     407         hsw  (:,:) = 2.80_wp                  ! meters 
     408         wmp  (:,:) = 8.00_wp                  ! seconds 
     409         ! 
     410      ELSE                          !==  create the structure associated with fields to be read  ==! 
     411         IF( ln_cdgw ) THEN                       ! wave drag 
     412            IF( .NOT. cpl_wdrag ) THEN 
     413               ALLOCATE( sf_cd(1), STAT=ierror )               !* allocate and fill sf_wave with sn_cdg 
     414               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
     415               ! 
     416                                      ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1)   ) 
     417               IF( sn_cdg%ln_tint )   ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) ) 
     418               CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 
     419            ENDIF 
     420            ALLOCATE( cdn_wave(jpi,jpj) ) 
     421            cdn_wave(:,:) = 0._wp 
     422         ENDIF 
     423         IF( ln_charn ) THEN                     ! wave drag 
     424            IF( .NOT. cpl_charn ) THEN 
     425               CALL ctl_stop( 'STOP', 'Charnock based wind stress can be used in coupled mode only' ) 
     426            ENDIF 
     427            ALLOCATE( charn(jpi,jpj) ) 
     428            charn(:,:) = 0._wp 
     429         ENDIF 
     430         IF( ln_taw ) THEN                     ! wind stress 
     431            IF( .NOT. cpl_taw ) THEN 
     432               CALL ctl_stop( 'STOP', 'wind stress from wave model can be used in coupled mode only, use ln_cdgw instead' ) 
     433            ENDIF 
     434            ALLOCATE( tawx(jpi,jpj) ) 
     435            ALLOCATE( tawy(jpi,jpj) ) 
     436            ALLOCATE( twox(jpi,jpj) ) 
     437            ALLOCATE( twoy(jpi,jpj) ) 
     438            ALLOCATE( tauoc_wavex(jpi,jpj) ) 
     439            ALLOCATE( tauoc_wavey(jpi,jpj) ) 
     440            tawx(:,:) = 0._wp 
     441            tawy(:,:) = 0._wp 
     442            twox(:,:) = 0._wp 
     443            twoy(:,:) = 0._wp 
     444            tauoc_wavex(:,:) = 1._wp 
     445            tauoc_wavey(:,:) = 1._wp 
     446         ENDIF 
     447 
     448         IF( ln_phioc ) THEN                     ! TKE flux 
     449            IF( .NOT. cpl_phioc ) THEN 
     450                CALL ctl_stop( 'STOP', 'phioc can be used in coupled mode only' ) 
     451            ENDIF 
     452            ALLOCATE( phioc(jpi,jpj) ) 
     453            phioc(:,:) = 0._wp 
     454         ENDIF 
     455 
     456         IF( ln_tauoc ) THEN                    ! normalized wave stress into the ocean 
     457            IF( .NOT. cpl_wstrf ) THEN 
     458               ALLOCATE( sf_tauoc(1), STAT=ierror )           !* allocate and fill sf_wave with sn_tauoc 
     459               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_tauoc structure' ) 
     460               ! 
     461                                       ALLOCATE( sf_tauoc(1)%fnow(jpi,jpj,1)   ) 
     462               IF( sn_tauoc%ln_tint )  ALLOCATE( sf_tauoc(1)%fdta(jpi,jpj,1,2) ) 
     463               CALL fld_fill( sf_tauoc, (/ sn_tauoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' ) 
     464            ENDIF 
     465            ALLOCATE( tauoc_wave(jpi,jpj) ) 
     466            tauoc_wave(:,:) = 0._wp 
     467         ENDIF 
     468 
     469         IF( ln_sdw ) THEN                      ! Stokes drift 
     470            ! 1. Find out how many fields have to be read from file if not coupled 
     471            jpfld=0 
     472            jp_usd=0   ;   jp_vsd=0   ;   jp_hsw=0   ;   jp_wmp=0 
     473            IF( .NOT. cpl_sdrftx ) THEN 
     474               jpfld  = jpfld + 1 
     475               jp_usd = jpfld 
     476            ENDIF 
     477            IF( .NOT. cpl_sdrfty ) THEN 
     478               jpfld  = jpfld + 1 
     479               jp_vsd = jpfld 
     480            ENDIF 
     481            IF( .NOT. cpl_hsig ) THEN 
     482               jpfld  = jpfld + 1 
     483               jp_hsw = jpfld 
     484            ENDIF 
     485            IF( .NOT. cpl_wper ) THEN 
     486               jpfld  = jpfld + 1 
     487               jp_wmp = jpfld 
     488            ENDIF 
     489            ! 2. Read from file only the non-coupled fields  
     490            IF( jpfld > 0 ) THEN 
     491               ALLOCATE( slf_i(jpfld) ) 
     492               IF( jp_usd > 0 )   slf_i(jp_usd) = sn_usd 
     493               IF( jp_vsd > 0 )   slf_i(jp_vsd) = sn_vsd 
     494               IF( jp_hsw > 0 )   slf_i(jp_hsw) = sn_hsw 
     495               IF( jp_wmp > 0 )   slf_i(jp_wmp) = sn_wmp 
     496               ALLOCATE( sf_sd(jpfld), STAT=ierror )   !* allocate and fill sf_sd with stokes drift 
     497               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
     498               ! 
     499               DO ifpr= 1, jpfld 
     500                  ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) ) 
     501                  IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 
     502               END DO 
     503               ! 
     504               CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 
     505            ENDIF 
    379506            ! 
    380                                    ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1)   ) 
    381             IF( sn_cdg%ln_tint )   ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) ) 
    382             CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 
    383          ENDIF 
    384          ALLOCATE( cdn_wave(jpi,jpj) ) 
    385       ENDIF 
    386  
    387       IF( ln_tauwoc ) THEN 
    388          IF( .NOT. cpl_tauwoc ) THEN 
    389             ALLOCATE( sf_tauwoc(1), STAT=ierror )           !* allocate and fill sf_wave with sn_tauwoc 
    390             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
     507            ! 3. Wave number (only needed for Qiao parametrisation, ln_zdfqiao=T) 
     508            IF( .NOT. cpl_wnum ) THEN 
     509               ALLOCATE( sf_wn(1), STAT=ierror )           !* allocate and fill sf_wave with sn_wnum 
     510               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wn structure' ) 
     511                                      ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1)   ) 
     512               IF( sn_wnum%ln_tint )  ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) ) 
     513               CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 
     514            ENDIF 
    391515            ! 
    392                                      ALLOCATE( sf_tauwoc(1)%fnow(jpi,jpj,1)   ) 
    393             IF( sn_tauwoc%ln_tint )  ALLOCATE( sf_tauwoc(1)%fdta(jpi,jpj,1,2) ) 
    394             CALL fld_fill( sf_tauwoc, (/ sn_tauwoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' ) 
    395          ENDIF 
    396          ALLOCATE( tauoc_wave(jpi,jpj) ) 
    397       ENDIF 
    398  
    399       IF( ln_tauw ) THEN 
    400          IF( .NOT. cpl_tauw ) THEN 
    401             ALLOCATE( sf_tauw(2), STAT=ierror )           !* allocate and fill sf_wave with sn_tauwx/y 
    402             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_tauw structure' ) 
    403             ! 
    404             ALLOCATE( slf_j(2) ) 
    405             slf_j(1) = sn_tauwx 
    406             slf_j(2) = sn_tauwy 
    407                                     ALLOCATE( sf_tauw(1)%fnow(jpi,jpj,1)   ) 
    408                                     ALLOCATE( sf_tauw(2)%fnow(jpi,jpj,1)   ) 
    409             IF( slf_j(1)%ln_tint )  ALLOCATE( sf_tauw(1)%fdta(jpi,jpj,1,2) ) 
    410             IF( slf_j(2)%ln_tint )  ALLOCATE( sf_tauw(2)%fdta(jpi,jpj,1,2) ) 
    411             CALL fld_fill( sf_tauw, (/ slf_j /), cn_dir, 'sbc_wave_init', 'read wave input', 'namsbc_wave' ) 
    412          ENDIF 
    413          ALLOCATE( tauw_x(jpi,jpj) ) 
    414          ALLOCATE( tauw_y(jpi,jpj) ) 
    415       ENDIF 
    416  
    417       IF( ln_sdw ) THEN   ! Find out how many fields have to be read from file if not coupled 
    418          jpfld=0 
    419          jp_usd=0   ;   jp_vsd=0   ;   jp_hsw=0   ;   jp_wmp=0   ;   jp_wfr=0 
    420          IF( .NOT. cpl_sdrftx ) THEN 
    421             jpfld  = jpfld + 1 
    422             jp_usd = jpfld 
    423          ENDIF 
    424          IF( .NOT. cpl_sdrfty ) THEN 
    425             jpfld  = jpfld + 1 
    426             jp_vsd = jpfld 
    427          ENDIF 
    428          IF( .NOT. cpl_hsig  .AND. ll_st_bv_li  ) THEN 
    429             jpfld  = jpfld + 1 
    430             jp_hsw = jpfld 
    431          ENDIF 
    432          IF( .NOT. cpl_wper  .AND. ll_st_bv_li  ) THEN 
    433             jpfld  = jpfld + 1 
    434             jp_wmp = jpfld 
    435          ENDIF 
    436          IF( .NOT. cpl_wfreq .AND. ll_st_peakfr ) THEN 
    437             jpfld  = jpfld + 1 
    438             jp_wfr = jpfld 
    439          ENDIF 
    440  
    441          ! Read from file only the non-coupled fields  
    442          IF( jpfld > 0 ) THEN 
    443             ALLOCATE( slf_i(jpfld) ) 
    444             IF( jp_usd > 0 )   slf_i(jp_usd) = sn_usd 
    445             IF( jp_vsd > 0 )   slf_i(jp_vsd) = sn_vsd 
    446             IF( jp_hsw > 0 )   slf_i(jp_hsw) = sn_hsw 
    447             IF( jp_wmp > 0 )   slf_i(jp_wmp) = sn_wmp 
    448             IF( jp_wfr > 0 )   slf_i(jp_wfr) = sn_wfr 
    449  
    450             ALLOCATE( sf_sd(jpfld), STAT=ierror )   !* allocate and fill sf_sd with stokes drift 
    451             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
    452             ! 
    453             DO ifpr= 1, jpfld 
    454                ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) ) 
    455                IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 
    456             END DO 
    457             ! 
    458             CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 
    459          ENDIF 
    460          ALLOCATE( usd  (jpi,jpj,jpk), vsd  (jpi,jpj,jpk), wsd(jpi,jpj,jpk) ) 
    461          ALLOCATE( hsw  (jpi,jpj)    , wmp  (jpi,jpj)     ) 
    462          ALLOCATE( wfreq(jpi,jpj) ) 
    463          ALLOCATE( ut0sd(jpi,jpj)    , vt0sd(jpi,jpj)     ) 
    464          ALLOCATE( div_sd(jpi,jpj) ) 
    465          ALLOCATE( tsd2d (jpi,jpj) ) 
    466  
    467          ut0sd(:,:) = 0._wp 
    468          vt0sd(:,:) = 0._wp 
    469          hsw(:,:) = 0._wp 
    470          wmp(:,:) = 0._wp 
    471  
    472          usd(:,:,:) = 0._wp 
    473          vsd(:,:,:) = 0._wp 
    474          wsd(:,:,:) = 0._wp 
    475          ! Wave number needed only if ln_zdfswm=T 
    476          IF( .NOT. cpl_wnum ) THEN 
    477             ALLOCATE( sf_wn(1), STAT=ierror )           !* allocate and fill sf_wave with sn_wnum 
    478             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable toallocate sf_wave structure' ) 
    479                                    ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1)   ) 
    480             IF( sn_wnum%ln_tint )  ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) ) 
    481             CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 
    482          ENDIF 
    483          ALLOCATE( wnum(jpi,jpj) ) 
     516         ENDIF 
     517         ! 
    484518      ENDIF 
    485519      ! 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/TRA/eosbn2.F90

    r14023 r14050  
    5656   !                  !! * Interface 
    5757   INTERFACE eos 
    58       MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 
     58      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 
    5959   END INTERFACE 
    6060   ! 
    … …  
    576576 
    577577 
     578   SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 
     579      !!---------------------------------------------------------------------- 
     580      !!                  ***  ROUTINE eos_insitu_pot  *** 
     581      !! 
     582      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
     583      !!      potential volumic mass (Kg/m3) from potential temperature and 
     584      !!      salinity fields using an equation of state selected in the 
     585      !!     namelist. 
     586      !! 
     587      !! ** Action  : 
     588      !!              - prhop, the potential volumic mass (Kg/m3) 
     589      !! 
     590      !!---------------------------------------------------------------------- 
     591      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     592      !                                                                ! 2 : salinity               [psu] 
     593      REAL(wp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     594      ! 
     595      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
     596      INTEGER  ::   jdof 
     597      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
     598      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
     599      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
     600      !!---------------------------------------------------------------------- 
     601      ! 
     602      IF( ln_timing )   CALL timing_start('eos-pot') 
     603      ! 
     604      SELECT CASE ( neos ) 
     605      ! 
     606      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     607         ! 
     608            DO_2D( 1, 1, 1, 1 ) 
     609               ! 
     610               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     611               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     612               ztm = tmask(ji,jj,1)                                         ! tmask 
     613               ! 
     614               zn0 = (((((EOS060*zt   & 
     615                  &   + EOS150*zs+EOS050)*zt   & 
     616                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     617                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     618                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     619                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     620                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     621                  ! 
     622               ! 
     623               prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface 
     624               ! 
     625            END_2D 
     626 
     627      CASE( np_seos )                !==  simplified EOS  ==! 
     628         ! 
     629         DO_2D( 1, 1, 1, 1 ) 
     630            zt  = pts  (ji,jj,jp_tem) - 10._wp 
     631            zs  = pts  (ji,jj,jp_sal) - 35._wp 
     632            ztm = tmask(ji,jj,1) 
     633            !                                                     ! potential density referenced at the surface 
     634            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     635               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     636               &  - rn_nu * zt * zs 
     637            prhop(ji,jj) = ( rho0 + zn ) * ztm 
     638            ! 
     639         END_2D 
     640         ! 
     641      END SELECT 
     642      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prhop, clinfo1=' pot: ', kdim=1 ) 
     643      ! 
     644      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 
     645      ! 
     646      IF( ln_timing )   CALL timing_stop('eos-pot') 
     647      ! 
     648   END SUBROUTINE eos_insitu_pot_2d 
     649 
     650 
    578651   SUBROUTINE rab_3d( pts, pab, Kmm ) 
    579652      !! 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/TRA/trazdf.F90

    r14023 r14050  
    1717   USE phycst         ! physical constant 
    1818   USE zdf_oce        ! ocean vertical physics variables 
     19   USE zdfmfc         ! Mass FLux Convection  
    1920   USE sbc_oce        ! surface boundary condition: ocean 
    2021   USE ldftra         ! lateral diffusion: eddy diffusivity 
    … …  
    198199            ENDIF 
    199200            ! 
     201            ! Modification of diagonal to add MF scheme 
     202            IF ( ln_zdfmfc ) THEN 
     203               CALL diag_mfc( zwi, zwd, zws, p2dt, Kaa ) 
     204            END IF 
     205            ! 
    200206            !! Matrix inversion from the first level 
    201207            !!---------------------------------------------------------------------- 
    … …  
    226232         ENDIF  
    227233         !          
     234         ! Modification of rhs to add MF scheme 
     235         IF ( ln_zdfmfc ) THEN 
     236            CALL rhs_mfc( pt(:,:,:,jn,Krhs), jn ) 
     237         END IF 
     238         ! 
    228239         DO_2D( 0, 0, 0, 0 )         !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    229240            pt(ji,jj,1,jn,Kaa) =        e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb)    & 
    230                &               + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 
     241               &               + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs)  
    231242         END_2D 
    232243         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/ZDF/zdf_oce.F90

    r10425 r14050  
    4040   LOGICAL , PUBLIC ::   ln_zdfswm   !: surface  wave-induced mixing flag 
    4141   LOGICAL , PUBLIC ::   ln_zdfiwm   !: internal wave-induced mixing flag 
     42   LOGICAL , PUBLIC ::   ln_zdfmfc   !: convection: eddy diffusivity Mass Flux Convection 
    4243   !                             ! coefficients  
    4344   REAL(wp), PUBLIC ::   rn_avm0     !: vertical eddy viscosity (m2/s) 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/ZDF/zdfphy.F90

    r13998 r14050  
    2121   USE zdfddm         ! vertical physics: double diffusion mixing       
    2222   USE zdfevd         ! vertical physics: convection via enhanced vertical diffusion   
     23   USE zdfmfc         ! vertical physics: Mass Flux Convection  
    2324   USE zdfiwm         ! vertical physics: internal wave-induced mixing   
    2425   USE zdfswm         ! vertical physics: surface  wave-induced mixing 
    … …  
    7879      NAMELIST/namzdf/ ln_zdfcst, ln_zdfric, ln_zdftke, ln_zdfgls,   &     ! type of closure scheme 
    7980         &             ln_zdfosm,                                    &     ! type of closure scheme 
     81         &             ln_zdfmfc,                                    &     ! convection : mass flux 
    8082         &             ln_zdfevd, nn_evdm, rn_evd ,                  &     ! convection : evd 
    8183         &             ln_zdfnpc, nn_npc , nn_npcp,                  &     ! convection : npc 
    … …  
    112114         WRITE(numout,*) '         OSMOSIS-OBL closure (OSM)               ln_zdfosm = ', ln_zdfosm 
    113115         WRITE(numout,*) '      convection: ' 
     116         WRITE(numout,*) '         convection mass flux (mfc)              ln_zdfmfc = ', ln_zdfmfc 
    114117         WRITE(numout,*) '         enhanced vertical diffusion             ln_zdfevd = ', ln_zdfevd 
    115118         WRITE(numout,*) '            applied on momentum (=1/0)             nn_evdm = ', nn_evdm 
    … …  
    172175      IF( ln_zdfnpc .AND. ln_zdfevd )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfnpc and ln_zdfevd' ) 
    173176      IF( ln_zdfosm .AND. ln_zdfevd )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfosm and ln_zdfevd' ) 
     177      IF( ln_zdfmfc .AND. ln_zdfevd )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfevd' ) 
     178      IF( ln_zdfmfc .AND. ln_zdfnpc )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfnpc' ) 
     179      IF( ln_zdfmfc .AND. ln_zdfosm )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfosm' ) 
    174180      IF( lk_top    .AND. ln_zdfnpc )   CALL ctl_stop( 'zdf_phy_init: npc scheme is not working with key_top' ) 
    175181      IF( lk_top    .AND. ln_zdfosm )   CALL ctl_stop( 'zdf_phy_init: osmosis scheme is not working with key_top' ) 
     182      IF( lk_top    .AND. ln_zdfmfc )   CALL ctl_stop( 'zdf_phy_init: Mass Flux scheme is not working with key_top' ) 
    176183      IF(lwp) THEN 
    177184         WRITE(numout,*) 
    178185         IF    ( ln_zdfnpc ) THEN  ;   WRITE(numout,*) '   ==>>>   convection: use non penetrative convective scheme' 
    179186         ELSEIF( ln_zdfevd ) THEN  ;   WRITE(numout,*) '   ==>>>   convection: use enhanced vertical diffusion scheme' 
     187         ELSEIF( ln_zdfmfc ) THEN  ;   WRITE(numout,*) '   ==>>>   convection: use Mass Flux scheme' 
    180188         ELSE                      ;   WRITE(numout,*) '   ==>>>   convection: no specific scheme used' 
    181189         ENDIF 
    … …  
    205213      ELSE                   ;   l_zdfsh2 = .TRUE. 
    206214      ENDIF 
    207  
     215      !                          !== Mass Flux Convectiive algorithm  ==! 
     216      IF( ln_zdfmfc )   CALL zdf_mfc_init       ! Convection computed with eddy diffusivity mass flux 
     217      ! 
    208218      !                          !== gravity wave-driven mixing  ==! 
    209219      IF( ln_zdfiwm )   CALL zdf_iwm_init       ! internal wave-driven mixing 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/ZDF/zdfsh2.F90

    r13998 r14050  
    66   !! History :   -   !  2014-10  (A. Barthelemy, G. Madec)  original code 
    77   !!   NEMO     4.0  !  2017-04  (G. Madec)  remove u-,v-pts avm 
     8   !!   NEMO     4.2  !  2020-12  (G. Madec, E. Clementi) add Stokes Drift Shear 
     9   !                  !           for wave coupling 
    810   !!---------------------------------------------------------------------- 
    911 
    … …  
    1315   USE oce 
    1416   USE dom_oce        ! domain: ocean 
     17   USE sbcwave        ! Surface Waves (add Stokes shear) 
     18   USE sbc_oce , ONLY: ln_stshear  !Stoked Drift shear contribution 
    1519   ! 
    1620   USE in_out_manager ! I/O manager 
    … …  
    2125 
    2226   PUBLIC   zdf_sh2        ! called by zdftke, zdfglf, and zdfric 
    23     
     27 
    2428   !! * Substitutions 
    2529#  include "do_loop_substitute.h90" 
    … …  
    5963      !!-------------------------------------------------------------------- 
    6064      ! 
    61       DO jk = 2, jpkm1 
    62          DO_2D( 1, 0, 1, 0 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
    63             zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
    64                &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) & 
    65                &         * (   uu(ji,jj,jk-1,Kbb) -   uu(ji,jj,jk,Kbb) ) &  
    66                &         / ( e3uw(ji,jj,jk  ,Kmm) * e3uw(ji,jj,jk,Kbb) ) & 
    67                &         * wumask(ji,jj,jk) 
    68             zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 
    69                &         * (   vv(ji,jj,jk-1,Kmm) -   vv(ji,jj,jk,Kmm) ) & 
    70                &         * (   vv(ji,jj,jk-1,Kbb) -   vv(ji,jj,jk,Kbb) ) & 
    71                &         / ( e3vw(ji,jj,jk  ,Kmm) * e3vw(ji,jj,jk,Kbb) ) & 
    72                &         * wvmask(ji,jj,jk) 
    73          END_2D 
     65      DO jk = 2, jpkm1                 !* Shear production at uw- and vw-points (energy conserving form) 
     66         IF ( cpl_sdrftx .AND. ln_stshear )  THEN       ! Surface Stokes Drift available  ===>>>  shear + stokes drift contibution 
     67            DO_2D( 1, 0, 1, 0 ) 
     68               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) )        & 
     69                  &         * ( uu (ji,jj,jk-1,Kmm) -   uu (ji,jj,jk,Kmm)    & 
     70                  &           + usd(ji,jj,jk-1) -   usd(ji,jj,jk) )  & 
     71                  &         * ( uu (ji,jj,jk-1,Kbb) -   uu (ji,jj,jk,Kbb) )  & 
     72                  &         / ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) * wumask(ji,jj,jk) 
     73               zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) )         & 
     74                  &         * ( vv (ji,jj,jk-1,Kmm) -   vv (ji,jj,jk,Kmm)     & 
     75                  &           + vsd(ji,jj,jk-1) -   vsd(ji,jj,jk) )   & 
     76                  &         * ( vv (ji,jj,jk-1,Kbb) -   vv (ji,jj,jk,Kbb) )   & 
     77                  &/ ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) * wvmask(ji,jj,jk) 
     78            END_2D 
     79         ELSE 
     80            DO_2D( 1, 0, 1, 0 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
     81               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
     82                  &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) & 
     83                  &         * (   uu(ji,jj,jk-1,Kbb) -   uu(ji,jj,jk,Kbb) ) &  
     84                  &         / ( e3uw(ji,jj,jk  ,Kmm) * e3uw(ji,jj,jk,Kbb) ) & 
     85                  &         * wumask(ji,jj,jk) 
     86               zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 
     87                  &         * (   vv(ji,jj,jk-1,Kmm) -   vv(ji,jj,jk,Kmm) ) & 
     88                  &         * (   vv(ji,jj,jk-1,Kbb) -   vv(ji,jj,jk,Kbb) ) & 
     89                  &         / ( e3vw(ji,jj,jk  ,Kmm) * e3vw(ji,jj,jk,Kbb) ) & 
     90                  &         * wvmask(ji,jj,jk) 
     91            END_2D 
     92         ENDIF 
    7493         DO_2D( 0, 0, 0, 0 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
    7594            p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 
    7695               &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   ) 
    7796         END_2D 
    78       END DO  
     97      END DO 
    7998      ! 
    8099   END SUBROUTINE zdf_sh2 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/ZDF/zdftke.F90

    r14018 r14050  
    2929   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only  
    3030   !!             -   !  2017-05  (G. Madec)  add top/bottom friction as boundary condition 
     31   !!            4.2  !  2020-12  (G. Madec, E. Clementi) add wave coupling 
     32   !                  !           following Couvelard et al., 2019 
    3133   !!---------------------------------------------------------------------- 
    3234 
    … …  
    5860   USE prtctl         ! Print control 
    5961   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     62   USE sbcwave        ! Surface boundary waves 
    6063 
    6164   IMPLICIT NONE 
    … …  
    6871   !                      !!** Namelist  namzdf_tke  ** 
    6972   LOGICAL  ::   ln_mxl0   ! mixing length scale surface value as function of wind stress or not 
     73   LOGICAL  ::   ln_mxhsw  ! mixing length scale surface value as a fonction of wave height 
    7074   INTEGER  ::   nn_mxlice ! type of scaling under sea-ice (=0/1/2/3) 
    7175   REAL(wp) ::   rn_mxlice ! ice thickness value when scaling under sea-ice 
    … …  
    8185   INTEGER  ::   nn_etau   ! type of depth penetration of surface tke (=0/1/2/3) 
    8286   INTEGER  ::      nn_htau   ! type of tke profile of penetration (=0/1) 
     87   INTEGER  ::   nn_bc_surf! surface condition (0/1=Dir/Neum) ! Only applicable for wave coupling 
     88   INTEGER  ::   nn_bc_bot ! surface condition (0/1=Dir/Neum) ! Only applicable for wave coupling 
    8389   REAL(wp) ::      rn_efr    ! fraction of TKE surface value which penetrates in the ocean 
    8490   LOGICAL  ::   ln_lc     ! Langmuir cells (LC) as a source term of TKE or not 
    … …  
    209215      REAL(wp) ::   zus   , zwlc  , zind       !   -      - 
    210216      REAL(wp) ::   zzd_up, zzd_lw             !   -      - 
     217      REAL(wp) ::   ztaui, ztauj, z1_norm 
    211218      INTEGER , DIMENSION(jpi,jpj)     ::   imlc 
    212       REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra, zhlc, zus3 
     219      REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra, zhlc, zus3, zWlc2 
    213220      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc, zdiag, zd_up, zd_lw 
    214221      !!-------------------------------------------------------------------- 
    … …  
    219226      zfact2  = 1.5_wp * rn_Dt * rn_ediss 
    220227      zfact3  = 0.5_wp         * rn_ediss 
     228      ! 
     229      zpelc(:,:,:) = 0._wp ! need to be initialised in case ln_lc is not used 
    221230      ! 
    222231      ! ice fraction considered for attenuation of langmuir & wave breaking 
    … …  
    232241      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    233242      ! 
    234       DO_2D( 0, 0, 0, 0 )         ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
    235 !! clem: this should be the right formulation but it makes the model unstable unless drags are calculated implicitly 
    236 !!       one way around would be to increase zbbirau  
    237 !!          en(ji,jj,1) = MAX( rn_emin0, ( ( 1._wp - fr_i(ji,jj) ) * zbbrau + & 
    238 !!             &                                     fr_i(ji,jj)   * zbbirau ) * taum(ji,jj) ) * tmask(ji,jj,1) 
     243      DO_2D( 0, 0, 0, 0 ) 
    239244         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 
     245         zdiag(ji,jj,1) = 1._wp/en(ji,jj,1) 
     246         zd_lw(ji,jj,1) = 1._wp   
     247         zd_up(ji,jj,1) = 0._wp 
    240248      END_2D 
    241249      ! 
    … …  
    274282      ! 
    275283      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    276       IF( ln_lc ) THEN      !  Langmuir circulation source term added to tke   !   (Axell JGR 2002) 
     284      IF( ln_lc ) THEN      !  Langmuir circulation source term added to tke (Axell JGR 2002) 
    277285         !                  !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    278286         ! 
    279          !                        !* total energy produce by LC : cumulative sum over jk 
     287         !                       !* Langmuir velocity scale 
     288         ! 
     289         IF ( cpl_sdrftx )  THEN       ! Surface Stokes Drift available 
     290            !                                ! Craik-Leibovich velocity scale Wlc = ( u* u_s )^1/2    with u* = (taum/rho0)^1/2 
     291            !                                ! associated kinetic energy : 1/2 (Wlc)^2 = u* u_s 
     292            !                                ! more precisely, it is the dot product that must be used : 
     293            !                                !     1/2  (W_lc)^2 = MAX( u* u_s + v* v_s , 0 )   only the positive part 
     294!!gm  ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s 
     295!!gm  ! so we will overestimate the LC velocity....   !!gm I will do the work if !LC have an effect ! 
     296            DO_2D( 0, 0, 0, 0 ) 
     297!!XC                  zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 )  ) 
     298                  zWlc2(ji,jj) = 0.5_wp *  ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) 
     299            END_2D 
     300! 
     301!  Projection of Stokes drift in the wind stress direction 
     302! 
     303            DO_2D( 0, 0, 0, 0 ) 
     304                  ztaui   = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) ) 
     305                  ztauj   = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj-1) ) 
     306                  z1_norm = 1._wp / MAX( SQRT(ztaui*ztaui+ztauj*ztauj), 1.e-12 ) * tmask(ji,jj,1) 
     307                  zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 
     308            END_2D 
     309         CALL lbc_lnk      ( 'zdftke', zWlc2, 'T', 1. ) 
     310! 
     311         ELSE                          ! Surface Stokes drift deduced from surface stress 
     312            !                                ! Wlc = u_s   with u_s = 0.016*U_10m, the surface stokes drift  (Axell 2002, Eq.44) 
     313            !                                ! using |tau| = rho_air Cd |U_10m|^2 , it comes: 
     314            !                                ! Wlc = 0.016 * [|tau|/(rho_air Cdrag) ]^1/2   and thus: 
     315            !                                ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag ) 
     316            zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )      ! to convert stress in 10m wind using a constant drag 
     317            DO_2D( 1, 1, 1, 1 ) 
     318               zWlc2(ji,jj) = zcof * taum(ji,jj) 
     319            END_2D 
     320            ! 
     321         ENDIF 
     322         ! 
     323         !                       !* Depth of the LC circulation  (Axell 2002, Eq.47) 
     324         !                             !- LHS of Eq.47 
    280325         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm) 
    281326         DO jk = 2, jpk 
    … …  
    283328               &        MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm) 
    284329         END DO 
    285          !                        !* finite Langmuir Circulation depth 
    286          zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 
     330         ! 
     331         !                             !- compare LHS to RHS of Eq.47 
    287332         imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    288          DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 )   ! Last w-level at which zpelc>=0.5*us*us  
    289             zus = zcof * taum(ji,jj)          !      with us=0.016*wind(starting from jpk-1) 
    290             IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk 
     333         DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 
     334            IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) )   imlc(ji,jj) = jk 
    291335         END_3D 
    292336         !                               ! finite LC depth 
    … …  
    294338            zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 
    295339         END_2D 
     340         ! 
    296341         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    297342         DO_2D( 0, 0, 0, 0 ) 
    298             zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
     343            zus = SQRT( 2. * zWlc2(ji,jj) )             ! Stokes drift 
    299344            zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    300345         END_2D 
    … …  
    351396            &                                ) * wmask(ji,jj,jk) 
    352397      END_3D 
     398      ! 
     399      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     400      !                     !  Surface boundary condition on tke if 
     401      !                     !  coupling with waves 
     402      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     403      ! 
     404      IF ( cpl_phioc .and. ln_phioc )  THEN 
     405         SELECT CASE (nn_bc_surf) ! Boundary Condition using surface TKE flux from waves  
     406 
     407         CASE ( 0 ) ! Dirichlet BC 
     408            DO_2D( 0, 0, 0, 0 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0) 
     409               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
     410               en(ji,jj,1) = MAX( rn_emin0, .5 * ( 15.8 * phioc(ji,jj) / rho0 )**(2./3.) )  * tmask(ji,jj,1) 
     411               zdiag(ji,jj,1) = 1._wp/en(ji,jj,1)  ! choose to keep coherence with former estimation of 
     412            END_2D 
     413 
     414         CASE ( 1 ) ! Neumann BC 
     415            DO_2D( 0, 0, 0, 0 ) 
     416               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
     417               en(ji,jj,2)    = en(ji,jj,2) + ( rn_Dt * phioc(ji,jj) / rho0 ) /e3w(ji,jj,2,Kmm) 
     418               en(ji,jj,1)    = en(ji,jj,2) + (2 * e3t(ji,jj,1,Kmm) * phioc(ji,jj)/rho0) / ( p_avm(ji,jj,1) + p_avm(ji,jj,2) ) 
     419               zdiag(ji,jj,2) = zdiag(ji,jj,2) + zd_lw(ji,jj,2) 
     420               zdiag(ji,jj,1) = 1._wp 
     421               zd_lw(ji,jj,2) = 0._wp 
     422            END_2D 
     423 
     424         END SELECT 
     425 
     426      ENDIF 
     427      ! 
    353428      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    354       DO_3D( 0, 0, 0, 0, 3, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     429      DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    355430         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    356431      END_3D 
    357       DO_2D( 0, 0, 0, 0 )                          ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    358          zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
    359       END_2D 
    360       DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 
     432!XC : commented to allow for neumann boundary condition 
     433!      DO_2D( 0, 0, 0, 0 ) 
     434!         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
     435!      END_2D 
     436      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    361437         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 
    362438      END_3D 
    … …  
    460536      zmxlm(:,:,:)  = rmxl_min     
    461537      zmxld(:,:,:)  = rmxl_min 
     538      ! 
     539      IF(ln_sdw .AND. ln_mxhsw) THEN 
     540         zmxlm(:,:,1)= vkarmn * MAX ( 1.6 * hsw(:,:) , 0.02 )        ! surface mixing length = F(wave height) 
     541         ! from terray et al 1999 and mellor and blumberg 2004 it should be 0.85 and not 1.6 
     542         zcoef       = vkarmn * ( (rn_ediff*rn_ediss)**0.25 ) / rn_ediff 
     543         zmxlm(:,:,1)= zcoef * MAX ( 1.6 * hsw(:,:) , 0.02 )        ! surface mixing length = F(wave height) 
     544      ELSE 
    462545      !  
    463      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
    464          ! 
    465          zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
     546         IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
     547         ! 
     548            zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
    466549#if ! defined key_si3 && ! defined key_cice 
    467          DO_2D( 0, 0, 0, 0 )                  ! No sea-ice 
    468             zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    469          END_2D 
     550            DO_2D( 0, 0, 0, 0 )                  ! No sea-ice 
     551               zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
     552            END_2D 
    470553#else 
    471          SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
    472          ! 
    473          CASE( 0 )                      ! No scaling under sea-ice 
     554            SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
     555            ! 
     556            CASE( 0 )                      ! No scaling under sea-ice 
     557               DO_2D( 0, 0, 0, 0 ) 
     558                  zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
     559               END_2D 
     560               ! 
     561            CASE( 1 )                      ! scaling with constant sea-ice thickness 
     562               DO_2D( 0, 0, 0, 0 ) 
     563                  zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     564                     &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1) 
     565               END_2D 
     566               ! 
     567            CASE( 2 )                      ! scaling with mean sea-ice thickness 
     568               DO_2D( 0, 0, 0, 0 ) 
     569#if defined key_si3 
     570                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     571                     &                         fr_i(ji,jj)   * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 
     572#elif defined key_cice 
     573                  zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     574                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     575                     &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
     576#endif 
     577               END_2D 
     578               ! 
     579            CASE( 3 )                      ! scaling with max sea-ice thickness 
     580               DO_2D( 0, 0, 0, 0 ) 
     581                  zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     582                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     583                     &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
     584               END_2D 
     585               ! 
     586            END SELECT 
     587#endif 
     588            ! 
    474589            DO_2D( 0, 0, 0, 0 ) 
    475                zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
     590               zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
    476591            END_2D 
    477592            ! 
    478          CASE( 1 )                      ! scaling with constant sea-ice thickness 
    479             DO_2D( 0, 0, 0, 0 ) 
    480                zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    481                   &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1) 
    482             END_2D 
    483             ! 
    484          CASE( 2 )                      ! scaling with mean sea-ice thickness 
    485             DO_2D( 0, 0, 0, 0 ) 
    486 #if defined key_si3 
    487                zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    488                   &                         fr_i(ji,jj)   * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 
    489 #elif defined key_cice 
    490                zmaxice = MAXVAL( h_i(ji,jj,:) ) 
    491                zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    492                   &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
    493 #endif 
    494             END_2D 
    495             ! 
    496          CASE( 3 )                      ! scaling with max sea-ice thickness 
    497             DO_2D( 0, 0, 0, 0 ) 
    498                zmaxice = MAXVAL( h_i(ji,jj,:) ) 
    499                zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    500                   &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
    501             END_2D 
    502             ! 
    503          END SELECT 
    504 #endif 
    505          ! 
    506          DO_2D( 0, 0, 0, 0 ) 
    507             zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
    508          END_2D 
    509          ! 
    510       ELSE 
    511          zmxlm(:,:,1) = rn_mxl0 
    512       ENDIF 
    513  
     593         ELSE 
     594            zmxlm(:,:,1) = rn_mxl0 
     595         ENDIF 
     596      ENDIF 
    514597      ! 
    515598      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    … …  
    624707         &                 rn_mxl0 , nn_mxlice, rn_mxlice,             & 
    625708         &                 nn_pdl  , ln_lc    , rn_lc    ,             & 
    626          &                 nn_etau , nn_htau  , rn_efr   , nn_eice   
     709         &                 nn_etau , nn_htau  , rn_efr   , nn_eice  ,  &    
     710         &                 nn_bc_surf, nn_bc_bot, ln_mxhsw 
    627711      !!---------------------------------------------------------------------- 
    628712      ! 
    … …  
    666750         WRITE(numout,*) '      Langmuir cells parametrization              ln_lc     = ', ln_lc 
    667751         WRITE(numout,*) '         coef to compute vertical velocity of LC     rn_lc  = ', rn_lc 
     752         IF ( cpl_phioc .and. ln_phioc )  THEN 
     753            SELECT CASE( nn_bc_surf)             ! Type of scaling under sea-ice 
     754            CASE( 0 )   ;   WRITE(numout,*) '  nn_bc_surf=0 ==>>> DIRICHLET SBC using surface TKE flux from waves' 
     755            CASE( 1 )   ;   WRITE(numout,*) '  nn_bc_surf=1 ==>>> NEUMANN SBC using surface TKE flux from waves' 
     756            END SELECT 
     757         ENDIF 
    668758         WRITE(numout,*) '      test param. to add tke induced by wind      nn_etau   = ', nn_etau 
    669759         WRITE(numout,*) '          type of tke penetration profile            nn_htau   = ', nn_htau 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/module_example

    r13998 r14050  
    4949 
    5050   !! * Substitutions 
     51   ! for DO macro 
     52#  include "do_loop_substitute.h90" 
     53   !for other substitutions 
    5154#  include "exampl_substitute.h90" 
    5255   !!---------------------------------------------------------------------- 
    … …  
    9598      REAL(wp) ::   zmlmin, zbbrho   ! temporary scalars     (DOCTOR : start with z) 
    9699      REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration 
    97       REAL(wp), DIMENSION(jpi,jpj) ::   zwrk_2d   ! 2D workspace 
     100      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zwrk_2d   ! 2D workspace 
     101      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwrk_3d   ! 3D workspace 
    98102      !!-------------------------------------------------------------------- 
    99103      ! 
    100       IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only) 
     104      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     105         IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only) 
    101106 
    102       zmlmin = 1.e-8                             ! Local constant initialization 
    103       zbbrho =  .5 * ebb / rho0 
    104       zfact1 = -.5 * rdt * efave 
    105       zfact2 = 1.5 * rdt * ediss 
    106  
     107         zmlmin = 1.e-8                             ! Local constant initialization 
     108         zbbrho =  .5 * ebb / rho0 
     109         zfact1 = -.5 * rdt * efave 
     110         zfact2 = 1.5 * rdt * ediss 
     111      ENDIF 
     112      
    107113      SELECT CASE ( npdl )                       ! short description of the action 
    108114      ! 
    109115      CASE ( 0 )                                      ! describe case 1 
    110          DO jk = 2, jpkm1 
    111             DO jj = 2, jpjm1 
    112                DO ji = fs_2, fs_jpim1   ! vector opt. 
    113                   avm(ji,jj,jk) = .... 
    114                END DO 
    115             END DO 
    116          END DO 
     116         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     117            avm(ji,jj,jk) = .... 
     118         END_3D 
    117119         ! 
    118120      CASE ( 1 )                                      ! describe case 2 
    119          DO jk = 2, jpkm1 
    120             DO jj = 2, jpjm1 
    121                DO ji = fs_2, fs_jpim1   ! vector opt. 
    122                   avm(ji,jj,jk) = ... 
    123                END DO 
    124             END DO 
    125          END DO 
     121         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     122            avm(ji,jj,jk) = .... 
     123         END_3D 
    126124         ! 
    127125      END SELECT 
    128126      ! 
    129       CALL lbc_lnk( 'module_example', avm, 'T', 1. )              ! Lateral boundary conditions (unchanged sign) 
     127      CALL lbc_lnk( 'module_example', avm, 'T', 1., ncsten=true )     ! Lateral boundary conditions (unchanged sign) 
     128      !                                                                ! ncsten=false for 5-points stencil communication 
     129      !                                                                ! ncsten=true (default)  for 9-points stencil communication 
    130130      ! 
    131131   END SUBROUTINE exa_mpl 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/nemogcm.F90

    r14018 r14050  
    468468                           CALL dyn_spg_init         ! surface pressure gradient 
    469469 
     470      !                                      ! Icebergs 
     471                           CALL icb_init( rn_Dt, nit000)   ! initialise icebergs instance 
     472 
     473                                                ! ice shelf 
     474                           CALL isf_init( Nbb, Nnn, Naa ) 
    470475#if defined key_top 
    471476      !                                      ! Passive tracers 
    … …  
    473478#endif 
    474479      IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing 
    475  
    476       !                                      ! Icebergs 
    477                            CALL icb_init( rn_Dt, nit000)   ! initialise icebergs instance 
    478  
    479                                                 ! ice shelf 
    480                            CALL isf_init( Nbb, Nnn, Naa ) 
    481480 
    482481      !                                      ! Misc. options 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/step.F90

    r14023 r14050  
    294294 
    295295                            CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
     296         IF( ln_zdfmfc  )   CALL tra_mfc    ( kstp, Nbb,      ts, Nrhs )  ! Mass Flux Convection  
    296297         IF( ln_zdfosm  )   CALL tra_osm    ( kstp,      Nnn, ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS 
    297298         IF( lrst_oce .AND. ln_zdfosm ) & 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/step_oce.F90

    r14023 r14050  
    7070   USE zdfdrg   , ONLY : ln_drgimp   ! implicit top/bottom friction 
    7171   USE zdfosm   , ONLY : osm_rst, dyn_osm, tra_osm      ! OSMOSIS routines used in step.F90 
     72   USE zdfmfc          ! Mass FLux Convection routine used in step.F90 
    7273 
    7374   USE diu_layers      ! diurnal SST bulk and coolskin routines 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/SAS/nemogcm.F90

    r14018 r14050  
    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 
    … …  
    395396      ! ==> 
    396397                           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 
    397404      ! 
    398405      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/SAS/sbcssm.F90

    r13286 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/TOP/TRP/trctrp.F90

    r12377 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/TOP/trc.F90

    r14018 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/TOP/trcini.F90

    r13286 r14050  
    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_r13327_KERNEL-06_2_techene_e3/src/TOP/trcnam.F90

    r12489 r14050  
    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_r13327_KERNEL-06_2_techene_e3/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90

    r13998 r14050  
    1818   USE sbc_ice         ! Surface boundary condition: ice fields 
    1919   USE phycst          ! physical constants 
    20    USE ice, ONLY       : at_i_b, a_i_b 
     20   USE ice, ONLY       : jpl, at_i_b, a_i_b 
    2121   USE icethd_dh       ! for CALL ice_thd_snwblow 
    2222   ! 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/ISOMIP+/MY_SRC/eosbn2.F90

    r14023 r14050  
    5656   !                  !! * Interface 
    5757   INTERFACE eos 
    58       MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 
     58      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 
    5959   END INTERFACE 
    6060   ! 
    … …  
    624624 
    625625 
     626   SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 
     627      !!---------------------------------------------------------------------- 
     628      !!                  ***  ROUTINE eos_insitu_pot  *** 
     629      !! 
     630      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
     631      !!      potential volumic mass (Kg/m3) from potential temperature and 
     632      !!      salinity fields using an equation of state selected in the 
     633      !!     namelist. 
     634      !! 
     635      !! ** Action  : 
     636      !!              - prhop, the potential volumic mass (Kg/m3) 
     637      !! 
     638      !!---------------------------------------------------------------------- 
     639      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     640      !                                                                ! 2 : salinity               [psu] 
     641      REAL(wp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     642      ! 
     643      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
     644      INTEGER  ::   jdof 
     645      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
     646      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
     647      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
     648      !!---------------------------------------------------------------------- 
     649      ! 
     650      IF( ln_timing )   CALL timing_start('eos-pot') 
     651      ! 
     652      SELECT CASE ( neos ) 
     653      ! 
     654      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     655         ! 
     656            DO_2D( 1, 1, 1, 1 ) 
     657               ! 
     658               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     659               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     660               ztm = tmask(ji,jj,1)                                         ! tmask 
     661               ! 
     662               zn0 = (((((EOS060*zt   & 
     663                  &   + EOS150*zs+EOS050)*zt   & 
     664                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     665                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     666                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     667                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     668                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     669                  ! 
     670               ! 
     671               prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface 
     672               ! 
     673            END_2D 
     674 
     675      CASE( np_seos )                !==  simplified EOS  ==! 
     676         ! 
     677         DO_2D( 1, 1, 1, 1 ) 
     678            zt  = pts  (ji,jj,jp_tem) - 10._wp 
     679            zs  = pts  (ji,jj,jp_sal) - 35._wp 
     680            ztm = tmask(ji,jj,1) 
     681            !                                                     ! potential density referenced at the surface 
     682            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     683               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     684               &  - rn_nu * zt * zs 
     685            prhop(ji,jj) = ( rho0 + zn ) * ztm 
     686            ! 
     687         END_2D 
     688         ! 
     689      CASE( np_leos )                !==  ISOMIP EOS  ==! 
     690         ! 
     691         DO_2D( 1, 1, 1, 1 ) 
     692            ! 
     693            zt    = pts  (ji,jj,jp_tem)  - (-1._wp) 
     694            zs    = pts  (ji,jj,jp_sal)  - 34.2_wp 
     695            !zh    = pdep (ji,jj)                         ! depth at the partial step level 
     696            ! 
     697            zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
     698            ! 
     699            prhop(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
     700            ! 
     701         END_2D 
     702         ! 
     703      END SELECT 
     704      ! 
     705      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 
     706      ! 
     707      IF( ln_timing )   CALL timing_stop('eos-pot') 
     708      ! 
     709   END SUBROUTINE eos_insitu_pot_2d 
     710 
     711 
    626712   SUBROUTINE rab_3d( pts, pab, Kmm ) 
    627713      !! 

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/demo_cfgs.txt

    r13753 r14050  
    1313CPL_OASIS  OCE TOP ICE NST 
    1414SWG OCE SWE 
     15C1D_ASICS OCE 
     16ICE_RHEO OCE SAS ICE 
Note: See TracChangeset for help on using the changeset viewer.