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 13466 for NEMO/branches – NEMO

Changeset 13466 for NEMO/branches


Ignore:
Timestamp:
2020-09-15T09:27:47+02:00 (4 years ago)
Author:
smasson
Message:

r4_trunk: merge r4 13280:13310, see #2523

Location:
NEMO/branches/2020/temporary_r4_trunk
Files:
86 edited
1 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/temporary_r4_trunk/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

    r13278 r13466  
    353353&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke =T) 
    354354!----------------------------------------------------------------------- 
    355       rn_eice     =   0       !  below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4    
    356355/ 
    357356!!====================================================================== 

  • NEMO/branches/2020/temporary_r4_trunk/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r13278 r13466  
    353353&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke =T) 
    354354!----------------------------------------------------------------------- 
    355       rn_eice     =   0       !  below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4    
    356355/ 
    357356!!====================================================================== 

  • NEMO/branches/2020/temporary_r4_trunk/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r13278 r13466  
    374374                               !        = 2 add a tke source just at the base of the ML 
    375375                               !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
    376       rn_eice     =   0       !  below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4    
    377376/ 
    378377!----------------------------------------------------------------------- 

  • NEMO/branches/2020/temporary_r4_trunk/cfgs/SHARED/field_def_nemo-ice.xml

    r12337 r13466  
    4949          <field id="icehpnd"      long_name="melt pond depth"                                         standard_name="sea_ice_meltpond_depth"                    unit="m" />  
    5050          <field id="icevpnd"      long_name="melt pond volume"                                        standard_name="sea_ice_meltpond_volume"                   unit="m" />  
     51          <field id="icehlid"      long_name="melt pond lid depth"                                     standard_name="sea_ice_meltpondlid_depth"                 unit="m" />  
     52          <field id="icevlid"      long_name="melt pond lid volume"                                    standard_name="sea_ice_meltpondlid_volume"                unit="m" />  
    5153      
    5254     <!-- heat --> 
    … …  
    8183          <field id="icediv"       long_name="Divergence of the sea-ice velocity field"                standard_name="divergence_of_sea_ice_velocity"            unit="s-1"  /> 
    8284          <field id="iceshe"       long_name="Maximum shear of sea-ice velocity field"                 standard_name="maximum_shear_of_sea_ice_velocity"         unit="s-1"  /> 
    83       
     85          <field id="beta_evp"     long_name="Relaxation parameter of ice rheology (beta)"             standard_name="relaxation_parameter_of_ice_rheology"      unit=""  />    
     86  
    8487     <!-- surface heat fluxes --> 
    8588          <field id="qt_ice"       long_name="total heat flux at ice surface"                          standard_name="surface_downward_heat_flux_in_air"         unit="W/m2" /> 
    … …  
    171174          <field id="frq_m"    unit="-"    /> 
    172175 
     176          <!-- rheology convergence tests --> 
     177          <field id="uice_cvg"   long_name="sea ice velocity convergence"      standard_name="sea_ice_velocity_convergence"      unit="m/s" /> 
     178 
    173179     <!-- ================= --> 
    174180          <!-- Add-ons for SIMIP --> 
    … …  
    209215          <field id="dmisum"       long_name="sea-ice mass change through surface melting"             standard_name="tendency_of_sea_ice_amount_due_to_surface_melting"                       unit="kg/m2/s" /> 
    210216          <field id="dmibom"       long_name="sea-ice mass change through bottom melting"              standard_name="tendency_of_sea_ice_amount_due_to_basal_melting"                         unit="kg/m2/s" /> 
     217          <field id="dmilam"       long_name="sea-ice mass change through lateral melting"             standard_name="tendency_of_sea_ice_amount_due_to_lateral_melting"                       unit="kg/m2/s" /> 
    211218          <field id="dmsspr"       long_name="snow mass change through snow fall"                      standard_name="snowfall_flux"                                                           unit="kg/m2/s" /> 
    212219          <field id="dmsmel"       long_name="snow mass change through melt"                           standard_name="surface_snow_melt_flux"                                                  unit="kg/m2/s" /> 
    … …  
    287294          <field id="iceapnd_cat"  long_name="Ice melt pond concentration per category"          unit=""        />  
    288295          <field id="icehpnd_cat"  long_name="Ice melt pond thickness per category"              unit="m"       detect_missing_value="true" />  
     296          <field id="icehlid_cat"  long_name="Ice melt pond lid thickness per category"          unit="m"       detect_missing_value="true" />  
    289297          <field id="iceafpnd_cat" long_name="Ice melt pond fraction per category"               unit=""        />  
     298          <field id="iceaepnd_cat" long_name="Ice melt pond effective fraction per category"     unit=""        />  
    290299          <field id="icemask_cat"  long_name="Fraction of time step with sea ice (per category)" unit=""        /> 
    291300          <field id="iceage_cat"   long_name="Ice age per category"                              unit="days"    detect_missing_value="true" /> 
    … …  
    298307          <field id="snwthic_cat_cmip"     long_name="Snow thickness in thickness categories"          standard_name="snow_thickness_over_categories"        detect_missing_value="true" unit="m"  > snwthic_cat      * icemask_cat + $missval * (1.-icemask_cat) </field> 
    299308          <field id="iceconc_cat_pct_cmip" long_name="Sea-ice area fractions in thickness categories"  standard_name="sea_ice_area_fraction_over_categories" detect_missing_value="true" unit="%"  > iceconc_cat*100. * icemask_cat + $missval * (1.-icemask_cat) </field> 
     309 
     310          <!-- heat diffusion convergence tests --> 
     311          <field id="tice_cvgerr" long_name="sea ice temperature convergence error"      standard_name="sea_ice_temperature_convergence_err" unit="K" /> 
     312          <field id="tice_cvgstp" long_name="sea ice temperature convergence iterations" standard_name="sea_ice_temperature_convergence_stp" unit=""  /> 
    300313 
    301314   </field_group> <!-- SBC_3D --> 
    … …  
    558571          <field field_ref="dmisum"           name="sidmassmelttop"   /> 
    559572          <field field_ref="dmibom"           name="sidmassmeltbot"   /> 
     573          <field field_ref="dmilam"           name="sidmassmeltlat"   /> 
    560574          <field field_ref="dmsspr"           name="sndmasssnf"       /> 
    561575          <field field_ref="dmsmel"           name="sndmassmelt"      /> 

  • NEMO/branches/2020/temporary_r4_trunk/cfgs/SHARED/field_def_nemo-oce.xml

    r12288 r13466  
    3636        <field id="toce_vmean300"     field_ref="toce_e3t_vsum300"  unit="degree_C"     grid_ref="grid_T_vsum"  detect_missing_value="true" > toce_e3t_vsum300/e3t_vsum300 </field> 
    3737 
     38   <!--- additions to diawri.F90 ---> 
     39        <field id="socegrad"    long_name="module of salinity gradient"              unit="psu/m"   grid_ref="grid_T_3D"/> 
     40        <field id="socegrad2"   long_name="square of module of salinity gradient"    unit="psu2/m2" grid_ref="grid_T_3D"/> 
     41        <field id="eken_int"    long_name="vertical integration of kinetic energy"   unit="m3/s2"   /> 
     42        <field id="relvor"      long_name="relative vorticity"                       unit="s-1"    grid_ref="grid_T_3D"/> 
     43        <field id="absvor"      long_name="absolute vorticity"                       unit="s-1"    grid_ref="grid_T_3D"/> 
     44        <field id="potvor"      long_name="potential vorticity"                      unit="s-1"    grid_ref="grid_T_3D"/> 
     45        <field id="salt2c"      long_name="Salt content vertically integrated"       unit="1e-3*kg/m2" /> 
    3846 
    3947        <!-- t-eddy viscosity coefficients (ldfdyn) --> 

  • NEMO/branches/2020/temporary_r4_trunk/cfgs/SHARED/namelist_ice_ref

    r12121 r13466  
    4343   ln_cat_usr       = .false.         !  ice categories are defined by rn_catbnd below (m) 
    4444      rn_catbnd     =   0.,0.45,1.1,2.1,3.7,6.0   
    45    rn_himin         =   0.1           !  minimum ice thickness (m) used in remapping 
     45   rn_himin         =   0.1           !  minimum ice thickness (m) allowed 
     46   rn_himax         =  99.0           !  maximum ice thickness (m) allowed 
    4647/ 
    4748!------------------------------------------------------------------------------ 
    … …  
    5657   rn_ishlat        =   2.            !  lbc : free slip (0) ; partial slip (0-2) ; no slip (2) ; strong slip (>2) 
    5758   ln_landfast_L16  = .false.         !  landfast: parameterization from Lemieux 2016 
    58       rn_depfra     =   0.125         !        fraction of ocean depth that ice must reach to initiate landfast 
     59      rn_lf_depfra  =   0.125         !        fraction of ocean depth that ice must reach to initiate landfast 
    5960                                      !          recommended range: [0.1 ; 0.25] 
    60       rn_icebfr     =  15.            !        maximum bottom stress per unit volume [N/m3] 
    61       rn_lfrelax    =   1.e-5         !        relaxation time scale to reach static friction [s-1] 
    62       rn_tensile    =   0.05          !        isotropic tensile strength [0-0.5??] 
     61      rn_lf_bfr     =  15.            !        maximum bottom stress per unit volume [N/m3] 
     62      rn_lf_relax   =   1.e-5         !        relaxation time scale to reach static friction [s-1] 
     63      rn_lf_tensile =   0.05          !        isotropic tensile strength [0-0.5??] 
    6364/ 
    6465!------------------------------------------------------------------------------ 
    … …  
    9798      rn_relast     =   0.333         !     ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
    9899                                      !        advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 
     100   ln_rhg_chkcvg    = .false.         !  check convergence of rheology (outputs: file ice_cvg.nc & variable uice_cvg) 
    99101/ 
    100102!------------------------------------------------------------------------------ 
    101103&namdyn_adv     !   Ice advection 
    102104!------------------------------------------------------------------------------ 
    103    ln_adv_Pra       = .true.         !  Advection scheme (Prather) 
    104    ln_adv_UMx       = .false.          !  Advection scheme (Ultimate-Macho) 
     105   ln_adv_Pra       = .true.          !  Advection scheme (Prather) 
     106   ln_adv_UMx       = .false.         !  Advection scheme (Ultimate-Macho) 
    105107      nn_UMx        =   5             !     order of the scheme for UMx (1-5 ; 20=centered 2nd order) 
    106108/ 
    … …  
    109111!------------------------------------------------------------------------------ 
    110112   rn_cio           =   5.0e-03       !  ice-ocean drag coefficient (-) 
    111    rn_blow_s        =   0.66          !  mesure of snow blowing into the leads 
     113   nn_snwfra        =   0             !  calculate the fraction of ice covered by snow (for zdf and albedo) 
     114                                      !     = 0  fraction = 1 (if snow) or 0 (if no snow) 
     115                                      !     = 1  fraction = 1-exp(-0.2*rhos*hsnw) [MetO formulation] 
     116                                      !     = 2  fraction = hsnw / (hsnw+0.02)    [CICE formulation] 
     117   rn_snwblow       =   0.66          !  mesure of snow blowing into the leads 
    112118                                      !     = 1 => no snow blowing, < 1 => some snow blowing 
    113119   nn_flxdist       =  -1             !  Redistribute heat flux over ice categories 
    … …  
    118124   ln_cndflx        = .false.         !  Use conduction flux as surface boundary conditions (i.e. for Jules coupling) 
    119125      ln_cndemulate = .false.         !     emulate conduction flux (if not provided in the inputs) 
     126   nn_qtrice        = 0               !  Solar flux transmitted thru the surface scattering layer: 
     127                                      !     = 0  Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow)  
     128                                      !     = 1  Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities) 
    120129/ 
    121130!------------------------------------------------------------------------------ 
    … …  
    126135   ln_icedO         = .true.          !  activate ice growth in open-water (T) or not (F) 
    127136   ln_icedS         = .true.          !  activate brine drainage (T) or not (F) 
     137   ! 
     138   ln_leadhfx       = .true.          !  heat in the leads is used to melt sea-ice before warming the ocean 
    128139/ 
    129140!------------------------------------------------------------------------------ 
    … …  
    135146   rn_cnd_s         =   0.31          !  thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971) 
    136147                                      !     Obs: 0.1-0.5 (Lecomte et al, JAMES 2013) 
    137    rn_kappa_i       =   1.0           !  radiation attenuation coefficient in sea ice [1/m] 
     148   rn_kappa_i       =   1.0           !  radiation attenuation coefficient in sea ice                     [1/m] 
     149   rn_kappa_s       =  10.0           !  nn_qtrice = 0: radiation attenuation coefficient in snow         [1/m] 
     150   rn_kappa_smlt    =   7.0           !  nn_qtrice = 1: radiation attenuation coefficient in melting snow [1/m] 
     151   rn_kappa_sdry    =  10.0           !                 radiation attenuation coefficient in dry snow     [1/m] 
     152   ln_zdf_chkcvg    = .false.         !  check convergence of heat diffusion scheme (outputs: tice_cvgerr, tice_cvgstp) 
    138153/ 
    139154!------------------------------------------------------------------------------ 
    … …  
    175190&namthd_pnd     !   Melt ponds 
    176191!------------------------------------------------------------------------------ 
    177    ln_pnd           = .false.         !  activate melt ponds or not 
    178      ln_pnd_H12     = .false.         !  activate evolutive melt ponds (from Holland et al 2012) 
    179      ln_pnd_CST     = .false.         !  activate constant  melt ponds 
    180        rn_apnd      =   0.2           !     prescribed pond fraction, at Tsu=0 degC 
    181        rn_hpnd      =   0.05          !     prescribed pond depth,    at Tsu=0 degC 
    182      ln_pnd_alb     = .false.         !  melt ponds affect albedo or not 
     192   ln_pnd            = .false.        !  activate melt ponds or not 
     193      ln_pnd_LEV     = .false.        !  level ice melt ponds (from Flocco et al 2007,2010 & Holland et al 2012) 
     194         rn_apnd_min =   0.15         !     minimum ice fraction that contributes to melt pond. range: 0.0 -- 0.15 ?? 
     195         rn_apnd_max =   0.85         !     maximum ice fraction that contributes to melt pond. range: 0.7 -- 0.85 ?? 
     196      ln_pnd_CST     = .false.        !  constant  melt ponds 
     197         rn_apnd     =   0.2          !     prescribed pond fraction, at Tsu=0 degC 
     198         rn_hpnd     =   0.05         !     prescribed pond depth,    at Tsu=0 degC 
     199      ln_pnd_lids    = .true.         !  frozen lids on top of the ponds (only for ln_pnd_LEV) 
     200      ln_pnd_alb     = .true.         !  effect of melt ponds on ice albedo 
    183201/ 
    184202!------------------------------------------------------------------------------ 
    … …  
    186204!------------------------------------------------------------------------------ 
    187205   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    188    ln_iceini_file   = .false.         !  netcdf file provided for initialization (T) or not (F) 
     206   nn_iceini_file   =   0             !     0 = Initialise sea ice based on SSTs 
     207                                      !     1 = Initialise sea ice from single category netcdf file 
     208                                      !     2 = Initialise sea ice from multi category restart file 
    189209   rn_thres_sst     =   2.0           !  max temp. above Tfreeze with initial ice = (sst - tfreeze) 
    190210   rn_hti_ini_n     =   3.0           !  initial ice thickness       (m), North 
    … …  
    206226   rn_hpd_ini_n     =   0.05          !  initial pond depth          (m), North 
    207227   rn_hpd_ini_s     =   0.05          !        "            "             South 
    208    ! -- for ln_iceini_file = T 
     228   rn_hld_ini_n     =   0.0           !  initial pond lid depth      (m), North 
     229   rn_hld_ini_s     =   0.0           !        "            "             South 
     230   ! -- for nn_iceini_file = 1 
    209231   sn_hti = 'Ice_initialization'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    210232   sn_hts = 'Ice_initialization'    , -12 ,'hts'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    … …  
    217239   sn_apd = 'NOT USED'              , -12 ,'apd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    218240   sn_hpd = 'NOT USED'              , -12 ,'hpd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     241   sn_hld = 'NOT USED'              , -12 ,'hld'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    219242   cn_dir='./' 
    220243/ 
    … …  
    238261   ln_icediahsb     = .false.         !  output the heat, mass & salt budgets (T) or not (F) 
    239262   ln_icectl        = .false.         !  ice points output for debug (T or F) 
    240    iiceprt          =  10             !  i-index for debug 
    241    jiceprt          =  10             !  j-index for debug 
    242 / 
     263      iiceprt       =  10             !     i-index for debug 
     264      jiceprt       =  10             !     j-index for debug 
     265/ 

  • NEMO/branches/2020/temporary_r4_trunk/cfgs/SHARED/namelist_ref

    r13278 r13466  
    281281   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    282282   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     283   sn_cc       = 'NOT USED'                   ,   24         , 'CC'      ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    283284   sn_tdif     = 'taudif_core'                ,   24         , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    284285/ 
    … …  
    286287&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    287288!----------------------------------------------------------------------- 
    288    nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
    289    ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models 
    290    !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    291    nn_cats_cpl   =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
     289   nn_cplmodel       =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
     290   ln_usecplmask     = .false. !  use a coupling mask file to merge data received from several models 
     291   !                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     292   ln_scale_ice_flux = .false. !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
     293   nn_cats_cpl       =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
    292294   !_____________!__________________________!____________!_____________!______________________!________! 
    293295   !             !        description       !  multiple  !    vector   !       vector         ! vector ! 
    … …  
    645647   bn_aip      = 'NOT USED'              ,         24.       , 'siapnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    646648   bn_hip      = 'NOT USED'              ,         24.       , 'sihpnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
     649   bn_hil      = 'NOT USED'              ,         24.       , 'sihlid'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    647650   ! if bn_t_i etc are "not used", then define arbitrary temperatures and salinity and ponds 
    648651   rn_ice_tem  = 270.         !  arbitrary temperature               of incoming sea ice 
    … …  
    651654   rn_ice_apnd = 0.2          !       --   pond fraction = a_ip/a_i            -- 
    652655   rn_ice_hpnd = 0.05         !       --   pond depth                          -- 
     656   rn_ice_hlid = 0.0          !       --   pond lid depth                      -- 
    653657/ 
    654658!----------------------------------------------------------------------- 
    … …  
    679683   ! 
    680684   ln_drgimp   = .true.    !  implicit top/bottom friction flag 
     685      ln_drgice_imp = .false. ! implicit ice-ocean drag 
    681686/ 
    682687!----------------------------------------------------------------------- 
    … …  
    10541059   !                       !                 = 3 as =2 with distinct dissipative an mixing length scale 
    10551060   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F) 
     1061      nn_mxlice    = 0        ! type of scaling under sea-ice 
     1062                              !    = 0 no scaling under sea-ice 
     1063                              !    = 1 scaling with constant sea-ice thickness 
     1064                              !    = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 
     1065                              !    = 3 scaling with maximum sea-ice thickness 
     1066      rn_mxlice   = 10.       ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    10561067   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value 
    10571068   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002) 
    … …  
    10651076                              !        = 0  constant 10 m length scale 
    10661077                              !        = 1  0.5m at the equator to 30m poleward of 40 degrees 
    1067       rn_eice     =   4       !  below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4    
     1078   nn_eice     =   1       !  attenutaion of langmuir & surface wave breaking under ice 
     1079   !                       !           = 0 no impact of ice cover on langmuir & surface wave breaking 
     1080   !                       !           = 1 weigthed by 1-TANH(10*fr_i) 
     1081   !                       !           = 2 weighted by 1-fr_i 
     1082   !                       !           = 3 weighted by 1-MIN(1,4*fr_i)    
    10681083/ 
    10691084!----------------------------------------------------------------------- 
    … …  
    10781093   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length 
    10791094   rn_hsro       =  0.02   !  Minimum surface roughness 
     1095   rn_hsri       =  0.03   !  Ice-ocean roughness 
    10801096   rn_frac_hs    =   1.3   !  Fraction of wave height as roughness (if nn_z0_met>1) 
    10811097   nn_z0_met     =     2   !  Method for surface roughness computation (0/1/2/3) 
    1082    !                             ! =3 requires ln_wave=T 
     1098   !                       !     = 3 requires ln_wave=T 
     1099   nn_z0_ice     =   1     !  attenutaion of surface wave breaking under ice 
     1100   !                       !           = 0 no impact of ice cover 
     1101   !                       !           = 1 roughness uses rn_hsri and is weigthed by 1-TANH(10*fr_i) 
     1102   !                       !           = 2 roughness uses rn_hsri and is weighted by 1-fr_i 
     1103   !                       !           = 3 roughness uses rn_hsri and is weighted by 1-MIN(1,4*fr_i) 
    10831104   nn_bc_surf    =     1   !  surface condition (0/1=Dir/Neum) 
    10841105   nn_bc_bot     =     1   !  bottom condition (0/1=Dir/Neum) 

  • NEMO/branches/2020/temporary_r4_trunk/cfgs/SPITZ12/EXPREF/namelist_cfg

    r13278 r13466  
    217217   ln_loglayer = .true.   !  logarithmic drag: Cd = vkarmn/log(z/z0) |U| 
    218218   ln_drgimp   = .true.   !  implicit top/bottom friction flag 
     219      ln_drgice_imp = .true. ! implicit ice-ocean drag 
    219220/ 
    220221!----------------------------------------------------------------------- 
    … …  
    340341   nn_havtb    =    1         !  horizontal shape for avtb (=1) or not (=0) 
    341342/ 
     343!----------------------------------------------------------------------- 
     344&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke =T) 
     345!----------------------------------------------------------------------- 
     346   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F) 
     347      nn_mxlice    = 2        ! type of scaling under sea-ice 
     348                              !    = 0 no scaling under sea-ice 
     349                              !    = 1 scaling with constant sea-ice thickness 
     350                              !    = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 
     351                              !    = 3 scaling with maximum sea-ice thickness 
     352   nn_eice     =   1       !  attenutaion of langmuir & surface wave breaking under ice 
     353   !                       !           = 0 no impact of ice cover on langmuir & surface wave breaking 
     354   !                       !           = 1 weigthed by 1-TANH(10*fr_i) 
     355   !                       !           = 2 weighted by 1-fr_i 
     356   !                       !           = 3 weighted by 1-MIN(1,4*fr_i) 
     357/ 
    342358!!====================================================================== 
    343359!!                  ***  Diagnostics namelists  ***                   !! 

  • NEMO/branches/2020/temporary_r4_trunk/cfgs/SPITZ12/EXPREF/namelist_ice_cfg

    r11731 r13466  
    8282!------------------------------------------------------------------------------ 
    8383   ln_pnd           = .true.          !  activate melt ponds or not 
    84      ln_pnd_H12     = .true.          !  activate evolutive melt ponds (from Holland et al 2012) 
    85      ln_pnd_alb     = .true.          !  melt ponds affect albedo or not 
     84     ln_pnd_LEV     = .true.          !  activate level ice melt ponds 
    8685/ 
    8786 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/nambdy_dta

    r11703 r13466  
    2929   bn_aip      = 'NOT USED'              ,         24.       , 'siapnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    3030   bn_hip      = 'NOT USED'              ,         24.       , 'sihpnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
     31   bn_hil      = 'NOT USED'              ,         24.       , 'sihlid'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    3132   ! if bn_t_i etc are "not used", then define arbitrary temperatures and salinity and ponds 
    3233   rn_ice_tem  = 270.         !  arbitrary temperature               of incoming sea ice 
    … …  
    3536   rn_ice_apnd = 0.2          !       --   pond fraction = a_ip/a_i            -- 
    3637   rn_ice_hpnd = 0.05         !       --   pond depth                          -- 
     38   rn_ice_hlid = 0.0          !       --   pond lid depth                      -- 
    3739/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namdia

    r11703 r13466  
    88   ln_icediahsb     = .false.         !  output the heat, mass & salt budgets (T) or not (F) 
    99   ln_icectl        = .false.         !  ice points output for debug (T or F) 
    10    iiceprt          =  10             !  i-index for debug 
    11    jiceprt          =  10             !  j-index for debug 
     10      iiceprt       =  10             !     i-index for debug 
     11      jiceprt       =  10             !     j-index for debug 
    1212/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namdrg

    r13272 r13466  
    88   ! 
    99   ln_drgimp   = .true.    !  implicit top/bottom friction flag 
     10      ln_drgice_imp = .false. ! implicit ice-ocean drag 
    1011/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namdyn

    r11703 r13466  
    1010   rn_ishlat        =   2.            !  lbc : free slip (0) ; partial slip (0-2) ; no slip (2) ; strong slip (>2) 
    1111   ln_landfast_L16  = .false.         !  landfast: parameterization from Lemieux 2016 
    12       rn_depfra     =   0.125         !        fraction of ocean depth that ice must reach to initiate landfast 
     12      rn_lf_depfra  =   0.125         !        fraction of ocean depth that ice must reach to initiate landfast 
    1313                                      !          recommended range: [0.1 ; 0.25] 
    14       rn_icebfr     =  15.            !        maximum bottom stress per unit volume [N/m3] 
    15       rn_lfrelax    =   1.e-5         !        relaxation time scale to reach static friction [s-1] 
    16       rn_tensile    =   0.05          !        isotropic tensile strength [0-0.5??] 
     14      rn_lf_bfr     =  15.            !        maximum bottom stress per unit volume [N/m3] 
     15      rn_lf_relax   =   1.e-5         !        relaxation time scale to reach static friction [s-1] 
     16      rn_lf_tensile =   0.05          !        isotropic tensile strength [0-0.5??] 
    1717/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namdyn_rhg

    r11025 r13466  
    99      rn_relast     =   0.333         !     ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
    1010                                      !        advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 
     11   ln_rhg_chkcvg    = .false.         !  check convergence of rheology (outputs: file ice_cvg.nc & variable uice_cvg) 
    1112/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namini

    r11703 r13466  
    33!------------------------------------------------------------------------------ 
    44   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    5    ln_iceini_file   = .false.         !  netcdf file provided for initialization (T) or not (F) 
     5   nn_iceini_file   =   0             !     0 = Initialise sea ice based on SSTs 
     6                                      !     1 = Initialise sea ice from single category netcdf file 
     7                                      !     2 = Initialise sea ice from multi category restart file 
    68   rn_thres_sst     =   2.0           !  max temp. above Tfreeze with initial ice = (sst - tfreeze) 
    79   rn_hti_ini_n     =   3.0           !  initial ice thickness       (m), North 
    … …  
    2325   rn_hpd_ini_n     =   0.05          !  initial pond depth          (m), North 
    2426   rn_hpd_ini_s     =   0.05          !        "            "             South 
    25    ! -- for ln_iceini_file = T 
     27   rn_hld_ini_n     =   0.0           !  initial pond lid depth      (m), North 
     28   rn_hld_ini_s     =   0.0           !        "            "             South 
     29   ! -- for nn_iceini_file = 1 
    2630   sn_hti = 'Ice_initialization'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    2731   sn_hts = 'Ice_initialization'    , -12 ,'hts'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    … …  
    3438   sn_apd = 'NOT USED'              , -12 ,'apd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    3539   sn_hpd = 'NOT USED'              , -12 ,'hpd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     40   sn_hld = 'NOT USED'              , -12 ,'hld'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    3641   cn_dir='./' 
    3742/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namsbc_blk

    r11703 r13466  
    3131   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    3232   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     33   sn_cc       = 'NOT USED'                   ,   24         , 'CC'      ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    3334   sn_tdif     = 'taudif_core'                ,   24         , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    3435/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namsbc_cpl

    r10075 r13466  
    22&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    33!----------------------------------------------------------------------- 
    4    nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
    5    ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models 
    6    !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    7    nn_cats_cpl   =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
    8  
     4   nn_cplmodel       =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
     5   ln_usecplmask     = .false. !  use a coupling mask file to merge data received from several models 
     6   !                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     7   ln_scale_ice_flux = .false. !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
     8   nn_cats_cpl       =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
    99   !_____________!__________________________!____________!_____________!______________________!________! 
    1010   !             !        description       !  multiple  !    vector   !       vector         ! vector ! 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namthd

    r11025 r13466  
    66   ln_icedO         = .true.          !  activate ice growth in open-water (T) or not (F) 
    77   ln_icedS         = .true.          !  activate brine drainage (T) or not (F) 
     8   !                                    
     9   ln_leadhfx       = .true.          !  heat in the leads is used to melt sea-ice before warming the ocean 
    810/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namthd_pnd

    r11536 r13466  
    22&namthd_pnd     !   Melt ponds 
    33!------------------------------------------------------------------------------ 
    4    ln_pnd           = .false.         !  activate melt ponds or not 
    5      ln_pnd_H12     = .false.         !  activate evolutive melt ponds (from Holland et al 2012) 
    6      ln_pnd_CST     = .false.         !  activate constant  melt ponds 
    7        rn_apnd      =   0.2           !     prescribed pond fraction, at Tsu=0 degC 
    8        rn_hpnd      =   0.05          !     prescribed pond depth,    at Tsu=0 degC 
    9      ln_pnd_alb     = .false.         !  melt ponds affect albedo or not 
     4   ln_pnd            = .false.        !  activate melt ponds or not 
     5      ln_pnd_LEV     = .false.        !  level ice melt ponds (from Flocco et al 2007,2010 & Holland et al 2012) 
     6         rn_apnd_min =   0.15         !     minimum ice fraction that contributes to melt pond. range: 0.0 -- 0.15 ?? 
     7         rn_apnd_max =   0.85         !     maximum ice fraction that contributes to melt pond. range: 0.7 -- 0.85 ?? 
     8      ln_pnd_CST     = .false.        !  constant  melt ponds 
     9         rn_apnd     =   0.2          !     prescribed pond fraction, at Tsu=0 degC 
     10         rn_hpnd     =   0.05         !     prescribed pond depth,    at Tsu=0 degC 
     11      ln_pnd_lids    = .true.         !  frozen lids on top of the ponds (only for ln_pnd_LEV) 
     12      ln_pnd_alb     = .true.         !  effect of melt ponds on ice albedo 
    1013/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namthd_zdf

    r11025 r13466  
    77   rn_cnd_s         =   0.31          !  thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971) 
    88                                      !     Obs: 0.1-0.5 (Lecomte et al, JAMES 2013) 
    9    rn_kappa_i       =   1.0           !  radiation attenuation coefficient in sea ice [1/m] 
     9   rn_kappa_i       =   1.0           !  radiation attenuation coefficient in sea ice                     [1/m] 
     10   rn_kappa_s       =  10.0           !  nn_qtrice = 0: radiation attenuation coefficient in snow         [1/m] 
     11   rn_kappa_smlt    =   7.0           !  nn_qtrice = 1: radiation attenuation coefficient in melting snow [1/m] 
     12   rn_kappa_sdry    =  10.0           !                 radiation attenuation coefficient in dry snow     [1/m] 
     13   ln_zdf_chkcvg    = .false.         !  check convergence of heat diffusion scheme (output variable: tice_cvg) 
    1014/ 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namzdf_gls

    r9355 r13466  
    1313   nn_z0_met     =     2   !  Method for surface roughness computation (0/1/2/3) 
    1414   !                             ! =3 requires ln_wave=T 
     15   nn_z0_ice     =   1     !  attenutaion of surface wave breaking under ice 
     16   !                       !           = 0 no impact of ice cover 
     17   !                       !           = 1 roughness uses rn_hsri and is weigthed by 1-TANH(10*fr_i) 
     18   !                       !           = 2 roughness uses rn_hsri and is weighted by 1-fr_i 
     19   !                       !           = 3 roughness uses rn_hsri and is weighted by 1-MIN(1,4*fr_i) 
    1520   nn_bc_surf    =     1   !  surface condition (0/1=Dir/Neum) 
    1621   nn_bc_bot     =     1   !  bottom condition (0/1=Dir/Neum) 

  • NEMO/branches/2020/temporary_r4_trunk/doc/namelists/namzdf_tke

    r13272 r13466  
    2525                              !        = 0  constant 10 m length scale 
    2626                              !        = 1  0.5m at the equator to 30m poleward of 40 degrees 
    27       rn_eice     =   4       !  below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4    
     27   nn_eice     =   1       !  attenutaion of langmuir & surface wave breaking under ice 
     28   !                       !           = 0 no impact of ice cover on langmuir & surface wave breaking 
     29   !                       !           = 1 weigthed by 1-TANH(10*fr_i) 
     30   !                       !           = 2 weighted by 1-fr_i 
     31   !                       !           = 3 weighted by 1-MIN(1,4*fr_i) 
    2832/ 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/ice.F90

    r11627 r13466  
    7070   !! a_ip        |      -      |    Ice pond concentration       |       | 
    7171   !! v_ip        |      -      |    Ice pond volume per unit area| m     | 
     72   !! v_il        |    v_il_1d  |    Ice pond lid volume per area | m     | 
    7273   !!                                                                     | 
    7374   !!-------------|-------------|---------------------------------|-------| 
    … …  
    8586   !! t_su        ! t_su_1d     |    Sea ice surface temperature  ! K     | 
    8687   !! h_ip        | h_ip_1d     |    Ice pond thickness           | m     | 
     88   !! h_il        | h_il_1d     |    Ice pond lid thickness       | m     | 
    8789   !!                                                                     | 
    8890   !! notes: the ice model only sees a bulk (i.e., vertically averaged)   | 
    … …  
    112114   !! hm_ip       |      -      |    Mean ice pond depth          | m     | 
    113115   !! vt_ip       |      -      |    Total ice pond vol. per unit area| m | 
     116   !! hm_il       |      -      |    Mean ice pond lid depth      | m     | 
     117   !! vt_il       |      -      |    Total ice pond lid vol. per area | m | 
    114118   !!===================================================================== 
    115119 
    … …  
    137141   REAL(wp), PUBLIC ::   rn_ishlat        !: lateral boundary condition for sea-ice 
    138142   LOGICAL , PUBLIC ::   ln_landfast_L16  !: landfast ice parameterizationfrom lemieux2016  
    139    REAL(wp), PUBLIC ::   rn_depfra        !:    fraction of ocean depth that ice must reach to initiate landfast ice 
    140    REAL(wp), PUBLIC ::   rn_icebfr        !:    maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home)  
    141    REAL(wp), PUBLIC ::   rn_lfrelax       !:    relaxation time scale (s-1) to reach static friction 
    142    REAL(wp), PUBLIC ::   rn_tensile       !:    isotropic tensile strength 
     143   REAL(wp), PUBLIC ::   rn_lf_depfra     !:    fraction of ocean depth that ice must reach to initiate landfast ice 
     144   REAL(wp), PUBLIC ::   rn_lf_bfr        !:    maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home)  
     145   REAL(wp), PUBLIC ::   rn_lf_relax      !:    relaxation time scale (s-1) to reach static friction 
     146   REAL(wp), PUBLIC ::   rn_lf_tensile    !:    isotropic tensile strength 
    143147   ! 
    144148   !                                     !!** ice-ridging/rafting namelist (namdyn_rdgrft) ** 
    … …  
    151155   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
    152156   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
     157   LOGICAL , PUBLIC ::   ln_rhg_chkcvg    !: check ice rheology convergence  
    153158   ! 
    154159   !                                     !!** ice-advection namelist (namdyn_adv) ** 
    … …  
    158163   !                                     !!** ice-surface boundary conditions namelist (namsbc) ** 
    159164                                          ! -- icethd_dh -- ! 
    160    REAL(wp), PUBLIC ::   rn_blow_s        !: coef. for partitioning of snowfall between leads and sea ice 
     165   REAL(wp), PUBLIC ::   rn_snwblow       !: coef. for partitioning of snowfall between leads and sea ice 
     166                                          ! -- icethd_zdf and icealb -- ! 
     167   INTEGER , PUBLIC ::   nn_snwfra        !: calculate the fraction of ice covered by snow 
     168   !                                      !   = 0  fraction = 1 (if snow) or 0 (if no snow) 
     169   !                                      !   = 1  fraction = 1-exp(-0.2*rhos*hsnw) [MetO formulation] 
     170   !                                      !   = 2  fraction = hsnw / (hsnw+0.02)    [CICE formulation] 
    161171                                          ! -- icethd -- ! 
    162172   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress 
    … …  
    166176   !                                      !   = 1  Average N(cat) fluxes then redistribute over the N(cat) ice using T-ice and albedo sensitivity 
    167177   !                                      !   = 2  Redistribute a single flux over categories 
     178                                          ! -- icethd_zdf -- ! 
    168179   LOGICAL , PUBLIC ::   ln_cndflx        !: use conduction flux as surface boundary condition (instead of qsr and qns)  
    169180   LOGICAL , PUBLIC ::   ln_cndemulate    !: emulate conduction flux (if not provided)  
    … …  
    172183   INTEGER, PUBLIC, PARAMETER ::   np_cnd_ON  = 1  !: forcing from conduction flux (SM0L) (compute qcn and qsr_tr via sbcblk.F90 or sbccpl.F90) 
    173184   INTEGER, PUBLIC, PARAMETER ::   np_cnd_EMU = 2  !: emulate conduction flux via icethd_zdf.F90 (BL99) (1st round compute qcn and qsr_tr, 2nd round use it) 
    174  
     185   INTEGER, PUBLIC ::   nn_qtrice         !: Solar flux transmitted thru the surface scattering layer: 
     186   !                                      !   = 0  Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow)  
     187   !                                      !   = 1  Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities) 
     188   ! 
    175189   !                                     !!** ice-vertical diffusion namelist (namthd_zdf) ** 
    176190   LOGICAL , PUBLIC ::   ln_cndi_U64      !: thermal conductivity: Untersteiner (1964) 
    177191   LOGICAL , PUBLIC ::   ln_cndi_P07      !: thermal conductivity: Pringle et al (2007) 
    178    REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
    179192   REAL(wp), PUBLIC ::   rn_cnd_s         !: thermal conductivity of the snow [W/m/K]    
     193   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation in sea ice, Grenfell et al. (2006) [1/m] 
     194   REAL(wp), PUBLIC ::   rn_kappa_s       !: coef. for the extinction of radiation in snw (nn_qtrice=0) [1/m] 
     195   REAL(wp), PUBLIC ::   rn_kappa_smlt    !: coef. for the extinction of radiation in melt snw (nn_qtrice=1) [1/m] 
     196   REAL(wp), PUBLIC ::   rn_kappa_sdry    !: coef. for the extinction of radiation in dry  snw (nn_qtrice=1) [1/m] 
     197   LOGICAL , PUBLIC ::   ln_zdf_chkcvg    !: check convergence of heat diffusion scheme 
    180198 
    181199   !                                     !!** ice-salinity namelist (namthd_sal) ** 
    … …  
    190208   !                                     !!** ice-ponds namelist (namthd_pnd) 
    191209   LOGICAL , PUBLIC ::   ln_pnd           !: Melt ponds (T) or not (F) 
    192    LOGICAL , PUBLIC ::   ln_pnd_H12       !: Melt ponds scheme from Holland et al 2012 
     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 
    193213   LOGICAL , PUBLIC ::   ln_pnd_CST       !: Melt ponds scheme with constant fraction and depth 
    194214   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1) 
    195215   REAL(wp), PUBLIC ::   rn_hpnd          !: prescribed pond depth    (0<rn_hpnd<1) 
     216   LOGICAL,  PUBLIC ::   ln_pnd_lids      !: Allow ponds to have frozen lids 
    196217   LOGICAL , PUBLIC ::   ln_pnd_alb       !: melt ponds affect albedo 
    197218 
    … …  
    218239 
    219240   !                                     !!** define arrays 
    220    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce,v_oce !: surface ocean velocity used in ice dynamics 
    221    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_i_new    !: ice collection thickness accreted in leads 
    222    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength    !: ice strength 
    223    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element 
    224    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i     !: ice rheology elta factor (Flato & Hibler 95) [s-1] 
    225    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i      !: Divergence of the velocity field             [s-1] 
    226    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i     !: Shear of the velocity field                  [s-1] 
    227    ! 
    228    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    229    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
    230    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsb_ice_bot !: net downward heat flux from the ice to the ocean 
    231    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
    232  
    233    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: mass flux from snow-ocean mass exchange             [kg.m-2.s-1] 
    234    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sni !: mass flux from snow ice growth component of wfx_snw [kg.m-2.s-1] 
    235    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sum !: mass flux from surface melt component of wfx_snw    [kg.m-2.s-1] 
    236    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_pnd     !: mass flux from melt pond-ocean mass exchange        [kg.m-2.s-1] 
    237    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: mass flux from snow precipitation on ice            [kg.m-2.s-1] 
    238    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: mass flux from sublimation of snow/ice              [kg.m-2.s-1] 
    239    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sub !: mass flux from snow sublimation                     [kg.m-2.s-1] 
    240    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice_sub !: mass flux from ice sublimation                      [kg.m-2.s-1] 
    241  
    242    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_dyn !: mass flux from dynamical component of wfx_snw       [kg.m-2.s-1] 
    243  
    244    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: mass flux from ice-ocean mass exchange                   [kg.m-2.s-1] 
    245    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni     !: mass flux from snow ice growth component of wfx_ice      [kg.m-2.s-1] 
    246    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw     !: mass flux from lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
    247    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog     !: mass flux from bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
    248    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn     !: mass flux from dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
    249    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom     !: mass flux from bottom melt component of wfx_ice          [kg.m-2.s-1] 
    250    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum     !: mass flux from surface melt component of wfx_ice         [kg.m-2.s-1] 
    251    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_lam     !: mass flux from lateral melt component of wfx_ice         [kg.m-2.s-1] 
    252    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res     !: mass flux from residual component of wfx_ice             [kg.m-2.s-1] 
    253    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation                        [kg.m-2.s-1] 
    254  
    255    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice bottom growth                   [pss.kg.m-2.s-1 => g.m-2.s-1] 
    256    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice bottom melt                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
    257    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_lam     !: salt flux due to ice lateral melt                    [pss.kg.m-2.s-1 => g.m-2.s-1] 
    258    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice surface melt                    [pss.kg.m-2.s-1 => g.m-2.s-1] 
    259    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to snow-ice growth                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
    260    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_opw     !: salt flux due to growth in open water                [pss.kg.m-2.s-1 => g.m-2.s-1] 
    261    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bri     !: salt flux due to brine rejection                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
    262    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_dyn     !: salt flux due to porous ridged ice formation         [pss.kg.m-2.s-1 => g.m-2.s-1] 
    263    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: salt flux due to correction on ice thick. (residual) [pss.kg.m-2.s-1 => g.m-2.s-1] 
    264    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sub     !: salt flux due to ice sublimation                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
    265  
    266    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth           [W.m-2] 
    267    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt             [W.m-2] 
    268    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt            [W.m-2] 
    269    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation    [W.m-2] 
    270    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice      [W.m-2] 
    271    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt                             [W.m-2] 
    272    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 
    273    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping => must be 0   [W.m-2] 
    274    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_atm_oi   !: heat flux at the interface atm-[oce+ice]            [W.m-2] 
    275    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_oce_ai   !: heat flux at the interface oce-[atm+ice]            [W.m-2] 
     241   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_oce,v_oce     !: surface ocean velocity used in ice dynamics 
     242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ht_i_new        !: ice collection thickness accreted in leads 
     243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   strength        !: ice strength 
     244   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element 
     245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   delta_i         !: ice rheology elta factor (Flato & Hibler 95) [s-1] 
     246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   divu_i          !: Divergence of the velocity field             [s-1] 
     247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   shear_i         !: Shear of the velocity field                  [s-1] 
     248   ! 
     249   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   t_bo            !: Sea-Ice bottom temperature [Kelvin]      
     250   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qlead           !: heat balance of the lead (or of the open ocean) 
     251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsb_ice_bot     !: net downward heat flux from the ice to the ocean 
     252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fhld            !: heat flux from the lead used for bottom melting 
     253 
     254   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw         !: mass flux from snow-ocean mass exchange             [kg.m-2.s-1] 
     255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_sni     !: mass flux from snow ice growth component of wfx_snw [kg.m-2.s-1] 
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_sum     !: mass flux from surface melt component of wfx_snw    [kg.m-2.s-1] 
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_pnd         !: mass flux from melt pond-ocean mass exchange        [kg.m-2.s-1] 
     258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_spr         !: mass flux from snow precipitation on ice            [kg.m-2.s-1] 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_sub         !: mass flux from sublimation of snow/ice              [kg.m-2.s-1] 
     260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_sub     !: mass flux from snow sublimation                     [kg.m-2.s-1] 
     261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_ice_sub     !: mass flux from ice sublimation                      [kg.m-2.s-1] 
     262 
     263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_dyn     !: mass flux from dynamical component of wfx_snw       [kg.m-2.s-1] 
     264 
     265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_ice         !: mass flux from ice-ocean mass exchange                   [kg.m-2.s-1] 
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_sni         !: mass flux from snow ice growth component of wfx_ice      [kg.m-2.s-1] 
     267   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_opw         !: mass flux from lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_bog         !: mass flux from bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_dyn         !: mass flux from dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
     270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_bom         !: mass flux from bottom melt component of wfx_ice          [kg.m-2.s-1] 
     271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_sum         !: mass flux from surface melt component of wfx_ice         [kg.m-2.s-1] 
     272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_lam         !: mass flux from lateral melt component of wfx_ice         [kg.m-2.s-1] 
     273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_res         !: mass flux from residual component of wfx_ice             [kg.m-2.s-1] 
     274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_err_sub     !: mass flux error after sublimation                        [kg.m-2.s-1] 
     275 
     276   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_bog         !: salt flux due to ice bottom growth                   [pss.kg.m-2.s-1 => g.m-2.s-1] 
     277   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_bom         !: salt flux due to ice bottom melt                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
     278   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_lam         !: salt flux due to ice lateral melt                    [pss.kg.m-2.s-1 => g.m-2.s-1] 
     279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_sum         !: salt flux due to ice surface melt                    [pss.kg.m-2.s-1 => g.m-2.s-1] 
     280   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_sni         !: salt flux due to snow-ice growth                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
     281   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_opw         !: salt flux due to growth in open water                [pss.kg.m-2.s-1 => g.m-2.s-1] 
     282   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_bri         !: salt flux due to brine rejection                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
     283   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_dyn         !: salt flux due to porous ridged ice formation         [pss.kg.m-2.s-1 => g.m-2.s-1] 
     284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_res         !: salt flux due to correction on ice thick. (residual) [pss.kg.m-2.s-1 => g.m-2.s-1] 
     285   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_sub         !: salt flux due to ice sublimation                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
     286 
     287   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_bog         !: total heat flux causing bottom ice growth           [W.m-2] 
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_bom         !: total heat flux causing bottom ice melt             [W.m-2] 
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_sum         !: total heat flux causing surface ice melt            [W.m-2] 
     290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_opw         !: total heat flux causing open water ice formation    [W.m-2] 
     291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_dif         !: total heat flux causing Temp change in the ice      [W.m-2] 
     292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_snw         !: heat flux for snow melt                             [W.m-2] 
     293   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_err_dif     !: heat flux remaining due to change in non-solar flux [W.m-2] 
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qt_atm_oi       !: heat flux at the interface atm-[oce+ice]            [W.m-2] 
     295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qt_oce_ai       !: heat flux at the interface oce-[atm+ice]            [W.m-2] 
    276296    
    277297   ! heat flux associated with ice-atmosphere mass exchange 
    278    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation            [W.m-2] 
    279    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  [W.m-2] 
     298   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_sub         !: heat flux for sublimation            [W.m-2] 
     299   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_spr         !: heat flux of the snow precipitation  [W.m-2] 
    280300 
    281301   ! heat flux associated with ice-ocean mass exchange 
    282    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 
    283    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from ridging                      [W.m-2] 
    284    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: heat flux due to correction on ice thick. (residual)  [W.m-2] 
    285  
    286    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array 
    287    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_bot    !: transmitted solar radiation under ice 
    288    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t1_ice         !: temperature of the first layer                (ln_cndflx=T) [K] 
    289    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   cnd_ice        !: effective conductivity at the top of ice/snow (ln_cndflx=T) [W.m-2.K-1] 
     302   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_thd         !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 
     303   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_dyn         !: ice-ocean heat flux from ridging                      [W.m-2] 
     304   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_res         !: heat flux due to correction on ice thick. (residual)  [W.m-2] 
     305 
     306   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d      !: maximum ice concentration 2d array 
     307   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_bot     !: transmitted solar radiation under ice 
     308   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t1_ice          !: temperature of the first layer          (ln_cndflx=T) [K] 
     309   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   cnd_ice         !: effective conductivity of the 1st layer (ln_cndflx=T) [W.m-2.K-1] 
    290310 
    291311   !!---------------------------------------------------------------------- 
    … …  
    293313   !!---------------------------------------------------------------------- 
    294314   !! Variables defined for each ice category 
    295    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i       !: Ice thickness                           (m) 
    296    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration) 
    297    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area                (m) 
    298    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area               (m) 
    299    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_s       !: Snow thickness                          (m) 
    300    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su      !: Sea-Ice Surface Temperature             (K) 
    301    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   s_i       !: Sea-Ice Bulk salinity                   (pss) 
    302    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sv_i      !: Sea-Ice Bulk salinity * volume per area (pss.m) 
    303    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age                             (s) 
    304    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area              (s) 
    305    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bv_i      !: brine volume 
     315   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_i           !: Ice thickness                           (m) 
     316   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i           !: Ice fractional areas (concentration) 
     317   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_i           !: Ice volume per unit area                (m) 
     318   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s           !: Snow volume per unit area               (m) 
     319   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_s           !: Snow thickness                          (m) 
     320   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   t_su          !: Sea-Ice Surface Temperature             (K) 
     321   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   s_i           !: Sea-Ice Bulk salinity                   (pss) 
     322   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sv_i          !: Sea-Ice Bulk salinity * volume per area (pss.m) 
     323   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   o_i           !: Sea-Ice Age                             (s) 
     324   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   oa_i          !: Sea-Ice Age times ice area              (s) 
     325   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   bv_i          !: brine volume 
    306326 
    307327   !! Variables summed over all categories, or associated to all the ice in a single grid cell 
    308    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice !: components of the ice velocity                          (m/s) 
    309    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s  !: ice and snow total volume per unit area                 (m) 
    310    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   st_i         !: Total ice salinity content                              (pss.m) 
    311    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i         !: ice total fractional area (ice concentration) 
    312    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i        !: =1-at_i ; total open water fractional area 
    313    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   et_i , et_s  !: ice and snow total heat content                         (J/m2) 
    314    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i         !: mean ice temperature over all categories                (K) 
    315    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_s         !: mean snw temperature over all categories                (K) 
    316    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bvm_i        !: brine volume averaged over all categories 
    317    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sm_i         !: mean sea ice salinity averaged over all categories      (pss) 
    318    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_su        !: mean surface temperature over all categories            (K) 
    319    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_i         !: mean ice  thickness over all categories                 (m) 
    320    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_s         !: mean snow thickness over all categories                 (m) 
    321    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   om_i         !: mean ice age over all categories                        (s) 
    322    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tau_icebfr   !: ice friction on ocean bottom (landfast param activated) 
    323  
    324    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures     [K] 
    325    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow enthalpy         [J/m2] 
    326    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures      [K] 
    327    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice enthalpy          [J/m2] 
    328    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sz_i     !: ice salinity          [PSS] 
    329  
    330    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip       !: melt pond concentration 
    331    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_ip       !: melt pond volume per grid cell area      [m] 
    332    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip_frac  !: melt pond fraction (a_ip/a_i) 
    333    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_ip       !: melt pond depth                          [m] 
    334  
    335    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   at_ip      !: total melt pond concentration 
    336    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hm_ip      !: mean melt pond depth                     [m] 
    337    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_ip      !: total melt pond volume per gridcell area [m] 
    338  
    339    !!---------------------------------------------------------------------- 
    340    !! * Old values of global variables 
    341    !!---------------------------------------------------------------------- 
    342    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b, h_ip_b    !: snow and ice volumes/thickness 
    343    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b, oa_i_b                 !: 
    344    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                                 !: snow heat content 
    345    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                                 !: ice temperatures 
    346    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b                      !: ice velocity 
    347    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                                !: ice concentration (total) 
     328   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice, v_ice  !: components of the ice velocity                          (m/s) 
     329   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_i , vt_s   !: ice and snow total volume per unit area                 (m) 
     330   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   st_i          !: Total ice salinity content                              (pss.m) 
     331   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i          !: ice total fractional area (ice concentration) 
     332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ato_i         !: =1-at_i ; total open water fractional area 
     333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   et_i , et_s   !: ice and snow total heat content                         (J/m2) 
     334   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_i          !: mean ice temperature over all categories                (K) 
     335   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_s          !: mean snw temperature over all categories                (K) 
     336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   bvm_i         !: brine volume averaged over all categories 
     337   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sm_i          !: mean sea ice salinity averaged over all categories      (pss) 
     338   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_su         !: mean surface temperature over all categories            (K) 
     339   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_i          !: mean ice  thickness over all categories                 (m) 
     340   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_s          !: mean snow thickness over all categories                 (m) 
     341   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   om_i          !: mean ice age over all categories                        (s) 
     342   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tau_icebfr    !: ice friction on ocean bottom (landfast param activated) 
     343 
     344   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s           !: Snow temperatures     [K] 
     345   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s           !: Snow enthalpy         [J/m2] 
     346   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i           !: ice temperatures      [K] 
     347   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i           !: ice enthalpy          [J/m2] 
     348   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sz_i          !: ice salinity          [PSS] 
     349 
     350   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_ip          !: melt pond concentration 
     351   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_ip          !: melt pond volume per grid cell area      [m] 
     352   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_ip_frac     !: melt pond fraction (a_ip/a_i) 
     353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_ip_eff      !: melt pond effective fraction (not covered up by lid) (a_ip/a_i) 
     354   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_ip          !: melt pond depth                          [m] 
     355   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_il          !: melt pond lid volume                     [m] 
     356   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_il          !: melt pond lid thickness                  [m] 
     357 
     358   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_ip         !: total melt pond concentration 
     359   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_ip         !: mean melt pond depth                     [m] 
     360   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_ip         !: total melt pond volume per gridcell area [m] 
     361   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_il         !: mean melt pond lid depth                     [m] 
     362   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_il         !: total melt pond lid volume per gridcell area [m] 
     363 
     364   !!---------------------------------------------------------------------- 
     365   !! * Global variables at before time step 
     366   !!---------------------------------------------------------------------- 
     367   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b !: snow and ice volumes/thickness 
     368   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b              !: 
     369   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content 
     370   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
     371   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
     372   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                     !: ice concentration (total) 
    348373             
    349374   !!---------------------------------------------------------------------- 
    350375   !! * Ice thickness distribution variables 
    351376   !!---------------------------------------------------------------------- 
    352    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    353    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hi_mean        !: Mean ice thickness in catgories  
     377   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max            !: Boundary of ice thickness categories in thickness space 
     378   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean           !: Mean ice thickness in catgories  
    354379   ! 
    355380   !!---------------------------------------------------------------------- 
    356381   !! * Ice diagnostics 
    357382   !!---------------------------------------------------------------------- 
    358    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vi   !: transport of ice volume 
    359    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vs   !: transport of snw volume 
    360    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_ei   !: transport of ice enthalpy [W/m2] 
    361    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_es   !: transport of snw enthalpy [W/m2] 
    362    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_sv   !: transport of salt content 
    363    ! 
    364    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_heat     !: snw/ice heat content variation   [W/m2]  
    365    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_sice     !: ice salt content variation   []  
    366    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vice     !: ice volume variation   [m/s]  
    367    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw     !: snw volume variation   [m/s]  
    368  
     383   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vi       !: transport of ice volume 
     384   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vs       !: transport of snw volume 
     385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_ei       !: transport of ice enthalpy [W/m2] 
     386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_es       !: transport of snw enthalpy [W/m2] 
     387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_sv       !: transport of salt content 
     388   ! 
     389   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_heat         !: snw/ice heat content variation   [W/m2]  
     390   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_sice         !: ice salt content variation   []  
     391   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vice         !: ice volume variation   [m/s]  
     392   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw         !: snw volume variation   [m/s]  
     393   ! 
    369394   !!---------------------------------------------------------------------- 
    370395   !! * Ice conservation 
    371396   !!---------------------------------------------------------------------- 
    372    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_v        !: conservation of ice volume 
    373    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_s        !: conservation of ice salt 
    374    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_t        !: conservation of ice heat 
    375    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fv       !: conservation of ice volume 
    376    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fs       !: conservation of ice salt 
    377    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_ft       !: conservation of ice heat 
     397   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_v            !: conservation of ice volume 
     398   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_s            !: conservation of ice salt 
     399   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_t            !: conservation of ice heat 
     400   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fv           !: conservation of ice volume 
     401   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fs           !: conservation of ice salt 
     402   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_ft           !: conservation of ice heat 
    378403   ! 
    379404   !!---------------------------------------------------------------------- 
    … …  
    381406   !!---------------------------------------------------------------------- 
    382407   ! Extra sea ice diagnostics to address the data request 
    383    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_si          !: Temperature at Snow-ice interface (K)  
    384    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tm_si         !: mean temperature at the snow-ice interface (K)  
    385    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_bot   !: Bottom  conduction flux (W/m2) 
    386    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top   !: Surface conduction flux (W/m2) 
    387  
     408   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_si            !: Temperature at Snow-ice interface (K)  
     409   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tm_si           !: mean temperature at the snow-ice interface (K)  
     410   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_bot     !: Bottom  conduction flux (W/m2) 
     411   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top     !: Surface conduction flux (W/m2) 
     412   ! 
     413   !!---------------------------------------------------------------------- 
     414   !! * Only for atmospheric coupling 
     415   !!---------------------------------------------------------------------- 
     416   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i_last_couple !: Ice fractional area at last coupling time 
    388417   ! 
    389418   !!---------------------------------------------------------------------- 
    … …  
    400429      INTEGER :: ice_alloc 
    401430      ! 
    402       INTEGER :: ierr(16), ii 
     431      INTEGER :: ierr(17), ii 
    403432      !!----------------------------------------------------------------- 
    404433      ierr(:) = 0 
    … …  
    424453         &      hfx_sum    (jpi,jpj) , hfx_bom   (jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     & 
    425454         &      hfx_opw    (jpi,jpj) , hfx_thd   (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,     & 
    426          &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj)             , STAT=ierr(ii) ) 
     455         &      hfx_err_dif(jpi,jpj) , wfx_err_sub(jpi,jpj)                   , STAT=ierr(ii) ) 
    427456 
    428457      ! * Ice global state variables 
    … …  
    448477 
    449478      ii = ii + 1 
    450       ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl) , STAT = ierr(ii) ) 
    451  
    452       ii = ii + 1 
    453       ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 
     479      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) ) 
     481 
     482      ii = ii + 1 
     483      ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , hm_il(jpi,jpj) , vt_il(jpi,jpj) , STAT = ierr(ii) ) 
    454484 
    455485      ! * Old values of global variables 
    456486      ii = ii + 1 
    457       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), h_ip_b(jpi,jpj,jpl),  & 
    458          &      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) ,               & 
    459          &      oa_i_b(jpi,jpj,jpl)                                                   , STAT=ierr(ii) ) 
     487      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),         & 
     488         &      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) , & 
     489         &      STAT=ierr(ii) ) 
    460490 
    461491      ii = ii + 1 
    … …  
    481511      ALLOCATE( t_si(jpi,jpj,jpl) , tm_si(jpi,jpj) , qcn_ice_bot(jpi,jpj,jpl) , qcn_ice_top(jpi,jpj,jpl) , STAT = ierr(ii) ) 
    482512 
     513      ! * For atmospheric coupling 
     514      ii = ii + 1 
     515      ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(ii) ) 
     516 
    483517      ice_alloc = MAXVAL( ierr(:) ) 
    484518      IF( ice_alloc /= 0 )   CALL ctl_stop( 'STOP', 'ice_alloc: failed to allocate arrays.' ) 
    485519      ! 
     520 
    486521   END FUNCTION ice_alloc 
    487522 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/ice1d.F90

    r10786 r13466  
    5151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d 
    5252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dyn_1d 
    53    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
    5453   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d 
    5554   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qt_oce_ai_1d 
    … …  
    124123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oa_i_1d       !: 
    125124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_1d        !: 
    126    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !: 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !: ice ponds 
    127126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_ip_1d       !: 
    128127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_ip_1d       !: 
    129    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_frac_1d  !: 
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_il_1d       !: Ice pond lid 
     129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_il_1d       !: 
    130130 
    131131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d      !: corresponding to the 2D var  t_s 
    … …  
    146146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sss_1d 
    147147 
     148   ! convergence check 
     149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tice_cvgerr_1d   !: convergence of ice/snow temp (dT)          [K] 
     150   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tice_cvgstp_1d   !: convergence of ice/snow temp (subtimestep) [-] 
    148151   !  
    149152   !!---------------------- 
    … …  
    157160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   a_ip_2d 
    158161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_ip_2d  
     162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_il_2d  
    159163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_su_2d  
    160164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_2d 
    … …  
    175179      !!---------------------------------------------------------------------! 
    176180      INTEGER ::   ice1D_alloc   ! return value 
    177       INTEGER ::   ierr(7), ii 
     181      INTEGER ::   ierr(8), ii 
    178182      !!---------------------------------------------------------------------! 
    179183      ierr(:) = 0 
    … …  
    189193         &      hfx_thd_1d(jpij) , hfx_spr_1d    (jpij) ,                      & 
    190194         &      hfx_snw_1d(jpij) , hfx_sub_1d    (jpij) ,                      & 
    191          &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 
     195         &      hfx_res_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 
    192196      ! 
    193197      ii = ii + 1 
    … …  
    208212         &      dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm  (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) ,  &     
    209213         &      dh_i_sub(jpij) , dh_s_mlt(jpij) , dh_snowice(jpij) , s_i_1d  (jpij) , s_i_new (jpij) ,  & 
    210          &      a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d    (jpij) , v_s_1d  (jpij) ,                   & 
    211          &      h_ip_1d (jpij) , a_ip_frac_1d(jpij) ,                                                   & 
     214         &      a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d    (jpij) , v_s_1d  (jpij) , v_il_1d (jpij) ,  & 
     215         &      h_il_1d (jpij) , h_ip_1d (jpij) ,                                                       & 
    212216         &      sv_i_1d (jpij) , oa_i_1d (jpij) , o_i_1d    (jpij) , STAT=ierr(ii) ) 
    213217      ! 
    … …  
    224228      ! 
    225229      ii = ii + 1 
     230      ALLOCATE( tice_cvgerr_1d(jpij) , tice_cvgstp_1d(jpij) , STAT=ierr(ii) ) 
     231      ! 
     232      ii = ii + 1 
    226233      ALLOCATE( a_i_2d (jpij,jpl) , a_ib_2d(jpij,jpl) , h_i_2d (jpij,jpl) , h_ib_2d(jpij,jpl) ,  & 
    227234         &      v_i_2d (jpij,jpl) , v_s_2d (jpij,jpl) , oa_i_2d(jpij,jpl) , sv_i_2d(jpij,jpl) ,  & 
    228          &      a_ip_2d(jpij,jpl) , v_ip_2d(jpij,jpl) , t_su_2d(jpij,jpl) ,                      & 
     235         &      a_ip_2d(jpij,jpl) , v_ip_2d(jpij,jpl) , t_su_2d(jpij,jpl) , v_il_2d(jpij,jpl) ,  & 
    229236         &      STAT=ierr(ii) ) 
    230237 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90

    r11536 r13466  
    1414   !!   ice_alb_init   : initialisation of albedo computation 
    1515   !!---------------------------------------------------------------------- 
    16    USE ice, ONLY: jpl ! sea-ice: number of categories 
    1716   USE phycst         ! physical constants 
    1817   USE dom_oce        ! domain: ocean 
     18   USE ice, ONLY: jpl ! sea-ice: number of categories 
     19   USE icevar         ! sea-ice: operations 
    1920   ! 
    2021   USE in_out_manager ! I/O manager 
    … …  
    4546CONTAINS 
    4647 
    47    SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, palb_cs, palb_os ) 
     48   SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, pcloud_fra, palb_ice ) 
    4849      !!---------------------------------------------------------------------- 
    4950      !!               ***  ROUTINE ice_alb  *** 
    … …  
    9798      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pafrac_pnd   !  melt pond relative fraction (per unit ice area) 
    9899      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_pnd       !  melt pond depth 
    99       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_cs      !  albedo of ice under clear    sky 
    100       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_os      !  albedo of ice under overcast sky 
    101       ! 
     100      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   pcloud_fra   !  cloud fraction 
     101      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_ice     !  albedo of ice 
     102      ! 
     103      REAL(wp), DIMENSION(jpi,jpj,jpl) :: za_s_fra   ! ice fraction covered by snow 
    102104      INTEGER  ::   ji, jj, jl                ! dummy loop indices 
    103105      REAL(wp) ::   z1_c1, z1_c2,z1_c3, z1_c4 ! local scalar 
    … …  
    106108      REAL(wp) ::   zalb_ice, zafrac_ice      ! bare sea ice albedo & relative ice fraction 
    107109      REAL(wp) ::   zalb_snw, zafrac_snw      ! snow-covered sea ice albedo & relative snow fraction 
     110      REAL(wp) ::   zalb_cs, zalb_os          ! albedo of ice under clear/overcast sky 
    108111      !!--------------------------------------------------------------------- 
    109112      ! 
    … …  
    116119      z1_c4 = 1. / 0.03 
    117120      ! 
     121      CALL ice_var_snwfra( ph_snw, za_s_fra )   ! calculate ice fraction covered by snow 
     122      ! 
    118123      DO jl = 1, jpl 
    119124         DO jj = 1, jpj 
    120125            DO ji = 1, jpi 
    121                !                       !--- Specific snow, ice and pond fractions (for now, we prevent melt ponds and snow at the same time) 
    122                IF( ph_snw(ji,jj,jl) == 0._wp ) THEN 
    123                   zafrac_snw = 0._wp 
    124                   IF( ld_pnd_alb ) THEN 
    125                      zafrac_pnd = pafrac_pnd(ji,jj,jl) 
    126                   ELSE 
    127                      zafrac_pnd = 0._wp 
    128                   ENDIF 
    129                   zafrac_ice = 1._wp - zafrac_pnd 
     126               ! 
     127               !---------------------------------------------! 
     128               !--- Specific snow, ice and pond fractions ---! 
     129               !---------------------------------------------!                
     130               zafrac_snw = za_s_fra(ji,jj,jl) 
     131               IF( ld_pnd_alb ) THEN 
     132                  zafrac_pnd = MIN( pafrac_pnd(ji,jj,jl), 1._wp - zafrac_snw ) ! make sure (a_ip_eff + a_s_fra) <= 1 
    130133               ELSE 
    131                   zafrac_snw = 1._wp      ! Snow fully "shades" melt ponds and ice 
    132134                  zafrac_pnd = 0._wp 
    133                   zafrac_ice = 0._wp 
    134                ENDIF 
    135                ! 
     135               ENDIF 
     136               zafrac_ice = MAX( 0._wp, 1._wp - zafrac_pnd - zafrac_snw ) ! max for roundoff errors 
     137               ! 
     138               !---------------! 
     139               !--- Albedos ---! 
     140               !---------------!                
    136141               !                       !--- Bare ice albedo (for hi > 150cm) 
    137142               IF( ld_pnd_alb ) THEN 
    138143                  zalb_ice = rn_alb_idry 
    139144               ELSE 
    140                   IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN  ;   zalb_ice = rn_alb_imlt 
    141                   ELSE                                                               ;   zalb_ice = rn_alb_idry   ;   ENDIF 
     145                  IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN   ;   zalb_ice = rn_alb_imlt 
     146                  ELSE                                                                ;   zalb_ice = rn_alb_idry   ;   ENDIF 
    142147               ENDIF 
    143148               !                       !--- Bare ice albedo (for hi < 150cm) 
    … …  
    155160               ENDIF 
    156161               !                       !--- Ponded ice albedo 
    157                IF( ld_pnd_alb ) THEN 
    158                   zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd )  
    159                ELSE 
    160                   zalb_pnd = rn_alb_dpnd 
    161                ENDIF 
     162               zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd )  
     163               ! 
    162164               !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 
    163                palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
    164                ! 
    165                palb_cs(ji,jj,jl) = palb_os(ji,jj,jl)  & 
    166                   &                - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl)  & 
    167                   &                    + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 
    168                ! 
     165               zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
     166               ! 
     167               zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os  & 
     168                  &                  + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 
     169               ! 
     170               ! albedo depends on cloud fraction because of non-linear spectral effects 
     171               palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os 
     172 
    169173            END DO 
    170174         END DO 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icecor.F90

    r11536 r13466  
    8181      DO jl = 1, jpl 
    8282         WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 
    83       END DO 
    84      
     83      END DO     
     84      !                             !----------------------------------------------------- 
     85      !                             !  Rebin categories with thickness out of bounds     ! 
     86      !                             !----------------------------------------------------- 
     87      IF ( jpl > 1 )   CALL ice_itd_reb( kt ) 
     88      ! 
    8589      !                             !----------------------------------------------------- 
    8690      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        ! 
    … …  
    97101         END DO 
    98102      ENDIF 
    99       !                             !----------------------------------------------------- 
    100       !                             !  Rebin categories with thickness out of bounds     ! 
    101       !                             !----------------------------------------------------- 
    102       IF ( jpl > 1 )   CALL ice_itd_reb( kt ) 
    103  
    104103      !                             !----------------------------------------------------- 
    105104      CALL ice_var_zapsmall         !  Zap small values                                  ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icectl.F90

    r12545 r13466  
    350350      !!                   ***  ROUTINE ice_ctl ***  
    351351      !!                  
    352       !! ** Purpose :   Alerts in case of model crash 
     352      !! ** Purpose :   control checks 
    353353      !!------------------------------------------------------------------- 
    354354      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    355       INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices 
    356       INTEGER  ::   inb_altests       ! number of alert tests (max 20) 
    357       INTEGER  ::   ialert_id         ! number of the current alert 
    358       REAL(wp) ::   ztmelts           ! ice layer melting point 
     355      INTEGER  ::   ja, ji, jj, jk, jl ! dummy loop indices 
     356      INTEGER  ::   ialert_id          ! number of the current alert 
     357      REAL(wp) ::   ztmelts            ! ice layer melting point 
    359358      CHARACTER (len=30), DIMENSION(20) ::   cl_alname   ! name of alert 
    360359      INTEGER           , DIMENSION(20) ::   inb_alp     ! number of alerts positive 
    361360      !!------------------------------------------------------------------- 
    362  
    363       inb_altests = 10 
    364       inb_alp(:)  =  0 
    365  
    366       ! Alert if incompatible volume and concentration 
    367       ialert_id = 2 ! reference number of this alert 
    368       cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert 
     361      inb_alp(:) = 0 
     362      ialert_id = 0 
     363       
     364      ! Alert if very high salinity 
     365      ialert_id = ialert_id + 1 ! reference number of this alert 
     366      cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert 
    369367      DO jl = 1, jpl 
    370368         DO jj = 1, jpj 
    371369            DO ji = 1, jpi 
    372                IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN 
    373                   WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
    374                   inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     370               IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     371                  IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 
     372                     WRITE(numout,*) ' ALERTE :   Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) 
     373                     WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     374                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     375                  ENDIF 
    375376               ENDIF 
    376377            END DO 
    … …  
    378379      END DO 
    379380 
    380       ! Alerte if very thick ice 
    381       ialert_id = 3 ! reference number of this alert 
    382       cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert 
    383       jl = jpl  
    384       DO jj = 1, jpj 
    385          DO ji = 1, jpi 
    386             IF(   h_i(ji,jj,jl)  >  50._wp   ) THEN 
    387                WRITE(numout,*) ' ALERTE 3 :   Very thick ice' 
    388                !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' ) 
    389                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    390             ENDIF 
    391          END DO 
    392       END DO 
    393  
    394       ! Alert if very fast ice 
    395       ialert_id = 4 ! reference number of this alert 
    396       cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert 
    397       DO jj = 1, jpj 
    398          DO ji = 1, jpi 
    399             IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2.  .AND.  & 
    400                &  at_i(ji,jj) > 0._wp   ) THEN 
    401                WRITE(numout,*) ' ALERTE 4 :   Very fast ice' 
    402                !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' ) 
    403                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    404             ENDIF 
    405          END DO 
    406       END DO 
    407  
    408       ! Alert on salt flux 
    409       ialert_id = 5 ! reference number of this alert 
    410       cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert 
    411       DO jj = 1, jpj 
    412          DO ji = 1, jpi 
    413             IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth 
    414                WRITE(numout,*) ' ALERTE 5 :   High salt flux' 
    415                !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    416                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    417             ENDIF 
    418          END DO 
    419       END DO 
    420  
    421       ! Alert if there is ice on continents 
    422       ialert_id = 6 ! reference number of this alert 
    423       cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert 
    424       DO jj = 1, jpj 
    425          DO ji = 1, jpi 
    426             IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN  
    427                WRITE(numout,*) ' ALERTE 6 :   Ice on continents' 
    428                !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' ) 
    429                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    430             ENDIF 
    431          END DO 
    432       END DO 
    433  
    434 ! 
    435 !     ! Alert if very fresh ice 
    436       ialert_id = 7 ! reference number of this alert 
    437       cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert 
     381      ! Alert if very low salinity 
     382      ialert_id = ialert_id + 1 ! reference number of this alert 
     383      cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert 
    438384      DO jl = 1, jpl 
    439385         DO jj = 1, jpj 
    440386            DO ji = 1, jpi 
    441                IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    442                   WRITE(numout,*) ' ALERTE 7 :   Very fresh ice' 
    443 !                 CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' ) 
    444                   inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     387               IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     388                  IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 
     389                     WRITE(numout,*) ' ALERTE :   Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) 
     390                     WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     391                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     392                  ENDIF 
    445393               ENDIF 
    446394            END DO 
    447395         END DO 
    448396      END DO 
    449 ! 
    450       ! Alert if qns very big 
    451       ialert_id = 8 ! reference number of this alert 
    452       cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert 
    453       DO jj = 1, jpj 
    454          DO ji = 1, jpi 
    455             IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
    456                ! 
    457                WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
    458                !CALL ice_prt( kt, ji, jj, 2, '   ') 
    459                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    460                ! 
    461             ENDIF 
    462          END DO 
    463       END DO 
    464       !+++++ 
    465  
    466 !     ! Alert if too old ice 
    467       ialert_id = 9 ! reference number of this alert 
    468       cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert 
    469       DO jl = 1, jpl 
    470          DO jj = 1, jpj 
    471             DO ji = 1, jpi 
    472                IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 
    473                       ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 
    474                              ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
    475                   WRITE(numout,*) ' ALERTE 9 :   Wrong ice age' 
    476                   !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ') 
    477                   inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    478                ENDIF 
    479             END DO 
    480          END DO 
    481       END DO 
    482    
    483       ! Alert if very warm ice 
    484       ialert_id = 10 ! reference number of this alert 
    485       cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert 
    486       inb_alp(ialert_id) = 0 
     397 
     398      ! Alert if very cold ice 
     399      ialert_id = ialert_id + 1 ! reference number of this alert 
     400      cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert 
    487401      DO jl = 1, jpl 
    488402         DO jk = 1, nlay_i 
    … …  
    490404               DO ji = 1, jpi 
    491405                  ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    492                   IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   & 
    493                      &                            .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN 
    494                      WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
     406                  IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     407                     WRITE(numout,*) ' ALERTE :   Very cold ice ',(t_i(ji,jj,jk,jl)-rt0) 
     408                     WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
    495409                    inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    496410                  ENDIF 
    … …  
    499413         END DO 
    500414      END DO 
     415   
     416      ! Alert if very warm ice 
     417      ialert_id = ialert_id + 1 ! reference number of this alert 
     418      cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 
     419      DO jl = 1, jpl 
     420         DO jk = 1, nlay_i 
     421            DO jj = 1, jpj 
     422               DO ji = 1, jpi 
     423                  ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
     424                  IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     425                     WRITE(numout,*) ' ALERTE :   Very warm ice',(t_i(ji,jj,jk,jl)-rt0) 
     426                     WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
     427                    inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     428                  ENDIF 
     429               END DO 
     430            END DO 
     431         END DO 
     432      END DO 
     433       
     434      ! Alerte if very thick ice 
     435      ialert_id = ialert_id + 1 ! reference number of this alert 
     436      cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 
     437      jl = jpl  
     438      DO jj = 1, jpj 
     439         DO ji = 1, jpi 
     440            IF( h_i(ji,jj,jl) > 50._wp ) THEN 
     441               WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl) 
     442               WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     443               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     444            ENDIF 
     445         END DO 
     446      END DO 
     447 
     448      ! Alerte if very thin ice 
     449      ialert_id = ialert_id + 1 ! reference number of this alert 
     450      cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 
     451      jl = 1  
     452      DO jj = 1, jpj 
     453         DO ji = 1, jpi 
     454            IF( h_i(ji,jj,jl) < rn_himin ) THEN 
     455               WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl) 
     456               WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     457               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     458            ENDIF 
     459         END DO 
     460      END DO 
     461 
     462      ! Alert if very fast ice 
     463      ialert_id = ialert_id + 1 ! reference number of this alert 
     464      cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 
     465      DO jj = 1, jpj 
     466         DO ji = 1, jpi 
     467            IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 
     468               WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 
     469               WRITE(numout,*) ' at i,j = ',ji,jj 
     470               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     471            ENDIF 
     472         END DO 
     473      END DO 
     474 
     475      ! Alert if there is ice on continents 
     476      ialert_id = ialert_id + 1 ! reference number of this alert 
     477      cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 
     478      DO jj = 1, jpj 
     479         DO ji = 1, jpi 
     480            IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN  
     481               WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 
     482               WRITE(numout,*) ' at i,j = ',ji,jj 
     483               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     484            ENDIF 
     485         END DO 
     486      END DO 
     487 
     488      ! Alert if incompatible ice concentration and volume 
     489      ialert_id = ialert_id + 1 ! reference number of this alert 
     490      cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert 
     491      DO jj = 1, jpj 
     492         DO ji = 1, jpi 
     493            IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. & 
     494               & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN  
     495               WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 
     496               WRITE(numout,*) ' at i,j = ',ji,jj 
     497               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     498            ENDIF 
     499         END DO 
     500      END DO 
    501501 
    502502      ! sum of the alerts on all processors 
    503503      IF( lk_mpp ) THEN 
    504          DO ialert_id = 1, inb_altests 
    505             CALL mpp_sum('icectl', inb_alp(ialert_id)) 
     504         DO ja = 1, ialert_id 
     505            CALL mpp_sum('icectl', inb_alp(ja)) 
    506506         END DO 
    507507      ENDIF 
    … …  
    509509      ! print alerts 
    510510      IF( lwp ) THEN 
    511          ialert_id = 1                                 ! reference number of this alert 
    512          cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert 
    513511         WRITE(numout,*) ' time step ',kt 
    514512         WRITE(numout,*) ' All alerts at the end of ice model ' 
    515          DO ialert_id = 1, inb_altests 
    516             WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! ' 
     513         DO ja = 1, ialert_id 
     514            WRITE(numout,*) ja, cl_alname(ja)//' : ', inb_alp(ja), ' times ! ' 
    517515         END DO 
    518516      ENDIF 
    … …  
    563561               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    564562               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    565                WRITE(numout,*) 
    566563               WRITE(numout,*) ' - Cell values ' 
    567564               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    … …  
    572569               DO jl = 1, jpl 
    573570                  WRITE(numout,*) ' - Category (', jl,')' 
     571                  WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    574572                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl) 
    575573                  WRITE(numout,*) ' h_i           : ', h_i(ji,jj,jl) 
    … …  
    608606               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    609607               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    610                WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)   
    611608               WRITE(numout,*) 
    612609                
    … …  
    625622                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)  
    626623                  WRITE(numout,*) ' sv_i       : ', sv_i(ji,jj,jl)             , ' sv_i_b     : ', sv_i_b(ji,jj,jl)    
    627                   WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl) 
    628624               END DO !jl 
    629625                
    … …  
    733729         CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' v_i         : ') 
    734730         CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' v_s         : ') 
    735          CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' e_i1        : ') 
    736731         CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' e_snow      : ') 
    737732         CALL prt_ctl(tab2d_1=sv_i       (:,:,jl)        , clinfo1= ' sv_i        : ') 
    … …  
    741736            CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    742737            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ') 
     738            CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' e_i       : ') 
    743739         END DO 
    744740      END DO 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn.F90

    r11536 r13466  
    9999      WHERE( a_ip(:,:,:) >= epsi20 ) 
    100100         h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 
     101         h_il(:,:,:) = v_il(:,:,:) / a_ip(:,:,:) 
    101102      ELSEWHERE 
    102103         h_ip(:,:,:) = 0._wp 
     104         h_il(:,:,:) = 0._wp 
    103105      END WHERE 
    104106      ! 
    … …  
    221223      NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice,  & 
    222224         &             rn_ishlat ,                                                           & 
    223          &             ln_landfast_L16, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile 
     225         &             ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile 
    224226      !!------------------------------------------------------------------- 
    225227      ! 
    … …  
    244246         WRITE(numout,*) '      lateral boundary condition for sea ice dynamics        rn_ishlat       = ', rn_ishlat 
    245247         WRITE(numout,*) '      Landfast: param from Lemieux 2016                      ln_landfast_L16 = ', ln_landfast_L16 
    246          WRITE(numout,*) '         fraction of ocean depth that ice must reach         rn_depfra       = ', rn_depfra 
    247          WRITE(numout,*) '         maximum bottom stress per unit area of contact      rn_icebfr       = ', rn_icebfr 
    248          WRITE(numout,*) '         relax time scale (s-1) to reach static friction     rn_lfrelax      = ', rn_lfrelax 
    249          WRITE(numout,*) '         isotropic tensile strength                          rn_tensile      = ', rn_tensile 
     248         WRITE(numout,*) '         fraction of ocean depth that ice must reach         rn_lf_depfra    = ', rn_lf_depfra 
     249         WRITE(numout,*) '         maximum bottom stress per unit area of contact      rn_lf_bfr       = ', rn_lf_bfr 
     250         WRITE(numout,*) '         relax time scale (s-1) to reach static friction     rn_lf_relax     = ', rn_lf_relax 
     251         WRITE(numout,*) '         isotropic tensile strength                          rn_lf_tensile   = ', rn_lf_tensile 
    250252         WRITE(numout,*) 
    251253      ENDIF 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv.F90

    r12197 r13466  
    8484         !                             !-----------------------! 
    8585         CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, h_i, h_s, h_ip, & 
    86             &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
     86            &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) 
    8787         !                             !-----------------------! 
    8888      CASE( np_advPRA )                ! PRATHER scheme        ! 
    8989         !                             !-----------------------! 
    9090         CALL ice_dyn_adv_pra(         kt, u_ice, v_ice, h_i, h_s, h_ip, & 
    91             &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
     91            &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) 
    9292      END SELECT 
    9393 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_pra.F90

    r12197 r13466  
    4444   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxap , syap , sxxap , syyap , sxyap    ! melt pond fraction 
    4545   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxvp , syvp , sxxvp , syyvp , sxyvp    ! melt pond volume 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxvl , syvl , sxxvl , syyvl , sxyvl    ! melt pond lid volume 
    4647 
    4748   !! * Substitutions 
    … …  
    5556 
    5657   SUBROUTINE ice_dyn_adv_pra(         kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip,  & 
    57       &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     58      &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    5859      !!---------------------------------------------------------------------- 
    5960      !!                **  routine ice_dyn_adv_pra  ** 
    … …  
    8182      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    8283      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     84      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid thickness 
    8385      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    8486      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    8587      ! 
    86       INTEGER  ::   ji,jj, jk, jl, jt       ! dummy loop indices 
     88      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices 
    8789      INTEGER  ::   icycle                  ! number of sub-timestep for the advection 
    8890      REAL(wp) ::   zdt                     !   -      - 
    … …  
    9092      REAL(wp), DIMENSION(jpi,jpj)            ::   zati1, zati2 
    9193      REAL(wp), DIMENSION(jpi,jpj)            ::   zudy, zvdx 
    92       REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zhi_max, zhs_max, zhip_max 
     94      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zhi_max, zhs_max, zhip_max, zs_i, zsi_max 
     95      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   ze_i, zei_max 
     96      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   ze_s, zes_max 
    9397      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zarea 
    9498      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ice, z0snw, z0ai, z0smi, z0oi 
    95       REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp 
     99      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp, z0vl 
    96100      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   z0es 
    97101      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   z0ei 
    … …  
    100104      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' 
    101105      ! 
    102       ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 
     106      ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! 
     107      ! thickness and salinity 
     108      WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) 
     109      ELSEWHERE                      ; zs_i(:,:,:) = 0._wp 
     110      END WHERE 
    103111      DO jl = 1, jpl 
    104112         DO jj = 2, jpjm1 
    … …  
    116124                  &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
    117125                  &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
     126               zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), & 
     127                  &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), & 
     128                  &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 
     129                  &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 
    118130            END DO 
    119131         END DO 
    120132      END DO 
    121       CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) 
     133      CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1., zsi_max, 'T', 1. ) 
     134      ! 
     135      ! enthalpies 
     136      DO jk = 1, nlay_i 
     137         WHERE( pv_i(:,:,:) >= epsi10 ) ; ze_i(:,:,jk,:) = pe_i(:,:,jk,:) / pv_i(:,:,:) 
     138         ELSEWHERE                      ; ze_i(:,:,jk,:) = 0._wp 
     139         END WHERE 
     140      END DO 
     141      DO jk = 1, nlay_s 
     142         WHERE( pv_s(:,:,:) >= epsi10 ) ; ze_s(:,:,jk,:) = pe_s(:,:,jk,:) / pv_s(:,:,:) 
     143         ELSEWHERE                      ; ze_s(:,:,jk,:) = 0._wp 
     144         END WHERE 
     145      END DO 
     146      DO jl = 1, jpl 
     147         DO jk = 1, nlay_i 
     148            DO jj = 2, jpjm1 
     149               DO ji = fs_2, fs_jpim1 
     150                  zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
     151                     &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
     152                     &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 
     153                     &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 
     154               END DO 
     155            END DO 
     156         END DO 
     157      END DO 
     158      DO jl = 1, jpl 
     159         DO jk = 1, nlay_s 
     160            DO jj = 2, jpjm1 
     161               DO ji = fs_2, fs_jpim1 
     162                  zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
     163                     &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
     164                     &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 
     165                     &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 
     166               END DO 
     167            END DO 
     168         END DO 
     169      END DO 
     170      CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) 
     171      CALL lbc_lnk( 'icedyn_adv_pra', zes_max, 'T', 1. ) 
     172      ! 
    122173      ! 
    123174      ! --- If ice drift is too fast, use  subtime steps for advection (CFL test for stability) --- ! 
    … …  
    158209               z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content 
    159210            END DO 
    160             IF ( ln_pnd_H12 ) THEN 
    161                z0ap(:,:,jl)  = pa_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond fraction 
    162                z0vp(:,:,jl)  = pv_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond volume 
     211            IF ( ln_pnd_LEV ) THEN 
     212               z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond fraction 
     213               z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond volume 
     214               IF ( ln_pnd_lids ) THEN 
     215                  z0vl(:,:,jl) = pv_il(:,:,jl) * e1e2t(:,:)   ! Melt pond lid volume 
     216               ENDIF 
    163217            ENDIF 
    164218         END DO 
    … …  
    191245            END DO 
    192246            ! 
    193             IF ( ln_pnd_H12 ) THEN 
     247            IF ( ln_pnd_LEV ) THEN 
    194248               CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    195249               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )  
    196250               CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    197251               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )  
     252               IF ( ln_pnd_lids ) THEN 
     253                  CALL adv_x( zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 
     254                  CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )  
     255               ENDIF 
    198256            ENDIF 
    199257            !                                                               !--------------------------------------------! 
    … …  
    222280                  &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 
    223281            END DO 
    224             IF ( ln_pnd_H12 ) THEN 
     282            IF ( ln_pnd_LEV ) THEN 
    225283               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    226284               CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
    227285               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    228286               CALL adv_x( zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 
    229             ENDIF 
     287               IF ( ln_pnd_lids ) THEN 
     288                  CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 
     289                  CALL adv_x( zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )  
     290               ENDIF 
     291           ENDIF 
    230292            ! 
    231293         ENDIF 
    … …  
    244306               pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    245307            END DO 
    246             IF ( ln_pnd_H12 ) THEN 
     308            IF ( ln_pnd_LEV ) THEN 
    247309               pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    248310               pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     311               IF ( ln_pnd_lids ) THEN 
     312                  pv_il(:,:,jl) = z0vl(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     313               ENDIF 
    249314            ENDIF 
    250315         END DO 
    … …  
    263328         !     Remove negative values (conservation is ensured) 
    264329         !     (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 
    265          CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     330         CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    266331         ! 
    267332         ! --- Make sure ice thickness is not too big --- ! 
    268333         !     (because ice thickness can be too large where ice concentration is very small) 
    269          CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     334         CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, & 
     335            &            pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    270336         ! 
    271337         ! --- Ensure snow load is not too big --- ! 
    … …  
    619685 
    620686 
    621    SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     687   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & 
     688      &                  pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    622689      !!------------------------------------------------------------------- 
    623690      !!                  ***  ROUTINE Hbig  *** 
    … …  
    633700      !! ** input   : Max thickness of the surrounding 9-points 
    634701      !!------------------------------------------------------------------- 
    635       REAL(wp)                    , INTENT(in   ) ::   pdt                          ! tracer time-step 
    636       REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max   ! max ice thick from surrounding 9-pts 
    637       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip 
     702      REAL(wp)                    , INTENT(in   ) ::   pdt                                   ! tracer time-step 
     703      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max, psi_max   ! max ice thick from surrounding 9-pts 
     704      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pes_max 
     705      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pei_max 
     706      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i 
    638707      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s 
    639       ! 
    640       INTEGER  ::   ji, jj, jl         ! dummy loop indices 
    641       REAL(wp) ::   z1_dt, zhip, zhi, zhs, zfra 
     708      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i 
     709      ! 
     710      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices 
     711      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra 
    642712      !!------------------------------------------------------------------- 
    643713      ! 
    … …  
    645715      ! 
    646716      DO jl = 1, jpl 
    647  
    648717         DO jj = 1, jpj 
    649718            DO ji = 1, jpi 
    … …  
    652721                  !                               ! -- check h_ip -- ! 
    653722                  ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    654                   IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     723                  IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    655724                     zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    656725                     IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
    … …  
    679748                  ENDIF            
    680749                  !                   
     750                  !                               ! -- check s_i -- ! 
     751                  ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
     752                  zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
     753                  IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     754                     zfra = psi_max(ji,jj,jl) / zsi 
     755                     sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
     756                     psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
     757                  ENDIF 
     758                  ! 
    681759               ENDIF 
    682760            END DO 
    683761         END DO 
    684762      END DO  
     763      ! 
     764      !                                           ! -- check e_i/v_i -- ! 
     765      DO jl = 1, jpl 
     766         DO jk = 1, nlay_i 
     767            DO jj = 1, jpj 
     768               DO ji = 1, jpi 
     769                  IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     770                     ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
     771                     zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
     772                     IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     773                        zfra = pei_max(ji,jj,jk,jl) / zei 
     774                        hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     775                        pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
     776                     ENDIF 
     777                  ENDIF 
     778               END DO 
     779            END DO 
     780         END DO 
     781      END DO 
     782      !                                           ! -- check e_s/v_s -- ! 
     783      DO jl = 1, jpl 
     784         DO jk = 1, nlay_s 
     785            DO jj = 1, jpj 
     786               DO ji = 1, jpi 
     787                  IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
     788                     ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
     789                     zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
     790                     IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     791                        zfra = pes_max(ji,jj,jk,jl) / zes 
     792                        hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     793                        pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
     794                     ENDIF 
     795                  ENDIF 
     796               END DO 
     797            END DO 
     798         END DO 
     799      END DO 
    685800      ! 
    686801   END SUBROUTINE Hbig 
    … …  
    756871         &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   & 
    757872         &      sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) ,   & 
    758          &      sxap(jpi,jpj,jpl)  , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   & 
    759          &      sxvp(jpi,jpj,jpl)  , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   & 
     873         &      sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   & 
     874         &      sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   & 
     875         &      sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) ,   & 
    760876         ! 
    761877         &      sxc0 (jpi,jpj,nlay_s,jpl) , syc0 (jpi,jpj,nlay_s,jpl) , sxxc0(jpi,jpj,nlay_s,jpl) , & 
    … …  
    852968            END DO 
    853969            ! 
    854             IF( ln_pnd_H12 ) THEN                                    ! melt pond fraction 
    855                CALL iom_get( numrir, jpdom_autoglo, 'sxap' , sxap  ) 
    856                CALL iom_get( numrir, jpdom_autoglo, 'syap' , syap  ) 
    857                CALL iom_get( numrir, jpdom_autoglo, 'sxxap', sxxap ) 
    858                CALL iom_get( numrir, jpdom_autoglo, 'syyap', syyap ) 
    859                CALL iom_get( numrir, jpdom_autoglo, 'sxyap', sxyap ) 
    860                !                                                     ! melt pond volume 
    861                CALL iom_get( numrir, jpdom_autoglo, 'sxvp' , sxvp  ) 
    862                CALL iom_get( numrir, jpdom_autoglo, 'syvp' , syvp  ) 
    863                CALL iom_get( numrir, jpdom_autoglo, 'sxxvp', sxxvp ) 
    864                CALL iom_get( numrir, jpdom_autoglo, 'syyvp', syyvp ) 
    865                CALL iom_get( numrir, jpdom_autoglo, 'sxyvp', sxyvp ) 
     970            IF( ln_pnd_LEV ) THEN                                    ! melt pond fraction 
     971               IF( iom_varid( numror, 'sxap', ldstop = .FALSE. ) > 0 ) THEN 
     972                  CALL iom_get( numrir, jpdom_autoglo, 'sxap' , sxap  ) 
     973                  CALL iom_get( numrir, jpdom_autoglo, 'syap' , syap  ) 
     974                  CALL iom_get( numrir, jpdom_autoglo, 'sxxap', sxxap ) 
     975                  CALL iom_get( numrir, jpdom_autoglo, 'syyap', syyap ) 
     976                  CALL iom_get( numrir, jpdom_autoglo, 'sxyap', sxyap ) 
     977                  !                                                     ! melt pond volume 
     978                  CALL iom_get( numrir, jpdom_autoglo, 'sxvp' , sxvp  ) 
     979                  CALL iom_get( numrir, jpdom_autoglo, 'syvp' , syvp  ) 
     980                  CALL iom_get( numrir, jpdom_autoglo, 'sxxvp', sxxvp ) 
     981                  CALL iom_get( numrir, jpdom_autoglo, 'syyvp', syyvp ) 
     982                  CALL iom_get( numrir, jpdom_autoglo, 'sxyvp', sxyvp ) 
     983               ELSE 
     984                  sxap = 0._wp ;   syap = 0._wp    ;   sxxap = 0._wp    ;   syyap = 0._wp    ;   sxyap = 0._wp   ! melt pond fraction 
     985                  sxvp = 0._wp ;   syvp = 0._wp    ;   sxxvp = 0._wp    ;   syyvp = 0._wp    ;   sxyvp = 0._wp   ! melt pond volume 
     986               ENDIF 
     987                  ! 
     988               IF ( ln_pnd_lids ) THEN                               ! melt pond lid volume 
     989                  IF( iom_varid( numror, 'sxvl', ldstop = .FALSE. ) > 0 ) THEN 
     990                     CALL iom_get( numrir, jpdom_autoglo, 'sxvl' , sxvl  ) 
     991                     CALL iom_get( numrir, jpdom_autoglo, 'syvl' , syvl  ) 
     992                     CALL iom_get( numrir, jpdom_autoglo, 'sxxvl', sxxvl ) 
     993                     CALL iom_get( numrir, jpdom_autoglo, 'syyvl', syyvl ) 
     994                     CALL iom_get( numrir, jpdom_autoglo, 'sxyvl', sxyvl ) 
     995                  ELSE 
     996                     sxvl = 0._wp; syvl = 0._wp    ;   sxxvl = 0._wp    ;   syyvl = 0._wp    ;   sxyvl = 0._wp   ! melt pond lid volume 
     997                  ENDIF 
     998               ENDIF 
    866999            ENDIF 
    8671000            ! 
    … …  
    8771010            sxc0  = 0._wp   ;   syc0  = 0._wp   ;   sxxc0  = 0._wp   ;   syyc0  = 0._wp   ;   sxyc0  = 0._wp      ! snow layers heat content 
    8781011            sxe   = 0._wp   ;   sye   = 0._wp   ;   sxxe   = 0._wp   ;   syye   = 0._wp   ;   sxye   = 0._wp      ! ice layers heat content 
    879             IF( ln_pnd_H12 ) THEN 
    880                sxap  = 0._wp   ;   syap  = 0._wp   ;   sxxap  = 0._wp   ;   syyap  = 0._wp   ;   sxyap  = 0._wp   ! melt pond fraction 
    881                sxvp  = 0._wp   ;   syvp  = 0._wp   ;   sxxvp  = 0._wp   ;   syyvp  = 0._wp   ;   sxyvp  = 0._wp   ! melt pond volume 
     1012            IF( ln_pnd_LEV ) THEN 
     1013               sxap = 0._wp ;   syap = 0._wp    ;   sxxap = 0._wp    ;   syyap = 0._wp    ;   sxyap = 0._wp       ! melt pond fraction 
     1014               sxvp = 0._wp ;   syvp = 0._wp    ;   sxxvp = 0._wp    ;   syyvp = 0._wp    ;   sxyvp = 0._wp       ! melt pond volume 
     1015               IF ( ln_pnd_lids ) THEN 
     1016                  sxvl = 0._wp; syvl = 0._wp    ;   sxxvl = 0._wp    ;   syyvl = 0._wp    ;   sxyvl = 0._wp       ! melt pond lid volume 
     1017               ENDIF 
    8821018            ENDIF 
    8831019         ENDIF 
    … …  
    9421078         END DO 
    9431079         ! 
    944          IF( ln_pnd_H12 ) THEN                                       ! melt pond fraction 
     1080         IF( ln_pnd_LEV ) THEN                                       ! melt pond fraction 
    9451081            CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap  ) 
    9461082            CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap  ) 
    … …  
    9541090            CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp ) 
    9551091            CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp ) 
     1092            ! 
     1093            IF ( ln_pnd_lids ) THEN                                  ! melt pond lid volume 
     1094               CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl  ) 
     1095               CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl  ) 
     1096               CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl ) 
     1097               CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl ) 
     1098               CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl ) 
     1099            ENDIF 
    9561100         ENDIF 
    9571101         ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_umx.F90

    r12197 r13466  
    6060 
    6161   SUBROUTINE ice_dyn_adv_umx( kn_umx, kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip,  & 
    62       &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     62      &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    6363      !!---------------------------------------------------------------------- 
    6464      !!                  ***  ROUTINE ice_dyn_adv_umx  *** 
    … …  
    8585      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond concentration 
    8686      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     87      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    8788      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    8889      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    … …  
    9293      REAL(wp) ::   zamsk                   ! 1 if advection of concentration, 0 if advection of other tracers 
    9394      REAL(wp) ::   zdt, zvi_cen 
    94       REAL(wp), DIMENSION(1)           ::   zcflprv, zcflnow   ! for global communication 
    95       REAL(wp), DIMENSION(jpi,jpj)     ::   zudy, zvdx, zcu_box, zcv_box 
    96       REAL(wp), DIMENSION(jpi,jpj)     ::   zati1, zati2 
    97       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zu_cat, zv_cat 
    98       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zua_ho, zva_ho, zua_ups, zva_ups 
    99       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_ai , z1_aip, zhvar 
    100       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zhi_max, zhs_max, zhip_max 
     95      REAL(wp), DIMENSION(1)                  ::   zcflprv, zcflnow   ! for global communication 
     96      REAL(wp), DIMENSION(jpi,jpj)            ::   zudy, zvdx, zcu_box, zcv_box 
     97      REAL(wp), DIMENSION(jpi,jpj)            ::   zati1, zati2 
     98      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zu_cat, zv_cat 
     99      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zua_ho, zva_ho, zua_ups, zva_ups 
     100      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z1_ai , z1_aip, zhvar 
     101      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zhi_max, zhs_max, zhip_max, zs_i, zsi_max 
     102      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   ze_i, zei_max 
     103      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   ze_s, zes_max 
    101104      ! 
    102105      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs  
    … …  
    105108      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme' 
    106109      ! 
    107       ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 
     110      ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! 
     111      ! thickness and salinity 
     112      WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) 
     113      ELSEWHERE                      ; zs_i(:,:,:) = 0._wp 
     114      END WHERE 
    108115      DO jl = 1, jpl 
    109116         DO jj = 2, jpjm1 
    … …  
    121128                  &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
    122129                  &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
    123             END DO 
    124          END DO 
    125       END DO 
    126       CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) 
     130               zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), & 
     131                  &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), & 
     132                  &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 
     133                  &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 
     134            END DO 
     135         END DO 
     136      END DO 
     137      CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1., zsi_max, 'T', 1. ) 
     138      ! 
     139      ! enthalpies 
     140      DO jk = 1, nlay_i 
     141         WHERE( pv_i(:,:,:) >= epsi10 ) ; ze_i(:,:,jk,:) = pe_i(:,:,jk,:) / pv_i(:,:,:) 
     142         ELSEWHERE                      ; ze_i(:,:,jk,:) = 0._wp 
     143         END WHERE 
     144      END DO 
     145      DO jk = 1, nlay_s 
     146         WHERE( pv_s(:,:,:) >= epsi10 ) ; ze_s(:,:,jk,:) = pe_s(:,:,jk,:) / pv_s(:,:,:) 
     147         ELSEWHERE                      ; ze_s(:,:,jk,:) = 0._wp 
     148         END WHERE 
     149      END DO 
     150      DO jl = 1, jpl 
     151         DO jk = 1, nlay_i 
     152            DO jj = 2, jpjm1 
     153               DO ji = fs_2, fs_jpim1 
     154                  zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
     155                     &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
     156                     &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 
     157                     &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 
     158               END DO 
     159            END DO 
     160         END DO 
     161      END DO 
     162      DO jl = 1, jpl 
     163         DO jk = 1, nlay_s 
     164            DO jj = 2, jpjm1 
     165               DO ji = fs_2, fs_jpim1 
     166                  zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
     167                     &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
     168                     &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 
     169                     &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 
     170               END DO 
     171            END DO 
     172         END DO 
     173      END DO 
     174      CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) 
     175      CALL lbc_lnk( 'icedyn_adv_pra', zes_max, 'T', 1. ) 
    127176      ! 
    128177      ! 
    … …  
    324373         ! 
    325374         !== melt ponds ==! 
    326          IF ( ln_pnd_H12 ) THEN 
     375         IF ( ln_pnd_LEV ) THEN 
    327376            ! concentration 
    328377            zamsk = 1._wp 
    … …  
    334383            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 
    335384               &                                      zhvar, pv_ip, zua_ups, zva_ups ) 
     385            ! lid 
     386            IF ( ln_pnd_lids ) THEN 
     387               zamsk = 0._wp 
     388               zhvar(:,:,:) = pv_il(:,:,:) * z1_aip(:,:,:) 
     389               CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 
     390                  &                                      zhvar, pv_il, zua_ups, zva_ups ) 
     391            ENDIF 
    336392         ENDIF 
    337393         ! 
    … …  
    350406         ! Remove negative values (conservation is ensured) 
    351407         !    (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 
    352          CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     408         CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    353409         ! 
    354410         ! --- Make sure ice thickness is not too big --- ! 
    355411         !     (because ice thickness can be too large where ice concentration is very small) 
    356          CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     412         CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, & 
     413            &            pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    357414         ! 
    358415         ! --- Ensure snow load is not too big --- ! 
    … …  
    15171574 
    15181575 
    1519    SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     1576   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & 
     1577      &                  pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    15201578      !!------------------------------------------------------------------- 
    15211579      !!                  ***  ROUTINE Hbig  *** 
    … …  
    15311589      !! ** input   : Max thickness of the surrounding 9-points 
    15321590      !!------------------------------------------------------------------- 
    1533       REAL(wp)                    , INTENT(in   ) ::   pdt                          ! tracer time-step 
    1534       REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max   ! max ice thick from surrounding 9-pts 
    1535       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip 
     1591      REAL(wp)                    , INTENT(in   ) ::   pdt                                   ! tracer time-step 
     1592      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max, psi_max   ! max ice thick from surrounding 9-pts 
     1593      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pes_max 
     1594      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pei_max 
     1595      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i 
    15361596      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s 
    1537       ! 
    1538       INTEGER  ::   ji, jj, jl         ! dummy loop indices 
    1539       REAL(wp) ::   z1_dt, zhip, zhi, zhs, zfra 
     1597      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i 
     1598      ! 
     1599      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices 
     1600      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra 
    15401601      !!------------------------------------------------------------------- 
    15411602      ! 
    … …  
    15431604      ! 
    15441605      DO jl = 1, jpl 
    1545  
    15461606         DO jj = 1, jpj 
    15471607            DO ji = 1, jpi 
    … …  
    15501610                  !                               ! -- check h_ip -- ! 
    15511611                  ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    1552                   IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     1612                  IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    15531613                     zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    15541614                     IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
    … …  
    15771637                  ENDIF            
    15781638                  !                   
     1639                  !                               ! -- check s_i -- ! 
     1640                  ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
     1641                  zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
     1642                  IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1643                     zfra = psi_max(ji,jj,jl) / zsi 
     1644                     sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
     1645                     psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
     1646                  ENDIF 
     1647                  ! 
    15791648               ENDIF 
    15801649            END DO 
    15811650         END DO 
    15821651      END DO  
     1652      ! 
     1653      !                                           ! -- check e_i/v_i -- ! 
     1654      DO jl = 1, jpl 
     1655         DO jk = 1, nlay_i 
     1656            DO jj = 1, jpj 
     1657               DO ji = 1, jpi 
     1658                  IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     1659                     ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
     1660                     zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
     1661                     IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1662                        zfra = pei_max(ji,jj,jk,jl) / zei 
     1663                        hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     1664                        pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
     1665                     ENDIF 
     1666                  ENDIF 
     1667               END DO 
     1668            END DO 
     1669         END DO 
     1670      END DO 
     1671      !                                           ! -- check e_s/v_s -- ! 
     1672      DO jl = 1, jpl 
     1673         DO jk = 1, nlay_s 
     1674            DO jj = 1, jpj 
     1675               DO ji = 1, jpi 
     1676                  IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
     1677                     ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
     1678                     zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
     1679                     IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1680                        zfra = pes_max(ji,jj,jk,jl) / zes 
     1681                        hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     1682                        pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
     1683                     ENDIF 
     1684                  ENDIF 
     1685               END DO 
     1686            END DO 
     1687         END DO 
     1688      END DO 
    15831689      ! 
    15841690   END SUBROUTINE Hbig 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rdgrft.F90

    r11732 r13466  
    494494      REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1 
    495495      REAL(wp)                  ::   airft1, oirft1, aprft1 
    496       REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg  ! area etc of new ridges 
    497       REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft  ! area etc of rafted ice 
     496      REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg  ! area etc of new ridges 
     497      REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft  ! area etc of rafted ice 
    498498      ! 
    499499      REAL(wp), DIMENSION(jpij) ::   ersw             ! enth of water trapped into ridges 
    … …  
    565565               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft  
    566566 
    567                IF ( ln_pnd_H12 ) THEN 
     567               IF ( ln_pnd_LEV ) THEN 
    568568                  aprdg1     = a_ip_2d(ji,jl1) * afrdg 
    569569                  aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) 
    … …  
    572572                  aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft 
    573573                  vprft (ji) = v_ip_2d(ji,jl1) * afrft 
     574                  IF ( ln_pnd_lids ) THEN 
     575                     vlrdg (ji) = v_il_2d(ji,jl1) * afrdg 
     576                     vlrft (ji) = v_il_2d(ji,jl1) * afrft 
     577                  ENDIF 
    574578               ENDIF 
    575579 
    … …  
    598602               sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1    - sirft(ji) 
    599603               oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1    - oirft1 
    600                IF ( ln_pnd_H12 ) THEN 
     604               IF ( ln_pnd_LEV ) THEN 
    601605                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1    - aprft1 
    602606                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 
     607                  IF ( ln_pnd_lids ) THEN 
     608                     v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji) 
     609                  ENDIF 
    603610               ENDIF 
    604611            ENDIF 
    … …  
    692699                  v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji)  +  & 
    693700                     &                                  vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 
    694                   IF ( ln_pnd_H12 ) THEN 
     701                  IF ( ln_pnd_LEV ) THEN 
    695702                     v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + (   vprdg (ji) * rn_fpndrdg * fvol   (ji)   & 
    696703                        &                                   + vprft (ji) * rn_fpndrft * zswitch(ji)   ) 
    697704                     a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + (   aprdg2(ji) * rn_fpndrdg * farea         &  
    698705                        &                                   + aprft2(ji) * rn_fpndrft * zswitch(ji)   ) 
     706                     IF ( ln_pnd_lids ) THEN 
     707                        v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + (   vlrdg(ji) * rn_fpndrdg * fvol   (ji) & 
     708                           &                                   + vlrft(ji) * rn_fpndrft * zswitch(ji) ) 
     709                     ENDIF 
    699710                  ENDIF 
    700711                   
    … …  
    727738      !---------------- 
    728739      ! In case ridging/rafting lead to very small negative values (sometimes it happens) 
    729       CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, ze_s_2d, ze_i_2d ) 
     740      CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, ze_s_2d, ze_i_2d ) 
    730741      ! 
    731742   END SUBROUTINE rdgrft_shift 
    … …  
    839850         CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    840851         CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     852         CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    841853         DO jl = 1, jpl 
    842854            DO jk = 1, nlay_s 
    … …  
    865877         CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    866878         CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     879         CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    867880         DO jl = 1, jpl 
    868881            DO jk = 1, nlay_s 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg.F90

    r11536 r13466  
    110110      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
    111111      !! 
    112       NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast 
     112      NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast, ln_rhg_chkcvg 
    113113      !!------------------------------------------------------------------- 
    114114      ! 
    … …  
    126126         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    127127         WRITE(numout,*) '   Namelist : namdyn_rhg:' 
    128          WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP = ', ln_rhg_EVP 
    129          WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP    = ', ln_aEVP 
    130          WRITE(numout,*) '         creep limit                                       rn_creepl  = ', rn_creepl 
    131          WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc     = ', rn_ecc 
    132          WRITE(numout,*) '         number of iterations for subcycling               nn_nevp    = ', nn_nevp 
    133          WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast  = ', rn_relast 
     128         WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP    = ', ln_rhg_EVP 
     129         WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP       = ', ln_aEVP 
     130         WRITE(numout,*) '         creep limit                                       rn_creepl     = ', rn_creepl 
     131         WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc        = ', rn_ecc 
     132         WRITE(numout,*) '         number of iterations for subcycling               nn_nevp       = ', nn_nevp 
     133         WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast     = ', rn_relast 
     134         WRITE(numout,*) '      check convergence of rheology                        ln_rhg_chkcvg = ', ln_rhg_chkcvg 
    134135      ENDIF 
    135136      ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90

    r13271 r13466  
    4141   USE prtctl         ! Print control 
    4242 
     43   USE netcdf         ! NetCDF library for convergence test 
    4344   IMPLICIT NONE 
    4445   PRIVATE 
    … …  
    4950   !! * Substitutions 
    5051#  include "vectopt_loop_substitute.h90" 
     52 
     53   !! for convergence tests 
     54   INTEGER ::   ncvgid   ! netcdf file id 
     55   INTEGER ::   nvarid   ! netcdf variable id 
     56   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zmsk00, zmsk15 
    5157   !!---------------------------------------------------------------------- 
    5258   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    119125      REAL(wp) ::   ecc2, z1_ecc2                                       ! square of yield ellipse eccenticity 
    120126      REAL(wp) ::   zalph1, z1_alph1, zalph2, z1_alph2                  ! alpha coef from Bouillon 2009 or Kimmritz 2017 
     127      REAl(wp) ::   zbetau, zbetav 
    121128      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV, zvU, zvV             ! ice/snow mass and volume 
    122129      REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2       ! temporary scalars 
    … …  
    125132      REAL(wp) ::   zvCr                                                ! critical ice volume above which ice is landfast 
    126133      ! 
    127       REAL(wp) ::   zresm                                               ! Maximal error on ice velocity 
    128134      REAL(wp) ::   zintb, zintn                                        ! dummy argument 
    129135      REAL(wp) ::   zfac_x, zfac_y 
    … …  
    141147      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear 
    142148      REAL(wp), DIMENSION(jpi,jpj) ::   zs1, zs2, zs12                  ! stress tensor components 
    143 !!$      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice, zresr           ! check convergence 
    144149      REAL(wp), DIMENSION(jpi,jpj) ::   zsshdyn                         ! array used for the calculation of ice surface slope: 
    145150      !                                                                 !    ocean surface (ssh_m) if ice is not embedded 
    … …  
    160165      REAL(wp), PARAMETER          ::   zmmin  = 1._wp                  ! ice mass (kg/m2)  below which ice velocity becomes very small 
    161166      REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small 
     167      !! --- check convergence 
     168      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice 
    162169      !! --- diags 
    163       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00 
    164170      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig1, zsig2, zsig3 
    165171      !! --- SIMIP diags 
    … …  
    174180      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology' 
    175181      ! 
    176 !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
     182      ! for diagnostics and convergence tests 
     183      ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
     184      DO jj = 1, jpj 
     185         DO ji = 1, jpi 
     186            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     187            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     188         END DO 
     189      END DO 
     190      ! 
     191      !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
    177192      !------------------------------------------------------------------------------! 
    178193      ! 0) mask at F points for the ice 
    … …  
    222237      z1_ecc2 = 1._wp / ecc2 
    223238 
    224       ! Time step for subcycling 
    225       zdtevp   = rdt_ice / REAL( nn_nevp ) 
    226       z1_dtevp = 1._wp / zdtevp 
    227  
    228239      ! alpha parameters (Bouillon 2009) 
    229240      IF( .NOT. ln_aEVP ) THEN 
    230          zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp 
     241         zdtevp   = rdt_ice / REAL( nn_nevp ) 
     242         zalph1 =   2._wp * rn_relast * REAL( nn_nevp ) 
    231243         zalph2 = zalph1 * z1_ecc2 
    232244 
    233245         z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 
    234246         z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
     247      ELSE 
     248         zdtevp   = rdt_ice 
     249         ! zalpha parameters set later on adaptatively 
    235250      ENDIF 
     251      z1_dtevp = 1._wp / zdtevp 
    236252          
    237253      ! Initialise stress tensor  
    … …  
    244260 
    245261      ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 
    246       IF( ln_landfast_L16 ) THEN   ;   zkt = rn_tensile 
     262      IF( ln_landfast_L16 ) THEN   ;   zkt = rn_lf_tensile 
    247263      ELSE                         ;   zkt = 0._wp 
    248264      ENDIF 
    … …  
    315331               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) 
    316332               ! ice-bottom stress at U points 
    317                zvCr = zaU(ji,jj) * rn_depfra * hu_n(ji,jj) 
    318                ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
     333               zvCr = zaU(ji,jj) * rn_lf_depfra * hu_n(ji,jj) 
     334               ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
    319335               ! ice-bottom stress at V points 
    320                zvCr = zaV(ji,jj) * rn_depfra * hv_n(ji,jj) 
    321                ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
     336               zvCr = zaV(ji,jj) * rn_lf_depfra * hv_n(ji,jj) 
     337               ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
    322338               ! ice_bottom stress at T points 
    323                zvCr = at_i(ji,jj) * rn_depfra * ht_n(ji,jj) 
    324                tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
     339               zvCr = at_i(ji,jj) * rn_lf_depfra * ht_n(ji,jj) 
     340               tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    325341            END DO 
    326342         END DO 
    … …  
    345361         l_full_nf_update = jter == nn_nevp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 
    346362         ! 
    347 !!$         IF(ln_ctl) THEN   ! Convergence test 
    348 !!$            DO jj = 1, jpjm1 
    349 !!$               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 
    350 !!$               zv_ice(:,jj) = v_ice(:,jj) 
    351 !!$            END DO 
    352 !!$         ENDIF 
     363         ! convergence test 
     364         IF( ln_rhg_chkcvg ) THEN 
     365            DO jj = 1, jpj 
     366               DO ji = 1, jpi 
     367                  zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 
     368                  zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 
     369               END DO 
     370            END DO 
     371         ENDIF 
    353372 
    354373         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    … …  
    391410               zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 
    392411 
    393                ! alpha & beta for aEVP 
     412               ! alpha for aEVP 
    394413               !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 
    395414               !   alpha = beta = sqrt(4*gamma) 
    … …  
    399418                  zalph2   = zalph1 
    400419                  z1_alph2 = z1_alph1 
     420                  ! explicit: 
     421                  ! z1_alph1 = 1._wp / zalph1 
     422                  ! z1_alph2 = 1._wp / zalph1 
     423                  ! zalph1 = zalph1 - 1._wp 
     424                  ! zalph2 = zalph1 
    401425               ENDIF 
    402426                
    … …  
    409433         CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. ) 
    410434 
     435         ! Save beta at T-points for further computations 
     436         IF( ln_aEVP ) THEN 
     437            DO jj = 1, jpj 
     438               DO ji = 1, jpi 
     439                  zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
     440               END DO 
     441            END DO 
     442         ENDIF 
     443          
    411444         DO jj = 1, jpjm1 
    412445            DO ji = 1, jpim1 
    413446 
    414                ! alpha & beta for aEVP 
     447               ! alpha for aEVP 
    415448               IF( ln_aEVP ) THEN 
    416                   zalph2   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
     449                  zalph2   = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 
    417450                  z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
    418                   zbeta(ji,jj) = zalph2 
     451                  ! explicit: 
     452                  ! z1_alph2 = 1._wp / zalph2 
     453                  ! zalph2 = zalph2 - 1._wp 
    419454               ENDIF 
    420455                
    … …  
    486521                  ! 
    487522                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    488                      v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
    489                         &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    490                         &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    491                         &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    492                         &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     523                     zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
     524                     v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     525                        &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     526                        &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     527                        &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &  
     528                        &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     529                        &                                    ) / ( zbetav + 1._wp )                                              & 
     530                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    493531                        &           )   * zmsk00y(ji,jj) 
    494532                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    495                      v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
    496                         &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    497                         &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    498                         &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    499                         &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    500                         &            )   * zmsk00y(ji,jj) 
     533                     v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
     534                        &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     535                        &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     536                        &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     537                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     538                        &            )  * zmsk00y(ji,jj) 
    501539                  ENDIF 
    502540               END DO 
    … …  
    537575                  ! 
    538576                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    539                      u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
    540                         &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    541                         &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    542                         &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    543                         &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     577                     zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
     578                     u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     579                        &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     580                        &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     581                        &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
     582                        &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     583                        &                                    ) / ( zbetau + 1._wp )                                              & 
     584                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    544585                        &           )   * zmsk00x(ji,jj) 
    545586                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    546                      u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
    547                         &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    548                         &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    549                         &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    550                         &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    551                         &            )   * zmsk00x(ji,jj) 
     587                     u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
     588                        &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     589                        &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     590                        &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     591                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     592                        &           )   * zmsk00x(ji,jj) 
    552593                  ENDIF 
    553594               END DO 
    … …  
    590631                  ! 
    591632                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    592                      u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
    593                         &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    594                         &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    595                         &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    596                         &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     633                     zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
     634                     u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     635                        &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     636                        &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     637                        &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
     638                        &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     639                        &                                    ) / ( zbetau + 1._wp )                                              & 
     640                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    597641                        &           )   * zmsk00x(ji,jj) 
    598642                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    599                      u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
    600                         &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    601                         &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    602                         &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    603                         &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    604                         &            )   * zmsk00x(ji,jj) 
     643                     u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
     644                        &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     645                        &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     646                        &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     647                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     648                        &           )   * zmsk00x(ji,jj) 
    605649                  ENDIF 
    606650               END DO 
    … …  
    641685                  ! 
    642686                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    643                      v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
    644                         &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    645                         &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    646                         &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    647                         &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     687                     zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
     688                     v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     689                        &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     690                        &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     691                        &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
     692                        &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     693                        &                                    ) / ( zbetav + 1._wp )                                              &  
     694                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    648695                        &           )   * zmsk00y(ji,jj) 
    649696                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    650                      v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
    651                         &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    652                         &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    653                         &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    654                         &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    655                         &            )   * zmsk00y(ji,jj) 
     697                     v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
     698                        &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     699                        &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     700                        &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     701                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     702                        &           )   * zmsk00y(ji,jj) 
    656703                  ENDIF 
    657704               END DO 
    … …  
    667714         ENDIF 
    668715 
    669 !!$         IF(ln_ctl) THEN   ! Convergence test 
    670 !!$            DO jj = 2 , jpjm1 
    671 !!$               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    672 !!$            END DO 
    673 !!$            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 
    674 !!$            CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
    675 !!$         ENDIF 
     716         ! convergence test 
     717         IF( ln_rhg_chkcvg )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
    676718         ! 
    677719         !                                                ! ==================== ! 
    678720      END DO                                              !  end loop over jter  ! 
    679721      !                                                   ! ==================== ! 
     722      IF( ln_aEVP )   CALL iom_put( 'beta_evp' , zbeta ) 
    680723      ! 
    681724      !------------------------------------------------------------------------------! 
    … …  
    734777      ! 5) diagnostics 
    735778      !------------------------------------------------------------------------------! 
    736       DO jj = 1, jpj 
    737          DO ji = 1, jpi 
    738             zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
    739          END DO 
    740       END DO 
    741  
    742779      ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 
    743780      IF(  iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & 
    … …  
    796833         DEALLOCATE( zsig1 , zsig2 , zsig3 ) 
    797834      ENDIF 
    798        
     835 
    799836      ! --- SIMIP --- ! 
    800837      IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & 
    … …  
    852889      ENDIF 
    853890      ! 
     891      ! --- convergence tests --- ! 
     892      IF( ln_rhg_chkcvg ) THEN 
     893         IF( iom_use('uice_cvg') ) THEN 
     894            IF( ln_aEVP ) THEN   ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
     895               CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 
     896                  &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 
     897            ELSE                 ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
     898               CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 
     899                  &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 
     900            ENDIF 
     901         ENDIF 
     902      ENDIF       
     903      ! 
     904      DEALLOCATE( zmsk00, zmsk15 ) 
     905      ! 
    854906   END SUBROUTINE ice_dyn_rhg_evp 
     907 
     908 
     909   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     910      !!---------------------------------------------------------------------- 
     911      !!                    ***  ROUTINE rhg_cvg  *** 
     912      !!                      
     913      !! ** Purpose :   check convergence of oce rheology 
     914      !! 
     915      !! ** Method  :   create a file ice_cvg.nc containing the convergence of ice velocity 
     916      !!                during the sub timestepping of rheology so as: 
     917      !!                  uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) ) 
     918      !!                This routine is called every sub-iteration, so it is cpu expensive 
     919      !! 
     920      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)    
     921      !!---------------------------------------------------------------------- 
     922      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
     923      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     924      !! 
     925      INTEGER           ::   it, idtime, istatus 
     926      INTEGER           ::   ji, jj          ! dummy loop indices 
     927      REAL(wp)          ::   zresm           ! local real  
     928      CHARACTER(len=20) ::   clname 
     929      REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence 
     930      !!---------------------------------------------------------------------- 
     931 
     932      ! create file 
     933      IF( kt == nit000 .AND. kiter == 1 ) THEN 
     934         ! 
     935         IF( lwp ) THEN 
     936            WRITE(numout,*) 
     937            WRITE(numout,*) 'rhg_cvg : ice rheology convergence control' 
     938            WRITE(numout,*) '~~~~~~~' 
     939         ENDIF 
     940         ! 
     941         IF( lwm ) THEN 
     942            clname = 'ice_cvg.nc' 
     943            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     944            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid ) 
     945            istatus = NF90_DEF_DIM( ncvgid, 'time'  , NF90_UNLIMITED, idtime ) 
     946            istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE   , (/ idtime /), nvarid ) 
     947            istatus = NF90_ENDDEF(ncvgid) 
     948         ENDIF 
     949         ! 
     950      ENDIF 
     951 
     952      ! time 
     953      it = ( kt - 1 ) * kitermax + kiter 
     954       
     955      ! convergence 
     956      IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large) 
     957         zresm = 0._wp 
     958      ELSE 
     959         DO jj = 1, jpj 
     960            DO ji = 1, jpi 
     961               zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     962                  &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 
     963            END DO 
     964         END DO 
     965         zresm = MAXVAL( zres ) 
     966         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
     967      ENDIF 
     968 
     969      IF( lwm ) THEN 
     970         ! write variables 
     971         istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) ) 
     972         ! close file 
     973         IF( kt == nitend )   istatus = NF90_CLOSE(ncvgid) 
     974      ENDIF 
     975       
     976   END SUBROUTINE rhg_cvg 
    855977 
    856978 
    … …  
    9101032   END SUBROUTINE rhg_evp_rst 
    9111033 
     1034    
    9121035#else 
    9131036   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceistate.F90

    r12735 r13466  
    4141   !                             !! ** namelist (namini) ** 
    4242   LOGICAL, PUBLIC  ::   ln_iceini        !: Ice initialization or not 
    43    LOGICAL, PUBLIC  ::   ln_iceini_file   !: Ice initialization from 2D netcdf file 
     43   INTEGER, PUBLIC  ::   nn_iceini_file   !: Ice initialization: 
     44                                  !        0 = Initialise sea ice based on SSTs 
     45                                  !        1 = Initialise sea ice from single category netcdf file 
     46                                  !        2 = Initialise sea ice from multi category restart file 
    4447   REAL(wp) ::   rn_thres_sst 
    4548   REAL(wp) ::   rn_hti_ini_n, rn_hts_ini_n, rn_ati_ini_n, rn_smi_ini_n, rn_tmi_ini_n, rn_tsu_ini_n, rn_tms_ini_n 
    4649   REAL(wp) ::   rn_hti_ini_s, rn_hts_ini_s, rn_ati_ini_s, rn_smi_ini_s, rn_tmi_ini_s, rn_tsu_ini_s, rn_tms_ini_s 
    47    REAL(wp) ::   rn_apd_ini_n, rn_hpd_ini_n 
    48    REAL(wp) ::   rn_apd_ini_s, rn_hpd_ini_s 
     50   REAL(wp) ::   rn_apd_ini_n, rn_hpd_ini_n, rn_hld_ini_n 
     51   REAL(wp) ::   rn_apd_ini_s, rn_hpd_ini_s, rn_hld_ini_s 
    4952   ! 
    50    !                              ! if ln_iceini_file = T 
    51    INTEGER , PARAMETER ::   jpfldi = 9           ! maximum number of files to read 
     53   !                              ! if nn_iceini_file = 1 
     54   INTEGER , PARAMETER ::   jpfldi = 10          ! maximum number of files to read 
    5255   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness    (m) 
    5356   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snw thickness    (m) 
    … …  
    5962   INTEGER , PARAMETER ::   jp_apd = 8           ! index of pnd fraction     (-) 
    6063   INTEGER , PARAMETER ::   jp_hpd = 9           ! index of pnd depth        (m) 
     64   INTEGER , PARAMETER ::   jp_hld = 10          ! index of pnd lid depth    (m) 
    6165   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    6266   !    
    … …  
    8185      !! ** Steps   :   1) Set initial surface and basal temperatures 
    8286      !!                2) Recompute or read sea ice state variables 
    83       !!                3) Fill in the ice thickness distribution using gaussian 
    84       !!                4) Fill in space-dependent arrays for state variables 
    85       !!                5) snow-ice mass computation 
    86       !!                6) store before fields 
     87      !!                3) Fill in space-dependent arrays for state variables 
     88      !!                4) snow-ice mass computation 
    8789      !! 
    8890      !! ** Notes   : o_i, t_su, t_s, t_i, sz_i must be filled everywhere, even 
    … …  
    98100      REAL(wp), DIMENSION(jpi,jpj)     ::   zht_i_ini, zat_i_ini, ztm_s_ini            !data from namelist or nc file 
    99101      REAL(wp), DIMENSION(jpi,jpj)     ::   zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
    100       REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini                       !data from namelist or nc file 
     102      REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini, zhlid_ini            !data from namelist or nc file 
    101103      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !temporary arrays 
    102104      !! 
    103       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 
     105      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d 
    104106      !-------------------------------------------------------------------- 
    105107 
    … …  
    155157      a_ip     (:,:,:) = 0._wp 
    156158      v_ip     (:,:,:) = 0._wp 
    157       a_ip_frac(:,:,:) = 0._wp 
     159      v_il     (:,:,:) = 0._wp 
     160      a_ip_eff (:,:,:) = 0._wp 
    158161      h_ip     (:,:,:) = 0._wp 
     162      h_il     (:,:,:) = 0._wp 
    159163      ! 
    160164      ! ice velocities 
    … …  
    167171      IF( ln_iceini ) THEN 
    168172         !                             !---------------! 
    169          IF( ln_iceini_file )THEN      ! Read a file   ! 
     173         IF( nn_iceini_file == 1 )THEN ! Read a file   ! 
    170174            !                          !---------------! 
    171175            WHERE( ff_t(:,:) >= 0._wp )   ;   zswitch(:,:) = 1._wp 
    … …  
    193197               si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    194198               si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    195             ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 
    196                si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 
    197             ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 
    198                si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 
    199             ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s 
    200                si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 
    201             ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i 
    202                si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
    203             ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su 
    204                si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 
    205             ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i 
    206                si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
    207199            ENDIF 
     200            IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) & ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 
     201               &     si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 
     202            IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) & ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 
     203               &     si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 
     204            IF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) & ! if T_s is read and not T_su, set T_su = T_s 
     205               &     si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 
     206            IF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) & ! if T_i is read and not T_su, set T_su = T_i 
     207               &     si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
     208            IF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) & ! if T_su is read and not T_s, set T_s = T_su 
     209               &     si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 
     210            IF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) & ! if T_i is read and not T_s, set T_s = T_i 
     211               &     si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
    208212            ! 
    209213            ! pond concentration 
    … …  
    215219            IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 
    216220               &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     221            ! 
     222            ! pond lid depth 
     223            IF( TRIM(si(jp_hld)%clrootname) == 'NOT USED' ) & 
     224               &     si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zswitch + rn_hld_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    217225            ! 
    218226            zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 
    … …  
    222230            zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 
    223231            zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 
     232            zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * tmask(:,:,1) 
    224233            ! 
    225234            ! change the switch for the following 
    … …  
    246255               zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
    247256               zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
     257               zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:) 
    248258            ELSEWHERE 
    249259               zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 
    … …  
    256266               zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
    257267               zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
     268               zhlid_ini(:,:) = rn_hld_ini_s * zswitch(:,:) 
    258269            END WHERE 
    259270            ! 
    … …  
    264275            zapnd_ini(:,:) = 0._wp 
    265276            zhpnd_ini(:,:) = 0._wp 
     277            zhlid_ini(:,:) = 0._wp 
     278         ENDIF 
     279 
     280         IF ( .NOT.ln_pnd_lids ) THEN 
     281            zhlid_ini(:,:) = 0._wp 
    266282         ENDIF 
    267283          
    268          !-------------! 
    269          ! fill fields ! 
    270          !-------------! 
     284         !----------------! 
     285         ! 3) fill fields ! 
     286         !----------------! 
    271287         ! select ice covered grid points 
    272288         npti = 0 ; nptidx(:) = 0 
    … …  
    290306         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
    291307         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
     308         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti)  , zhlid_ini ) 
    292309 
    293310         ! allocate temporary arrays 
    294          ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 
    295             &      zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 
     311         ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), & 
     312            &      zti_2d (npti,jpl), zts_2d (npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), & 
     313            &      zaip_2d(npti,jpl), zhip_2d(npti,jpl), zhil_2d(npti,jpl) ) 
    296314          
    297315         ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 
    298          CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                                                   & 
    299             &              zhi_2d          , zhs_2d          , zai_2d         ,                                                   & 
    300             &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 
    301             &              zti_2d          , zts_2d          , ztsu_2d        , zsi_2d        , zaip_2d        , zhip_2d ) 
     316         CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                  & 
     317            &              zhi_2d          , zhs_2d          , zai_2d         ,                  & 
     318            &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti),                  & 
     319            &              s_i_1d(1:npti)  , a_ip_1d(1:npti) , h_ip_1d(1:npti), h_il_1d(1:npti), & 
     320            &              zti_2d          , zts_2d          , ztsu_2d        ,                  & 
     321            &              zsi_2d          , zaip_2d         , zhip_2d        , zhil_2d ) 
    302322 
    303323         ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
    … …  
    315335         CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
    316336         CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d  , h_ip   ) 
     337         CALL tab_2d_3d( npti, nptidx(1:npti), zhil_2d  , h_il   ) 
    317338 
    318339         ! deallocate temporary arrays 
    319340         DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
    320             &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 
     341            &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d ) 
    321342 
    322343         ! calculate extensive and intensive variables 
    … …  
    360381 
    361382         ! Melt ponds 
    362          WHERE( a_i > epsi10 ) 
    363             a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
    364          ELSEWHERE 
    365             a_ip_frac(:,:,:) = 0._wp 
     383         WHERE( a_i > epsi10 )   ;   a_ip_eff(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
     384         ELSEWHERE               ;   a_ip_eff(:,:,:) = 0._wp 
    366385         END WHERE 
    367386         v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     387         v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
    368388           
    369389         ! specific temperatures for coupled runs 
    … …  
    371391         t1_ice(:,:,:) = t_i (:,:,1,:) 
    372392         ! 
     393         ! ice concentration should not exceed amax 
     394         at_i(:,:) = SUM( a_i, dim=3 ) 
     395         DO jl = 1, jpl 
     396            WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 
     397         END DO 
     398         at_i(:,:) = SUM( a_i, dim=3 ) 
     399         ! 
    373400      ENDIF ! ln_iceini 
    374401      ! 
    375       at_i(:,:) = SUM( a_i, dim=3 ) 
    376       ! 
    377402      !---------------------------------------------- 
    378       ! 3) Snow-ice mass (case ice is fully embedded) 
     403      ! 4) Snow-ice mass (case ice is fully embedded) 
    379404      !---------------------------------------------- 
    380405      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3  )   ! snow+ice mass 
    … …  
    426451         ENDIF 
    427452      ENDIF 
    428        
    429       !------------------------------------ 
    430       ! 4) store fields at before time-step 
    431       !------------------------------------ 
    432       ! it is only necessary for the 1st interpolation by Agrif 
    433       a_i_b  (:,:,:)   = a_i  (:,:,:) 
    434       e_i_b  (:,:,:,:) = e_i  (:,:,:,:) 
    435       v_i_b  (:,:,:)   = v_i  (:,:,:) 
    436       v_s_b  (:,:,:)   = v_s  (:,:,:) 
    437       e_s_b  (:,:,:,:) = e_s  (:,:,:,:) 
    438       sv_i_b (:,:,:)   = sv_i (:,:,:) 
    439       oa_i_b (:,:,:)   = oa_i (:,:,:) 
    440       u_ice_b(:,:)     = u_ice(:,:) 
    441       v_ice_b(:,:)     = v_ice(:,:) 
    442       ! total concentration is needed for Lupkes parameterizations 
    443       at_i_b (:,:)     = at_i (:,:)  
    444453 
    445454!!clem: output of initial state should be written here but it is impossible because 
    … …  
    466475      ! 
    467476      CHARACTER(len=256) ::  cn_dir          ! Root directory for location of ice files 
    468       TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd 
     477      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd, sn_hld 
    469478      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read 
    470479      ! 
    471       NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, & 
     480      NAMELIST/namini/ ln_iceini, nn_iceini_file, rn_thres_sst, & 
    472481         &             rn_hti_ini_n, rn_hti_ini_s, rn_hts_ini_n, rn_hts_ini_s, & 
    473482         &             rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, & 
    474483         &             rn_tmi_ini_n, rn_tmi_ini_s, rn_tsu_ini_n, rn_tsu_ini_s, rn_tms_ini_n, rn_tms_ini_s, & 
    475          &             rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, & 
    476          &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, cn_dir 
     484         &             rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, rn_hld_ini_n, rn_hld_ini_s, & 
     485         &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, sn_hld, cn_dir 
    477486      !!----------------------------------------------------------------------------- 
    478487      ! 
    … …  
    488497      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_smi) = sn_smi 
    489498      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_tsu) = sn_tsu   ;   slf_i(jp_tms) = sn_tms 
    490       slf_i(jp_apd) = sn_apd  ;  slf_i(jp_hpd) = sn_hpd 
     499      slf_i(jp_apd) = sn_apd  ;  slf_i(jp_hpd) = sn_hpd   ;   slf_i(jp_hld) = sn_hld 
    491500      ! 
    492501      IF(lwp) THEN                          ! control print 
    … …  
    496505         WRITE(numout,*) '   Namelist namini:' 
    497506         WRITE(numout,*) '      ice initialization (T) or not (F)                ln_iceini      = ', ln_iceini 
    498          WRITE(numout,*) '      ice initialization from a netcdf file            ln_iceini_file = ', ln_iceini_file 
     507         WRITE(numout,*) '      ice initialization from a netcdf file            nn_iceini_file = ', nn_iceini_file 
    499508         WRITE(numout,*) '      max ocean temp. above Tfreeze with initial ice   rn_thres_sst   = ', rn_thres_sst 
    500          IF( ln_iceini .AND. .NOT.ln_iceini_file ) THEN 
     509         IF( ln_iceini .AND. nn_iceini_file == 0 ) THEN 
    501510            WRITE(numout,*) '      initial snw thickness in the north-south         rn_hts_ini     = ', rn_hts_ini_n,rn_hts_ini_s  
    502511            WRITE(numout,*) '      initial ice thickness in the north-south         rn_hti_ini     = ', rn_hti_ini_n,rn_hti_ini_s 
    … …  
    508517            WRITE(numout,*) '      initial pnd fraction  in the north-south         rn_apd_ini     = ', rn_apd_ini_n,rn_apd_ini_s 
    509518            WRITE(numout,*) '      initial pnd depth     in the north-south         rn_hpd_ini     = ', rn_hpd_ini_n,rn_hpd_ini_s 
     519            WRITE(numout,*) '      initial pnd lid depth in the north-south         rn_hld_ini     = ', rn_hld_ini_n,rn_hld_ini_s 
    510520         ENDIF 
    511521      ENDIF 
    512522      ! 
    513       IF( ln_iceini_file ) THEN                      ! Ice initialization using input file 
     523      IF( nn_iceini_file == 1 ) THEN                      ! Ice initialization using input file 
    514524         ! 
    515525         ! set si structure 
    … …  
    532542         rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 
    533543         rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 
    534          CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 when no ponds' ) 
     544         rn_hld_ini_n = 0. ; rn_hld_ini_s = 0. 
     545         CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 & rn_hld_ini = 0 when no ponds' ) 
     546      ENDIF 
     547      ! 
     548      IF( .NOT.ln_pnd_lids ) THEN 
     549         rn_hld_ini_n = 0. ; rn_hld_ini_s = 0. 
    535550      ENDIF 
    536551      ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceitd.F90

    r11732 r13466  
    4747   LOGICAL                    ::   ln_cat_usr   ! ice categories are defined by rn_catbnd 
    4848   REAL(wp), DIMENSION(0:100) ::   rn_catbnd    ! ice categories bounds 
     49   REAL(wp)                   ::   rn_himax     ! maximum ice thickness allowed 
    4950   ! 
    5051   !!---------------------------------------------------------------------- 
    … …  
    304305            IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 
    305306               a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin  
    306                IF( ln_pnd_H12 )   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
     307               IF( ln_pnd_LEV )   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
    307308               h_i_1d(ji) = rn_himin 
    308309            ENDIF 
    … …  
    410411      CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    411412      CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 
     413      CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 
    412414      CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    413415      DO jl = 1, jpl 
    … …  
    474476               zaTsfn(ji,jl2)  = zaTsfn(ji,jl2) + ztrans 
    475477               !   
    476                IF ( ln_pnd_H12 ) THEN 
     478               IF ( ln_pnd_LEV ) THEN 
    477479                  ztrans          = a_ip_2d(ji,jl1) * zworka(ji)     ! Pond fraction 
    478480                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans 
    … …  
    482484                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 
    483485                  v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 
     486                  ! 
     487                  IF ( ln_pnd_lids ) THEN                            ! Pond lid volume 
     488                     ztrans          = v_il_2d(ji,jl1) * zworka(ji) 
     489                     v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 
     490                     v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans 
     491                  ENDIF 
    484492               ENDIF 
    485493               ! 
    … …  
    526534      ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 
    527535      !       because of truncation error ( i.e. 1. - 1. /= 0 ) 
    528       CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, ze_s_2d, ze_i_2d ) 
     536      CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, ze_s_2d, ze_i_2d ) 
    529537 
    530538      ! at_i must be <= rn_amax 
    … …  
    554562      CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    555563      CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 
     564      CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 
    556565      CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    557566      DO jl = 1, jpl 
    … …  
    683692      REAL(wp) ::   zhmax, znum, zden, zalpha   !   -      - 
    684693      ! 
    685       NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin 
     694      NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin, rn_himax 
    686695      !!------------------------------------------------------------------ 
    687696      ! 
    … …  
    702711         WRITE(numout,*) '         mean ice thickness in the domain                               rn_himean  = ', rn_himean 
    703712         WRITE(numout,*) '      Ice categories are defined by rn_catbnd                           ln_cat_usr = ', ln_cat_usr 
    704          WRITE(numout,*) '      minimum ice thickness                                             rn_himin   = ', rn_himin  
     713         WRITE(numout,*) '      minimum ice thickness allowed                                     rn_himin   = ', rn_himin  
     714         WRITE(numout,*) '      maximum ice thickness allowed                                     rn_himax   = ', rn_himax  
    705715      ENDIF 
    706716      ! 
    … …  
    739749      END DO 
    740750      ! 
    741       hi_max(jpl) = 99._wp          ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 
     751      hi_max(jpl) = rn_himax        ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 
    742752      ! 
    743753      IF(lwp) WRITE(numout,*) 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icerst.F90

    r11536 r13466  
    132132      CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip  ) 
    133133      CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip  ) 
     134      CALL iom_rstput( iter, nitrst, numriw, 'v_il' , v_il  ) 
    134135      ! Snow enthalpy 
    135136      DO jk = 1, nlay_s  
    … …  
    171172      INTEGER           ::   jk 
    172173      LOGICAL           ::   llok 
    173       INTEGER           ::   id0, id1, id2, id3, id4   ! local integer 
     174      INTEGER           ::   id0, id1, id2, id3, id4, id5   ! local integer 
    174175      CHARACTER(len=25) ::   znam 
    175176      CHARACTER(len=2)  ::   zchar, zchar1 
    … …  
    250251            v_ip(:,:,:) = 0._wp 
    251252         ENDIF 
     253         ! melt pond lids 
     254         id3 = iom_varid( numrir, 'v_il' , ldstop = .FALSE. ) 
     255         IF( id3 > 0 ) THEN 
     256            CALL iom_get( numrir, jpdom_autoglo, 'v_il', v_il) 
     257         ELSE 
     258            IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds lids output then set it to zero' 
     259            v_il(:,:,:) = 0._wp 
     260         ENDIF 
    252261         ! fields needed for Met Office (Jules) coupling 
    253262         IF( ln_cpl ) THEN 
    254             id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
    255             id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
    256             IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist 
     263            id4 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
     264            id5 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
     265            IF( id4 > 0 .AND. id5 > 0 ) THEN         ! fields exist 
    257266               CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice ) 
    258267               CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice  ) 
    … …  
    274283         CALL ice_istate( nit000 ) 
    275284         ! 
    276          IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 
    277             &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 
     285         IF( .NOT.ln_iceini .OR. nn_iceini_file == 0 ) & 
     286            &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and nn_iceini_file=0') 
    278287         ! 
    279288      ENDIF 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icesbc.F90

    r11575 r13466  
    116116      INTEGER  ::   ji, jj, jl      ! dummy loop index 
    117117      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
    118       REAL(wp), DIMENSION(jpi,jpj,jpl)              ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    119       REAL(wp), DIMENSION(:,:)        , ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
     118      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
    120119      !!-------------------------------------------------------------------- 
    121120      ! 
    … …  
    131130      CALL iom_miss_val( "icetemp", zmiss_val ) 
    132131 
    133       ! --- cloud-sky and overcast-sky ice albedos --- ! 
    134       CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_frac, h_ip, zalb_cs, zalb_os ) 
    135  
    136       ! albedo depends on cloud fraction because of non-linear spectral effects 
    137 !!gm cldf_ice is a real, DOCTOR naming rule: start with cd means CHARACTER passed in argument ! 
    138       alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    139       ! 
     132      ! --- ice albedo --- ! 
     133      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) 
     134 
    140135      ! 
    141136      SELECT CASE( ksbc )   !== fluxes over sea ice ==! 
    … …  
    281276      INTEGER ::   ios, ioptio   ! Local integer 
    282277      !! 
    283       NAMELIST/namsbc/ rn_cio, rn_blow_s, nn_flxdist, ln_cndflx, ln_cndemulate 
     278      NAMELIST/namsbc/ rn_cio, nn_snwfra, rn_snwblow, nn_flxdist, ln_cndflx, ln_cndemulate, nn_qtrice 
    284279      !!------------------------------------------------------------------- 
    285280      ! 
    … …  
    297292         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    298293         WRITE(numout,*) '   Namelist namsbc:' 
    299          WRITE(numout,*) '      drag coefficient for oceanic stress              rn_cio        = ', rn_cio 
    300          WRITE(numout,*) '      coefficient for ice-lead partition of snowfall   rn_blow_s     = ', rn_blow_s 
    301          WRITE(numout,*) '      Multicategory heat flux formulation              nn_flxdist    = ', nn_flxdist 
    302          WRITE(numout,*) '      Use conduction flux as surface condition         ln_cndflx     = ', ln_cndflx 
    303          WRITE(numout,*) '         emulate conduction flux                       ln_cndemulate = ', ln_cndemulate 
     294         WRITE(numout,*) '      drag coefficient for oceanic stress                       rn_cio        = ', rn_cio 
     295         WRITE(numout,*) '      fraction of ice covered by snow (options 0,1,2)           nn_snwfra     = ', nn_snwfra 
     296         WRITE(numout,*) '      coefficient for ice-lead partition of snowfall            rn_snwblow    = ', rn_snwblow 
     297         WRITE(numout,*) '      Multicategory heat flux formulation                       nn_flxdist    = ', nn_flxdist 
     298         WRITE(numout,*) '      Use conduction flux as surface condition                  ln_cndflx     = ', ln_cndflx 
     299         WRITE(numout,*) '         emulate conduction flux                                ln_cndemulate = ', ln_cndemulate 
     300         WRITE(numout,*) '      solar flux transmitted thru the surface scattering layer  nn_qtrice     = ', nn_qtrice 
     301         WRITE(numout,*) '         = 0  Grenfell and Maykut 1977' 
     302         WRITE(numout,*) '         = 1  Lebrun 2019' 
    304303      ENDIF 
    305304      ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icestp.F90

    r11536 r13466  
    202202         IF( lrst_ice )                 CALL ice_rst_write( kt )      ! -- Ice restart file  
    203203         ! 
    204          IF( ln_icectl )                CALL ice_ctl( kt )            ! -- alerts in case of model crash 
     204         IF( ln_icectl )                CALL ice_ctl( kt )            ! -- Control checks 
    205205         ! 
    206206      ENDIF   ! End sea-ice time step only 
    … …  
    223223      !! ** purpose :   Initialize sea-ice parameters 
    224224      !!---------------------------------------------------------------------- 
    225       INTEGER :: ji, jj, ierr 
     225      INTEGER :: jl, ierr 
    226226      !!---------------------------------------------------------------------- 
    227227      IF(lwp) WRITE(numout,*) 
    … …  
    247247      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays') 
    248248      ! 
    249       CALL ice_itd_init                ! ice thickness distribution initialization 
    250       ! 
    251       CALL ice_thd_init                ! set ice thermodynics parameters (clem: important to call it first for melt ponds) 
    252       ! 
    253       !                                ! Initial sea-ice state 
    254       IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst 
    255          CALL ice_istate_init 
    256          CALL ice_istate( nit000 ) 
    257       ELSE                                    ! start from a restart file 
    258          CALL ice_rst_read 
    259       ENDIF 
    260       CALL ice_var_glo2eqv 
    261       CALL ice_var_agg(1) 
    262       ! 
    263       CALL ice_sbc_init                ! set ice-ocean and ice-atm. coupling parameters 
    264       ! 
    265       CALL ice_dyn_init                ! set ice dynamics parameters 
    266       ! 
    267       CALL ice_update_init             ! ice surface boundary condition 
    268       ! 
    269       CALL ice_alb_init                ! ice surface albedo 
    270       ! 
    271       CALL ice_dia_init                ! initialization for diags 
    272       ! 
    273       fr_i  (:,:)   = at_i(:,:)        ! initialisation of sea-ice fraction 
    274       tn_ice(:,:,:) = t_su(:,:,:)      ! initialisation of surface temp for coupled simu 
    275       ! 
    276249      !                                ! set max concentration in both hemispheres 
    277250      WHERE( gphit(:,:) > 0._wp )   ;   rn_amax_2d(:,:) = rn_amax_n  ! NH 
    278251      ELSEWHERE                     ;   rn_amax_2d(:,:) = rn_amax_s  ! SH 
    279252      END WHERE 
    280  
     253      ! 
     254      CALL ice_itd_init                ! ice thickness distribution initialization 
     255      ! 
     256      CALL ice_thd_init                ! set ice thermodynics parameters (clem: important to call it first for melt ponds) 
     257      ! 
     258      !                                ! Initial sea-ice state 
     259      IF ( ln_rstart .OR. nn_iceini_file == 2 ) THEN 
     260         CALL ice_rst_read                      ! start from a restart file 
     261      ELSE 
     262         CALL ice_istate_init 
     263         CALL ice_istate( nit000 )              ! start from rest or read a file 
     264      ENDIF 
     265      CALL ice_var_glo2eqv 
     266      CALL ice_var_agg(1) 
     267      ! 
     268      CALL ice_sbc_init                ! set ice-ocean and ice-atm. coupling parameters 
     269      ! 
     270      CALL ice_dyn_init                ! set ice dynamics parameters 
     271      ! 
     272      CALL ice_update_init             ! ice surface boundary condition 
     273      ! 
     274      CALL ice_alb_init                ! ice surface albedo 
     275      ! 
     276      CALL ice_dia_init                ! initialization for diags 
     277      ! 
     278      fr_i  (:,:)   = at_i(:,:)        ! initialisation of sea-ice fraction 
     279      tn_ice(:,:,:) = t_su(:,:,:)      ! initialisation of surface temp for coupled simu 
     280      ! 
    281281      IF( ln_rstart )   CALL iom_close( numrir )  ! close input ice restart file 
    282282      ! 
    … …  
    363363      v_s_b (:,:,:)   = v_s (:,:,:)     ! snow volume 
    364364      sv_i_b(:,:,:)   = sv_i(:,:,:)     ! salt content 
    365       oa_i_b(:,:,:)   = oa_i(:,:,:)     ! areal age content 
    366365      e_s_b (:,:,:,:) = e_s (:,:,:,:)   ! snow thermal energy 
    367366      e_i_b (:,:,:,:) = e_i (:,:,:,:)   ! ice thermal energy 
    … …  
    372371         h_i_b(:,:,:) = 0._wp 
    373372         h_s_b(:,:,:) = 0._wp 
    374       END WHERE 
    375        
    376       WHERE( a_ip(:,:,:) >= epsi20 ) 
    377          h_ip_b(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:)   ! ice pond thickness 
    378       ELSEWHERE 
    379          h_ip_b(:,:,:) = 0._wp 
    380373      END WHERE 
    381374      ! 
    … …  
    421414      hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
    422415      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
    423       hfx_err_rem(:,:) = 0._wp 
    424416      hfx_err_dif(:,:) = 0._wp 
    425417      wfx_err_sub(:,:) = 0._wp 
    … …  
    442434      diag_trp_ei(:,:) = 0._wp   ;   diag_trp_es(:,:) = 0._wp 
    443435      diag_trp_sv(:,:) = 0._wp 
    444  
     436       
    445437   END SUBROUTINE diag_set0 
    446438 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd.F90

    r11536 r13466  
    3535   ! 
    3636   USE in_out_manager ! I/O manager 
     37   USE iom            ! I/O manager library 
    3738   USE lib_mpp        ! MPP library 
    3839   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    … …  
    5152   LOGICAL ::   ln_icedO         ! activate ice growth in open-water (T) or not (F) 
    5253   LOGICAL ::   ln_icedS         ! activate gravity drainage and flushing (T) or not (F) 
     54   LOGICAL ::   ln_leadhfx       !  heat in the leads is used to melt sea-ice before warming the ocean 
     55 
     56   !! for convergence tests 
     57   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztice_cvgerr, ztice_cvgstp 
    5358 
    5459   !! * Substitutions 
    … …  
    102107         WRITE(numout,*) '~~~~~~~' 
    103108      ENDIF 
     109 
     110      ! convergence tests 
     111      IF( ln_zdf_chkcvg ) THEN 
     112         ALLOCATE( ztice_cvgerr(jpi,jpj,jpl) , ztice_cvgstp(jpi,jpj,jpl) ) 
     113         ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp 
     114      ENDIF 
    104115       
    105116      !---------------------------------------------! 
    … …  
    164175            ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 
    165176            IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 
    166                fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
     177               IF( ln_leadhfx ) THEN   ;   fhld(ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
     178               ELSE                    ;   fhld(ji,jj) = 0._wp 
     179               ENDIF 
    167180               qlead(ji,jj) = 0._wp 
    168181            ELSE 
    … …  
    216229            !                                                       ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 
    217230            ! 
    218             s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp  ! --- some init --- !  (important to have them here)  
     231            s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp   ! --- some init --- !  (important to have them here)  
    219232            dh_i_sum  (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm  (1:npti) = 0._wp  
    220233            dh_i_sub  (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp 
    … …  
    249262      ! 
    250263      IF( ln_icedO )          CALL ice_thd_do                       ! --- Frazil ice growth in leads --- ! 
     264      ! 
     265      ! convergence tests 
     266      IF( ln_zdf_chkcvg ) THEN 
     267         CALL iom_put( 'tice_cvgerr', ztice_cvgerr ) ; DEALLOCATE( ztice_cvgerr ) 
     268         CALL iom_put( 'tice_cvgstp', ztice_cvgstp ) ; DEALLOCATE( ztice_cvgstp ) 
     269      ENDIF 
    251270      ! 
    252271      ! controls 
    … …  
    354373         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    355374         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    356          CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
     375         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    357376         ! 
    358377         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d  (1:npti), qprec_ice            ) 
    … …  
    406425         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res       ) 
    407426         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif   ) 
    408          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem   ) 
    409427         CALL tab_2d_1d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai     ) 
    410428         ! 
    … …  
    441459         sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 
    442460         v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 
     461         v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti) 
    443462         oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 
    444463          
    … …  
    460479         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    461480         CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    462          CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
     481         CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    463482         ! 
    464483         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) 
    … …  
    498517         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res     ) 
    499518         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 
    500          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem ) 
    501519         CALL tab_1d_2d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai   ) 
    502520         ! 
    … …  
    515533         CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 
    516534         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 
     535         CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 
    517536         CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 
     537         ! check convergence of heat diffusion scheme 
     538         IF( ln_zdf_chkcvg ) THEN 
     539            CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgerr_1d(1:npti), ztice_cvgerr(:,:,kl) ) 
     540            CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgstp_1d(1:npti), ztice_cvgstp(:,:,kl) ) 
     541         ENDIF 
    518542         ! 
    519543      END SELECT 
    … …  
    536560      INTEGER  ::   ios   ! Local integer output status for namelist read 
    537561      !! 
    538       NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS 
     562      NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS, ln_leadhfx 
    539563      !!------------------------------------------------------------------- 
    540564      ! 
    … …  
    552576         WRITE(numout,*) '~~~~~~~~~~~~' 
    553577         WRITE(numout,*) '   Namelist namthd:' 
    554          WRITE(numout,*) '      activate ice thick change from top/bot (T) or not (F)   ln_icedH  = ', ln_icedH 
    555          WRITE(numout,*) '      activate lateral melting (T) or not (F)                 ln_icedA  = ', ln_icedA 
    556          WRITE(numout,*) '      activate ice growth in open-water (T) or not (F)        ln_icedO  = ', ln_icedO 
    557          WRITE(numout,*) '      activate gravity drainage and flushing (T) or not (F)   ln_icedS  = ', ln_icedS 
     578         WRITE(numout,*) '      activate ice thick change from top/bot (T) or not (F)                ln_icedH   = ', ln_icedH 
     579         WRITE(numout,*) '      activate lateral melting (T) or not (F)                              ln_icedA   = ', ln_icedA 
     580         WRITE(numout,*) '      activate ice growth in open-water (T) or not (F)                     ln_icedO   = ', ln_icedO 
     581         WRITE(numout,*) '      activate gravity drainage and flushing (T) or not (F)                ln_icedS   = ', ln_icedS 
     582         WRITE(numout,*) '      heat in the leads is used to melt sea-ice before warming the ocean   ln_leadhfx = ', ln_leadhfx 
    558583     ENDIF 
    559584      ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd_dh.F90

    r10786 r13466  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   ice_thd_dh        : vertical sea-ice growth and melt 
    15    !!   ice_thd_snwblow   : distribute snow fall between ice and ocean 
    16   !!---------------------------------------------------------------------- 
     15   !!---------------------------------------------------------------------- 
    1716   USE dom_oce        ! ocean space and time domain 
    1817   USE phycst         ! physical constants 
    … …  
    2019   USE ice1D          ! sea-ice: thermodynamics variables 
    2120   USE icethd_sal     ! sea-ice: salinity profiles 
     21   USE icevar         ! for CALL ice_var_snwblow 
    2222   ! 
    2323   USE in_out_manager ! I/O manager 
    … …  
    2929 
    3030   PUBLIC   ice_thd_dh        ! called by ice_thd 
    31    PUBLIC   ice_thd_snwblow   ! called in sbcblk/sbccpl and here 
    32  
    33    INTERFACE ice_thd_snwblow 
    34       MODULE PROCEDURE ice_thd_snwblow_1d, ice_thd_snwblow_2d 
    35    END INTERFACE 
    3631 
    3732   !!---------------------------------------------------------------------- 
    … …  
    186181      ! Snow precipitation 
    187182      !------------------- 
    188       CALL ice_thd_snwblow( 1. - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
     183      CALL ice_var_snwblow( 1. - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
    189184 
    190185      zdeltah(1:npti,:) = 0._wp 
    … …  
    636631   END SUBROUTINE ice_thd_dh 
    637632 
    638  
    639    !!-------------------------------------------------------------------------- 
    640    !! INTERFACE ice_thd_snwblow 
    641    !! 
    642    !! ** Purpose :   Compute distribution of precip over the ice 
    643    !! 
    644    !!                Snow accumulation in one thermodynamic time step 
    645    !!                snowfall is partitionned between leads and ice. 
    646    !!                If snow fall was uniform, a fraction (1-at_i) would fall into leads 
    647    !!                but because of the winds, more snow falls on leads than on sea ice 
    648    !!                and a greater fraction (1-at_i)^beta of the total mass of snow  
    649    !!                (beta < 1) falls in leads. 
    650    !!                In reality, beta depends on wind speed,  
    651    !!                and should decrease with increasing wind speed but here, it is  
    652    !!                considered as a constant. an average value is 0.66 
    653    !!-------------------------------------------------------------------------- 
    654 !!gm  I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE.... 
    655    SUBROUTINE ice_thd_snwblow_2d( pin, pout ) 
    656       REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( 1. - a_i_b ) 
    657       REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout 
    658       pout = ( 1._wp - ( pin )**rn_blow_s ) 
    659    END SUBROUTINE ice_thd_snwblow_2d 
    660  
    661    SUBROUTINE ice_thd_snwblow_1d( pin, pout ) 
    662       REAL(wp), DIMENSION(:), INTENT(in   ) :: pin 
    663       REAL(wp), DIMENSION(:), INTENT(inout) :: pout 
    664       pout = ( 1._wp - ( pin )**rn_blow_s ) 
    665    END SUBROUTINE ice_thd_snwblow_1d 
    666  
    667633#else 
    668634   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd_ent.F90

    r10069 r13466  
    128128      ! comment: if input h_i_old and eh_i_old are already multiplied by a_i (as in icethd_do),  
    129129      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 
    130       DO ji = 1, npti 
    131          hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  & 
    132             &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) )  
    133       END DO 
     130      !DO ji = 1, npti 
     131      !   hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  & 
     132      !      &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) )  
     133      !END DO 
    134134       
    135135   END SUBROUTINE ice_thd_ent 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd_pnd.F90

    r11536 r13466  
    3535   !                                   ! associated indices: 
    3636   INTEGER, PARAMETER ::   np_pndNO  = 0   ! No pond scheme 
    37    INTEGER, PARAMETER ::   np_pndCST = 1   ! Constant pond scheme 
    38    INTEGER, PARAMETER ::   np_pndH12 = 2   ! Evolutive pond scheme (Holland et al. 2012) 
     37   INTEGER, PARAMETER ::   np_pndCST = 1   ! Constant ice pond scheme 
     38   INTEGER, PARAMETER ::   np_pndLEV = 2   ! Level ice pond scheme 
    3939 
    4040   !! * Substitutions 
    … …  
    5151      !!               ***  ROUTINE ice_thd_pnd   *** 
    5252      !!                
    53       !! ** Purpose :   change melt pond fraction 
     53      !! ** Purpose :   change melt pond fraction and thickness 
    5454      !!                 
    55       !! ** Method  :   brut force 
    5655      !!------------------------------------------------------------------- 
    5756      ! 
    … …  
    6059      CASE (np_pndCST)   ;   CALL pnd_CST    !==  Constant melt ponds  ==! 
    6160         ! 
    62       CASE (np_pndH12)   ;   CALL pnd_H12    !==  Holland et al 2012 melt ponds  ==! 
     61      CASE (np_pndLEV)   ;   CALL pnd_LEV    !==  Level ice melt ponds  ==! 
    6362         ! 
    6463      END SELECT 
    … …  
    8887         ! 
    8988         IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 
    90             a_ip_frac_1d(ji) = rn_apnd 
    9189            h_ip_1d(ji)      = rn_hpnd     
    92             a_ip_1d(ji)      = a_ip_frac_1d(ji) * a_i_1d(ji) 
     90            a_ip_1d(ji)      = rn_apnd * a_i_1d(ji) 
     91            h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever 
    9392         ELSE 
    94             a_ip_frac_1d(ji) = 0._wp 
    9593            h_ip_1d(ji)      = 0._wp     
    9694            a_ip_1d(ji)      = 0._wp 
     95            h_il_1d(ji)      = 0._wp 
    9796         ENDIF 
    9897         ! 
    … …  
    102101 
    103102 
    104    SUBROUTINE pnd_H12 
    105       !!------------------------------------------------------------------- 
    106       !!                ***  ROUTINE pnd_H12  *** 
    107       !! 
    108       !! ** Purpose    : Compute melt pond evolution 
    109       !! 
    110       !! ** Method     : Empirical method. A fraction of meltwater is accumulated in ponds  
    111       !!                 and sent to ocean when surface is freezing 
    112       !! 
    113       !!                 pond growth:      Vp = Vp + dVmelt 
    114       !!                    with dVmelt = R/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i 
    115       !!                 pond contraction: Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp) 
    116       !!                    with Tp = -2degC 
    117       !!   
    118       !! ** Tunable parameters : (no real expertise yet, ideas?) 
     103   SUBROUTINE pnd_LEV 
     104      !!------------------------------------------------------------------- 
     105      !!                ***  ROUTINE pnd_LEV  *** 
     106      !! 
     107      !! ** Purpose : Compute melt pond evolution 
     108      !! 
     109      !! ** Method  : A fraction of meltwater is accumulated in ponds and sent to ocean when surface is freezing 
     110      !!              We  work with volumes and then redistribute changes into thickness and concentration 
     111      !!              assuming linear relationship between the two.  
     112      !! 
     113      !! ** Action  : - pond growth:      Vp = Vp + dVmelt                                          --- from Holland et al 2012 --- 
     114      !!                                     dVmelt = (1-r)/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i 
     115      !!                                        dh_i  = meltwater from ice surface melt 
     116      !!                                        dh_s  = meltwater from snow melt 
     117      !!                                        (1-r) = fraction of melt water that is not flushed 
     118      !! 
     119      !!              - limtations:       a_ip must not exceed (1-r)*a_i 
     120      !!                                  h_ip must not exceed 0.5*h_i 
     121      !! 
     122      !!              - pond shrinking: 
     123      !!                       if lids:   Vp = Vp -dH * a_ip 
     124      !!                                     dH = lid thickness change. Retrieved from this eq.:    --- from Flocco et al 2010 --- 
     125      !! 
     126      !!                                                                   rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H  
     127      !!                                                                      H = lid thickness 
     128      !!                                                                      Lf = latent heat of fusion 
     129      !!                                                                      Tp = -2C 
     130      !! 
     131      !!                                                                And solved implicitely as: 
     132      !!                                                                   H(t+dt)**2 -H(t) * H(t+dt) -ki * (Tp-Tsu) * dt / (rhoi*Lf) = 0 
     133      !! 
     134      !!                    if no lids:   Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp)                      --- from Holland et al 2012 --- 
     135      !! 
     136      !!              - Flushing:         w = -perm/visc * rho_oce * grav * Hp / Hi                 --- from Flocco et al 2007 --- 
     137      !!                                     perm = permability of sea-ice 
     138      !!                                     visc = water viscosity 
     139      !!                                     Hp   = height of top of the pond above sea-level 
     140      !!                                     Hi   = ice thickness thru which there is flushing 
     141      !! 
     142      !!              - Corrections:      remove melt ponds when lid thickness is 10 times the pond thickness 
     143      !! 
     144      !!              - pond thickness and area is retrieved from pond volume assuming a linear relationship between h_ip and a_ip: 
     145      !!                                  a_ip/a_i = a_ip_frac = h_ip / zaspect 
     146      !! 
     147      !! ** Tunable parameters : ln_pnd_lids, rn_apnd_max, rn_apnd_min 
    119148      !!  
    120       !! ** Note       : Stolen from CICE for quick test of the melt pond 
    121       !!                 radiation and freshwater interfaces 
    122       !!                 Coupling can be radiative AND freshwater 
    123       !!                 Advection, ridging, rafting are called 
    124       !! 
    125       !! ** References : Holland, M. M. et al (J Clim 2012) 
    126       !!------------------------------------------------------------------- 
    127       REAL(wp), PARAMETER ::   zrmin       = 0.15_wp  ! minimum fraction of available meltwater retained for melt ponding 
    128       REAL(wp), PARAMETER ::   zrmax       = 0.70_wp  ! maximum     -           -         -         -            - 
    129       REAL(wp), PARAMETER ::   zpnd_aspect = 0.8_wp   ! pond aspect ratio 
    130       REAL(wp), PARAMETER ::   zTp         = -2._wp   ! reference temperature 
    131       ! 
    132       REAL(wp) ::   zfr_mlt          ! fraction of available meltwater retained for melt ponding 
    133       REAL(wp) ::   zdv_mlt          ! available meltwater for melt ponding 
    134       REAL(wp) ::   z1_Tp            ! inverse reference temperature 
    135       REAL(wp) ::   z1_rhow          ! inverse freshwater density 
    136       REAL(wp) ::   z1_zpnd_aspect   ! inverse pond aspect ratio 
    137       REAL(wp) ::   zfac, zdum 
    138       ! 
    139       INTEGER  ::   ji   ! loop indices 
    140       !!------------------------------------------------------------------- 
    141       z1_rhow        = 1._wp / rhow  
    142       z1_zpnd_aspect = 1._wp / zpnd_aspect 
    143       z1_Tp          = 1._wp / zTp  
     149      !! ** Note       :   mostly stolen from CICE 
     150      !! 
     151      !! ** References :   Flocco and Feltham (JGR, 2007) 
     152      !!                   Flocco et al       (JGR, 2010) 
     153      !!                   Holland et al      (J. Clim, 2012) 
     154      !!------------------------------------------------------------------- 
     155      REAL(wp), DIMENSION(nlay_i) ::   ztmp           ! temporary array 
     156      !! 
     157      REAL(wp), PARAMETER ::   zaspect =  0.8_wp      ! pond aspect ratio 
     158      REAL(wp), PARAMETER ::   zTp     = -2._wp       ! reference temperature 
     159      REAL(wp), PARAMETER ::   zvisc   =  1.79e-3_wp  ! water viscosity 
     160      !! 
     161      REAL(wp) ::   zfr_mlt, zdv_mlt                  ! fraction and volume of available meltwater retained for melt ponding 
     162      REAL(wp) ::   zdv_frz, zdv_flush                ! Amount of melt pond that freezes, flushes 
     163      REAL(wp) ::   zhp                               ! heigh of top of pond lid wrt ssh 
     164      REAL(wp) ::   zv_ip_max                         ! max pond volume allowed 
     165      REAL(wp) ::   zdT                               ! zTp-t_su 
     166      REAL(wp) ::   zsbr                              ! Brine salinity 
     167      REAL(wp) ::   zperm                             ! permeability of sea ice 
     168      REAL(wp) ::   zfac, zdum                        ! temporary arrays 
     169      REAL(wp) ::   z1_rhow, z1_aspect, z1_Tp         ! inverse 
     170      !! 
     171      INTEGER  ::   ji, jk                            ! loop indices 
     172      !!------------------------------------------------------------------- 
     173      z1_rhow   = 1._wp / rhow  
     174      z1_aspect = 1._wp / zaspect 
     175      z1_Tp     = 1._wp / zTp  
    144176 
    145177      DO ji = 1, npti 
    146          !                                                        !--------------------------------! 
    147          IF( h_i_1d(ji) < rn_himin) THEN                          ! Case ice thickness < rn_himin ! 
    148             !                                                     !--------------------------------! 
    149             !--- Remove ponds on thin ice 
     178         !                                                            !----------------------------------------------------! 
     179         IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < epsi10 ) THEN    ! Case ice thickness < rn_himin or tiny ice fraction ! 
     180            !                                                         !----------------------------------------------------! 
     181            !--- Remove ponds on thin ice or tiny ice fractions 
    150182            a_ip_1d(ji)      = 0._wp 
    151             a_ip_frac_1d(ji) = 0._wp 
    152183            h_ip_1d(ji)      = 0._wp 
    153             !                                                     !--------------------------------! 
    154          ELSE                                                     ! Case ice thickness >= rn_himin ! 
    155             !                                                     !--------------------------------! 
    156             v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! record pond volume at previous time step 
    157             ! 
    158             ! available meltwater for melt ponding [m, >0] and fraction 
    159             zdv_mlt = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 
    160             zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji)  ! from CICE doc 
    161             !zfr_mlt = zrmin + zrmax * a_i_1d(ji)             ! from Holland paper  
    162             ! 
    163             !--- Pond gowth ---! 
    164             ! v_ip should never be negative, otherwise code crashes 
    165             v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zfr_mlt * zdv_mlt ) 
    166             ! 
    167             ! melt pond mass flux (<0) 
     184            h_il_1d(ji)      = 0._wp 
     185            !                                                         !--------------------------------! 
     186         ELSE                                                         ! Case ice thickness >= rn_himin ! 
     187            !                                                         !--------------------------------! 
     188            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! retrieve volume from thickness 
     189            v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
     190            ! 
     191            !------------------! 
     192            ! case ice melting ! 
     193            !------------------! 
     194            ! 
     195            !--- available meltwater for melt ponding ---! 
     196            zdum    = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 
     197            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 
     198            zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! max for roundoff errors?  
     199            ! 
     200            !--- overflow ---! 
     201            ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 
     202            !    a_ip_max = zfr_mlt * a_i 
     203            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     204            zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 
     205            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     206 
     207            ! If pond depth exceeds half the ice thickness then reduce the pond volume 
     208            !    h_ip_max = 0.5 * h_i 
     209            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     210            zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 
     211            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     212             
     213            !--- Pond growing ---! 
     214            v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 
     215            ! 
     216            !--- Lid melting ---! 
     217            IF( ln_pnd_lids )   v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 
     218            ! 
     219            !--- mass flux ---! 
    168220            IF( zdv_mlt > 0._wp ) THEN 
    169                zfac = zfr_mlt * zdv_mlt * rhow * r1_rdtice 
     221               zfac = zdv_mlt * rhow * r1_rdtice                        ! melt pond mass flux < 0 [kg.m-2.s-1] 
    170222               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 
    171223               ! 
    172                ! adjust ice/snow melting flux to balance melt pond flux (>0) 
    173                zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) ) 
     224               zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) )    ! adjust ice/snow melting flux > 0 to balance melt pond flux 
    174225               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum) 
    175226               wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum) 
    176227            ENDIF 
     228 
     229            !-------------------! 
     230            ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 
     231            !-------------------! 
     232            ! 
     233            zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 
    177234            ! 
    178235            !--- Pond contraction (due to refreezing) ---! 
    179             v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) * z1_Tp ) 
    180             ! 
    181             ! Set new pond area and depth assuming linear relation between h_ip and a_ip_frac 
    182             !    h_ip = zpnd_aspect * a_ip_frac = zpnd_aspect * a_ip/a_i 
    183             a_ip_1d(ji)      = SQRT( v_ip_1d(ji) * z1_zpnd_aspect * a_i_1d(ji) ) 
    184             a_ip_frac_1d(ji) = a_ip_1d(ji) / a_i_1d(ji) 
    185             h_ip_1d(ji)      = zpnd_aspect * a_ip_frac_1d(ji) 
     236            IF( ln_pnd_lids ) THEN 
     237               ! 
     238               !--- Lid growing and subsequent pond shrinking ---!  
     239               zdv_frz = 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 
     240                  &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rdt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 
     241                
     242               ! Lid growing 
     243               v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) + zdv_frz ) 
     244                
     245               ! Pond shrinking 
     246               v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) - zdv_frz ) 
     247 
     248            ELSE 
     249               ! Pond shrinking 
     250               v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * zdT * z1_Tp ) ! Holland 2012 (eq. 6) 
     251            ENDIF 
     252            ! 
     253            !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     254            ! v_ip     = h_ip * a_ip 
     255            ! 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) 
     256            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 
     257            h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     258 
     259            !---------------!             
     260            ! Pond flushing ! 
     261            !---------------! 
     262            ! height of top of the pond above sea-level 
     263            zhp = ( h_i_1d(ji) * ( rau0 - rhoi ) + h_ip_1d(ji) * ( rau0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rau0 
     264             
     265            ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 
     266            DO jk = 1, nlay_i 
     267               zsbr = - 1.2_wp                                  & 
     268                  &   - 21.8_wp    * ( t_i_1d(ji,jk) - rt0 )    & 
     269                  &   - 0.919_wp   * ( t_i_1d(ji,jk) - rt0 )**2 & 
     270                  &   - 0.0178_wp  * ( t_i_1d(ji,jk) - rt0 )**3 
     271               ztmp(jk) = sz_i_1d(ji,jk) / zsbr 
     272            END DO 
     273            zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 
     274             
     275            ! Do the drainage using Darcy's law 
     276            zdv_flush   = -zperm * rau0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 
     277            zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) 
     278            v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 
     279             
     280            !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     281            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 
     282            h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     283 
     284            !--- Corrections and lid thickness ---! 
     285            IF( ln_pnd_lids ) THEN 
     286               !--- retrieve lid thickness from volume ---! 
     287               IF( a_ip_1d(ji) > epsi10 ) THEN   ;   h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 
     288               ELSE                              ;   h_il_1d(ji) = 0._wp 
     289               ENDIF 
     290               !--- remove ponds if lids are much larger than ponds ---! 
     291               IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 
     292                  a_ip_1d(ji)      = 0._wp 
     293                  h_ip_1d(ji)      = 0._wp 
     294                  h_il_1d(ji)      = 0._wp 
     295               ENDIF 
     296            ENDIF 
    186297            ! 
    187298         ENDIF 
     299          
    188300      END DO 
    189301      ! 
    190    END SUBROUTINE pnd_H12 
     302   END SUBROUTINE pnd_LEV 
    191303 
    192304 
    … …  
    205317      INTEGER  ::   ios, ioptio   ! Local integer 
    206318      !! 
    207       NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 
     319      NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, & 
     320         &                          ln_pnd_CST , rn_apnd, rn_hpnd,         & 
     321         &                          ln_pnd_lids, ln_pnd_alb 
    208322      !!------------------------------------------------------------------- 
    209323      ! 
    … …  
    221335         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    222336         WRITE(numout,*) '   Namelist namicethd_pnd:' 
    223          WRITE(numout,*) '      Melt ponds activated or not                                     ln_pnd     = ', ln_pnd 
    224          WRITE(numout,*) '         Evolutive  melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 
    225          WRITE(numout,*) '         Prescribed melt pond fraction and depth                      ln_pnd_CST = ', ln_pnd_CST 
    226          WRITE(numout,*) '            Prescribed pond fraction                                  rn_apnd    = ', rn_apnd 
    227          WRITE(numout,*) '            Prescribed pond depth                                     rn_hpnd    = ', rn_hpnd 
    228          WRITE(numout,*) '         Melt ponds affect albedo or not                              ln_pnd_alb = ', ln_pnd_alb 
     337         WRITE(numout,*) '      Melt ponds activated or not                                 ln_pnd       = ', ln_pnd 
     338         WRITE(numout,*) '         Level ice melt pond scheme                               ln_pnd_LEV   = ', ln_pnd_LEV 
     339         WRITE(numout,*) '            Minimum ice fraction that contributes to melt ponds   rn_apnd_min  = ', rn_apnd_min 
     340         WRITE(numout,*) '            Maximum ice fraction that contributes to melt ponds   rn_apnd_max  = ', rn_apnd_max 
     341         WRITE(numout,*) '         Constant ice melt pond scheme                            ln_pnd_CST   = ', ln_pnd_CST 
     342         WRITE(numout,*) '            Prescribed pond fraction                              rn_apnd      = ', rn_apnd 
     343         WRITE(numout,*) '            Prescribed pond depth                                 rn_hpnd      = ', rn_hpnd 
     344         WRITE(numout,*) '         Frozen lids on top of melt ponds                         ln_pnd_lids  = ', ln_pnd_lids 
     345         WRITE(numout,*) '         Melt ponds affect albedo or not                          ln_pnd_alb   = ', ln_pnd_alb 
    229346      ENDIF 
    230347      ! 
    … …  
    233350      IF( .NOT.ln_pnd ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndNO     ;   ENDIF 
    234351      IF( ln_pnd_CST  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndCST    ;   ENDIF 
    235       IF( ln_pnd_H12  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndH12    ;   ENDIF 
     352      IF( ln_pnd_LEV  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndLEV    ;   ENDIF 
    236353      IF( ioptio /= 1 )   & 
    237          & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 
     354         & 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)' ) 
    238355      ! 
    239356      SELECT CASE( nice_pnd ) 
    240357      CASE( np_pndNO )          
    241          IF( ln_pnd_alb ) THEN ; ln_pnd_alb = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' ) ; ENDIF 
     358         IF( ln_pnd_alb  ) THEN ; ln_pnd_alb  = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' )  ; ENDIF 
     359         IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when no ponds' ) ; ENDIF 
     360      CASE( np_pndCST )          
     361         IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when constant ponds' ) ; ENDIF 
    242362      END SELECT 
    243363      ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd_sal.F90

    r11536 r13466  
    5555      !!               -> nn_icesal = 3 -> Sice = S(z)   [multiyear ice] 
    5656      !!--------------------------------------------------------------------- 
    57       LOGICAL, INTENT(in) ::   ld_sal            ! gravity drainage and flushing or not  
     57      LOGICAL, INTENT(in) ::   ld_sal          ! gravity drainage and flushing or not  
    5858      ! 
    59       INTEGER  ::   ji, jk                       ! dummy loop indices  
    60       REAL(wp) ::   iflush, igravdr              ! local scalars 
    61       REAL(wp) ::   zs_sni, zs_i_gd, zs_i_fl, zs_i_si, zs_i_bg   ! local scalars 
     59      INTEGER  ::   ji                         ! dummy loop indices  
     60      REAL(wp) ::   zs_sni, zds                ! local scalars 
    6261      REAL(wp) ::   z1_time_gd, z1_time_fl 
    6362      !!--------------------------------------------------------------------- 
    … …  
    6867      CASE( 2 )       !  time varying salinity with linear profile  ! 
    6968         !            !---------------------------------------------! 
    70          z1_time_gd = 1._wp / rn_time_gd * rdt_ice 
    71          z1_time_fl = 1._wp / rn_time_fl * rdt_ice 
     69         z1_time_gd = rdt_ice / rn_time_gd 
     70         z1_time_fl = rdt_ice / rn_time_fl 
    7271         ! 
    7372         DO ji = 1, npti 
    7473            ! 
    75             !--------------------------------------------------------- 
    76             !  Update ice salinity from snow-ice and bottom growth 
    77             !--------------------------------------------------------- 
    7874            IF( h_i_1d(ji) > 0._wp ) THEN 
    79                zs_sni  = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi                     ! Salinity of snow ice 
    80                zs_i_si = ( zs_sni      - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice     
    81                zs_i_bg = ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog  (ji) / h_i_1d(ji) ! bottom growth 
    82                ! Update salinity (nb: salt flux already included in icethd_dh) 
    83                s_i_1d(ji) = s_i_1d(ji) + zs_i_bg + zs_i_si 
     75               ! 
     76               ! --- Update ice salinity from snow-ice and bottom growth --- ! 
     77               zs_sni = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi                           ! salinity of snow ice 
     78               zds    =       ( zs_sni      - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice     
     79               zds    = zds + ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog  (ji) / h_i_1d(ji) ! bottom growth 
     80               ! update salinity (nb: salt flux already included in icethd_dh) 
     81               s_i_1d(ji) = s_i_1d(ji) + zds 
     82               ! 
     83               ! --- Update ice salinity from brine drainage and flushing --- ! 
     84               IF( ld_sal ) THEN 
     85                  IF( t_su_1d(ji) >= rt0 ) THEN             ! flushing (summer time) 
     86                     zds = - MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl 
     87                  ELSEIF( t_su_1d(ji) <= t_bo_1d(ji) ) THEN ! gravity drainage 
     88                     zds = - MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd 
     89                  ELSE 
     90                     zds = 0._wp 
     91                  ENDIF 
     92                  ! update salinity 
     93                  s_i_1d(ji) = s_i_1d(ji) + zds 
     94                  ! salt flux 
     95                  sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_rdtice 
     96               ENDIF 
     97               ! 
     98               ! --- salinity must stay inbounds --- ! 
     99               zds =       MAX( 0._wp, rn_simin - s_i_1d(ji) ) ! > 0 if s_i < simin 
     100               zds = zds + MIN( 0._wp, rn_simax - s_i_1d(ji) ) ! < 0 if s_i > simax 
     101               ! update salinity 
     102               s_i_1d(ji) = s_i_1d(ji) + zds 
     103               ! salt flux 
     104               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_rdtice 
     105               ! 
    84106            ENDIF 
    85107            ! 
    86             IF( ld_sal ) THEN 
    87                !--------------------------------------------------------- 
    88                !  Update ice salinity from brine drainage and flushing 
    89                !--------------------------------------------------------- 
    90                iflush   = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0         ) )  ! =1 if summer  
    91                igravdr  = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )  ! =1 if t_su < t_bo 
    92  
    93                zs_i_gd = - igravdr * MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd  ! gravity drainage  
    94                zs_i_fl = - iflush  * MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl  ! flushing 
    95                 
    96                ! Update salinity    
    97                s_i_1d(ji) = s_i_1d(ji) + zs_i_fl + zs_i_gd 
    98                 
    99                ! Salt flux 
    100                sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * ( zs_i_fl + zs_i_gd ) * r1_rdtice 
    101             ENDIF 
    102108         END DO 
    103109         ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd_zdf.F90

    r11536 r13466  
    8585      INTEGER  ::   ios, ioptio   ! Local integer 
    8686      !! 
    87       NAMELIST/namthd_zdf/ ln_zdf_BL99, ln_cndi_U64, ln_cndi_P07, rn_cnd_s, rn_kappa_i 
     87      NAMELIST/namthd_zdf/ ln_zdf_BL99, ln_cndi_U64, ln_cndi_P07, rn_cnd_s, & 
     88         &                 rn_kappa_i, rn_kappa_s, rn_kappa_smlt, rn_kappa_sdry, ln_zdf_chkcvg 
    8889      !!------------------------------------------------------------------- 
    8990      ! 
    … …  
    101102         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    102103         WRITE(numout,*) '   Namelist namthd_zdf:' 
    103          WRITE(numout,*) '      Bitz and Lipscomb (1999) formulation                    ln_zdf_BL99  = ', ln_zdf_BL99 
    104          WRITE(numout,*) '      thermal conductivity in the ice (Untersteiner 1964)     ln_cndi_U64  = ', ln_cndi_U64 
    105          WRITE(numout,*) '      thermal conductivity in the ice (Pringle et al 2007)    ln_cndi_P07  = ', ln_cndi_P07 
    106          WRITE(numout,*) '      thermal conductivity in the snow                        rn_cnd_s     = ', rn_cnd_s 
    107          WRITE(numout,*) '      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i 
     104         WRITE(numout,*) '      Bitz and Lipscomb (1999) formulation                      ln_zdf_BL99   = ', ln_zdf_BL99 
     105         WRITE(numout,*) '      thermal conductivity in the ice (Untersteiner 1964)       ln_cndi_U64   = ', ln_cndi_U64 
     106         WRITE(numout,*) '      thermal conductivity in the ice (Pringle et al 2007)      ln_cndi_P07   = ', ln_cndi_P07 
     107         WRITE(numout,*) '      thermal conductivity in the snow                          rn_cnd_s      = ', rn_cnd_s 
     108         WRITE(numout,*) '      extinction radiation parameter in sea ice                 rn_kappa_i    = ', rn_kappa_i 
     109         WRITE(numout,*) '      extinction radiation parameter in snw      (nn_qtrice=0)  rn_kappa_s    = ', rn_kappa_s 
     110         WRITE(numout,*) '      extinction radiation parameter in melt snw (nn_qtrice=1)  rn_kappa_smlt = ', rn_kappa_smlt 
     111         WRITE(numout,*) '      extinction radiation parameter in dry  snw (nn_qtrice=1)  rn_kappa_sdry = ', rn_kappa_sdry 
     112         WRITE(numout,*) '      check convergence of heat diffusion scheme                ln_zdf_chkcvg = ', ln_zdf_chkcvg 
    108113      ENDIF 
    109114      ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd_zdf_bl99.F90

    r12395 r13466  
    8585 
    8686      LOGICAL, DIMENSION(jpij) ::   l_T_converged   ! true when T converges (per grid point) 
    87 ! 
     87      ! 
    8888      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
    8989      REAL(wp) ::   zg1       =  2._wp        ! 
    9090      REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat 
    9191      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13) 
    92       REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow 
    9392      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
    9493      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered at 0C  
    9594      REAL(wp) ::   zdti_bnd  =  1.e-4_wp     ! maximal authorized error on temperature  
    96       REAL(wp) ::   zhs_min   =  0.01_wp      ! minimum snow thickness for conductivity calculation  
     95      REAL(wp) ::   zhs_ssl   =  0.03_wp      ! surface scattering layer in the snow  
     96      REAL(wp) ::   zhi_ssl   =  0.10_wp      ! surface scattering layer in the ice 
     97      REAL(wp) ::   zh_min    =  1.e-3_wp     ! minimum ice/snow thickness for conduction 
    9798      REAL(wp) ::   ztmelts                   ! ice melting temperature 
    9899      REAL(wp) ::   zdti_max                  ! current maximal error on temperature  
    99100      REAL(wp) ::   zcpi                      ! Ice specific heat 
    100101      REAL(wp) ::   zhfx_err, zdq             ! diag errors on heat 
    101       REAL(wp) ::   zfac                      ! dummy factor 
    102       ! 
    103       REAL(wp), DIMENSION(jpij) ::   isnow        ! switch for presence (1) or absence (0) of snow 
     102      ! 
     103      REAL(wp), DIMENSION(jpij) ::   zraext_s     ! extinction coefficient of radiation in the snow 
    104104      REAL(wp), DIMENSION(jpij) ::   ztsub        ! surface temperature at previous iteration 
    105105      REAL(wp), DIMENSION(jpij) ::   zh_i, z1_h_i ! ice layer thickness 
    … …  
    124124      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zkappa_s    ! Kappa factor in the snow 
    125125      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 
    126127      REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindterm    ! 'Ind'ependent term 
    127128      REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindtbis    ! Temporary 'ind'ependent term 
    … …  
    130131      REAL(wp), DIMENSION(jpij)            ::   zq_ini      ! diag errors on heat 
    131132      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  
    132136      ! 
    133137      ! Mono-category 
    … …  
    143147      END DO 
    144148 
     149      ! calculate ice fraction covered by snow for radiation 
     150      CALL ice_var_snwfra( h_s_1d(1:npti), za_s_fra(1:npti) ) 
     151       
    145152      !------------------ 
    146153      ! 1) Initialization 
    147154      !------------------ 
     155      ! 
     156      ! extinction radiation in the snow 
     157      IF    ( nn_qtrice == 0 ) THEN   ! constant  
     158         zraext_s(1:npti) = rn_kappa_s 
     159      ELSEIF( nn_qtrice == 1 ) THEN   ! depends on melting/freezing conditions 
     160         WHERE( t_su_1d(1:npti) < rt0 )   ;   zraext_s(1:npti) = rn_kappa_sdry   ! no surface melting 
     161         ELSEWHERE                        ;   zraext_s(1:npti) = rn_kappa_smlt   !    surface melting 
     162         END WHERE 
     163      ENDIF 
     164      ! 
     165      ! thicknesses 
    148166      DO ji = 1, npti 
    149          isnow(ji) = 1._wp - MAX( 0._wp , SIGN(1._wp, - h_s_1d(ji) ) )  ! is there snow or not 
    150          ! layer thickness 
    151          zh_i(ji) = h_i_1d(ji) * r1_nlay_i 
    152          zh_s(ji) = h_s_1d(ji) * r1_nlay_s 
     167         ! ice thickness 
     168         IF( h_i_1d(ji) > 0._wp ) THEN  
     169            zh_i  (ji) = MAX( zh_min , h_i_1d(ji) ) * r1_nlay_i ! set a minimum thickness for conduction 
     170            z1_h_i(ji) = 1._wp / zh_i(ji)                       !       it must be very small 
     171         ELSE 
     172            zh_i  (ji) = 0._wp 
     173            z1_h_i(ji) = 0._wp 
     174         ENDIF 
     175         ! snow thickness 
     176         IF( h_s_1d(ji) > 0._wp ) THEN 
     177            zh_s  (ji) = MAX( zh_min , h_s_1d(ji) ) * r1_nlay_s ! set a minimum thickness for conduction 
     178            z1_h_s(ji) = 1._wp / zh_s(ji)                       !       it must be very small 
     179            isnow (ji) = 1._wp 
     180         ELSE 
     181            zh_s  (ji) = 0._wp 
     182            z1_h_s(ji) = 0._wp 
     183            isnow (ji) = 0._wp 
     184         ENDIF 
     185         ! for Met-Office 
     186         IF( h_s_1d(ji) < zh_min ) THEN 
     187            isnow_comb(ji) = h_s_1d(ji) / zh_min 
     188         ELSE 
     189            isnow_comb(ji) = 1._wp 
     190         ENDIF 
    153191      END DO 
    154       ! 
    155       WHERE( zh_i(1:npti) >= epsi10 )   ;   z1_h_i(1:npti) = 1._wp / zh_i(1:npti) 
    156       ELSEWHERE                         ;   z1_h_i(1:npti) = 0._wp 
    157       END WHERE 
    158       ! 
    159       WHERE( zh_s(1:npti) > 0._wp   )       zh_s(1:npti) = MAX( zhs_min * r1_nlay_s, zh_s(1:npti) ) 
    160       ! 
    161       WHERE( zh_s(1:npti) > 0._wp   )   ;   z1_h_s(1:npti) = 1._wp / zh_s(1:npti) 
    162       ELSEWHERE                         ;   z1_h_s(1:npti) = 0._wp 
    163       END WHERE 
     192      ! clem: we should apply correction on snow thickness to take into account snow fraction 
     193      !       it must be a distribution, so it is a bit complicated 
    164194      ! 
    165195      ! Store initial temperatures and non solar heat fluxes 
    166196      IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_EMU ) THEN 
    167          ! 
    168197         ztsub      (1:npti) = t_su_1d(1:npti)                          ! surface temperature at iteration n-1 
    169198         ztsuold    (1:npti) = t_su_1d(1:npti)                          ! surface temperature initial value 
    … …  
    185214         DO ji = 1, npti 
    186215            !                             ! radiation transmitted below the layer-th snow layer 
    187             zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * h_s_1d(ji) * r1_nlay_s * REAL(jk) ) 
     216            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s(ji) * MAX( 0._wp, zh_s(ji) * REAL(jk) - zhs_ssl ) ) 
    188217            !                             ! radiation absorbed by the layer-th snow layer 
    189218            zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk) 
    … …  
    191220      END DO 
    192221      ! 
    193       zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - isnow(1:npti) ) 
     222      zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * za_s_fra(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - za_s_fra(1:npti) ) 
    194223      DO jk = 1, nlay_i  
    195224         DO ji = 1, npti 
    196225            !                             ! radiation transmitted below the layer-th ice layer 
    197             zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * zh_i(ji) * REAL(jk) ) 
     226            zradtr_i(ji,jk) =           za_s_fra(ji)   * zradtr_s(ji,nlay_s)                       &   ! part covered by snow 
     227               &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zh_min  ) ) & 
     228               &            + ( 1._wp - za_s_fra(ji) ) * qtr_ice_top_1d(ji)                        &   ! part snow free 
     229               &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zhi_ssl ) )             
    198230            !                             ! radiation absorbed by the layer-th ice layer 
    199231            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) 
    … …  
    203235      qtr_ice_bot_1d(1:npti) = zradtr_i(1:npti,nlay_i)   ! record radiation transmitted below the ice 
    204236      ! 
    205       iconv    = 0          ! number of iterations 
     237      iconv = 0          ! number of iterations 
    206238      ! 
    207239      l_T_converged(:) = .FALSE. 
    … …  
    230262               DO ji = 1, npti 
    231263                  ztcond_i_cp(ji,jk) = rcnd_i + zbeta * 0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /  & 
    232                      &                         MIN( -epsi10, 0.5_wp * (t_i_1d(ji,jk) + t_i_1d(ji,jk+1)) - rt0 ) 
     264                     &                    MIN( -epsi10, 0.5_wp * (  t_i_1d(ji,jk) +  t_i_1d(ji,jk+1) ) - rt0 ) 
    233265               END DO 
    234266            END DO 
    … …  
    238270            DO ji = 1, npti 
    239271               ztcond_i_cp(ji,0)      = rcnd_i + 0.09_wp  *  sz_i_1d(ji,1)      / MIN( -epsi10, t_i_1d(ji,1) - rt0 )  & 
    240                   &                           - 0.011_wp * ( t_i_1d(ji,1) - rt0 ) 
     272                  &                            - 0.011_wp * ( t_i_1d(ji,1) - rt0 ) 
    241273               ztcond_i_cp(ji,nlay_i) = rcnd_i + 0.09_wp  *  sz_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji)  - rt0 )  & 
    242                   &                           - 0.011_wp * ( t_bo_1d(ji) - rt0 ) 
     274                  &                            - 0.011_wp * ( t_bo_1d(ji) - rt0 ) 
    243275            END DO 
    244276            DO jk = 1, nlay_i-1 
    245277               DO ji = 1, npti 
    246                   ztcond_i_cp(ji,jk) = rcnd_i + 0.09_wp  *   0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /        & 
    247                      &                        MIN( -epsi10, 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) ) - rt0 ) & 
    248                      &                       - 0.011_wp * ( 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) ) - rt0 ) 
     278                  ztcond_i_cp(ji,jk) = rcnd_i + 0.09_wp  *   0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /       & 
     279                     &                         MIN( -epsi10, 0.5_wp * (  t_i_1d(ji,jk) +  t_i_1d(ji,jk+1) ) - rt0 ) & 
     280                     &                        - 0.011_wp * ( 0.5_wp * (  t_i_1d(ji,jk) +  t_i_1d(ji,jk+1) ) - rt0 ) 
    249281               END DO 
    250282            END DO 
    … …  
    290322         END DO 
    291323         DO ji = 1, npti   ! Snow-ice interface 
    292             IF ( .NOT. l_T_converged(ji) ) THEN 
    293                zfac = 0.5_wp * ( ztcond_i(ji,0) * zh_s(ji) + rn_cnd_s * zh_i(ji) ) 
    294                IF( zfac > epsi10 ) THEN 
    295                   zkappa_s(ji,nlay_s) = zghe(ji) * rn_cnd_s * ztcond_i(ji,0) / zfac 
    296                ELSE 
    297                   zkappa_s(ji,nlay_s) = 0._wp 
    298                ENDIF 
    299             ENDIF 
     324            IF ( .NOT. l_T_converged(ji) ) & 
     325               zkappa_s(ji,nlay_s) = isnow(ji) * zghe(ji) * rn_cnd_s * ztcond_i(ji,0) & 
     326                  &                            / ( 0.5_wp * ( ztcond_i(ji,0) * zh_s(ji) + rn_cnd_s * zh_i(ji) ) ) 
    300327         END DO 
    301328 
    … …  
    310337         END DO 
    311338         DO ji = 1, npti   ! Snow-ice interface 
    312             IF ( .NOT. l_T_converged(ji) ) & 
    313                zkappa_i(ji,0) = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) ) 
     339            IF ( .NOT. l_T_converged(ji) ) THEN 
     340               ! Calculate combined surface snow and ice conductivity to pass through the coupler (met-office) 
     341               zkappa_comb(ji) = isnow_comb(ji) * zkappa_s(ji,0) + ( 1._wp - isnow_comb(ji) ) * zkappa_i(ji,0) 
     342               ! If there is snow then use the same snow-ice interface conductivity for the top layer of ice 
     343               IF( h_s_1d(ji) > 0._wp )   zkappa_i(ji,0) = zkappa_s(ji,nlay_s) 
     344           ENDIF 
    314345         END DO 
    315346         ! 
    … …  
    320351            DO ji = 1, npti 
    321352               zcpi = rcpi + zgamma * sz_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztiold(ji,jk) - rt0 ), epsi10 ) 
    322                zeta_i(ji,jk) = rdt_ice * r1_rhoi * z1_h_i(ji) / MAX( epsi10, zcpi )  
     353               zeta_i(ji,jk) = rdt_ice * r1_rhoi * z1_h_i(ji) / zcpi 
    323354            END DO 
    324355         END DO 
    … …  
    544575                  ztsub(ji) = t_su_1d(ji) 
    545576                  IF( t_su_1d(ji) < rt0 ) THEN 
    546                      t_su_1d(ji) = ( zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) *  & 
    547                         &          ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji)) 
     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)) 
    548579                  ENDIF 
    549580               ENDIF 
    550581            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) 
    551583            ! 
    552584            !-------------------------------------------------------------- 
    … …  
    561593 
    562594               IF ( .NOT. l_T_converged(ji) ) THEN 
     595 
    563596                  t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , rt0 ) , rt0 - 100._wp ) 
    564597                  zdti_max    = MAX( zdti_max, ABS( t_su_1d(ji) - ztsub(ji) ) ) 
    565598 
    566                   t_s_1d(ji,1:nlay_s) = MAX( MIN( t_s_1d(ji,1:nlay_s), rt0 ), rt0 - 100._wp ) 
    567                   zdti_max = MAX ( zdti_max , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 
     599                  IF( h_s_1d(ji) > 0._wp ) THEN 
     600                     DO jk = 1, nlay_s 
     601                        t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt0 ), rt0 - 100._wp ) 
     602                        zdti_max      = MAX ( zdti_max , ABS( t_s_1d(ji,jk) - ztsb(ji,jk) ) ) 
     603                     END DO 
     604                  ENDIF 
    568605 
    569606                  DO jk = 1, nlay_i 
    … …  
    572609                     zdti_max      =  MAX( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 
    573610                  END DO 
    574  
    575                   IF ( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 
     611                   
     612                  ! convergence test 
     613                  IF( ln_zdf_chkcvg ) THEN 
     614                     tice_cvgerr_1d(ji) = zdti_max 
     615                     tice_cvgstp_1d(ji) = REAL(iconv) 
     616                  ENDIF 
     617 
     618                  IF( zdti_max < zdti_bnd )   l_T_converged(ji) = .TRUE. 
    576619 
    577620               ENDIF 
    … …  
    726769               ENDIF 
    727770            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) 
    728772            ! 
    729773            !-------------------------------------------------------------- 
    … …  
    738782 
    739783               IF ( .NOT. l_T_converged(ji) ) THEN 
    740                   ! t_s 
    741                   t_s_1d(ji,1:nlay_s) = MAX( MIN( t_s_1d(ji,1:nlay_s), rt0 ), rt0 - 100._wp ) 
    742                   zdti_max = MAX ( zdti_max , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 
    743                   ! t_i 
     784 
     785                  IF( h_s_1d(ji) > 0._wp ) THEN 
     786                     DO jk = 1, nlay_s 
     787                        t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt0 ), rt0 - 100._wp ) 
     788                        zdti_max      = MAX ( zdti_max , ABS( t_s_1d(ji,jk) - ztsb(ji,jk) ) ) 
     789                     END DO 
     790                  ENDIF 
     791 
    744792                  DO jk = 1, nlay_i 
    745793                     ztmelts       = -rTmlt * sz_i_1d(ji,jk) + rt0  
    … …  
    748796                  END DO 
    749797 
    750                   IF ( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 
     798                  ! convergence test 
     799                  IF( ln_zdf_chkcvg ) THEN 
     800                     tice_cvgerr_1d(ji) = zdti_max 
     801                     tice_cvgstp_1d(ji) = REAL(iconv) 
     802                  ENDIF 
     803 
     804                  IF( zdti_max < zdti_bnd )   l_T_converged(ji) = .TRUE. 
    751805 
    752806               ENDIF 
    … …  
    755809 
    756810         ENDIF ! k_cnd 
    757           
     811 
    758812      END DO  ! End of the do while iterative procedure 
    759        
    760       IF( ln_icectl .AND. lwp ) THEN 
    761          WRITE(numout,*) ' zdti_max : ', zdti_max 
    762          WRITE(numout,*) ' iconv    : ', iconv 
    763       ENDIF 
    764        
    765813      ! 
    766814      !----------------------------- 
    … …  
    771819      !     bottom ice conduction flux 
    772820      DO ji = 1, npti 
    773          qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1  * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 
     821         qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1 * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 
    774822      END DO 
    775823      !     surface ice conduction flux 
    … …  
    777825         ! 
    778826         DO ji = 1, npti 
    779             qcn_ice_top_1d(ji) =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) ) & 
    780                &                  - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) ) 
     827            qcn_ice_top_1d(ji) = -           isnow(ji)   * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) ) & 
     828               &                 - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) ) 
    781829         END DO 
    782830         ! 
    … …  
    792840         ! 
    793841         DO ji = 1, npti 
    794             t_su_1d(ji) = (  qcn_ice_top_1d(ji) &            ! calculate surface temperature 
    795                &           +           isnow(ji)   * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) & 
    796                &           + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * t_i_1d(ji,1) & 
    797                &          ) / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 ) 
     842            t_su_1d(ji) = ( qcn_ice_top_1d(ji) +          isnow(ji)   * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) + & 
     843               &                                ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * t_i_1d(ji,1) ) & 
     844               &          / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 ) 
    798845            t_su_1d(ji) = MAX( MIN( t_su_1d(ji), rt0 ), rt0 - 100._wp )  ! cap t_su 
    799846         END DO 
    … …  
    853900      !-------------------------------------------------------------------- 
    854901      ! effective conductivity and 1st layer temperature (needed by Met Office) 
     902      ! this is a conductivity at mid-layer, hence the factor 2 
    855903      DO ji = 1, npti 
    856          IF( h_s_1d(ji) > 0.1_wp ) THEN  
    857             cnd_ice_1d(ji) = 2._wp * zkappa_s(ji,0) 
     904         IF( h_i_1d(ji) >= zhi_ssl ) THEN 
     905            cnd_ice_1d(ji) = 2._wp * zkappa_comb(ji) 
     906            !!cnd_ice_1d(ji) = 2._wp * zkappa_i(ji,0) 
    858907         ELSE 
    859             IF( h_i_1d(ji) > 0.1_wp ) THEN 
    860                cnd_ice_1d(ji) = 2._wp * zkappa_i(ji,0) 
    861             ELSE 
    862                cnd_ice_1d(ji) = 2._wp * ztcond_i(ji,0) * 10._wp 
    863             ENDIF 
     908            cnd_ice_1d(ji) = 2._wp * ztcond_i(ji,0) / zhi_ssl ! cnd_ice is capped by: cond_i/zhi_ssl 
    864909         ENDIF 
    865910         t1_ice_1d(ji) = isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) 
    … …  
    877922      DO ji = 1, npti          
    878923         !--- Snow-ice interfacial temperature (diagnostic SIMIP) 
    879          zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji) 
    880          IF( h_s_1d(ji) >= zhs_min ) THEN 
    881             t_si_1d(ji) = ( rn_cnd_s       * zh_i(ji) * t_s_1d(ji,1) +   & 
    882                &            ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / MAX( epsi10, zfac ) 
     924         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) ) & 
     927               &          / ( rn_cnd_s       * h_i_1d(ji) * r1_nlay_i & 
     928               &            + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s ) 
    883929         ELSE 
    884930            t_si_1d(ji) = t_su_1d(ji) 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceupdate.F90

    r11536 r13466  
    2626   USE icectl         ! sea-ice: control prints 
    2727   USE bdy_oce , ONLY : ln_bdy 
     28   USE zdfdrg  , ONLY : ln_drgice_imp 
    2829   ! 
    2930   USE in_out_manager ! I/O manager 
    … …  
    9495      REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    9596      REAL(wp) ::   zqsr             ! New solar flux received by the ocean 
    96       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  ! 2D workspace 
    97       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_cs, zalb_os     ! 3D workspace 
     97      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                  ! 2D workspace 
    9898      !!--------------------------------------------------------------------- 
    9999      IF( ln_timing )   CALL timing_start('ice_update') 
    … …  
    185185      ! Snow/ice albedo (only if sent to coupler, useless in forced mode) 
    186186      !------------------------------------------------------------------ 
    187       CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_frac, h_ip, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    188       ! 
    189       alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     187      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) ! ice albedo 
     188 
    190189      ! 
    191190      IF( lrst_ice ) THEN                       !* write snwice_mass fields in the restart file 
    … …  
    323322      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar 
    324323      REAL(wp) ::   zat_v, zvtau_ice, zv_t, zrhoco  !   -      - 
     324      REAL(wp) ::   zflagi                          !   -      - 
    325325      !!--------------------------------------------------------------------- 
    326326      IF( ln_timing )   CALL timing_start('ice_update_tau') 
    … …  
    355355      ! 
    356356      !                                      !==  every ocean time-step  ==! 
     357      IF ( ln_drgice_imp ) THEN 
     358         ! Save drag with right sign to update top drag in the ocean implicit friction  
     359         rCdU_ice(:,:) = -r1_rau0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1)  
     360         zflagi = 0._wp 
     361      ELSE 
     362         zflagi = 1._wp 
     363      ENDIF 
    357364      ! 
    358365      DO jj = 2, jpjm1                                !* update the stress WITHOUT an ice-ocean rotation angle 
    … …  
    364371               &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji  ,jj+1,1) ) 
    365372            !                                                   ! linearized quadratic drag formulation 
    366             zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) ) 
    367             zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) ) 
     373            zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - zflagi * pu_oce(ji,jj) ) 
     374            zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - zflagi * pv_oce(ji,jj) ) 
    368375            !                                                   ! stresses at the ocean surface 
    369376            utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icevar.F90

    r11732 r13466  
    5151   !!   ice_var_sshdyn    : compute equivalent ssh in lead 
    5252   !!   ice_var_itd       : convert N-cat to M-cat 
     53   !!   ice_var_snwfra    : fraction of ice covered by snow 
     54   !!   ice_var_snwblow   : distribute snow fall between ice and ocean 
    5355   !!---------------------------------------------------------------------- 
    5456   USE dom_oce        ! ocean space and time domain 
    … …  
    7779   PUBLIC   ice_var_sshdyn 
    7880   PUBLIC   ice_var_itd 
     81   PUBLIC   ice_var_snwfra 
     82   PUBLIC   ice_var_snwblow 
    7983 
    8084   INTERFACE ice_var_itd 
    8185      MODULE PROCEDURE ice_var_itd_1c1c, ice_var_itd_Nc1c, ice_var_itd_1cMc, ice_var_itd_NcMc 
     86   END INTERFACE 
     87 
     88   INTERFACE ice_var_snwfra 
     89      MODULE PROCEDURE ice_var_snwfra_1d, ice_var_snwfra_2d, ice_var_snwfra_3d 
     90   END INTERFACE 
     91 
     92   INTERFACE ice_var_snwblow 
     93      MODULE PROCEDURE ice_var_snwblow_1d, ice_var_snwblow_2d 
    8294   END INTERFACE 
    8395 
    … …  
    113125      at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds 
    114126      vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) 
     127      vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) 
    115128      ! 
    116129      ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction   
    … …  
    161174         ! 
    162175         !                           ! mean melt pond depth 
    163          WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 
    164          ELSEWHERE                      ;   hm_ip(:,:) = 0._wp 
     176         WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:)   ;   hm_il(:,:) = vt_il(:,:) / at_ip(:,:) 
     177         ELSEWHERE                      ;   hm_ip(:,:) = 0._wp                     ;   hm_il(:,:) = 0._wp 
    165178         END WHERE          
    166179         ! 
    … …  
    184197      REAL(wp) ::   zhmax, z1_zhmax                 !   -      - 
    185198      REAL(wp) ::   zlay_i, zlay_s                  !   -      - 
    186       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i, z1_v_i 
     199      REAL(wp), PARAMETER ::   zhl_max =  0.015_wp  ! pond lid thickness above which the ponds disappear from the albedo calculation 
     200      REAL(wp), PARAMETER ::   zhl_min =  0.005_wp  ! pond lid thickness below which the full pond area is used in the albedo calculation 
     201      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i, z1_v_i, z1_a_ip, za_s_fra 
    187202      !!------------------------------------------------------------------- 
    188203 
    … …  
    202217      WHERE( v_i(:,:,:) > epsi20 )   ;   z1_v_i(:,:,:) = 1._wp / v_i(:,:,:) 
    203218      ELSEWHERE                      ;   z1_v_i(:,:,:) = 0._wp 
     219      END WHERE 
     220      ! 
     221      WHERE( a_ip(:,:,:) > epsi20 )  ;   z1_a_ip(:,:,:) = 1._wp / a_ip(:,:,:) 
     222      ELSEWHERE                      ;   z1_a_ip(:,:,:) = 0._wp 
    204223      END WHERE 
    205224      !                                           !--- ice thickness 
    … …  
    217236      !                                           !--- ice age       
    218237      o_i(:,:,:) = oa_i(:,:,:) * z1_a_i(:,:,:) 
    219       !                                           !--- pond fraction and thickness       
     238      !                                           !--- pond and lid thickness       
     239      h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:) 
     240      h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:) 
     241      !                                           !--- melt pond effective area (used for albedo) 
    220242      a_ip_frac(:,:,:) = a_ip(:,:,:) * z1_a_i(:,:,:) 
    221       WHERE( a_ip_frac(:,:,:) > epsi20 )   ;   h_ip(:,:,:) = v_ip(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:) 
    222       ELSEWHERE                            ;   h_ip(:,:,:) = 0._wp 
     243      WHERE    ( h_il(:,:,:) <= zhl_min )  ;   a_ip_eff(:,:,:) = a_ip_frac(:,:,:)       ! lid is very thin.  Expose all the pond 
     244      ELSEWHERE( h_il(:,:,:) >= zhl_max )  ;   a_ip_eff(:,:,:) = 0._wp                  ! lid is very thick. Cover all the pond up with ice and snow 
     245      ELSEWHERE                            ;   a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * &   ! lid is in between. Expose part of the pond 
     246         &                                                       ( h_il(:,:,:) - zhl_min ) / ( zhl_max - zhl_min ) 
    223247      END WHERE 
     248      ! 
     249      CALL ice_var_snwfra( h_s, za_s_fra )           ! calculate ice fraction covered by snow 
     250      a_ip_eff = MIN( a_ip_eff, 1._wp - za_s_fra )   ! make sure (a_ip_eff + a_s_fra) <= 1 
    224251      ! 
    225252      !                                           !---  salinity (with a minimum value imposed everywhere)      
    … …  
    289316      sv_i(:,:,:) = s_i (:,:,:) * v_i (:,:,:) 
    290317      v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     318      v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
    291319      ! 
    292320   END SUBROUTINE ice_var_eqv2glo 
    … …  
    533561               a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 
    534562               v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
     563               v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 
    535564               ! 
    536565            END DO 
    … …  
    555584 
    556585 
    557    SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     586   SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    558587      !!------------------------------------------------------------------- 
    559588      !!                   ***  ROUTINE ice_var_zapneg *** 
    … …  
    570599      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    571600      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     601      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    572602      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    573603      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    … …  
    636666      WHERE( pa_ip (:,:,:) < 0._wp )   pa_ip (:,:,:) = 0._wp 
    637667      WHERE( pv_ip (:,:,:) < 0._wp )   pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+) 
    638       !                                                        but it does not change conservation, so keep it this way is ok 
     668      WHERE( pv_il (:,:,:) < 0._wp )   pv_il (:,:,:) = 0._wp !    but it does not change conservation, so keep it this way is ok 
    639669      ! 
    640670   END SUBROUTINE ice_var_zapneg 
    641671 
    642672 
    643    SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     673   SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    644674      !!------------------------------------------------------------------- 
    645675      !!                   ***  ROUTINE ice_var_roundoff *** 
    … …  
    654684      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    655685      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     686      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    656687      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    657688      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    … …  
    665696      WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 )   pe_i (1:npti,:,:) = 0._wp   !  e_i must be >= 0 
    666697      WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 )   pe_s (1:npti,:,:) = 0._wp   !  e_s must be >= 0 
    667       IF( ln_pnd_H12 ) THEN 
     698      IF( ln_pnd_LEV ) THEN 
    668699         WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 )    pa_ip(1:npti,:)   = 0._wp   ! a_ip must be >= 0 
    669700         WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 
     701         IF( ln_pnd_lids ) THEN 
     702            WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:)   = 0._wp   ! v_il must be >= 0 
     703         ENDIF 
    670704      ENDIF 
    671705      ! 
    … …  
    786820   !! ** Purpose :  converting N-cat ice to jpl ice categories 
    787821   !!------------------------------------------------------------------- 
    788    SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    789       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     822   SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     823      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    790824      !!------------------------------------------------------------------- 
    791825      !! ** Purpose :  converting 1-cat ice to 1 ice category 
    … …  
    793827      REAL(wp), DIMENSION(:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    794828      REAL(wp), DIMENSION(:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    795       REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    796       REAL(wp), DIMENSION(:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     829      REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     830      REAL(wp), DIMENSION(:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il    ! output ice/snow temp & sal & ponds 
    797831      !!------------------------------------------------------------------- 
    798832      ! == thickness and concentration == ! 
    … …  
    808842      pa_ip(:) = patip(:) 
    809843      ph_ip(:) = phtip(:) 
     844      ph_il(:) = phtil(:) 
    810845       
    811846   END SUBROUTINE ice_var_itd_1c1c 
    812847 
    813    SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    814       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     848   SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     849      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    815850      !!------------------------------------------------------------------- 
    816851      !! ** Purpose :  converting N-cat ice to 1 ice category 
    … …  
    818853      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    819854      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    820       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    821       REAL(wp), DIMENSION(:)  , INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     855      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     856      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il    ! output ice/snow temp & sal & ponds 
    822857      ! 
    823858      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z1_ai, z1_vi, z1_vs 
    … …  
    854889      ! == ponds == ! 
    855890      pa_ip(:) = SUM( patip(:,:), dim=2 ) 
    856       WHERE( pa_ip(:) /= 0._wp )   ;   ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
    857       ELSEWHERE                    ;   ph_ip(:) = 0._wp 
     891      WHERE( pa_ip(:) /= 0._wp ) 
     892         ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     893         ph_il(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     894      ELSEWHERE 
     895         ph_ip(:) = 0._wp 
     896         ph_il(:) = 0._wp 
    858897      END WHERE 
    859898      ! 
    … …  
    862901   END SUBROUTINE ice_var_itd_Nc1c 
    863902    
    864    SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    865       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     903   SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     904      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    866905      !!------------------------------------------------------------------- 
    867906      !! 
    … …  
    885924      REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    886925      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    887       REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    888       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     926      REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     927      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il    ! output ice/snow temp & sal & ponds 
    889928      ! 
    890929      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zfra, z1_hti 
    … …  
    9761015         pt_su(:,jl) = ptmsu(:) 
    9771016         ps_i (:,jl) = psmi (:) 
    978          ps_i (:,jl) = psmi (:)          
    9791017      END DO 
    9801018      ! 
    … …  
    9971035         END WHERE 
    9981036      END DO 
     1037      ! keep the same v_il/v_i ratio for each category 
     1038      WHERE( ( phti(:) * pati(:) ) /= 0._wp )   ;   zfra(:) = ( phtil(:) * patip(:) ) / ( phti(:) * pati(:) ) 
     1039      ELSEWHERE                                 ;   zfra(:) = 0._wp 
     1040      END WHERE 
     1041      DO jl = 1, jpl 
     1042         WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1043         ELSEWHERE                       ;   ph_il(:,jl) = 0._wp 
     1044         END WHERE 
     1045      END DO 
    9991046      DEALLOCATE( zfra ) 
    10001047      ! 
    10011048   END SUBROUTINE ice_var_itd_1cMc 
    10021049 
    1003    SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    1004       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     1050   SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     1051      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    10051052      !!------------------------------------------------------------------- 
    10061053      !! 
    … …  
    10171064      !! 
    10181065      !!               2) Expand the filling to the cat jlmin-1 and jlmax+1 
    1019        !!                   by removing 25% ice area from jlmin and jlmax (resp.)  
     1066      !!                   by removing 25% ice area from jlmin and jlmax (resp.)  
    10201067      !!               
    10211068      !!               3) Expand the filling to the empty cat between jlmin and jlmax  
    … …  
    10331080      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    10341081      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    1035       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    1036       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     1082      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     1083      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il    ! output ice/snow temp & sal & ponds 
    10371084      ! 
    10381085      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   jlfil, jlfil2 
    … …  
    10631110         pa_ip(:,:) = patip(:,:) 
    10641111         ph_ip(:,:) = phtip(:,:) 
     1112         ph_il(:,:) = phtil(:,:) 
    10651113         !                              ! ---------------------- ! 
    10661114      ELSEIF( icat == 1 ) THEN          ! input cat = 1          ! 
    … …  
    10681116         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 
    10691117            &                    ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
    1070             &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 
    1071             &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:)  ) 
     1118            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), phtil(:,1), & 
     1119            &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:), ph_il(:,:)  ) 
    10721120         !                              ! ---------------------- ! 
    10731121      ELSEIF( jpl == 1 ) THEN           ! output cat = 1         ! 
    … …  
    10751123         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 
    10761124            &                    ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
    1077             &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 
    1078             &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1)  ) 
     1125            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), phtil(:,:), & 
     1126            &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1), ph_il(:,1)  ) 
    10791127         !                              ! ----------------------- ! 
    10801128      ELSE                              ! input cat /= output cat ! 
    … …  
    12181266            END WHERE 
    12191267         END DO 
     1268         ! keep the same v_il/v_i ratio for each category 
     1269         WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 
     1270            zfra(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 
     1271         ELSEWHERE 
     1272            zfra(:) = 0._wp 
     1273         END WHERE 
     1274         DO jl = 1, jpl 
     1275            WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1276            ELSEWHERE                       ;   ph_il(:,jl) = 0._wp 
     1277            END WHERE 
     1278         END DO 
    12201279         DEALLOCATE( zfra ) 
    12211280         ! 
    … …  
    12231282      ! 
    12241283   END SUBROUTINE ice_var_itd_NcMc 
     1284 
     1285   !!------------------------------------------------------------------- 
     1286   !! INTERFACE ice_var_snwfra 
     1287   !! 
     1288   !! ** Purpose :  fraction of ice covered by snow 
     1289   !! 
     1290   !! ** Method  :  In absence of proper snow model on top of sea ice, 
     1291   !!               we argue that snow does not cover the whole ice because 
     1292   !!               of wind blowing... 
     1293   !!                 
     1294   !! ** Arguments : ph_s: snow thickness 
     1295   !!                 
     1296   !! ** Output    : pa_s_fra: fraction of ice covered by snow 
     1297   !! 
     1298   !!------------------------------------------------------------------- 
     1299   SUBROUTINE ice_var_snwfra_3d( ph_s, pa_s_fra ) 
     1300      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ph_s        ! snow thickness 
     1301      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pa_s_fra    ! ice fraction covered by snow 
     1302      IF    ( nn_snwfra == 0 ) THEN   ! basic 0 or 1 snow cover 
     1303         WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 
     1304         ELSEWHERE             ; pa_s_fra = 0._wp 
     1305         END WHERE 
     1306      ELSEIF( nn_snwfra == 1 ) THEN   ! snow cover depends on hsnow (met-office style) 
     1307         pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 
     1308      ELSEIF( nn_snwfra == 2 ) THEN   ! snow cover depends on hsnow (cice style) 
     1309         pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 
     1310      ENDIF 
     1311   END SUBROUTINE ice_var_snwfra_3d 
     1312 
     1313   SUBROUTINE ice_var_snwfra_2d( ph_s, pa_s_fra ) 
     1314      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ph_s        ! snow thickness 
     1315      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pa_s_fra    ! ice fraction covered by snow 
     1316      IF    ( nn_snwfra == 0 ) THEN   ! basic 0 or 1 snow cover 
     1317         WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 
     1318         ELSEWHERE             ; pa_s_fra = 0._wp 
     1319         END WHERE 
     1320      ELSEIF( nn_snwfra == 1 ) THEN   ! snow cover depends on hsnow (met-office style) 
     1321         pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 
     1322      ELSEIF( nn_snwfra == 2 ) THEN   ! snow cover depends on hsnow (cice style) 
     1323         pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 
     1324      ENDIF 
     1325   END SUBROUTINE ice_var_snwfra_2d 
     1326 
     1327   SUBROUTINE ice_var_snwfra_1d( ph_s, pa_s_fra ) 
     1328      REAL(wp), DIMENSION(:), INTENT(in   ) ::   ph_s        ! snow thickness 
     1329      REAL(wp), DIMENSION(:), INTENT(  out) ::   pa_s_fra    ! ice fraction covered by snow 
     1330      IF    ( nn_snwfra == 0 ) THEN   ! basic 0 or 1 snow cover 
     1331         WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 
     1332         ELSEWHERE             ; pa_s_fra = 0._wp 
     1333         END WHERE 
     1334      ELSEIF( nn_snwfra == 1 ) THEN   ! snow cover depends on hsnow (met-office style) 
     1335         pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 
     1336      ELSEIF( nn_snwfra == 2 ) THEN   ! snow cover depends on hsnow (cice style) 
     1337         pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 
     1338      ENDIF 
     1339   END SUBROUTINE ice_var_snwfra_1d 
     1340    
     1341   !!-------------------------------------------------------------------------- 
     1342   !! INTERFACE ice_var_snwblow 
     1343   !! 
     1344   !! ** Purpose :   Compute distribution of precip over the ice 
     1345   !! 
     1346   !!                Snow accumulation in one thermodynamic time step 
     1347   !!                snowfall is partitionned between leads and ice. 
     1348   !!                If snow fall was uniform, a fraction (1-at_i) would fall into leads 
     1349   !!                but because of the winds, more snow falls on leads than on sea ice 
     1350   !!                and a greater fraction (1-at_i)^beta of the total mass of snow  
     1351   !!                (beta < 1) falls in leads. 
     1352   !!                In reality, beta depends on wind speed,  
     1353   !!                and should decrease with increasing wind speed but here, it is  
     1354   !!                considered as a constant. an average value is 0.66 
     1355   !!-------------------------------------------------------------------------- 
     1356!!gm  I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE.... 
     1357   SUBROUTINE ice_var_snwblow_2d( pin, pout ) 
     1358      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( 1. - a_i_b ) 
     1359      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout 
     1360      pout = ( 1._wp - ( pin )**rn_snwblow ) 
     1361   END SUBROUTINE ice_var_snwblow_2d 
     1362 
     1363   SUBROUTINE ice_var_snwblow_1d( pin, pout ) 
     1364      REAL(wp), DIMENSION(:), INTENT(in   ) :: pin 
     1365      REAL(wp), DIMENSION(:), INTENT(inout) :: pout 
     1366      pout = ( 1._wp - ( pin )**rn_snwblow ) 
     1367   END SUBROUTINE ice_var_snwblow_1d 
    12251368 
    12261369#else 

  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icewri.F90

    r11575 r13466  
    116116      IF( iom_use('icehpnd' ) )   CALL iom_put( 'icehpnd', hm_ip  * zmsk00      )                                           ! melt pond depth 
    117117      IF( iom_use('icevpnd' ) )   CALL iom_put( 'icevpnd', vt_ip  * zmsk00      )                                           ! melt pond total volume per unit area 
     118      IF( iom_use('icehlid' ) )   CALL iom_put( 'icehlid', hm_il  * zmsk00      )                                           ! melt pond lid depth 
     119      IF( iom_use('icevlid' ) )   CALL iom_put( 'icevlid', vt_il  * zmsk00      )                                           ! melt pond lid total volume per unit area 
    118120      ! salt 
    119121      IF( iom_use('icesalt' ) )   CALL iom_put( 'icesalt', sm_i                 * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity 
    … …  
    162164      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( 'icebrv_cat'  ,   bv_i * 100.  * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 
    163165      IF( iom_use('iceapnd_cat' ) )   CALL iom_put( 'iceapnd_cat' ,   a_ip         * zmsk00l                                   ) ! melt pond frac for categories 
    164       IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond frac for categories 
     166      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories 
     167      IF( iom_use('icehlid_cat' ) )   CALL iom_put( 'icehlid_cat' ,   h_il         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories 
    165168      IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac for categories 
     169      IF( iom_use('iceaepnd_cat') )   CALL iom_put( 'iceaepnd_cat',   a_ip_eff     * zmsk00l                                   ) ! melt pond effective frac for categories 
    166170      IF( iom_use('icealb_cat'  ) )   CALL iom_put( 'icealb_cat'  ,   alb_ice      * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories 
    167171 
    … …  
    177181      IF( iom_use('dmisum') )   CALL iom_put( 'dmisum', - wfx_sum                                                             ) ! Sea-ice mass change through surface melting 
    178182      IF( iom_use('dmibom') )   CALL iom_put( 'dmibom', - wfx_bom                                                             ) ! Sea-ice mass change through bottom melting 
     183      IF( iom_use('dmilam') )   CALL iom_put( 'dmilam', - wfx_lam                                                             ) ! Sea-ice mass change through lateral melting 
    179184      IF( iom_use('dmtsub') )   CALL iom_put( 'dmtsub', - wfx_sub                                                             ) ! Sea-ice mass change through evaporation and sublimation 
    180185      IF( iom_use('dmssub') )   CALL iom_put( 'dmssub', - wfx_snw_sub                                                         ) ! Snow mass change through sublimation 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/BDY/bdy_oce.F90

    r11536 r13466  
    6363      REAL(wp), POINTER, DIMENSION(:,:) ::  aip    !: now ice  pond concentration 
    6464      REAL(wp), POINTER, DIMENSION(:,:) ::  hip    !: now ice  pond depth 
     65      REAL(wp), POINTER, DIMENSION(:,:) ::  hil    !: now ice  pond lid depth 
    6566#if defined key_top 
    6667      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply 
    … …  
    115116   REAL(wp), DIMENSION(jp_bdy) ::   rice_apnd               !: pond conc.  of incoming sea ice 
    116117   REAL(wp), DIMENSION(jp_bdy) ::   rice_hpnd               !: pond thick. of incoming sea ice 
     118   REAL(wp), DIMENSION(jp_bdy) ::   rice_hlid               !: pond lid thick. of incoming sea ice 
    117119   ! 
    118120   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/BDY/bdydta.F90

    r13255 r13466  
    4343   PUBLIC   bdy_dta_init     ! routine called by nemogcm.F90 
    4444 
    45    INTEGER , PARAMETER ::   jpbdyfld  = 16    ! maximum number of files to read  
     45   INTEGER , PARAMETER ::   jpbdyfld  = 17    ! maximum number of files to read  
    4646   INTEGER , PARAMETER ::   jp_bdyssh = 1     !  
    4747   INTEGER , PARAMETER ::   jp_bdyu2d = 2     !  
    … …  
    6060   INTEGER , PARAMETER ::   jp_bdyaip = 15    !  
    6161   INTEGER , PARAMETER ::   jp_bdyhip = 16    !  
     62   INTEGER , PARAMETER ::   jp_bdyhil = 17    !  
    6263#if ! defined key_si3 
    6364   INTEGER , PARAMETER ::   jpl = 1 
    … …  
    190191                        dta_bdy(jbdy)%aip(ib,jl) =  a_ip(ii,ij,jl) * tmask(ii,ij,1)  
    191192                        dta_bdy(jbdy)%hip(ib,jl) =  h_ip(ii,ij,jl) * tmask(ii,ij,1)  
     193                        dta_bdy(jbdy)%hil(ib,jl) =  h_il(ii,ij,jl) * tmask(ii,ij,1)  
    192194                     END DO 
    193195                  END DO 
    … …  
    299301               &                                                                         bf_alias(jp_bdya_i)%fnow(:,1,:)     !   ( a_ip = rice_apnd * a_i ) 
    300302            IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 
     303            IF( TRIM(bf_alias(jp_bdyhil)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyhil)%fnow(:,1,:) = rice_hlid(jbdy) 
    301304 
    302305            ! if T_i is read and not T_su, set T_su = T_i 
    … …  
    323326               bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp 
    324327               bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp 
     328               bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 
     329            ENDIF 
     330            IF ( .NOT.ln_pnd_lids ) THEN 
     331               bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 
    325332            ENDIF 
    326333             
    … …  
    328335            ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3)             
    329336            IF( ipl /= jpl ) THEN      ! ice: convert N-cat fields (input) into jpl-cat (output) 
    330                CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & 
    331                   &              dta_alias%h_i                  , dta_alias%h_s                  , dta_alias%a_i                  , & 
    332                   &              bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & 
    333                   &              bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & 
    334                   &              bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), & 
    335                   &              dta_alias%t_i                  , dta_alias%t_s                  , & 
    336                   &              dta_alias%tsu                  , dta_alias%s_i                  , & 
    337                   &              dta_alias%aip                  , dta_alias%hip ) 
     337               CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & ! in 
     338                  &              dta_alias%h_i                  , dta_alias%h_s                  , dta_alias%a_i                  , & ! out 
     339                  &              bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), &                                  ! in (optional) 
     340                  &              bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), &                                  ! in     - 
     341                  &              bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), bf_alias(jp_bdyhil)%fnow(:,1,:), & ! in     - 
     342                  &              dta_alias%t_i                  , dta_alias%t_s                  , &                                  ! out    - 
     343                  &              dta_alias%tsu                  , dta_alias%s_i                  , &                                  ! out    - 
     344                  &              dta_alias%aip                  , dta_alias%hip                  , dta_alias%hil )                    ! out    - 
    338345            ENDIF 
    339346         ENDIF 
    … …  
    379386      !                                                         ! =F => baroclinic velocities in 3D boundary data 
    380387      LOGICAL                                ::   ln_zinterp    ! =T => requires a vertical interpolation of the bdydta 
    381       REAL(wp)                               ::   rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd  
     388      REAL(wp)                               ::   rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid 
    382389      INTEGER                                ::   ipk,ipl       ! 
    383390      INTEGER                                ::   idvar         ! variable ID 
    … …  
    392399      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill 
    393400      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
    394       TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip        
     401      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil        
    395402      TYPE(FLD_N), DIMENSION(:), POINTER ::   bn_alias                        ! must be an array to be used with fld_fill 
    396403      TYPE(FLD  ), DIMENSION(:), POINTER ::   bf_alias 
    397404      ! 
    398       NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d,         & 
    399                          & bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, & 
    400                          & rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd,           & 
     405      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d,                 & 
     406                         & bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil, & 
     407                         & rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid,      & 
    401408                         & ln_full_vel, ln_zinterp 
    402409      !!--------------------------------------------------------------------------- 
    … …  
    455462#if defined key_si3 
    456463         IF( .NOT.ln_pnd ) THEN 
    457             rn_ice_apnd = 0. ; rn_ice_hpnd = 0. 
    458             CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' ) 
     464            rn_ice_apnd = 0. ; rn_ice_hpnd = 0. ; rn_ice_hlid = 0. 
     465            CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 & rn_ice_hlid = 0 when no ponds' ) 
     466         ENDIF 
     467         IF( .NOT.ln_pnd_lids ) THEN 
     468            rn_ice_hlid = 0. 
    459469         ENDIF 
    460470#endif 
    … …  
    466476         rice_apnd(jbdy) = rn_ice_apnd 
    467477         rice_hpnd(jbdy) = rn_ice_hpnd 
    468           
     478         rice_hlid(jbdy) = rn_ice_hlid 
     479 
    469480          
    470481         DO jfld = 1, jpbdyfld 
    … …  
    567578            IF(  jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. & 
    568579               & jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. & 
    569                & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip     ) THEN 
     580               & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip .OR. jfld == jp_bdyhil ) THEN 
    570581               igrd = 1                                                    ! T point 
    571582               ipk = ipl                                                   ! jpl-cat data 
    … …  
    618629               bf_alias => bf(jp_bdyhip,jbdy:jbdy)                         ! alias for hip structure of bdy number jbdy 
    619630               bn_alias => bn_hip                                          ! alias for hip structure of nambdy_dta  
     631            ENDIF 
     632            IF( jfld == jp_bdyhil ) THEN 
     633               cl3 = 'hil' 
     634               bf_alias => bf(jp_bdyhil,jbdy:jbdy)                         ! alias for hil structure of bdy number jbdy 
     635               bn_alias => bn_hil                                          ! alias for hil structure of nambdy_dta  
    620636            ENDIF 
    621637 
    … …  
    687703                  ENDIF 
    688704               ENDIF 
     705               IF( jfld == jp_bdyhil ) THEN 
     706                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%hil => bf_alias(1)%fnow(:,1,:) 
     707                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%hil(iszdim,jpl) ) 
     708                  ENDIF 
     709               ENDIF 
    689710            ENDIF 
    690711 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/BDY/bdyice.F90

    r12520 r13466  
    9494         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    9595            ! exchange 3d arrays 
    96             CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1. & 
    97                  &                      , a_ip, 'T', 1., v_ip, 'T', 1., s_i , 'T', 1., t_su, 'T', 1. & 
    98                  &                      , v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1.                & 
    99                  &                      , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1      ) 
     96            CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1.                 & 
     97               &                        , s_i , 'T', 1., t_su, 'T', 1., v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1. & 
     98               &                        , a_ip, 'T', 1., v_ip, 'T', 1., v_il, 'T', 1.                                & 
     99               &                        , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    100100            ! exchange 4d arrays :   third dimension = 1   and then   third dimension = jpk 
    101101            CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    … …  
    163163            a_ip(ji,jj,  jl) = ( a_ip(ji,jj,  jl) * zwgt1 + dta%aip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond concentration 
    164164            h_ip(ji,jj,  jl) = ( h_ip(ji,jj,  jl) * zwgt1 + dta%hip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond depth 
     165            h_il(ji,jj,  jl) = ( h_il(ji,jj,  jl) * zwgt1 + dta%hil(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond lid depth 
    165166            ! 
    166167            sz_i(ji,jj,:,jl) = s_i(ji,jj,jl) 
    … …  
    170171               a_ip(ji,jj,jl) = 0._wp 
    171172               h_ip(ji,jj,jl) = 0._wp 
     173               h_il(ji,jj,jl) = 0._wp 
     174            ENDIF 
     175 
     176            IF( .NOT.ln_pnd_lids ) THEN 
     177               h_il(ji,jj,jl) = 0._wp 
    172178            ENDIF 
    173179            ! 
    … …  
    231237               a_ip(ji,jj,  jl) = a_ip(ib,jb,  jl) 
    232238               h_ip(ji,jj,  jl) = h_ip(ib,jb,  jl) 
     239               h_il(ji,jj,  jl) = h_il(ib,jb,  jl) 
    233240               ! 
    234241               sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) 
    … …  
    268275               ! 
    269276               ! melt ponds 
    270                IF( a_i(ji,jj,jl) > epsi10 ) THEN 
    271                   a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i (ji,jj,jl) 
    272                ELSE 
    273                   a_ip_frac(ji,jj,jl) = 0._wp 
    274                ENDIF 
    275277               v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) 
     278               v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl) 
    276279               ! 
    277280            ELSE   ! no ice at the boundary 
    … …  
    281284               h_s (ji,jj,  jl) = 0._wp 
    282285               oa_i(ji,jj,  jl) = 0._wp 
    283                a_ip(ji,jj,  jl) = 0._wp 
    284                v_ip(ji,jj,  jl) = 0._wp 
    285286               t_su(ji,jj,  jl) = rt0 
    286287               t_s (ji,jj,:,jl) = rt0 
    287288               t_i (ji,jj,:,jl) = rt0  
    288289 
    289                a_ip_frac(ji,jj,jl) = 0._wp 
    290                h_ip     (ji,jj,jl) = 0._wp 
    291                a_ip     (ji,jj,jl) = 0._wp 
    292                v_ip     (ji,jj,jl) = 0._wp 
     290               a_ip(ji,jj,jl) = 0._wp 
     291               h_ip(ji,jj,jl) = 0._wp 
     292               h_il(ji,jj,jl) = 0._wp 
    293293                
    294294               IF( nn_icesal == 1 ) THEN     ! if constant salinity 
    … …  
    306306               e_s (ji,jj,:,jl) = 0._wp 
    307307               e_i (ji,jj,:,jl) = 0._wp 
     308               v_ip(ji,jj,  jl) = 0._wp 
     309               v_il(ji,jj,  jl) = 0._wp 
    308310 
    309311            ENDIF 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/DOM/domain.F90

    r11536 r13466  
    113113         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg 
    114114      ENDIF 
    115       lwxios = .FALSE. 
     115      nn_wxios = 0 
    116116      ln_xios_read = .FALSE. 
    117117      ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynnxt.F90

    r12366 r13466  
    3434   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme 
    3535   USE domvvl         ! variable volume 
    36    USE bdy_oce   , ONLY: ln_bdy 
     36   USE bdy_oce , ONLY : ln_bdy 
    3737   USE bdydta         ! ocean open boundary conditions 
    3838   USE bdydyn         ! ocean open boundary conditions 
    … …  
    4848   USE prtctl         ! Print control 
    4949   USE timing         ! Timing 
     50   USE zdfdrg ,  ONLY : ln_drgice_imp, rCdU_top 
    5051#if defined key_agrif 
    5152   USE agrif_oce_interp 
    … …  
    99100      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      - 
    100101      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve 
     102      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zutau, zvtau 
    101103      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3u_f, ze3v_f, zua, zva  
    102104      !!---------------------------------------------------------------------- 
    … …  
    354356      ENDIF 
    355357      ! 
     358      IF ( iom_use("utau") ) THEN 
     359         IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 
     360            ALLOCATE(zutau(jpi,jpj))  
     361            DO jj = 2, jpjm1 
     362               DO ji = 2, jpim1 
     363                  jk = miku(ji,jj)  
     364                  zutau(ji,jj) = utau(ji,jj) &  
     365                  &  + 0.5_wp * rau0 * (rCdU_top(ji+1,jj)+rCdU_top(ji,jj)) * ua(ji,jj,jk)  
     366               END DO 
     367            END DO 
     368            CALL lbc_lnk( 'dynnxt' , zutau, 'U', -1.) 
     369            CALL iom_put(  "utau", zutau(:,:) ) 
     370            DEALLOCATE(zutau) 
     371         ELSE 
     372            CALL iom_put(  "utau", utau(:,:) ) 
     373         ENDIF 
     374      ENDIF 
     375      ! 
     376      IF ( iom_use("vtau") ) THEN 
     377         IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 
     378            ALLOCATE(zvtau(jpi,jpj)) 
     379            DO jj = 2, jpjm1 
     380               DO ji = 2, jpim1 
     381                  jk = mikv(ji,jj) 
     382                  zvtau(ji,jj) = vtau(ji,jj) & 
     383                  &  + 0.5_wp * rau0 * (rCdU_top(ji,jj+1)+rCdU_top(ji,jj)) * va(ji,jj,jk) 
     384               END DO 
     385            END DO 
     386            CALL lbc_lnk( 'dynnxt' , zvtau, 'V', -1.) 
     387            CALL iom_put(  "vtau", zvtau(:,:) ) 
     388            DEALLOCATE(zvtau) 
     389         ELSE 
     390            CALL iom_put(  "vtau", vtau(:,:) ) 
     391         ENDIF 
     392      ENDIF 
     393      ! 
    356394      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt  - Un: ', mask1=umask,   & 
    357395         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynspg_ts.F90

    r12737 r13466  
    14651465      !                    !==  Set the barotropic drag coef.  ==! 
    14661466      ! 
    1467       IF( ln_isfcav ) THEN          ! top+bottom friction (ocean cavities) 
     1467      IF( ln_isfcav.OR.ln_drgice_imp ) THEN          ! top+bottom friction (ocean cavities) 
    14681468          
    14691469         DO jj = 2, jpjm1 
    … …  
    15281528      !                    !==  TOP stress contribution from baroclinic velocities  ==!   (no W/D case) 
    15291529      ! 
    1530       IF( ln_isfcav ) THEN 
     1530      IF( ln_isfcav.OR.ln_drgice_imp ) THEN 
    15311531         ! 
    15321532         IF( ln_bt_fw ) THEN                ! FORWARD integration: use NOW top baroclinic velocity 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynzdf.F90

    r12292 r13466  
    141141            END DO 
    142142         END DO 
    143          IF( ln_isfcav ) THEN    ! Ocean cavities (ISF) 
     143         IF( ln_isfcav.OR.ln_drgice_imp ) THEN    ! Ocean cavities (ISF) 
    144144            DO jj = 2, jpjm1         
    145145               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    258258            END DO 
    259259         END DO 
    260          IF ( ln_isfcav ) THEN   ! top friction (always implicit) 
     260         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN   ! top friction (always implicit) 
    261261            DO jj = 2, jpjm1 
    262262               DO ji = 2, jpim1 
    … …  
    423423            END DO 
    424424         END DO 
    425          IF ( ln_isfcav ) THEN 
     425         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN 
    426426            DO jj = 2, jpjm1 
    427427               DO ji = 2, jpim1 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/IOM/iom.F90

    r13280 r13466  
    321321           rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 
    322322        ELSE 
    323            rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in) 
     323           rst_file = TRIM(clpath)//TRIM(Agrif_CFixed())//'_'//TRIM(cn_ocerst_in) 
    324324        ENDIF 
    325325!set name of the restart file and enable available fields 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/LBC/lbc_lnk_multi_generic.h90

    r11536 r13466  
    1515#endif 
    1616 
    17    SUBROUTINE ROUTINE_MULTI( cdname                                                                             & 
    18       &                    , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4   & 
    19       &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   & 
    20       &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      & 
     17   SUBROUTINE ROUTINE_MULTI( cdname                                                                               & 
     18      &                    , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4   & 
     19      &                    , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8   & 
     20      &                    , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12  & 
     21      &                    , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16  & 
    2122      &                    , kfillmode, pfillval, lsend, lrecv, ihlcom ) 
    2223      !!--------------------------------------------------------------------- 
    23       CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine 
    24       ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) :: pt1     ! arrays on which the lbc is applied 
    25       ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2  , pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9  , pt10  , pt11 
    26       CHARACTER(len=1)                     , INTENT(in   ) :: cdna1   ! nature of pt2D. array grid-points 
    27       CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11 
    28       REAL(wp)                             , INTENT(in   ) :: psgn1   ! sign used across the north fold 
    29       REAL(wp)           , OPTIONAL        , INTENT(in   ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11 
    30       INTEGER            , OPTIONAL        , INTENT(in   ) :: kfillmode   ! filling method for halo over land (default = constant) 
    31       REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries) 
    32       LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out 
    33       INTEGER            , OPTIONAL        , INTENT(in   ) :: ihlcom         ! number of ranks and rows to be communicated 
     24      CHARACTER(len=*)     ,                   INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     25      ARRAY_TYPE(:,:,:,:)            , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied 
     26      ARRAY_TYPE(:,:,:,:)  , OPTIONAL, TARGET, INTENT(inout) ::   pt2   , pt3   , pt4   , pt5   , pt6   , pt7   , pt8   , pt9  , & 
     27         &                                                        pt10  , pt11  , pt12  , pt13  , pt14  , pt15  , pt16 
     28      CHARACTER(len=1)                       , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points 
     29      CHARACTER(len=1)     , OPTIONAL        , INTENT(in   ) ::   cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, & 
     30         &                                                        cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, cdna16 
     31      REAL(wp)                               , INTENT(in   ) ::   psgn1   ! sign used across the north fold 
     32      REAL(wp)             , OPTIONAL        , INTENT(in   ) ::   psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , psgn9, & 
     33         &                                                        psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, psgn16 
     34      INTEGER              , OPTIONAL        , INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant) 
     35      REAL(wp)             , OPTIONAL        , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
     36      LOGICAL, DIMENSION(4), OPTIONAL        , INTENT(in   ) ::   lsend, lrecv   ! indicate how communications are to be carried out 
     37      INTEGER              , OPTIONAL        , INTENT(in   ) ::   ihlcom         ! number of ranks and rows to be communicated 
    3438      !! 
    3539      INTEGER                          ::   kfld        ! number of elements that will be attributed 
    36       PTR_TYPE         , DIMENSION(11) ::   ptab_ptr    ! pointer array 
    37       CHARACTER(len=1) , DIMENSION(11) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
    38       REAL(wp)         , DIMENSION(11) ::   psgn_ptr    ! sign used across the north fold boundary 
     40      PTR_TYPE         , DIMENSION(16) ::   ptab_ptr    ! pointer array 
     41      CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
     42      REAL(wp)         , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary 
    3943      !!--------------------------------------------------------------------- 
    4044      ! 
    … …  
    5559      IF( PRESENT(psgn10) )   CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    5660      IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     61      IF( PRESENT(psgn12) )   CALL ROUTINE_LOAD( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     62      IF( PRESENT(psgn13) )   CALL ROUTINE_LOAD( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     63      IF( PRESENT(psgn14) )   CALL ROUTINE_LOAD( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     64      IF( PRESENT(psgn15) )   CALL ROUTINE_LOAD( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     65      IF( PRESENT(psgn16) )   CALL ROUTINE_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    5766      ! 
    58       CALL lbc_lnk_ptr    ( cdname,              ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     67      CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
    5968      ! 
    6069   END SUBROUTINE ROUTINE_MULTI 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbc_ice.F90

    r12395 r13466  
    6969   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s] 
    7070   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s] 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz         !: wind speed module at T-point                 [m/s] 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz         !: sea surface freezing temperature            [degC] 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rCdU_ice       !: ice-ocean drag at T-point (<0)               [m/s] 
    7273#endif 
    7374 
    … …  
    8990   ! variables used in the coupled interface 
    9091   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
    91    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice  
    9293    
    9394   ! already defined in ice.F90 for SI3 
    9495   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    9596   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  h_i, h_s 
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i_last_couple   !: Sea ice fraction on categories at the last coupling point 
    9698 
    9799   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    98100#endif 
    99101 
    100    REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
     102   REAL(wp), PUBLIC, SAVE ::   pp_cldf = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
    101103 
    102104   !! arrays relating to embedding ice in the ocean 
    … …  
    131133         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce   (jpi,jpj)     ,   & 
    132134         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce    (jpi,jpj)     ,   & 
    133          &      emp_ice (jpi,jpj)     , sstfrz   (jpi,jpj)     , STAT= ierr(2) ) 
     135         &      emp_ice (jpi,jpj)     , sstfrz   (jpi,jpj)     , rCdU_ice   (jpi,jpj)     , STAT= ierr(2) ) 
    134136#endif 
    135137 
    … …  
    167169   LOGICAL         , PUBLIC, PARAMETER ::   lk_si3     = .FALSE.  !: no SI3 ice model 
    168170   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE ice model 
    169    REAL(wp)        , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-] 
     171   REAL(wp)        , PUBLIC, PARAMETER ::   pp_cldf    = 0.81     !: cloud fraction over sea ice, summer CLIO value   [-] 
    170172   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1  
    171173   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice                        ! jpi, jpj 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbc_oce.F90

    r12132 r13466  
    136136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
    137137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cloud_fra         !: cloud cover (fraction of cloud in a gridcell) [-] 
    138139 
    139140   !!---------------------------------------------------------------------- 
    … …  
    178179         &      fwficb  (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) ) 
    179180         ! 
    180       ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     & 
    181          &      atm_co2(jpi,jpj) ,                                        & 
    182          &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      & 
    183          &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
     181      ALLOCATE( tprecip(jpi,jpj) , sprecip  (jpi,jpj) , fr_i(jpi,jpj) ,   & 
     182         &      atm_co2(jpi,jpj) , cloud_fra(jpi,jpj) ,                   & 
     183         &      ssu_m  (jpi,jpj) , sst_m    (jpi,jpj) , frq_m(jpi,jpj) ,  & 
     184         &      ssv_m  (jpi,jpj) , sss_m    (jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
    184185         ! 
    185186      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk.F90

    r12926 r13466  
    4646   USE lib_fortran    ! to use key_nosignedzero 
    4747#if defined key_si3 
    48    USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif 
    49    USE icethd_dh      ! for CALL ice_thd_snwblow 
     48   USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif, nn_qtrice 
     49   USE icevar         ! for CALL ice_var_snwblow 
    5050#endif 
    5151   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009)  
    … …  
    8080   REAL(wp), PARAMETER ::   rctv0 = R_vap/R_dry - 1._wp !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    8181 
    82    INTEGER , PARAMETER ::   jpfld   =10           ! maximum number of files to read 
     82   INTEGER , PARAMETER ::   jpfld   =11           ! maximum number of files to read 
    8383   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    8484   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    … …  
    9090   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    9191   INTEGER , PARAMETER ::   jp_slp  = 9           ! index of sea level pressure              (Pa) 
    92    INTEGER , PARAMETER ::   jp_tdif =10           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
     92   INTEGER , PARAMETER ::   jp_cc   =10           ! index of cloud cover                     (-)      range:0-1 
     93   INTEGER , PARAMETER ::   jp_tdif =11           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
    9394 
    9495   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
    … …  
    161162      !! 
    162163      !!---------------------------------------------------------------------- 
    163       INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument 
     164      INTEGER  ::   jfpr, jfld            ! dummy loop indice and argument 
    164165      INTEGER  ::   ios, ierror, ioptio   ! Local integer 
    165166      !! 
    … …  
    168169      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    169170      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        " 
    170       TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        " 
     171      TYPE(FLD_N) ::   sn_slp , sn_tdif, sn_cc                 !       "                        " 
    171172      NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    172          &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                & 
     173         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif, sn_cc,         & 
    173174         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm 
    174175         &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         &  
    … …  
    214215      slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    215216      slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    216       slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif 
     217      slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_cc)   = sn_cc 
     218      slf_i(jp_tdif) = sn_tdif 
    217219      ! 
    218220      lhftau = ln_taudif                     !- add an extra field if HF stress is used 
    … …  
    222224      ALLOCATE( sf(jfld), STAT=ierror ) 
    223225      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' ) 
    224       DO ifpr= 1, jfld 
    225          ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    226          IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    227          IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   & 
    228             &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    229             &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
    230  
    231       END DO 
     226 
    232227      !                                      !- fill the bulk structure with namelist informations 
    233228      CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 
    234229      ! 
     230      DO jfpr = 1, jfld 
     231         ! 
     232         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero) 
     233            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     234            sf(jfpr)%fnow(:,:,1) = 0._wp 
     235         ELSE                                                  !-- used field --! 
     236            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     237            IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 
     238            IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )                      & 
     239               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 
     240               &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
     241         ENDIF 
     242      ENDDO 
     243      ! fill cloud cover array with constant value if "not used" 
     244      IF( TRIM(sf(jp_cc)%clrootname) == 'NOT USED' )   sf(jp_cc)%fnow(:,:,1) = pp_cldf 
     245          
    235246      IF ( ln_wave ) THEN 
    236247      !Activated wave module but neither drag nor stokes drift activated 
    … …  
    384395      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
    385396 
     397      ! --- cloud cover --- ! 
     398      cloud_fra(:,:) = sf(jp_cc)%fnow(:,:,1) 
     399 
    386400      ! ----------------------------------------------------------------------------- ! 
    387401      !      0   Wind components and module at T-point relative to the moving ocean   ! 
    … …  
    797811      REAL(wp) ::   zst3                     ! local variable 
    798812      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
    799       REAL(wp) ::   zztmp, z1_rLsub           !   -      - 
    800       REAL(wp) ::   zfr1, zfr2               ! local variables 
     813      REAL(wp) ::   zztmp, z1_rLsub          !   -      - 
    801814      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature 
    802815      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qlw         ! long wave heat flux over ice 
    … …  
    807820      REAL(wp), DIMENSION(jpi,jpj)     ::   zrhoa 
    808821      REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp, ztmp2 
     822      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri 
    809823      !!--------------------------------------------------------------------- 
    810824      ! 
    … …  
    881895      ! --- evaporation minus precipitation --- ! 
    882896      zsnw(:,:) = 0._wp 
    883       CALL ice_thd_snwblow( (1.-at_i_b(:,:)), zsnw )  ! snow distribution over ice after wind blowing 
     897      CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw )  ! snow distribution over ice after wind blowing 
    884898      emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
    885899      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
    … …  
    908922      END DO 
    909923 
    910       ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    911       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    912       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
    913       ! 
    914       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    915          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    916       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    917          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    918       ELSEWHERE                                                         ! zero when hs>0 
    919          qtr_ice_top(:,:,:) = 0._wp  
    920       END WHERE 
     924      ! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- ! 
     925      IF( nn_qtrice == 0 ) THEN 
     926         ! formulation derived from Grenfell and Maykut (1977), where transmission rate 
     927         !    1) depends on cloudiness 
     928         !    2) is 0 when there is any snow 
     929         !    3) tends to 1 for thin ice 
     930         ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
     931         DO jl = 1, jpl 
     932            WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     933               qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     934            ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     935               qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     936            ELSEWHERE                                                         ! zero when hs>0 
     937               qtr_ice_top(:,:,jl) = 0._wp  
     938            END WHERE 
     939         ENDDO 
     940      ELSEIF( nn_qtrice == 1 ) THEN 
     941         ! formulation is derived from the thesis of M. Lebrun (2019). 
     942         !    It represents the best fit using several sets of observations 
     943         !    It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 
     944         qtr_ice_top(:,:,:) = 0.3_wp * qsr_ice(:,:,:) 
     945      ENDIF 
    921946      ! 
    922947 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk_algo_ncar.F90

    r10190 r13466  
    1111   !! 
    1212   !!       Routine turb_ncar maintained and developed in AeroBulk 
    13    !!                     (http://aerobulk.sourceforge.net/) 
     13   !!                     (https://github.com/brodeau/aerobulk/) 
    1414   !! 
    15    !!                         L. Brodeau, 2015 
     15   !!                         L. Brodeau, 2020 
    1616   !!===================================================================== 
    17    !! History :  3.6  !  2016-02  (L.Brodeau) successor of old turb_ncar of former sbcblk_core.F90 
     17   !! History :  4.0  !  2020-06  (L.Brodeau) successor of old turb_ncar of former sbcblk_core.F90 
    1818   !!---------------------------------------------------------------------- 
    1919 
    … …  
    4242   PRIVATE 
    4343 
    44    PUBLIC ::   TURB_NCAR   ! called by sbcblk.F90 
     44   PUBLIC :: TURB_NCAR   ! called by sbcblk.F90 
    4545 
    4646   !                              ! NCAR own values for given constants: 
    4747   REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature... 
    48     
     48 
     49   INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations 
     50 
    4951   !!---------------------------------------------------------------------- 
    5052CONTAINS 
    5153 
    5254   SUBROUTINE turb_ncar( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 
    53       &                  Cd, Ch, Ce, t_zu, q_zu, U_blk,      & 
    54       &                  Cdn, Chn, Cen                       ) 
    55       !!---------------------------------------------------------------------------------- 
     55      &                  Cd, Ch, Ce, t_zu, q_zu, Ub,         & 
     56      &                  CdN, ChN, CeN                       ) 
     57      !!---------------------------------------------------------------------- 
    5658      !!                      ***  ROUTINE  turb_ncar  *** 
    5759      !! 
    … …  
    5961      !!                fluxes according to Large & Yeager (2004) and Large & Yeager (2008) 
    6062      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu 
    61       !!                Returns the effective bulk wind speed at 10m to be used in the bulk formulas 
    62       !! 
    63       !! ** Method : Monin Obukhov Similarity Theory 
    64       !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10) 
    65       !! 
    66       !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008 
    67       !! 
    68       !! ** Last update: Laurent Brodeau, June 2014: 
    69       !!    - handles both cases zt=zu and zt/=zu 
    70       !!    - optimized: less 2D arrays allocated and less operations 
    71       !!    - better first guess of stability by checking air-sea difference of virtual temperature 
    72       !!       rather than temperature difference only... 
    73       !!    - added function "cd_neutral_10m" that uses the improved parametrization of 
    74       !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions! 
    75       !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them 
    76       !!      => 'vkarmn' and 'grav' 
    77       !! 
    78       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     63      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas 
    7964      !! 
    8065      !! INPUT : 
    8166      !! ------- 
    8267      !!    *  zt   : height for temperature and spec. hum. of air            [m] 
    83       !!    *  zu   : height for wind speed (generally 10m)                   [m] 
    84       !!    *  U_zu : scalar wind speed at 10m                                [m/s] 
    85       !!    *  sst  : SST                                                     [K] 
     68      !!    *  zu   : height for wind speed (usually 10m)                     [m] 
     69      !!    *  sst  : bulk SST                                                [K] 
    8670      !!    *  t_zt : potential air temperature at zt                         [K] 
    8771      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg] 
    8872      !!    *  q_zt : specific humidity of air at zt                          [kg/kg] 
    89       !! 
     73      !!    *  U_zu : scalar wind speed at zu                                 [m/s] 
    9074      !! 
    9175      !! OUTPUT : 
    … …  
    9680      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    9781      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    98       !!    *  U_blk  : bulk wind at 10m                                      [m/s] 
     82      !!    *  Ub  : bulk wind speed at zu                                 [m/s] 
     83      !! 
     84      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    9985      !!---------------------------------------------------------------------------------- 
    10086      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m] 
    … …  
    10389      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin] 
    10490      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg] 
    105       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg] 
     91      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg] 
    10692      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s] 
    10793      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
    … …  
    11096      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    11197      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    112       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
    113       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    114       ! 
    115       INTEGER ::   j_itt 
    116       LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    117       INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations 
     98      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ub    ! bulk wind speed at zu                     [m/s] 
     99      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   CdN, ChN, CeN ! neutral transfer coefficients 
     100      ! 
     101      INTEGER :: j_itt 
     102      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    118103      ! 
    119104      REAL(wp), DIMENSION(jpi,jpj) ::   Cx_n10        ! 10m neutral latent/sensible coefficient 
    120       REAL(wp), DIMENSION(jpi,jpj) ::   sqrt_Cd_n10   ! root square of Cd_n10 
     105      REAL(wp), DIMENSION(jpi,jpj) ::   sqrtCdN10   ! root square of Cd_n10 
    121106      REAL(wp), DIMENSION(jpi,jpj) ::   zeta_u        ! stability parameter at height zu 
    122107      REAL(wp), DIMENSION(jpi,jpj) ::   zpsi_h_u 
    123108      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2 
    124       REAL(wp), DIMENSION(jpi,jpj) ::   stab          ! stability test integer 
    125       !!---------------------------------------------------------------------------------- 
    126       ! 
    127       l_zt_equal_zu = .FALSE. 
    128       IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
    129  
    130       U_blk = MAX( 0.5 , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
    131  
    132       !! First guess of stability: 
    133       ztmp0 = t_zt*(1. + rctv0*q_zt) - sst*(1. + rctv0*ssq) ! air-sea difference of virtual pot. temp. at zt 
    134       stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable 
    135  
    136       !! Neutral coefficients at 10m: 
     109      REAL(wp), DIMENSION(jpi,jpj) ::   sqrtCd 
     110      !!---------------------------------------------------------------------------------- 
     111 
     112      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) 
     113 
     114      Ub = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
     115 
     116      !! Neutral drag coefficient at zu: 
    137117      IF( ln_cdgw ) THEN      ! wave drag case 
    138          cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 
    139          ztmp0   (:,:) = cdn_wave(:,:) 
     118         CdN = MAX( cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) , 0.1E-3_wp ) 
    140119      ELSE 
    141          ztmp0 = cd_neutral_10m( U_blk ) 
     120         CdN = CD_N10_NCAR( Ub ) 
    142121      ENDIF 
    143  
    144       sqrt_Cd_n10 = SQRT( ztmp0 ) 
     122      sqrtCdN10 = SQRT( CdN ) 
    145123 
    146124      !! Initializing transf. coeff. with their first guess neutral equivalents : 
    147       Cd = ztmp0 
    148       Ce = 1.e-3*( 34.6 * sqrt_Cd_n10 ) 
    149       Ch = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab)) 
    150       stab = sqrt_Cd_n10   ! Temporaty array !!! stab == SQRT(Cd) 
    151   
    152       IF( ln_cdgw )   Cen = Ce  ; Chn = Ch 
     125      Cd = CdN 
     126      Ce = CE_N10_NCAR( sqrtCdN10 ) 
     127      ztmp0 = 0.5_wp + SIGN(0.5_wp, virt_temp(t_zt, q_zt) - virt_temp(sst, ssq)) ! we guess stability based on delta of virt. pot. temp. 
     128      Ch = CH_N10_NCAR( sqrtCdN10 , ztmp0 ) 
     129      sqrtCd = sqrtCdN10 
    153130 
    154131      !! Initializing values at z_u with z_t values: 
    155       t_zu = t_zt   ;   q_zu = q_zt 
    156  
    157       !!  * Now starting iteration loop 
    158       DO j_itt=1, nb_itt 
     132      t_zu = t_zt 
     133      q_zu = q_zt 
     134 
     135      !! ITERATION BLOCK 
     136      DO j_itt = 1, nb_itt 
    159137         ! 
    160138         ztmp1 = t_zu - sst   ! Updating air/sea differences 
    161139         ztmp2 = q_zu - ssq 
    162140 
    163          ! Updating turbulent scales :   (L&Y 2004 eq. (7)) 
    164          ztmp1  = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd)) 
    165          ztmp2  = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd)) 
    166  
    167          ztmp0 = 1. + rctv0*q_zu      ! multiply this with t and you have the virtual temperature 
    168  
    169          ! Estimate the inverse of Monin-Obukov length (1/L) at height zu: 
    170          ztmp0 =  (grav*vkarmn/(t_zu*ztmp0)*(ztmp1*ztmp0 + rctv0*t_zu*ztmp2)) / (Cd*U_blk*U_blk) 
    171          !                                                      ( Cd*U_blk*U_blk is U*^2 at zu ) 
     141         ! Updating turbulent scales :   (L&Y 2004 Eq. (7)) 
     142         ztmp0 = sqrtCd*Ub          ! u* 
     143         ztmp1 = Ch/sqrtCd*ztmp1    ! theta* 
     144         ztmp2 = Ce/sqrtCd*ztmp2    ! q* 
     145 
     146         ! Estimate the inverse of Obukov length (1/L) at height zu: 
     147         ztmp0 = One_on_L( t_zu, q_zu, ztmp0, ztmp1, ztmp2 ) 
    172148 
    173149         !! Stability parameters : 
    174          zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u ) 
    175          zpsi_h_u = psi_h( zeta_u ) 
    176  
    177          !! Shifting temperature and humidity at zu (L&Y 2004 eq. (9b-9c)) 
     150         zeta_u   = zu*ztmp0 
     151         zeta_u   = sign( min(abs(zeta_u),10._wp), zeta_u ) 
     152 
     153         !! Shifting temperature and humidity at zu (L&Y 2004 Eq. (9b-9c)) 
    178154         IF( .NOT. l_zt_equal_zu ) THEN 
    179             !! Array 'stab' is free for the moment so using it to store 'zeta_t' 
    180             stab = zt*ztmp0 ;  stab = SIGN( MIN(ABS(stab),10.0), stab )  ! Temporaty array stab == zeta_t !!! 
    181             stab = LOG(zt/zu) + zpsi_h_u - psi_h(stab)                   ! stab just used as temp array again! 
    182             t_zu = t_zt - ztmp1/vkarmn*stab    ! ztmp1 is still theta*  L&Y 2004 eq.(9b) 
    183             q_zu = q_zt - ztmp2/vkarmn*stab    ! ztmp2 is still q*      L&Y 2004 eq.(9c) 
    184             q_zu = max(0., q_zu) 
     155            ztmp0 = zt*ztmp0 ! zeta_t ! 
     156            ztmp0 = SIGN( MIN(ABS(ztmp0),10._wp), ztmp0 )  ! Temporaty array ztmp0 == zeta_t !!! 
     157            ztmp0 = LOG(zt/zu) + psi_h_ncar(zeta_u) - psi_h_ncar(ztmp0)                   ! ztmp0 just used as temp array again! 
     158            t_zu = t_zt - ztmp1/vkarmn*ztmp0    ! ztmp1 is still theta*  L&Y 2004 Eq. (9b) 
     159            !! 
     160            q_zu = q_zt - ztmp2/vkarmn*ztmp0    ! ztmp2 is still q*      L&Y 2004 Eq. (9c) 
     161            q_zu = MAX(0._wp, q_zu) 
    185162         END IF 
    186163 
    187          ztmp2 = psi_m(zeta_u) 
    188          IF( ln_cdgw ) THEN      ! surface wave case 
    189             stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 )  ! (stab == SQRT(Cd)) 
    190             Cd   = stab * stab 
    191             ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    192             ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    193             ztmp1 = 1. + Chn * ztmp0      
    194             Ch    = Chn * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b) 
    195             ztmp1 = 1. + Cen * ztmp0 
    196             Ce    = Cen * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
    197  
     164         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 Eq. 9a)... 
     165         !   In very rare low-wind conditions, the old way of estimating the 
     166         !   neutral wind speed at 10m leads to a negative value that causes the code 
     167         !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
     168         ztmp2 = psi_m_ncar(zeta_u) 
     169         ztmp0 = MAX( 0.25_wp , UN10_from_CD(zu, Ub, Cd, ppsi=ztmp2) ) ! U_n10 (ztmp2 == psi_m_ncar(zeta_u)) 
     170 
     171         IF( ln_cdgw ) THEN      ! wave drag case 
     172            CdN = MAX( cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) , 0.1E-3_wp ) 
    198173         ELSE 
    199             ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
    200             !   In very rare low-wind conditions, the old way of estimating the 
    201             !   neutral wind speed at 10m leads to a negative value that causes the code 
    202             !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
    203             ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u)) 
    204             ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10 
    205             Cdn(:,:) = ztmp0 
    206             sqrt_Cd_n10 = sqrt(ztmp0) 
    207  
    208             stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability 
    209             Cx_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10) 
    210             Chn(:,:) = Cx_n10 
    211  
    212             !! Update of transfer coefficients: 
    213             ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u)) 
    214             Cd      = ztmp0 / ( ztmp1*ztmp1 ) 
    215             stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd)) 
    216  
    217             ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    218             ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    219             ztmp1 = 1. + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10) 
    220             Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b) 
    221  
    222             Cx_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10 
    223             Cen(:,:) = Cx_n10 
    224             ztmp1 = 1. + Cx_n10*ztmp0 
    225             Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
    226             ENDIF 
    227          ! 
    228       END DO 
    229       ! 
     174            CdN   = CD_N10_NCAR(ztmp0)                                       ! Cd_n10 
     175         END IF 
     176         sqrtCdN10 = SQRT(CdN) 
     177 
     178         !! Update of transfer coefficients: 
     179         ztmp1  = 1._wp + sqrtCdN10/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 Eq. (10a) (ztmp2 == psi_m(zeta_u)) 
     180         Cd     = MAX( CdN / ( ztmp1*ztmp1 ) , 0.1E-3_wp ) 
     181         sqrtCd = SQRT( Cd ) 
     182 
     183         ztmp0  = ( LOG(zu/10._wp) - psi_h_ncar(zeta_u) ) / vkarmn / sqrtCdN10 
     184         ztmp2  = sqrtCd / sqrtCdN10 
     185 
     186         ztmp1  = 0.5_wp + sign(0.5_wp,zeta_u) ! stability flag 
     187         ChN    = CH_N10_NCAR( sqrtCdN10 , ztmp1 ) 
     188         ztmp1  = 1._wp + ChN*ztmp0 
     189         Ch     = MAX( ChN*ztmp2 / ztmp1 , 0.1E-3_wp )   ! L&Y 2004 Eq. (10b) 
     190 
     191         CeN = CE_N10_NCAR( sqrtCdN10 ) 
     192         ztmp1  = 1._wp + CeN*ztmp0 
     193         Ce     = MAX( CeN*ztmp2 / ztmp1 , 0.1E-3_wp )  ! L&Y 2004 Eq. (10c) 
     194 
     195      END DO !DO j_itt = 1, nb_itt 
     196 
    230197   END SUBROUTINE turb_ncar 
    231198 
    232199 
    233    FUNCTION cd_neutral_10m( pw10 ) 
    234       !!----------------------------------------------------------------------------------       
     200   FUNCTION CD_N10_NCAR( pw10 ) 
     201      !!---------------------------------------------------------------------------------- 
    235202      !! Estimate of the neutral drag coefficient at 10m as a function 
    236203      !! of neutral wind  speed at 10m 
    237204      !! 
    238       !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b) 
    239       !! 
    240       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     205      !! Origin: Large & Yeager 2008, Eq. (11) 
     206      !! 
     207      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    241208      !!---------------------------------------------------------------------------------- 
    242209      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10           ! scalar wind speed at 10m (m/s) 
    243       REAL(wp), DIMENSION(jpi,jpj)             :: cd_neutral_10m 
     210      REAL(wp), DIMENSION(jpi,jpj)             :: CD_N10_NCAR 
    244211      ! 
    245212      INTEGER  ::     ji, jj     ! dummy loop indices 
    … …  
    255222            ! 
    256223            ! When wind speed > 33 m/s => Cyclone conditions => special treatment 
    257             zgt33 = 0.5 + SIGN( 0.5, (zw - 33.) )   ! If pw10 < 33. => 0, else => 1 
    258             ! 
    259             cd_neutral_10m(ji,jj) = 1.e-3 * ( & 
    260                &       (1. - zgt33)*( 2.7/zw + 0.142 + zw/13.09 - 3.14807E-10*zw6) & ! wind <  33 m/s 
    261                &      +    zgt33   *      2.34 )                                     ! wind >= 33 m/s 
    262             ! 
    263             cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6) 
     224            zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1 
     225            ! 
     226            CD_N10_NCAR(ji,jj) = 1.e-3_wp * ( & 
     227               &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s 
     228               &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s 
     229            ! 
     230            CD_N10_NCAR(ji,jj) = MAX( CD_N10_NCAR(ji,jj), 0.1E-3_wp ) 
    264231            ! 
    265232         END DO 
    266233      END DO 
    267234      ! 
    268    END FUNCTION cd_neutral_10m 
    269  
    270  
    271    FUNCTION psi_m( pzeta ) 
     235   END FUNCTION CD_N10_NCAR 
     236 
     237 
     238 
     239   FUNCTION CH_N10_NCAR( psqrtcdn10 , pstab ) 
     240      !!---------------------------------------------------------------------------------- 
     241      !! Estimate of the neutral heat transfer coefficient at 10m      !! 
     242      !! Origin: Large & Yeager 2008, Eq. (9) and (12) 
     243 
     244      !!---------------------------------------------------------------------------------- 
     245      REAL(wp), DIMENSION(jpi,jpj)             :: ch_n10_ncar 
     246      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 ) 
     247      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pstab      ! stable ABL => 1 / unstable ABL => 0 
     248      !!---------------------------------------------------------------------------------- 
     249      ! 
     250      ch_n10_ncar = MAX( 1.e-3_wp * psqrtcdn10*( 18._wp*pstab + 32.7_wp*(1._wp - pstab) )  , 0.1E-3_wp )   ! Eq. (9) & (12) Large & Yeager, 2008 
     251      ! 
     252   END FUNCTION CH_N10_NCAR 
     253 
     254   FUNCTION CE_N10_NCAR( psqrtcdn10 ) 
     255      !!---------------------------------------------------------------------------------- 
     256      !! Estimate of the neutral heat transfer coefficient at 10m      !! 
     257      !! Origin: Large & Yeager 2008, Eq. (9) and (13) 
     258      !!---------------------------------------------------------------------------------- 
     259      REAL(wp), DIMENSION(jpi,jpj)             :: ce_n10_ncar 
     260      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 ) 
     261      !!---------------------------------------------------------------------------------- 
     262      ce_n10_ncar = MAX( 1.e-3_wp * ( 34.6_wp * psqrtcdn10 ) , 0.1E-3_wp ) 
     263      ! 
     264   END FUNCTION CE_N10_NCAR 
     265 
     266 
     267   FUNCTION psi_m_ncar( pzeta ) 
    272268      !!---------------------------------------------------------------------------------- 
    273269      !! Universal profile stability function for momentum 
    274       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    275       !!      
    276       !! pzet0 : stability paramenter, z/L where z is altitude measurement                                           
     270      !!    !! Psis, L&Y 2004, Eq. (8c), (8d), (8e) 
     271      !! 
     272      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    277273      !!         and L is M-O length 
    278274      !! 
    279       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    280       !!---------------------------------------------------------------------------------- 
    281       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pzeta 
    282       REAL(wp), DIMENSION(jpi,jpj)             ::   psi_m 
    283       ! 
    284       INTEGER  ::   ji, jj         ! dummy loop indices 
    285       REAL(wp) :: zx2, zx, zstab   ! local scalars 
    286       !!---------------------------------------------------------------------------------- 
    287       ! 
     275      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     276      !!---------------------------------------------------------------------------------- 
     277      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ncar 
     278      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
     279      ! 
     280      INTEGER  ::   ji, jj    ! dummy loop indices 
     281      REAL(wp) :: zzeta, zx2, zx, zpsi_unst, zpsi_stab,  zstab   ! local scalars 
     282      !!---------------------------------------------------------------------------------- 
    288283      DO jj = 1, jpj 
    289284         DO ji = 1, jpi 
    290             zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) ) 
    291             zx2 = MAX ( zx2 , 1. ) 
    292             zx  = SQRT( zx2 ) 
    293             zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) ) 
    294             ! 
    295             psi_m(ji,jj) =        zstab  * (-5.*pzeta(ji,jj))       &          ! Stable 
    296                &          + (1. - zstab) * (2.*LOG((1. + zx)*0.5)   &          ! Unstable 
    297                &               + LOG((1. + zx2)*0.5) - 2.*ATAN(zx) + rpi*0.5)  !    " 
     285 
     286            zzeta = pzeta(ji,jj) 
     287            ! 
     288            zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 - 16z)^0.5 
     289            zx2 = MAX( zx2 , 1._wp ) 
     290            zx  = SQRT(zx2)                          ! (1 - 16z)^0.25 
     291            zpsi_unst = 2._wp*LOG( (1._wp + zx )*0.5_wp )   & 
     292               &            + LOG( (1._wp + zx2)*0.5_wp )   & 
     293               &          - 2._wp*ATAN(zx) + rpi*0.5_wp 
     294            ! 
     295            zpsi_stab = -5._wp*zzeta 
     296            ! 
     297            zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1 
     298            ! 
     299            psi_m_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable 
     300               &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable 
    298301            ! 
    299302         END DO 
    300303      END DO 
    301       ! 
    302    END FUNCTION psi_m 
    303  
    304  
    305    FUNCTION psi_h( pzeta ) 
     304   END FUNCTION psi_m_ncar 
     305 
     306 
     307   FUNCTION psi_h_ncar( pzeta ) 
    306308      !!---------------------------------------------------------------------------------- 
    307309      !! Universal profile stability function for temperature and humidity 
    308       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    309       !! 
    310       !! pzet0 : stability paramenter, z/L where z is altitude measurement                                           
     310      !!    !! Psis, L&Y 2004, Eq. (8c), (8d), (8e) 
     311      !! 
     312      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    311313      !!         and L is M-O length 
    312314      !! 
    313       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    314       !!---------------------------------------------------------------------------------- 
     315      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     316      !!---------------------------------------------------------------------------------- 
     317      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ncar 
    315318      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    316       REAL(wp), DIMENSION(jpi,jpj)             :: psi_h 
    317       ! 
    318       INTEGER  ::   ji, jj    ! dummy loop indices 
    319       REAL(wp) :: zx2, zstab  ! local scalars 
     319      ! 
     320      INTEGER  ::   ji, jj     ! dummy loop indices 
     321      REAL(wp) :: zzeta, zx2, zpsi_unst, zpsi_stab, zstab  ! local scalars 
    320322      !!---------------------------------------------------------------------------------- 
    321323      ! 
    322324      DO jj = 1, jpj 
    323325         DO ji = 1, jpi 
    324             zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) ) 
    325             zx2 = MAX ( zx2 , 1. ) 
    326             zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) ) 
    327             ! 
    328             psi_h(ji,jj) =         zstab  * (-5.*pzeta(ji,jj))        &  ! Stable 
    329                &           + (1. - zstab) * (2.*LOG( (1. + zx2)*0.5 ))   ! Unstable 
     326            ! 
     327            zzeta = pzeta(ji,jj) 
     328            ! 
     329            zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 -16z)^0.5 
     330            zx2 = MAX( zx2 , 1._wp ) 
     331            zpsi_unst = 2._wp*LOG( 0.5_wp*(1._wp + zx2) ) 
     332            ! 
     333            zpsi_stab = -5._wp*zzeta 
     334            ! 
     335            zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1 
     336            ! 
     337            psi_h_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable 
     338               &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable 
    330339            ! 
    331340         END DO 
    332341      END DO 
    333       ! 
    334    END FUNCTION psi_h 
     342   END FUNCTION psi_h_ncar 
     343 
     344 
     345 
     346 
     347   FUNCTION UN10_from_CD( pzu, pUb, pCd, ppsi ) 
     348      !!---------------------------------------------------------------------------------- 
     349      !!  Provides the neutral-stability wind speed at 10 m 
     350      !!---------------------------------------------------------------------------------- 
     351      REAL(wp), DIMENSION(jpi,jpj)             :: UN10_from_CD  !: [m/s] 
     352      REAL(wp),                     INTENT(in) :: pzu  !: measurement heigh of bulk wind speed 
     353      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUb  !: bulk wind speed at height pzu m   [m/s] 
     354      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd  !: drag coefficient 
     355      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] 
     356      !!---------------------------------------------------------------------------------- 
     357      !! Reminder: UN10 = u*/vkarmn * log(10/z0) 
     358      !!     and: u* = sqrt(Cd) * Ub 
     359      !!                                  u*/vkarmn * log(   10   /       z0    ) 
     360      UN10_from_CD(:,:) = SQRT(pCd(:,:))*pUb/vkarmn * LOG( 10._wp / z0_from_Cd( pzu, pCd(:,:), ppsi=ppsi(:,:) ) ) 
     361      !! 
     362   END FUNCTION UN10_from_CD 
     363 
     364 
     365   FUNCTION One_on_L( ptha, pqa, pus, pts, pqs ) 
     366      !!------------------------------------------------------------------------ 
     367      !! 
     368      !! Evaluates the 1./(Obukhov length) from air temperature, 
     369      !! air specific humidity, and frictional scales u*, t* and q* 
     370      !! 
     371      !! Author: L. Brodeau, June 2019 / AeroBulk 
     372      !!         (https://github.com/brodeau/aerobulk/) 
     373      !!------------------------------------------------------------------------ 
     374      REAL(wp), DIMENSION(jpi,jpj)             :: One_on_L     !: 1./(Obukhov length) [m^-1] 
     375      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha         !: reference potential temperature of air [K] 
     376      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa          !: reference specific humidity of air   [kg/kg] 
     377      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus          !: u*: friction velocity [m/s] 
     378      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pts, pqs     !: \theta* and q* friction aka turb. scales for temp. and spec. hum. 
     379      ! 
     380      INTEGER  ::   ji, jj         ! dummy loop indices 
     381      REAL(wp) ::     zqa          ! local scalar 
     382      !!------------------------------------------------------------------- 
     383      ! 
     384      DO jj = 1, jpj 
     385         DO ji = 1, jpi 
     386            ! 
     387            zqa = (1._wp + rctv0*pqa(ji,jj)) 
     388            ! 
     389            ! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with: 
     390            !  a/  -u* [ theta* (1 + 0.61 q) + 0.61 theta q* ] => this is the one that seems correct! chose this one! 
     391            !                      or 
     392            !  b/  -u* [ theta*              + 0.61 theta q* ] 
     393            ! 
     394            One_on_L(ji,jj) = grav*vkarmn*( pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj) ) & 
     395               &               / MAX( pus(ji,jj)*pus(ji,jj)*ptha(ji,jj)*zqa , 1.E-9_wp ) 
     396            ! 
     397         END DO 
     398      END DO 
     399      ! 
     400      One_on_L = SIGN( MIN(ABS(One_on_L),200._wp), One_on_L ) ! (prevent FPE from stupid values over masked regions...) 
     401      ! 
     402   END FUNCTION One_on_L 
     403 
     404 
     405   FUNCTION z0_from_Cd( pzu, pCd,  ppsi ) 
     406      REAL(wp), DIMENSION(jpi,jpj) :: z0_from_Cd        !: roughness length [m] 
     407      REAL(wp)                    , INTENT(in) :: pzu   !: reference height zu [m] 
     408      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd   !: (neutral or non-neutral) drag coefficient [] 
     409      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] 
     410      !! 
     411      !! If pCd is the NEUTRAL-STABILITY drag coefficient then ppsi must be 0 or not given 
     412      !! If pCd is the drag coefficient (in stable or unstable conditions) then pssi must be provided 
     413      !!---------------------------------------------------------------------------------- 
     414      IF ( PRESENT(ppsi) ) THEN 
     415         !! Cd provided is the actual Cd (not the neutral-stability CdN) : 
     416         z0_from_Cd = pzu * EXP( - ( vkarmn/SQRT(pCd(:,:)) + ppsi(:,:) ) ) !LB: ok, double-checked! 
     417      ELSE 
     418         !! Cd provided is the neutral-stability Cd, aka CdN : 
     419         z0_from_Cd = pzu * EXP( - vkarmn/SQRT(pCd(:,:)) )            !LB: ok, double-checked! 
     420      END IF 
     421   END FUNCTION z0_from_Cd 
     422 
     423   FUNCTION virt_temp( pta, pqa ) 
     424      REAL(wp), DIMENSION(jpi,jpj)             :: virt_temp !: virtual temperature [K] 
     425      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta !: absolute or potential air temperature [K] 
     426      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa !: specific humidity of air   [kg/kg] 
     427      virt_temp(:,:) = pta(:,:) * (1._wp + rctv0*pqa(:,:)) 
     428   END FUNCTION virt_temp 
    335429 
    336430   !!====================================================================== 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbccpl.F90

    r13066 r13466  
    4141#endif 
    4242#if defined key_si3 
    43    USE icethd_dh      ! for CALL ice_thd_snwblow 
     43   USE icevar         ! for CALL ice_var_snwblow 
    4444#endif 
    4545   ! 
    … …  
    4848   USE lib_mpp        ! distribued memory computing library 
    4949   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     50 
     51#if defined key_oasis3  
     52   USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut  
     53#endif  
    5054 
    5155   IMPLICIT NONE 
    … …  
    152156   INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level  
    153157   INTEGER, PARAMETER ::   jps_fice1  = 33   ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 
    154    INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area 
     158   INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area fraction 
    155159   INTEGER, PARAMETER ::   jps_ht_p   = 35   ! meltpond thickness 
    156160   INTEGER, PARAMETER ::   jps_kice   = 36   ! sea ice effective conductivity 
    … …  
    159163 
    160164   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent  
     165 
     166#if ! defined key_oasis3  
     167   ! Dummy variables to enable compilation when oasis3 is not being used  
     168   INTEGER                    ::   OASIS_Sent        = -1  
     169   INTEGER                    ::   OASIS_SentOut     = -1  
     170   INTEGER                    ::   OASIS_ToRest      = -1  
     171   INTEGER                    ::   OASIS_ToRestOut   = -1  
     172#endif  
    161173 
    162174   !                                  !!** namelist namsbc_cpl ** 
    … …  
    184196   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models 
    185197                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     198   LOGICAL     ::   ln_scale_ice_flux     !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration)  
     199 
    186200   TYPE ::   DYNARR      
    187201      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3    
    … …  
    248262      REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos 
    249263      !! 
    250       NAMELIST/namsbc_cpl/  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2  ,   &  
     264      NAMELIST/namsbc_cpl/  nn_cplmodel  , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux,             & 
     265         &                  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2   ,  &  
    251266         &                  sn_snd_ttilyr, sn_snd_cond  , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1,  &  
    252          &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc,   &  
    253          &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr  ,   &  
     267         &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  &  
     268         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  &  
    254269         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  & 
    255          &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal  ,   & 
    256          &                  sn_rcv_iceflx, sn_rcv_co2   , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,   & 
    257          &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl  ,   & 
     270         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  & 
     271         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                & 
     272         &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq, sn_rcv_tauw  ,                 & 
    258273         &                  sn_rcv_ts_ice 
    259  
    260274      !!--------------------------------------------------------------------- 
    261275      ! 
    … …  
    279293      ENDIF 
    280294      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
     295         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
     296         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
     297         WRITE(numout,*)'  ln_scale_ice_flux                   = ', ln_scale_ice_flux 
     298         WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl 
    281299         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
    282300         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
    … …  
    327345         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor  
    328346         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd  
    329          WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
    330          WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    331          WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl 
    332347      ENDIF 
    333348 
    … …  
    366381      !  
    367382      ! Vectors: change of sign at north fold ONLY if on the local grid 
    368       IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM(sn_rcv_tau%cldes ) == 'oce and ice') THEN ! avoid working with the atmospheric fields if they are not coupled 
     383      IF(       TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice'  & 
     384           .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled 
     385      ! 
    369386      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
    370387       
    … …  
    821838      END SELECT 
    822839 
     840      ! Initialise ice fractions from last coupling time to zero (needed by Met-Office) 
     841#if defined key_si3 || defined key_cice 
     842       a_i_last_couple(:,:,:) = 0._wp 
     843#endif 
    823844      !                                                      ! ------------------------- !  
    824845      !                                                      !      Ice Meltponds        !  
    … …  
    11081129      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    11091130      REAL(wp) ::   zzx, zzy               ! temporary variables 
    1110       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
     1131      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 
    11111132      !!---------------------------------------------------------------------- 
    11121133      ! 
    … …  
    12261247         ENDIF 
    12271248      ENDIF 
    1228  
     1249!!$      !                                                      ! ========================= ! 
     1250!!$      SELECT CASE( TRIM( sn_rcv_clouds%cldes ) )             !       cloud fraction      ! 
     1251!!$      !                                                      ! ========================= ! 
     1252!!$      cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1) 
     1253!!$      END SELECT 
     1254!!$ 
     1255      zcloud_fra(:,:) = pp_cldf   ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 
     1256      IF( ln_mixcpl ) THEN 
     1257         cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:) 
     1258      ELSE 
     1259         cloud_fra(:,:) = zcloud_fra(:,:) 
     1260      ENDIF 
     1261      !                                                      ! ========================= ! 
    12291262      ! u(v)tau and taum will be modified by ice model 
    12301263      ! -> need to be reset before each call of the ice/fsbc       
    … …  
    16231656      ! 
    16241657      INTEGER  ::   ji, jj, jl   ! dummy loop index 
    1625       REAL(wp) ::   ztri         ! local scalar 
    16261658      REAL(wp), DIMENSION(jpi,jpj)     ::   zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 
    16271659      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice 
    16281660      REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
     1661      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total 
    16291662      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 
     1663      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri 
    16301664      !!---------------------------------------------------------------------- 
    16311665      ! 
    … …  
    16471681         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here 
    16481682         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    1649          zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 
    16501683      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    16511684         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    … …  
    16591692 
    16601693#if defined key_si3 
     1694 
     1695      ! --- evaporation over ice (kg/m2/s) --- ! 
     1696      IF (ln_scale_ice_flux) THEN ! typically met-office requirements 
     1697         IF (sn_rcv_emp%clcat == 'yes') THEN 
     1698            WHERE( a_i(:,:,:) > 1.e-10 )  ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     1699            ELSEWHERE                     ; zevap_ice(:,:,:) = 0._wp 
     1700            END WHERE 
     1701            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 
     1702            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp 
     1703            END WHERE 
     1704         ELSE 
     1705            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 
     1706            ELSEWHERE                     ; zevap_ice(:,:,1) = 0._wp 
     1707            END WHERE 
     1708            zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1709            DO jl = 2, jpl 
     1710               zevap_ice(:,:,jl) = zevap_ice(:,:,1) 
     1711            ENDDO 
     1712         ENDIF 
     1713      ELSE 
     1714         IF (sn_rcv_emp%clcat == 'yes') THEN 
     1715            zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) 
     1716            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 
     1717            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp 
     1718            END WHERE 
     1719         ELSE 
     1720            zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 
     1721            zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1722            DO jl = 2, jpl 
     1723               zevap_ice(:,:,jl) = zevap_ice(:,:,1) 
     1724            ENDDO 
     1725         ENDIF 
     1726      ENDIF 
     1727 
     1728      IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 
     1729         ! For conservative case zemp_ice has not been defined yet. Do it now. 
     1730         zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 
     1731      ENDIF 
     1732 
    16611733      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 
    1662       zsnw(:,:) = 0._wp   ;   CALL ice_thd_snwblow( ziceld, zsnw ) 
     1734      zsnw(:,:) = 0._wp   ;   CALL ice_var_snwblow( ziceld, zsnw ) 
    16631735       
    16641736      ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 
    … …  
    16671739 
    16681740      ! --- evaporation over ocean (used later for qemp) --- ! 
    1669       zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 
    1670  
    1671       ! --- evaporation over ice (kg/m2/s) --- ! 
    1672       DO jl=1,jpl 
    1673          IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
    1674          ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF 
    1675       ENDDO 
     1741      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) 
    16761742 
    16771743      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 
    … …  
    17511817!!      IF( srcv(jpr_rnf)%laction )   CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1)                                 )  ! runoff 
    17521818!!      IF( srcv(jpr_isf)%laction )   CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1)                         )  ! iceshelf 
    1753       IF( srcv(jpr_cal)%laction )   CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1)                )  ! calving 
    1754       IF( srcv(jpr_icb)%laction )   CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1)                )  ! icebergs 
    1755       CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow 
    1756       CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation 
    1757       IF ( iom_use('rain') ) CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation  
    1758       IF ( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
    1759       IF ( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average) 
    1760       IF ( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average) 
    1761       IF ( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average) 
    1762       IF ( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  & 
    1763          &                                                        - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 
     1819      IF( srcv(jpr_cal)%laction )    CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1)                )  ! calving 
     1820      IF( srcv(jpr_icb)%laction )    CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1)                )  ! icebergs 
     1821      IF( iom_use('snowpre') )       CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow 
     1822      IF( iom_use('precip') )        CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation 
     1823      IF( iom_use('rain') )          CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation  
     1824      IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
     1825      IF( iom_use('snow_ai_cea') )  CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average) 
     1826      IF( iom_use('rain_ao_cea') )  CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average) 
     1827      IF( iom_use('subl_ai_cea') )   CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )     ! Sublimation over sea-ice (cell average) 
     1828      IF( iom_use('evap_ao_cea') )  CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  & 
     1829         &                                                         - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 
    17641830      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 
    17651831      ! 
    … …  
    17691835      CASE( 'oce only' )         ! the required field is directly provided 
    17701836         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1837         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 
     1838         ! here so the only flux is the ocean only one. 
     1839         zqns_ice(:,:,:) = 0._wp  
    17711840      CASE( 'conservative' )     ! the required fields are directly provided 
    17721841         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    … …  
    17981867               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl)    & 
    17991868                  &             + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   & 
    1800                   &                                                                + pist(:,:,jl) * picefr(:,:) ) ) 
     1869                  &                                             + pist(:,:,jl) * picefr(:,:) ) ) 
    18011870            END DO 
    18021871         ELSE 
    … …  
    18041873               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1)    & 
    18051874                  &             + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   & 
    1806                   &                                                                + pist(:,:,jl) * picefr(:,:) ) ) 
     1875                  &                                             + pist(:,:,jl) * picefr(:,:) ) ) 
    18071876            END DO 
    18081877         ENDIF 
    … …  
    19081977      CASE( 'oce only' ) 
    19091978         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1979         ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 
     1980         ! here so the only flux is the ocean only one. 
     1981         zqsr_ice(:,:,:) = 0._wp 
    19101982      CASE( 'conservative' ) 
    19111983         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    … …  
    19932065            ENDDO 
    19942066         ENDIF 
     2067      CASE( 'none' )  
     2068         zdqns_ice(:,:,:) = 0._wp 
    19952069      END SELECT 
    19962070       
    … …  
    20082082      !                                                      ! ========================= ! 
    20092083      CASE ('coupled') 
    2010          IF( ln_mixcpl ) THEN 
    2011             DO jl=1,jpl 
    2012                qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 
    2013                qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 
    2014             ENDDO 
     2084         IF (ln_scale_ice_flux) THEN 
     2085            WHERE( a_i(:,:,:) > 1.e-10_wp ) 
     2086               qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2087               qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2088            ELSEWHERE 
     2089               qml_ice(:,:,:) = 0.0_wp 
     2090               qcn_ice(:,:,:) = 0.0_wp 
     2091            END WHERE 
    20152092         ELSE 
    20162093            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
    … …  
    20232100      IF( .NOT.ln_cndflx ) THEN                              !==  No conduction flux as surface forcing  ==! 
    20242101         ! 
    2025          !                    ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
    2026          ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice    ! surface transmission when hi>10cm (Grenfell Maykut 77) 
    2027          ! 
    2028          WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    2029             zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    2030          ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (ztri) when hi>10cm 
    2031             zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 
    2032          ELSEWHERE                                                         ! zero when hs>0 
    2033             zqtr_ice_top(:,:,:) = 0._wp 
    2034          END WHERE 
     2102         IF( nn_qtrice == 0 ) THEN 
     2103            ! formulation derived from Grenfell and Maykut (1977), where transmission rate 
     2104            !    1) depends on cloudiness 
     2105            !       ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
     2106            !       !      should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 
     2107            !    2) is 0 when there is any snow 
     2108            !    3) tends to 1 for thin ice 
     2109            ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
     2110            DO jl = 1, jpl 
     2111               WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
     2112                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     2113               ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )       ! constant (ztri) when hi>10cm 
     2114                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:) 
     2115               ELSEWHERE                                                           ! zero when hs>0 
     2116                  zqtr_ice_top(:,:,jl) = 0._wp  
     2117               END WHERE 
     2118            ENDDO 
     2119         ELSEIF( nn_qtrice == 1 ) THEN 
     2120            ! formulation is derived from the thesis of M. Lebrun (2019). 
     2121            !    It represents the best fit using several sets of observations 
     2122            !    It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 
     2123            zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:) 
     2124         ENDIF 
    20352125         !      
    20362126      ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==! 
    20372127         ! 
    2038          !                    ! ===> here we must receive the qtr_ice_top array from the coupler 
    2039          !                           for now just assume zero (fully opaque ice) 
     2128         !          ! ===> here we must receive the qtr_ice_top array from the coupler 
     2129         !                 for now just assume zero (fully opaque ice) 
    20402130         zqtr_ice_top(:,:,:) = 0._wp 
    20412131         ! 
    … …  
    22312321      ENDIF 
    22322322 
     2323#if defined key_si3 || defined key_cice 
     2324      ! If this coupling was successful then save ice fraction for use between coupling points.  
     2325      ! This is needed for some calculations where the ice fraction at the last coupling point  
     2326      ! is needed.  
     2327      IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. &  
     2328         & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN  
     2329         IF ( sn_snd_thick%clcat == 'yes' ) THEN  
     2330           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 
     2331         ENDIF 
     2332      ENDIF 
     2333#endif 
     2334 
    22332335      IF( ssnd(jps_fice1)%laction ) THEN 
    22342336         SELECT CASE( sn_snd_thick1%clcat ) 
    … …  
    22942396            SELECT CASE( sn_snd_mpnd%clcat )   
    22952397            CASE( 'yes' )   
    2296                ztmp3(:,:,1:jpl) =  a_ip_frac(:,:,1:jpl) 
     2398               ztmp3(:,:,1:jpl) =  a_ip_eff(:,:,1:jpl) 
    22972399               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl)   
    22982400            CASE( 'no' )   
    … …  
    23002402               ztmp4(:,:,:) = 0.0   
    23012403               DO jl=1,jpl   
    2302                  ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl)   
    2303                  ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl)  
     2404                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 
     2405                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 
    23042406               ENDDO   
    23052407            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )   

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcmod.F90

    r12276 r13466  
    564564      ENDIF 
    565565      ! 
    566       CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at each time step in sea-ice) 
    567       CALL iom_put( "vtau", vtau )   ! j-wind stress 
    568       ! 
    569566      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    570567         CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i    - : ', mask1=tmask ) 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfdrg.F90

    r13268 r13466  
    3232   USE lib_mpp        ! distributed memory computing 
    3333   USE prtctl         ! Print control 
     34   USE sbc_oce , ONLY : nn_ice  
    3435 
    3536   IMPLICIT NONE 
    … …  
    4647   LOGICAL          ::   ln_loglayer  ! logarithmic drag: Cd = vkarmn/log(z/z0) 
    4748   LOGICAL , PUBLIC ::   ln_drgimp    ! implicit top/bottom friction flag 
    48  
     49   LOGICAL , PUBLIC ::   ln_drgice_imp ! implicit ice-ocean drag  
    4950   !                                 !!* Namelist namdrg_top & _bot: TOP or BOTTOM coefficient namelist * 
    5051   REAL(wp)         ::   rn_Cd0       !: drag coefficient                                           [ - ] 
    … …  
    231232      INTEGER   ::   ios, ioptio   ! local integers 
    232233      !! 
    233       NAMELIST/namdrg/ ln_drg_OFF, ln_lin, ln_non_lin, ln_loglayer, ln_drgimp 
     234      NAMELIST/namdrg/ ln_drg_OFF, ln_lin, ln_non_lin, ln_loglayer, ln_drgimp, ln_drgice_imp 
    234235      !!---------------------------------------------------------------------- 
    235236      ! 
    … …  
    254255         WRITE(numout,*) '      logarithmic drag: Cd = vkarmn/log(z/z0)   ln_loglayer = ', ln_loglayer 
    255256         WRITE(numout,*) '      implicit friction                         ln_drgimp   = ', ln_drgimp 
     257         WRITE(numout,*) '      implicit ice-ocean drag                   ln_drgice_imp  =', ln_drgice_imp 
    256258      ENDIF 
    257259      ! 
    … …  
    264266      IF( ioptio /= 1 )   CALL ctl_stop( 'zdf_drg_init: Choose ONE type of drag coef in namdrg' ) 
    265267      ! 
     268      IF ( ln_drgice_imp.AND.(.NOT.ln_drgimp) ) &  
     269         &                CALL ctl_stop( 'zdf_drg_init: ln_drgice_imp=T requires ln_drgimp=T' ) 
     270      ! 
     271      IF ( ln_drgice_imp.AND.( nn_ice /=2 ) ) & 
     272         &  CALL ctl_stop( 'zdf_drg_init: ln_drgice_imp=T requires si3' ) 
    266273      ! 
    267274      !                     !==  BOTTOM drag setting  ==!   (applied at seafloor) 
    … …  
    274281      !                     !==  TOP drag setting  ==!   (applied at the top of ocean cavities) 
    275282      ! 
    276       IF( ln_isfcav ) THEN              ! Ocean cavities: top friction setting 
    277          ALLOCATE( rCd0_top(jpi,jpj), rCdU_top(jpi,jpj) ) 
     283      IF( ln_isfcav.OR.ln_drgice_imp ) THEN              ! Ocean cavities: top friction setting 
     284         ALLOCATE( rCdU_top(jpi,jpj) ) 
     285      ENDIF 
     286      ! 
     287      IF( ln_isfcav ) THEN 
     288         ALLOCATE( rCd0_top(jpi,jpj)) 
    278289         CALL drg_init( 'TOP   '   , mikt       ,                                         &   ! <== in 
    279290            &           r_Cdmin_top, r_Cdmax_top, r_z0_top, r_ke0_top, rCd0_top, rCdU_top )   ! ==> out 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfgls.F90

    r13268 r13466  
    5454   INTEGER  ::   nn_bc_bot         ! bottom boundary condition (=0/1) 
    5555   INTEGER  ::   nn_z0_met         ! Method for surface roughness computation 
     56   INTEGER  ::   nn_z0_ice         ! Roughness accounting for sea ice 
    5657   INTEGER  ::   nn_stab_func      ! stability functions G88, KC or Canuto (=0/1/2) 
    5758   INTEGER  ::   nn_clos           ! closure 0/1/2/3 MY82/k-eps/k-w/gen 
    … …  
    6263   REAL(wp) ::   rn_crban          ! Craig and Banner constant for surface breaking waves mixing 
    6364   REAL(wp) ::   rn_hsro           ! Minimum surface roughness 
     65   REAL(wp) ::   rn_hsri           ! Ice ocean roughness 
    6466   REAL(wp) ::   rn_frac_hs        ! Fraction of wave height as surface roughness (if nn_z0_met > 1)  
    6567 
    … …  
    151153      REAL(wp), DIMENSION(jpi,jpj)     ::   zflxs       ! Turbulence fluxed induced by internal waves  
    152154      REAL(wp), DIMENSION(jpi,jpj)     ::   zhsro       ! Surface roughness (surface waves) 
     155      REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra    ! Tapering of wave breaking under sea ice 
    153156      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eb          ! tke at time before 
    154157      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   hmxl_b      ! mixing length at time before 
    … …  
    166169      ustar2_bot (:,:) = 0._wp 
    167170 
     171      SELECT CASE ( nn_z0_ice ) 
     172      CASE( 0 )   ;   zice_fra(:,:) = 0._wp 
     173      CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(:,:) * 10._wp ) 
     174      CASE( 2 )   ;   zice_fra(:,:) =              fr_i(:,:) 
     175      CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 
     176      END SELECT 
     177       
    168178      ! Compute surface, top and bottom friction at T-points 
    169179      DO jj = 2, jpjm1              !==  surface ocean friction 
    … …  
    211221      END SELECT 
    212222      ! 
     223      ! adapt roughness where there is sea ice 
     224      zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1)  + (1._wp - tmask(:,:,1))*rn_hsro 
     225      ! 
    213226      DO jk = 2, jpkm1              !==  Compute dissipation rate  ==! 
    214227         DO jj = 1, jpjm1 
    … …  
    305318      CASE ( 0 )             ! Dirichlet boundary condition (set e at k=1 & 2)  
    306319      ! First level 
    307       en   (:,:,1) = MAX(  rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3  ) 
     320      en   (:,:,1) = MAX(  rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3  ) 
    308321      zd_lw(:,:,1) = en(:,:,1) 
    309322      zd_up(:,:,1) = 0._wp 
    … …  
    311324      !  
    312325      ! One level below 
    313       en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2))  & 
    314          &                 / zhsro(:,:) )**(1.5_wp*ra_sf)  )**(2._wp/3._wp)                      , rn_emin   ) 
     326      en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2)) & 
     327         &                 / zhsro(:,:) )**(1.5_wp*ra_sf)  )**(2._wp/3._wp) , rn_emin   ) 
    315328      zd_lw(:,:,2) = 0._wp  
    316329      zd_up(:,:,2) = 0._wp 
    … …  
    321334      ! 
    322335      ! Dirichlet conditions at k=1 
    323       en   (:,:,1) = MAX(  rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3 , rn_emin  ) 
     336      en   (:,:,1) = MAX(  rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3 , rn_emin  ) 
    324337      zd_lw(:,:,1) = en(:,:,1) 
    325338      zd_up(:,:,1) = 0._wp 
    … …  
    331344      zd_lw(:,:,2) = 0._wp 
    332345      zkar (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) )) 
    333       zflxs(:,:)   = rsbc_tke2 * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 
     346      zflxs(:,:)   = rsbc_tke2 * (1._wp-zice_fra(:,:)) * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 
    334347          &                    * (  ( zhsro(:,:)+gdept_n(:,:,1) ) / zhsro(:,:)  )**(1.5_wp*ra_sf) 
    335348!!gm why not   :                        * ( 1._wp + gdept_n(:,:,1) / zhsro(:,:) )**(1.5_wp*ra_sf) 
    … …  
    582595         zkar (:,:)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope 
    583596         zdep (:,:)   = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf) 
    584          zflxs(:,:)   = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 
     597         zflxs(:,:)   = (rnn + (1._wp-zice_fra(:,:))*rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:)) & 
     598            &           *(1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 
    585599         zdep (:,:)   = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * & 
    586600            &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.) 
    … …  
    855869      REAL(wp)::   zcr   ! local scalar 
    856870      !! 
    857       NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, & 
    858          &            rn_clim_galp, ln_sigpsi, rn_hsro,      & 
    859          &            rn_crban, rn_charn, rn_frac_hs,        & 
    860          &            nn_bc_surf, nn_bc_bot, nn_z0_met,     & 
     871      NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim,       & 
     872         &            rn_clim_galp, ln_sigpsi, rn_hsro, rn_hsri,   & 
     873         &            rn_crban, rn_charn, rn_frac_hs,              & 
     874         &            nn_bc_surf, nn_bc_bot, nn_z0_met, nn_z0_ice, & 
    861875         &            nn_stab_func, nn_clos 
    862876      !!---------------------------------------------------------- 
    … …  
    886900         WRITE(numout,*) '      Charnock coefficient                          rn_charn       = ', rn_charn 
    887901         WRITE(numout,*) '      Surface roughness formula                     nn_z0_met      = ', nn_z0_met 
     902         WRITE(numout,*) '      surface wave breaking under ice               nn_z0_ice      = ', nn_z0_ice 
     903         SELECT CASE( nn_z0_ice ) 
     904         CASE( 0 )   ;   WRITE(numout,*) '   ==>>>   no impact of ice cover on surface wave breaking' 
     905         CASE( 1 )   ;   WRITE(numout,*) '   ==>>>   roughness uses rn_hsri and is weigthed by 1-TANH( fr_i(:,:) * 10 )' 
     906         CASE( 2 )   ;   WRITE(numout,*) '   ==>>>   roughness uses rn_hsri and is weighted by 1-fr_i(:,:)' 
     907         CASE( 3 )   ;   WRITE(numout,*) '   ==>>>   roughness uses rn_hsri and is weighted by 1-MIN( 1, 4 * fr_i(:,:) )' 
     908         CASE DEFAULT 
     909            CALL ctl_stop( 'zdf_gls_init: wrong value for nn_z0_ice, should be 0,1,2, or 3') 
     910         END SELECT 
    888911         WRITE(numout,*) '      Wave height frac. (used if nn_z0_met=2)       rn_frac_hs     = ', rn_frac_hs 
    889912         WRITE(numout,*) '      Stability functions                           nn_stab_func   = ', nn_stab_func 
    890913         WRITE(numout,*) '      Type of closure                               nn_clos        = ', nn_clos 
    891914         WRITE(numout,*) '      Surface roughness (m)                         rn_hsro        = ', rn_hsro 
     915         WRITE(numout,*) '      Ice-ocean roughness (used if nn_z0_ice/=0)    rn_hsri        = ', rn_hsri 
    892916         WRITE(numout,*) 
    893917         WRITE(numout,*) '   Namelist namdrg_top/_bot:   used values:' 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdfphy.F90

    r11536 r13466  
    2828   USE sbc_oce        ! surface module (only for nn_isf in the option compatibility test) 
    2929   USE sbcrnf         ! surface boundary condition: runoff variables 
     30   USE sbc_ice        ! sea ice drag 
    3031#if defined key_agrif 
    3132   USE agrif_oce_interp   ! interpavm 
    … …  
    252253      ENDIF 
    253254      ! 
     255#if defined key_si3 
     256      IF ( ln_drgice_imp) THEN 
     257         IF ( ln_isfcav ) THEN 
     258            rCdU_top(:,:) = rCdU_top(:,:) + ssmask(:,:) * tmask(:,:,1) * rCdU_ice(:,:) 
     259         ELSE 
     260            rCdU_top(:,:) = rCdU_ice(:,:) 
     261         ENDIF 
     262      ENDIF 
     263#endif 
     264      !  
    254265      !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
    255266      ! 

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/ZDF/zdftke.F90

    r13268 r13466  
    4646   USE zdfmxl         ! vertical physics: mixed layer 
    4747   ! 
     48#if defined key_si3 
     49   USE ice, ONLY: hm_i, h_i 
     50#endif 
     51#if defined key_cice 
     52   USE sbc_ice, ONLY: h_i 
     53#endif 
    4854   USE in_out_manager ! I/O manager 
    4955   USE iom            ! I/O manager library 
    … …  
    6268   !                      !!** Namelist  namzdf_tke  ** 
    6369   LOGICAL  ::   ln_mxl0   ! mixing length scale surface value as function of wind stress or not 
     70   INTEGER  ::   nn_mxlice ! type of scaling under sea-ice (=0/1/2/3) 
     71   REAL(wp) ::   rn_mxlice ! ice thickness value when scaling under sea-ice 
    6472   INTEGER  ::   nn_mxl    ! type of mixing length (=0/1/2/3) 
    6573   REAL(wp) ::   rn_mxl0   ! surface  min value of mixing length (kappa*z_o=0.4*0.1 m)  [m] 
    … …  
    7482   INTEGER  ::      nn_htau   ! type of tke profile of penetration (=0/1) 
    7583   REAL(wp) ::      rn_efr    ! fraction of TKE surface value which penetrates in the ocean 
    76    REAL(wp) ::      rn_eice   ! =0 ON below sea-ice, =4 OFF when ice fraction > 1/4    
    7784   LOGICAL  ::   ln_lc     ! Langmuir cells (LC) as a source term of TKE or not 
    7885   REAL(wp) ::      rn_lc     ! coef to compute vertical velocity of Langmuir cells 
     86   INTEGER  ::   nn_eice   ! attenutaion of langmuir & surface wave breaking under ice (=0/1/2/3)    
    7987 
    8088   REAL(wp) ::   ri_cri    ! critic Richardson number (deduced from rn_ediff and rn_ediss values) 
    … …  
    190198      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points) 
    191199      ! 
    192       INTEGER ::   ji, jj, jk              ! dummy loop arguments 
     200      INTEGER ::   ji, jj, jk                  ! dummy loop arguments 
    193201      REAL(wp) ::   zetop, zebot, zmsku, zmskv ! local scalars 
    194202      REAL(wp) ::   zrhoa  = 1.22              ! Air density kg/m3 
    195203      REAL(wp) ::   zcdrag = 1.5e-3            ! drag coefficient 
    196       REAL(wp) ::   zbbrau, zri                ! local scalars 
    197       REAL(wp) ::   zfact1, zfact2, zfact3     !   -         - 
    198       REAL(wp) ::   ztx2  , zty2  , zcof       !   -         - 
    199       REAL(wp) ::   ztau  , zdif               !   -         - 
    200       REAL(wp) ::   zus   , zwlc  , zind       !   -         - 
    201       REAL(wp) ::   zzd_up, zzd_lw             !   -         - 
     204      REAL(wp) ::   zbbrau, zbbirau, zri       ! local scalars 
     205      REAL(wp) ::   zfact1, zfact2, zfact3     !   -      - 
     206      REAL(wp) ::   ztx2  , zty2  , zcof       !   -      - 
     207      REAL(wp) ::   ztau  , zdif               !   -      - 
     208      REAL(wp) ::   zus   , zwlc  , zind       !   -      - 
     209      REAL(wp) ::   zzd_up, zzd_lw             !   -      - 
    202210      INTEGER , DIMENSION(jpi,jpj)     ::   imlc 
    203       REAL(wp), DIMENSION(jpi,jpj)     ::   zhlc, zfr_i 
     211      REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra, zhlc, zus3 
    204212      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc, zdiag, zd_up, zd_lw 
    205213      !!-------------------------------------------------------------------- 
    206214      ! 
    207       zbbrau = rn_ebb / rau0       ! Local constant initialisation 
    208       zfact1 = -.5_wp * rdt  
    209       zfact2 = 1.5_wp * rdt * rn_ediss 
    210       zfact3 = 0.5_wp       * rn_ediss 
     215      zbbrau  =  rn_ebb / rau0       ! Local constant initialisation 
     216      zbbirau =  3.75_wp / rau0 
     217      zfact1  = -0.5_wp * rdt  
     218      zfact2  =  1.5_wp * rdt * rn_ediss 
     219      zfact3  =  0.5_wp       * rn_ediss 
     220      ! 
     221      ! ice fraction considered for attenuation of langmuir & wave breaking 
     222      SELECT CASE ( nn_eice ) 
     223      CASE( 0 )   ;   zice_fra(:,:) = 0._wp 
     224      CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(:,:) * 10._wp ) 
     225      CASE( 2 )   ;   zice_fra(:,:) =              fr_i(:,:) 
     226      CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 
     227      END SELECT 
    211228      ! 
    212229      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    213230      !                     !  Surface/top/bottom boundary condition on tke 
    214231      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    215        
     232      ! 
    216233      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
    217234         DO ji = fs_2, fs_jpim1   ! vector opt. 
     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) 
    218239            en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 
    219240         END DO 
    … …  
    248269                  zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  & 
    249270                     &                                           + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  ) 
    250                   en(ji,jj,mikt(ji,jj)) = en(ji,jj,1)           * tmask(ji,jj,1) & 
     271                  en(ji,jj,mikt(ji,jj)) = en(ji,jj,1)           * tmask(ji,jj,1) &      
    251272                     &                  + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) 
    252273               END DO 
    … …  
    286307            DO ji = fs_2, fs_jpim1   ! vector opt. 
    287308               zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
    288                zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    289                IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 
     309               zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    290310            END DO 
    291311         END DO          
    … …  
    293313            DO jj = 2, jpjm1 
    294314               DO ji = fs_2, fs_jpim1   ! vector opt. 
    295                   IF ( zfr_i(ji,jj) /= 0. ) THEN                
     315                  IF ( zus3(ji,jj) /= 0._wp ) THEN                
    296316                     ! vertical velocity due to LC    
    297317                     IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 
    298318                        !                                           ! vertical velocity due to LC 
    299                         zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) )   ! warning: optimization: zus^3 is in zfr_i 
     319                        zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 
    300320                        !                                           ! TKE Langmuir circulation source term 
    301                         en(ji,jj,jk) = en(ji,jj,jk) + rdt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 
     321                        en(ji,jj,jk) = en(ji,jj,jk) + rdt * zus3(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 
    302322                     ENDIF 
    303323                  ENDIF 
    … …  
    399419       
    400420      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    401          DO jk = 2, jpkm1                       ! rn_eice =0 ON below sea-ice, =4 OFF when ice fraction > 0.25 
     421         DO jk = 2, jpkm1                       ! nn_eice=0 : ON below sea-ice ; nn_eice>0 : partly OFF 
    402422            DO jj = 2, jpjm1 
    403423               DO ji = fs_2, fs_jpim1   ! vector opt. 
    404424                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    405                      &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     425                     &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    406426               END DO 
    407427            END DO 
    … …  
    412432               jk = nmln(ji,jj) 
    413433               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    414                   &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     434                  &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    415435            END DO 
    416436         END DO 
    … …  
    425445                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    426446                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    427                      &                        * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     447                     &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    428448               END DO 
    429449            END DO 
    … …  
    477497      REAL(wp) ::   zrn2, zraug, zcoef, zav   ! local scalars 
    478498      REAL(wp) ::   zdku,   zdkv, zsqen       !   -      - 
    479       REAL(wp) ::   zemxl, zemlm, zemlp       !   -      - 
     499      REAL(wp) ::   zemxl, zemlm, zemlp, zmaxice       !   -      - 
    480500      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld   ! 3D workspace 
    481501      !!-------------------------------------------------------------------- 
    … …  
    490510      zmxlm(:,:,:)  = rmxl_min     
    491511      zmxld(:,:,:)  = rmxl_min 
    492       ! 
     512      !  
    493513      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 
     514         ! 
    494515         zraug = vkarmn * 2.e5_wp / ( rau0 * grav ) 
    495          DO jj = 2, jpjm1 
     516#if ! defined key_si3 && ! defined key_cice 
     517         DO jj = 2, jpjm1                     ! No sea-ice 
    496518            DO ji = fs_2, fs_jpim1 
    497                zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 
    498             END DO 
    499          END DO 
    500       ELSE  
     519               zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
     520            END DO 
     521         END DO 
     522#else 
     523 
     524         SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
     525         ! 
     526         CASE( 0 )                      ! No scaling under sea-ice 
     527            DO jj = 2, jpjm1 
     528               DO ji = fs_2, fs_jpim1 
     529                  zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
     530               END DO 
     531            END DO 
     532            ! 
     533         CASE( 1 )                      ! scaling with constant sea-ice thickness 
     534            DO jj = 2, jpjm1 
     535               DO ji = fs_2, fs_jpim1 
     536                  zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     537                     &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1) 
     538               END DO 
     539            END DO 
     540            ! 
     541         CASE( 2 )                      ! scaling with mean sea-ice thickness 
     542            DO jj = 2, jpjm1 
     543               DO ji = fs_2, fs_jpim1 
     544#if defined key_si3 
     545                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     546                     &                         fr_i(ji,jj)   * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 
     547#elif defined key_cice 
     548                  zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     549                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     550                     &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
     551#endif 
     552               END DO 
     553            END DO 
     554            ! 
     555         CASE( 3 )                      ! scaling with max sea-ice thickness 
     556            DO jj = 2, jpjm1 
     557               DO ji = fs_2, fs_jpim1 
     558                  zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     559                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     560                     &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
     561               END DO 
     562            END DO 
     563            ! 
     564         END SELECT 
     565#endif 
     566         ! 
     567         DO jj = 2, jpjm1 
     568            DO ji = fs_2, fs_jpim1 
     569               zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
     570            END DO 
     571         END DO 
     572         ! 
     573      ELSE 
    501574         zmxlm(:,:,1) = rn_mxl0 
    502575      ENDIF 
    … …  
    643716      INTEGER ::   ios 
    644717      !! 
    645       NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,  & 
    646          &                 rn_emin0, rn_bshear, nn_mxl , ln_mxl0  ,  & 
    647          &                 rn_mxl0 , nn_pdl   , ln_lc  , rn_lc,      & 
    648          &                 nn_etau , nn_htau  , rn_efr , rn_eice   
     718      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb   , rn_emin  ,  & 
     719         &                 rn_emin0, rn_bshear, nn_mxl   , ln_mxl0  ,  & 
     720         &                 rn_mxl0 , nn_mxlice, rn_mxlice,             & 
     721         &                 nn_pdl  , ln_lc    , rn_lc,                 & 
     722         &                 nn_etau , nn_htau  , rn_efr   , nn_eice   
    649723      !!---------------------------------------------------------------------- 
    650724      ! 
    … …  
    675749         WRITE(numout,*) '         surface mixing length = F(stress) or not    ln_mxl0   = ', ln_mxl0 
    676750         WRITE(numout,*) '         surface  mixing length minimum value        rn_mxl0   = ', rn_mxl0 
     751         IF( ln_mxl0 ) THEN 
     752            WRITE(numout,*) '      type of scaling under sea-ice               nn_mxlice = ', nn_mxlice 
     753            IF( nn_mxlice == 1 ) & 
     754            WRITE(numout,*) '      ice thickness when scaling under sea-ice    rn_mxlice = ', rn_mxlice 
     755            SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
     756            CASE( 0 )   ;   WRITE(numout,*) '   ==>>>   No scaling under sea-ice' 
     757            CASE( 1 )   ;   WRITE(numout,*) '   ==>>>   scaling with constant sea-ice thickness' 
     758            CASE( 2 )   ;   WRITE(numout,*) '   ==>>>   scaling with mean sea-ice thickness' 
     759            CASE( 3 )   ;   WRITE(numout,*) '   ==>>>   scaling with max sea-ice thickness' 
     760            CASE DEFAULT 
     761               CALL ctl_stop( 'zdf_tke_init: wrong value for nn_mxlice, should be 0,1,2,3 or 4') 
     762            END SELECT 
     763         ENDIF 
    677764         WRITE(numout,*) '      Langmuir cells parametrization              ln_lc     = ', ln_lc 
    678765         WRITE(numout,*) '         coef to compute vertical velocity of LC     rn_lc  = ', rn_lc 
    … …  
    680767         WRITE(numout,*) '          type of tke penetration profile            nn_htau   = ', nn_htau 
    681768         WRITE(numout,*) '          fraction of TKE that penetrates            rn_efr    = ', rn_efr 
    682          WRITE(numout,*) '          below sea-ice:  =0 ON                      rn_eice   = ', rn_eice 
    683          WRITE(numout,*) '          =4 OFF when ice fraction > 1/4   ' 
     769         WRITE(numout,*) '      langmuir & surface wave breaking under ice  nn_eice = ', nn_eice 
     770         SELECT CASE( nn_eice )  
     771         CASE( 0 )   ;   WRITE(numout,*) '   ==>>>   no impact of ice cover on langmuir & surface wave breaking' 
     772         CASE( 1 )   ;   WRITE(numout,*) '   ==>>>   weigthed by 1-TANH( fr_i(:,:) * 10 )' 
     773         CASE( 2 )   ;   WRITE(numout,*) '   ==>>>   weighted by 1-fr_i(:,:)' 
     774         CASE( 3 )   ;   WRITE(numout,*) '   ==>>>   weighted by 1-MIN( 1, 4 * fr_i(:,:) )' 
     775         CASE DEFAULT 
     776            CALL ctl_stop( 'zdf_tke_init: wrong value for nn_eice, should be 0,1,2, or 3') 
     777         END SELECT       
    684778         IF( .NOT.ln_drg_OFF ) THEN 
    685779            WRITE(numout,*) 

  • NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zfechem.F90

    r12276 r13466  
    121121               ! 
    122122               zfeequi = zFe3(ji,jj,jk) * 1E-9 
    123                zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    124                fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    125                   &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    126                   &         + fesol(ji,jj,jk,5) / zhplus ) 
    127123               zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
    128124               ! precipitation of Fe3+, creation of nanoparticles 

  • NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsbc.F90

    r12837 r13466  
    270270      ENDIF 
    271271 
    272  
    273272      ! dust input from the atmosphere 
    274273      ! ------------------------------ 

  • NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/EXPREF/file_def_nemo-oce.xml

    r9572 r13466  
    1515     <field field_ref="soce" />  
    1616     <field field_ref="ssh"  /> 
    17      <field field_ref="salgrad"  /> 
    18      <field field_ref="ke_zint"  /> 
     17     <field field_ref="socegrad"  /> 
     18     <field field_ref="eken_int"  /> 
    1919     <field field_ref="relvor"  /> 
    2020     <field field_ref="potvor"  /> 

  • NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/EXPREF/namelist_cfg

    r13278 r13466  
    2020&namusr_def    !   User defined :   CANAL configuration: Flat bottom, beta-plane 
    2121!----------------------------------------------------------------------- 
    22    rn_domszx   =   3600.   !  x horizontal size         [km] 
    23    rn_domszy   =   1800.   !  y horizontal size         [km] 
    24    rn_domszz   =   5000.   !  z vertical size            [m] 
    25    rn_dx       =     30.   !  x horizontal resolution   [km] 
    26    rn_dy       =     30.   !  y horizontal resolution   [km] 
    27    rn_dz       =    500.   !  z vertical resolution      [m] 
     22   rn_domszx   =   2000.   !  x horizontal size         [km] 
     23   rn_domszy   =   1000.   !  y horizontal size         [km] 
     24   rn_domszz   =   1000.   !  z vertical size            [m] 
     25   rn_dx       =     10.   !  x horizontal resolution   [km] 
     26   rn_dy       =     10.   !  y horizontal resolution   [km] 
     27   rn_dz       =   1000.   !  z vertical resolution      [m] 
    2828   rn_0xratio  =      0.5  !  x-domain ratio of the 0 
    2929   rn_0yratio  =      0.5  !  y-domain ratio of the 0 
    … …  
    3131   rn_ppgphi0  =    38.5   !  Reference latitude      [degrees] 
    3232   rn_u10      =      0.   !  10m wind speed              [m/s] 
    33      rn_windszx =   4000.   !  longitudinal wind extension   [km] 
    34      rn_windszy =   4000.   !  latitudinal wind extension    [km] 
    35      rn_uofac  =      0.   !  Uoce multiplicative factor (0.:absolute or 1.:relative winds) 
     33     rn_windszx =   90.    !  longitudinal wind extension   [km] 
     34     rn_windszy =   90.    !  latitudinal wind extension    [km] 
     35!!clem     rn_uofac  =     0.    !  Uoce multiplicative factor (0.:absolute or 1.:relative winds) 
    3636   rn_vtxmax   =      1.   !  initial vortex max current  [m/s] 
    3737   rn_uzonal   =      1.   !  initial zonal current       [m/s] 
    38      rn_ujetszx =   4000.   !  longitudinal jet extension   [km] 
    39      rn_ujetszy =   4000.   !  latitudinal jet extension    [km] 
     38     rn_ujetszx =   4000.  !  longitudinal jet extension   [km] 
     39     rn_ujetszy =   400.   !  latitudinal jet extension    [km] 
    4040   nn_botcase  =      0    !  bottom definition (0:flat, 1:bump) 
    41    nn_initcase =      1    !  initial condition case (0:rest, 1:zonal current, 2:current shear, 3: gaussian zonal current, 
    42       !                    !                          4: geostrophic zonal pulse, 5: vortex) 
    43    ln_sshnoise =  .false.  !  add random noise on initial ssh 
    44    rn_lambda   =     50.   ! gaussian lambda 
     41   nn_initcase =      1    !  initial condition case 
     42   !                       !          -1 : stratif at rest 
     43   !                       !           0 : rest 
     44   !                       !           1 : zonal current 
     45   !                       !           2 : current shear 
     46   !                       !           3 : gaussian zonal current 
     47   !                       !           4 : geostrophic zonal pulse 
     48   !                       !           5 : baroclinic vortex 
     49   ln_sshnoise =  .FALSE.  !  add random noise on initial ssh 
     50   rn_lambda   =     50.   !  gaussian lambda 
     51   nn_perio    = 1 
    4552/ 
    4653!----------------------------------------------------------------------- 
    … …  
    5966!----------------------------------------------------------------------- 
    6067   ln_linssh   =  .false.  !  =T  linear free surface  ==>>  model level are fixed in time 
    61    rn_rdt      =   1440.   !  time step for the dynamics (and tracer if nn_acc=0) 
    62    rn_atfp     =   0.05    !  asselin time filter parameter 
     68   rn_rdt      =   1200.   !  time step for the dynamics (and tracer if nn_acc=0) 
     69   rn_atfp     =   0.0     !  asselin time filter parameter 
     70/ 
     71!----------------------------------------------------------------------- 
     72&namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg) 
     73!----------------------------------------------------------------------- 
     74   ln_write_cfg = .false.   !  (=T) create the domain configuration file 
     75      cn_domcfg_out = "domain_cfg" ! newly created domain configuration filename 
    6376/ 
    6477!!====================================================================== 
    … …  
    148161   ln_traadv_OFF = .false. !  No tracer advection 
    149162   ln_traadv_cen = .false. !  2nd order centered scheme 
    150       nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN 
    151       nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT 
     163      nn_cen_h   =  2            !  =2/4, horizontal 2nd order CEN / 4th order CEN 
     164      nn_cen_v   =  2            !  =2/4, vertical   2nd order CEN / 4th order COMPACT 
    152165   ln_traadv_fct = .false. !  FCT scheme 
    153       nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
     166      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    154167      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    155168   ln_traadv_mus = .false. !  MUSCL scheme 
    … …  
    162175&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO selection) 
    163176!----------------------------------------------------------------------- 
    164    ln_traldf_OFF   =  .true.  !  No explicit diffusion 
     177   !                       !  Operator type: 
     178   ln_traldf_OFF   = .true.    !  No explicit diffusion 
     179   ln_traldf_lap   = .false.   !    laplacian operator 
     180   ln_traldf_blp   = .false.   !  bilaplacian operator 
     181   ! 
     182   !                       !  Direction of action: 
     183   ln_traldf_lev   = .false.   !  iso-level 
     184   ln_traldf_hor   = .true.    !  horizontal  (geopotential) 
     185   ln_traldf_iso   = .false.   !  iso-neutral (standard operator) 
     186   ln_traldf_triad = .false.   !  iso-neutral (triad    operator) 
     187   ! 
     188   !                             !  iso-neutral options: 
     189   ln_traldf_msc   = .false.   !  Method of Stabilizing Correction      (both operators) 
     190   rn_slpmax       =  0.01     !  slope limit                           (both operators) 
     191   ln_triad_iso    = .false.   !  pure horizontal mixing in ML              (triad only) 
     192   rn_sw_triad     = 1         !  =1 switching triad ; =0 all 4 triads used (triad only) 
     193   ln_botmix_triad = .false.   !  lateral mixing on bottom                  (triad only) 
     194   ! 
     195   !                       !  Coefficients: 
     196   nn_aht_ijk_t    = 31         !  space/time variation of eddy coefficient: 
     197      !                             !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file 
     198      !                             !   =  0           constant 
     199      !                             !   = 10 F(k)      =ldf_c1d 
     200      !                             !   = 20 F(i,j)    =ldf_c2d 
     201      !                             !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation 
     202      !                             !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d 
     203      !                             !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing) 
     204      !                        !  time invariant coefficients:  aht0 = 1/2  Ud*Ld   (lap case) 
     205      !                             !                           or   = 1/12 Ud*Ld^3 (blp case) 
     206      rn_Ud        = 0.01           !  lateral diffusive velocity [m/s] (nn_aht_ijk_t= 0, 10, 20, 30) 
     207      rn_Ld        = 200.e+3        !  lateral diffusive length   [m]   (nn_aht_ijk_t= 0, 10) 
    165208/ 
    166209!!====================================================================== 
    … …  
    183226      nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    184227   ln_dynadv_cen2 = .false. !  flux form - 2nd order centered scheme 
    185    ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
     228   ln_dynadv_ubs  = .true.  !  flux form - 3rd order UBS      scheme 
    186229/ 
    187230!----------------------------------------------------------------------- 
    188231&namdyn_vor    !   Vorticity / Coriolis scheme                          (default: NO selection) 
    189232!----------------------------------------------------------------------- 
    190    ln_dynvor_ene = .true.  !  energy conserving scheme 
    191    ln_dynvor_ens = .false. !  enstrophy conserving scheme 
    192    ln_dynvor_mix = .false. !  mixed scheme 
     233   ln_dynvor_ene = .false.  !  energy conserving scheme 
     234   ln_dynvor_ens = .false.  !  enstrophy conserving scheme 
     235   ln_dynvor_mix = .false.  !  mixed scheme 
    193236   ln_dynvor_een = .false.  !  energy & enstrophy scheme 
     237   ln_dynvor_enT = .false.  !  energy conserving scheme (T-point) 
     238   ln_dynvor_eeT = .true.   !  energy conserving scheme (een using e3t) 
    194239      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    195240/ 
    … …  
    210255         !                          !                     = 1 Boxcar over   nn_baro sub-steps 
    211256         !                          !                     = 2 Boxcar over 2*nn_baro  "    " 
    212       ln_bt_auto    = .false.    ! Number of sub-step defined from: 
     257      ln_bt_auto    = .true.    ! Number of sub-step defined from: 
    213258         nn_baro      =  24         ! =F : the number of sub-step in rn_rdt seconds 
    214259/ 
    … …  
    222267   !                       !  Direction of action  : 
    223268   ln_dynldf_lev =  .false.    !  iso-level 
    224    ln_dynldf_hor =  .true.    !  horizontal (geopotential) 
     269   ln_dynldf_hor =  .false.    !  horizontal (geopotential) 
    225270   ln_dynldf_iso =  .false.    !  iso-neutral 
    226271   !                       !  Coefficient 
    227    nn_ahm_ijk_t  = 20           !  space/time variation of eddy coef 
     272   nn_ahm_ijk_t  = 31           !  space/time variation of eddy coef 
    228273      !                             !  =-30  read in eddy_viscosity_3D.nc file 
    229274      !                             !  =-20  read in eddy_viscosity_2D.nc file 
    … …  
    275320!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    276321!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    277 !!   namflo       float parameters                                      (default: OFF) 
    278 !!   nam_diaharm  Harmonic analysis of tidal constituents               (default: OFF) 
    279 !!   nam_diadct   transports through some sections                      (default: OFF) 
     322!!   namflo       float parameters                                      ("key_float") 
     323!!   nam_diaharm  Harmonic analysis of tidal constituents               ("key_diaharm") 
     324!!   namdct       transports through some sections                      ("key_diadct") 
     325!!   nam_diatmb   Top Middle Bottom Output                              (default: OFF) 
    280326!!   nam_dia25h   25h Mean Output                                       (default: OFF) 
    281327!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 
    … …  
    286332!----------------------------------------------------------------------- 
    287333   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE 
    288    ln_dyn_trd  = .true.   ! (T) 3D momentum trend output 
     334   ln_dyn_trd  = .true.    ! (T) 3D momentum trend output 
    289335   ln_dyn_mxl  = .false.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 
    290336   ln_vor_trd  = .false.   ! (T) 2D barotropic vorticity trends (not coded yet) 
    … …  
    313359&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi") 
    314360!----------------------------------------------------------------------- 
     361!!   jpni        =   8       !  jpni   number of processors following i (set automatically if < 1) 
     362!!   jpnj        =   1       !  jpnj   number of processors following j (set automatically if < 1) 
    315363/ 
    316364!----------------------------------------------------------------------- 
    317365&namctl        !   Control prints                                       (default: OFF) 
    318366!----------------------------------------------------------------------- 
     367   ln_timing   = .true.   !  timing by routine write out in timing.output file 
     368!!   ln_diacfl   = .true.   !  CFL diagnostics write out in cfl_diagnostics.ascii 
    319369/ 
    320370!----------------------------------------------------------------------- 

  • NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/diawri.F90

    r12206 r13466  
    230230      IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) ) 
    231231 
    232       IF ( iom_use("salgrad") .OR. iom_use("salgrad2") ) THEN 
     232      IF ( iom_use("socegrad") .OR. iom_use("socegrad2") ) THEN 
    233233         z3d(:,:,jpk) = 0. 
    234234         DO jk = 1, jpkm1 
    … …  
    244244         END DO 
    245245         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    246          CALL iom_put( "salgrad2",  z3d )          ! square of module of sal gradient 
     246         CALL iom_put( "socegrad2",  z3d )          ! square of module of sal gradient 
    247247         z3d(:,:,:) = SQRT( z3d(:,:,:) ) 
    248          CALL iom_put( "salgrad" ,  z3d )          ! module of sal gradient 
     248         CALL iom_put( "socegrad" ,  z3d )          ! module of sal gradient 
    249249      ENDIF 
    250250          
    … …  
    299299            END DO 
    300300         END DO 
    301          CALL iom_put( "salt2c", rau0 * z2d )          ! vertically integrated salt content (PSU*kg/m2) 
    302       ENDIF 
    303       ! 
    304       IF ( iom_use("eken") ) THEN 
     301         CALL iom_put( "salt2c", rau0 * z2d )          ! vertically integrated squared salt content (PSU*kg/m2) 
     302      ENDIF 
     303      ! 
     304      IF ( iom_use("eken") .OR. iom_use("eken_int") ) THEN 
    305305         z3d(:,:,jpk) = 0._wp  
    306306         DO jk = 1, jpkm1 
    307             DO jj = 2, jpj 
    308                DO ji = 2, jpi 
     307            DO jj = 2, jpjm1 
     308               DO ji = 2, jpim1 
    309309                  zztmpx = 0.5 * ( un(ji-1,jj  ,jk) + un(ji,jj,jk) ) 
    310310                  zztmpy = 0.5 * ( vn(ji  ,jj-1,jk) + vn(ji,jj,jk) ) 
    … …  
    315315         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    316316         CALL iom_put( "eken", z3d )                 ! kinetic energy 
    317       ENDIF 
    318  
    319       IF ( iom_use("ke") .or. iom_use("ke_zint") ) THEN 
    320          ! 
    321          z3d(:,:,jpk) = 0._wp 
    322          z3d(1,:, : ) = 0._wp 
    323          z3d(:,1, : ) = 0._wp 
    324          DO jk = 1, jpkm1 
    325             DO jj = 2, jpj 
    326                DO ji = 2, jpi 
    327                   z3d(ji,jj,jk) = 0.25_wp * ( un(ji  ,jj,jk) * un(ji  ,jj,jk) * e1e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)  & 
    328                      &                      + un(ji-1,jj,jk) * un(ji-1,jj,jk) * e1e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)  & 
    329                      &                      + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1e2v(ji,jj  ) * e3v_n(ji,jj  ,jk)  & 
    330                      &                      + vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1e2v(ji,jj-1) * e3v_n(ji,jj-1,jk)  )  & 
    331                      &                    * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    332                END DO 
    333             END DO 
    334          END DO 
    335           
    336          CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    337          CALL iom_put( "ke", z3d ) ! kinetic energy 
    338317 
    339318         z2d(:,:)  = 0._wp  
    … …  
    341320            DO jj = 1, jpj 
    342321               DO ji = 1, jpi 
    343                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * z3d(ji,jj,jk) * tmask(ji,jj,jk) 
    344                END DO 
    345             END DO 
    346          END DO 
    347          CALL iom_put( "ke_zint", z2d )   ! vertically integrated kinetic energy 
    348  
     322                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * z3d(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk) 
     323               END DO 
     324            END DO 
     325         END DO 
     326         CALL iom_put( "eken_int", z2d )   ! vertically integrated kinetic energy 
    349327      ENDIF 
    350328      ! 
    … …  
    358336               DO ji = 1, fs_jpim1   ! vector opt. 
    359337                  z3d(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    360                      &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
     338                     &             - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    361339               END DO 
    362340            END DO 

  • NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/usrdef_istate.F90

    r10425 r13466  
    6464      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
    6565      ! 
    66       IF (ln_sshnoise) CALL RANDOM_NUMBER(zrandom) 
    6766      zjetx = ABS(rn_ujetszx)/2. 
    6867      zjety = ABS(rn_ujetszy)/2. 
    6968      ! 
     69      zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
     70      ! 
    7071      SELECT CASE(nn_initcase) 
     72 
     73      CASE(-1)    ! stratif at rest 
     74 
     75         ! sea level: 
     76         pssh(:,:) = 0. 
     77         ! temperature: 
     78         pts(:,:,1,jp_tem) = 25. !!30._wp 
     79         pts(:,:,2:jpk,jp_tem) = 22. !!24._wp 
     80         ! salinity:   
     81         pts(:,:,:,jp_sal) = 35._wp 
     82         ! velocities: 
     83         pu(:,:,:) = 0. 
     84         pv(:,:,:) = 0. 
     85 
    7186      CASE(0)    ! rest 
    7287          
    … …  
    96111            zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
    97112            WHERE( ABS(gphit) <= zjety ) 
    98                pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    99             ELSEWHERE 
    100                pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3   & 
     113               pssh(:,:) = - rn_uzonal / grav * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     114            ELSEWHERE 
     115               pssh(:,:) = - rn_uzonal / grav * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3   & 
    101116                  &                             + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    102117            END WHERE 
    … …  
    107122         pts(:,:,jpk,jp_sal) = 0. 
    108123         DO jk=1, jpkm1 
    109             pts(:,:,jk,jp_sal) = gphit(:,:) 
     124            WHERE( ABS(gphit) <= zjety ) 
     125!!$            WHERE( ABS(gphit) <= zjety*0.5 .AND. ABS(glamt) <= zjety*0.5 ) ! for a square of salt 
     126               pts(:,:,jk,jp_sal) = 35. 
     127            ELSEWHERE 
     128               pts(:,:,jk,jp_sal) = 30. 
     129            END WHERE                     
    110130         END DO 
    111131         ! velocities: 
    … …  
    132152            WHERE( ABS(gphit) <= zjety ) 
    133153               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    134                   &        * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     154                  &        * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    135155            ELSEWHERE 
    136156               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    137                   &        * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
     157                  &        * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    138158            END WHERE 
    139159         END SELECT 
    … …  
    141161         pts(:,:,:,jp_tem) = 10._wp 
    142162         ! salinity:   
    143          pts(:,:,:,jp_sal) = 2. 
    144          DO jk=1, jpkm1 
    145             WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 2. + SIGN(1.,gphiv(:,:)) 
     163         pts(:,:,:,jp_sal) = 30. 
     164         DO jk=1, jpkm1 
     165            WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 30. + SIGN(1.,gphiv(:,:)) 
    146166         END DO 
    147167         ! velocities: 
    … …  
    176196         ! salinity:   
    177197         DO jk=1, jpkm1 
    178             pts(:,:,jk,jp_sal) = gphit(:,:) 
     198            pts(:,:,jk,jp_sal) = pssh(:,:) 
    179199         END DO 
    180200         ! velocities: 
    … …  
    213233         zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
    214234         zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 
    215          zlambda = SQRT(2._wp)*rn_lambda       ! Horizontal scale in meters  
     235         zlambda = SQRT(2._wp)*rn_lambda*1.e3       ! Horizontal scale in meters  
    216236         zn2 = 3.e-3**2 
    217237         zH = 0.5_wp * 5000._wp 
    … …  
    253273         ! velocities: 
    254274         za = 2._wp * zP0 / zlambda**2 
    255          DO jj=1, jpj 
    256             DO ji=1, jpim1 
     275         DO jj = 2, jpjm1 
     276            DO ji = 2, jpim1 
    257277               zx = glamu(ji,jj) * 1.e3 
    258278               zy = gphiu(ji,jj) * 1.e3 
    … …  
    270290         END DO 
    271291         ! 
    272          DO jj=1, jpjm1 
    273             DO ji=1, jpi 
     292         DO jj = 2, jpjm1 
     293            DO ji = 2, jpim1 
    274294               zx = glamv(ji,jj) * 1.e3 
    275295               zy = gphiv(ji,jj) * 1.e3 
    … …  
    287307         END DO 
    288308         !             
     309         CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
     310 
    289311      END SELECT 
    290312 
    291313      IF (ln_sshnoise) THEN 
     314         CALL RANDOM_SEED() 
    292315         CALL RANDOM_NUMBER(zrandom) 
    293316         pssh(:,:) = pssh(:,:) + ( 0.1  * zrandom(:,:) - 0.05 ) 
    294317      END IF 
    295       CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
    296       CALL lbc_lnk(  'usrdef_istate', pts, 'T',  1. ) 
    297       CALL lbc_lnk(   'usrdef_istate', pu, 'U', -1. ) 
    298       CALL lbc_lnk(   'usrdef_istate', pv, 'V', -1. ) 
    299  
     318   
    300319   END SUBROUTINE usr_def_istate 
    301320 

  • NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/usrdef_nam.F90

    r11899 r13466  
    5050   LOGICAL , PUBLIC ::   ln_sshnoise=.false. ! add random noise on initial ssh 
    5151   REAL(wp), PUBLIC ::   rn_lambda  = 50.    ! gaussian lambda 
     52   INTEGER , PUBLIC ::   nn_perio   =    0   ! periodicity of the channel (0=closed, 1=E-W) 
    5253 
    5354   !!---------------------------------------------------------------------- 
    … …  
    7980      !! 
    8081      NAMELIST/namusr_def/  rn_domszx, rn_domszy, rn_domszz, rn_dx, rn_dy, rn_dz, rn_0xratio, rn_0yratio   & 
    81          &                 , nn_fcase, rn_ppgphi0, rn_vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy   & 
    82          &                 , rn_u10, rn_windszx, rn_windszy, rn_uofac   & 
    83          &                 , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda 
     82         &                 , nn_fcase, rn_ppgphi0, rn_u10, rn_windszx, rn_windszy & !!, rn_uofac   & 
     83         &                 , rn_vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy  & 
     84         &                 , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda, nn_perio 
    8485      !!---------------------------------------------------------------------- 
    8586      ! 
    … …  
    151152         WRITE(numout,*) '      add random noise on initial ssh   ln_sshnoise= ', ln_sshnoise 
    152153         WRITE(numout,*) '      Gaussian lambda parameter          rn_lambda = ', rn_lambda 
    153          WRITE(numout,*) '   ' 
    154          WRITE(numout,*) '   Lateral boundary condition of the global domain' 
    155          WRITE(numout,*) '      EW_CANAL : closed basin               jperio = ', kperio 
     154         WRITE(numout,*) '      Periodicity of the basin            nn_perio = ', nn_perio 
    156155      ENDIF 
     156      !                             ! Set the lateral boundary condition of the global domain 
     157      kperio = nn_perio                    ! EW_CANAL configuration : closed basin 
    157158      ! 
    158159   END SUBROUTINE usr_def_nam 

  • NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/usrdef_sbc.F90

    r10074 r13466  
    1717   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1818   USE phycst          ! physical constants 
    19    USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy  
     19   USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy, rn_windszx  
    2020   ! 
    2121   USE in_out_manager  ! I/O manager 
    … …  
    7171         ! 
    7272         utau(:,:) = 0._wp 
    73          IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN 
    74             WHERE( ABS(gphit) <= rn_windszy/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u10 
    75          ENDIF 
    7673         vtau(:,:) = 0._wp 
    7774         taum(:,:) = 0._wp 
    … …  
    8380         qsr (:,:) = 0._wp 
    8481         !          
     82      ENDIF 
     83 
     84      IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN 
     85         IF( nyear == 1 .AND. nmonth == 1 .AND. nday <= 10 ) THEN 
     86            WHERE( ABS(gphit) <= rn_windszy/2. .AND. ABS(glamt) <= rn_windszx/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u10 
     87         ELSE 
     88            utau(:,:) = 0. 
     89         ENDIF 
    8590      ENDIF 
    8691 

  • NEMO/branches/2020/temporary_r4_trunk/tests/CANAL/MY_SRC/usrdef_zgr.F90

    r10425 r13466  
    199199         zmaxlam = MAXVAL(glamt) 
    200200         CALL mpp_max( 'usrdef_zgr', zmaxlam )                 ! max over the global domain 
    201          zscl = rpi / zmaxlam 
    202          z2d(:,:) = 0.5 * ( 1. - COS( glamt(:,:) * zscl ) ) 
    203          z2d(:,:) = REAL(jpkm1 - NINT( 0.75 * REAL(jpkm1,wp) * z2d(:,:) ), wp) 
     201         zscl = 0.5 * rpi / zmaxlam 
     202         z2d(:,:) = COS( glamt(:,:) * zscl ) 
     203         z2d(:,:) = REAL(jpkm1 - NINT( 0.5 * REAL(jpkm1,wp) * z2d(:,:) ), wp) 
    204204      END SELECT 
    205205      ! 

  • NEMO/branches/2020/temporary_r4_trunk/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg

    r10535 r13466  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization 
    9191 
    9292   sn_hti = 'initice_60pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/temporary_r4_trunk/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_120pts

    r10431 r13466  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    9191 
    9292   sn_hti = 'initice_120pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/temporary_r4_trunk/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_240pts

    r10431 r13466  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    9191 
    9292   sn_hti = 'initice_240pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/temporary_r4_trunk/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_60pts

    r10431 r13466  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    9191 
    9292   sn_hti = 'initice_60pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/temporary_r4_trunk/tests/ICE_ADV1D/MY_SRC/usrdef_sbc.F90

    r10513 r13466  
    108108      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    109109      !! 
     110      INTEGER  ::   jl 
    110111      REAL(wp) ::   zfr1, zfr2                 ! local variables 
    111112      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing 
     113      REAL(wp), DIMENSION(jpi,jpj) ::   ztri 
    112114      !!--------------------------------------------------------------------- 
    113115      ! 
    … …  
    142144 
    143145      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    144       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    145       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
     146      cloud_fra(:,:) = pp_cldf 
     147      ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    146148      ! 
    147       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    148          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    149       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    150          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    151       ELSEWHERE                                                         ! zero when hs>0 
    152          qtr_ice_top(:,:,:) = 0._wp  
    153       END WHERE 
    154            
     149      DO jl = 1, jpl 
     150         WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     151            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     152         ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     153            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     154         ELSEWHERE                                                         ! zero when hs>0 
     155            qtr_ice_top(:,:,jl) = 0._wp 
     156         END WHERE 
     157      ENDDO 
     158          
     159  
    155160   END SUBROUTINE usrdef_sbc_ice_flx 
    156161 

  • NEMO/branches/2020/temporary_r4_trunk/tests/ICE_ADV2D/EXPREF/namelist_ice_cfg

    r10535 r13466  
    8686!------------------------------------------------------------------------------ 
    8787   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    88    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     88   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    8989 
    9090   sn_hti = 'initice'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/temporary_r4_trunk/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90

    r10515 r13466  
    108108      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   phi    ! ice thickness 
    109109      !! 
     110      INTEGER  ::   jl 
    110111      REAL(wp) ::   zfr1, zfr2                 ! local variables 
    111112      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing 
     113      REAL(wp), DIMENSION(jpi,jpj) ::   ztri 
    112114      !!--------------------------------------------------------------------- 
    113115      ! 
    … …  
    142144 
    143145      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    144       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    145       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
     146      cloud_fra(:,:) = pp_cldf 
     147      ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    146148      ! 
    147       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    148          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    149       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    150          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    151       ELSEWHERE                                                         ! zero when hs>0 
    152          qtr_ice_top(:,:,:) = 0._wp  
    153       END WHERE 
    154            
     149      DO jl = 1, jpl 
     150         WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     151            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     152         ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     153            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     154         ELSEWHERE                                                         ! zero when hs>0 
     155            qtr_ice_top(:,:,jl) = 0._wp 
     156         END WHERE 
     157      ENDDO 
     158          
     159  
    155160   END SUBROUTINE usrdef_sbc_ice_flx 
    156161 

  • NEMO/branches/2020/temporary_r4_trunk/tests/ICE_AGRIF/EXPREF/namelist_ice_cfg

    r10535 r13466  
    8686!------------------------------------------------------------------------------ 
    8787   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    88    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     88   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    8989 
    9090   sn_hti = 'initice'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/2020/temporary_r4_trunk/tests/ICE_AGRIF/MY_SRC/usrdef_sbc.F90

    r10516 r13466  
    108108      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    109109      !! 
     110      INTEGER  ::   jl 
    110111      REAL(wp) ::   zfr1, zfr2                 ! local variables 
    111112      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing 
     113      REAL(wp), DIMENSION(jpi,jpj) ::   ztri 
    112114      !!--------------------------------------------------------------------- 
    113115      ! 
    … …  
    142144 
    143145      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    144       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    145       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
     146      cloud_fra(:,:) = pp_cldf 
     147      ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    146148      ! 
    147       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    148          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    149       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    150          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    151       ELSEWHERE                                                         ! zero when hs>0 
    152          qtr_ice_top(:,:,:) = 0._wp  
    153       END WHERE 
     149      DO jl = 1, jpl 
     150         WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     151            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     152         ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     153            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     154         ELSEWHERE                                                         ! zero when hs>0 
     155            qtr_ice_top(:,:,jl) = 0._wp 
     156         END WHERE 
     157      ENDDO 
    154158           
    155159   END SUBROUTINE usrdef_sbc_ice_flx 
Note: See TracChangeset for help on using the changeset viewer.