Changeset 5123


Ignore:
Timestamp:
2015-03-04T17:06:03+01:00 (6 years ago)
Author:
clem
Message:

major LIM3 cleaning + monocat capabilities + NEMO namelist-consistency; sette to follow

Location:
trunk/NEMOGCM/NEMO
Files:
41 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r5056 r5123  
    3535   INTEGER , PUBLIC ::   nbiter      !: number of sub-time steps for relaxation 
    3636   INTEGER , PUBLIC ::   nbitdr      !: maximum number of iterations for relaxation 
    37    INTEGER , PUBLIC ::   nevp        !: number of EVP subcycling iterations 
     37   INTEGER , PUBLIC ::   nn_nevp     !: number of EVP subcycling iterations 
    3838   INTEGER , PUBLIC ::   telast      !: timescale for EVP elastic waves 
    3939   REAL(wp), PUBLIC ::   epsd        !: tolerance parameter for dynamic 
     
    4747   REAL(wp), PUBLIC ::   c_rhg       !: second bulk-rhelogy parameter 
    4848   REAL(wp), PUBLIC ::   etamn       !: minimun value for viscosity 
    49    REAL(wp), PUBLIC ::   creepl      !: creep limit 
    50    REAL(wp), PUBLIC ::   ecc         !: eccentricity of the elliptical yield curve 
     49   REAL(wp), PUBLIC ::   rn_creepl   !: creep limit 
     50   REAL(wp), PUBLIC ::   rn_ecc      !: eccentricity of the elliptical yield curve 
    5151   REAL(wp), PUBLIC ::   ahi0        !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    5252   REAL(wp), PUBLIC ::   alphaevp    !: coefficient for the solution of EVP int. stresses 
    53    REAL(wp), PUBLIC ::   hminrhg = 0.001_wp    !: clem : ice volume (a*h in m) below which ice velocity is set to ocean velocity 
    54  
    55    REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( ecc * ecc ) 
     53 
     54   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( rn_ecc * rn_ecc ) 
    5655   REAL(wp), PUBLIC ::   rhoco                 !: = rau0 * cw 
    5756   REAL(wp), PUBLIC ::   sangvg, cangvg        !: sin and cos of the turning angle for ocean stress 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90

    r4624 r5123  
    227227      NAMELIST/namicedyn/ epsd, alpha,     & 
    228228         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   & 
    229          &                c_rhg, etamn, creepl, ecc, ahi0,                  & 
    230          &                nevp, telast, alphaevp, hminrhg 
     229         &                c_rhg, etamn, rn_creepl, rn_ecc, ahi0,                  & 
     230         &                nn_nevp, telast, alphaevp 
    231231      !!------------------------------------------------------------------- 
    232232                     
     
    256256         WRITE(numout,*) '       second bulk-rhelogy parameter                    c_rhg  = ', c_rhg 
    257257         WRITE(numout,*) '       minimun value for viscosity                      etamn  = ', etamn 
    258          WRITE(numout,*) '       creep limit                                      creepl = ', creepl 
    259          WRITE(numout,*) '       eccentricity of the elliptical yield curve       ecc    = ', ecc 
     258         WRITE(numout,*) '       creep limit                                      rn_creepl = ', rn_creepl 
     259         WRITE(numout,*) '       eccentricity of the elliptical yield curve       rn_ecc = ', rn_ecc 
    260260         WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
    261          WRITE(numout,*) '       number of iterations for subcycling nevp   = ', nevp 
     261         WRITE(numout,*) '       number of iterations for subcycling              nn_nevp= ', nn_nevp 
    262262         WRITE(numout,*) '       timescale for elastic waves telast = ', telast 
    263263         WRITE(numout,*) '       coefficient for the solution of int. stresses alphaevp = ', alphaevp 
    264          WRITE(numout,*) '       min ice thickness for rheology calculations     hminrhg = ', hminrhg 
    265264      ENDIF 
    266265      ! 
     
    272271 
    273272      !  Initialization 
    274       usecc2 = 1.0 / ( ecc * ecc ) 
     273      usecc2 = 1.0 / ( rn_ecc * rn_ecc ) 
    275274      rhoco  = rau0 * cw 
    276275      angvg  = angvg * rad      ! convert angvg from degree to radian 
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

    r3680 r5123  
    266266 
    267267               !  Creep limit depends on the size of the grid. 
    268                zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  creepl) 
     268               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  rn_creepl) 
    269269 
    270270               !-  Computation of viscosities. 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90

    r4161 r5123  
    55   !!====================================================================== 
    66   !! History :  3.0  ! 2003-08  (M. Vancoppenolle)  LIM-3 original code 
    7    !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
     7   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation 
    88   !!---------------------------------------------------------------------- 
    9    USE par_ice        ! LIM-3 parameter 
    109   USE in_out_manager ! I/O manager 
    1110   USE lib_mpp        ! MPP library 
     
    2120   INTEGER, PUBLIC ::   njeq , njeqm1        !: j-index of the equator if it is inside the domain 
    2221 
    23    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcor       !: coriolis coefficient 
    24    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   covrai     !: sine of geographic latitude 
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   area       !: surface of grid cell  
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tms, tmi   !: temperature mask, mask for stress 
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmu, tmv   !: mask at u and v velocity points 
    28    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmf        !: mask at f-point 
    29  
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   fcor   !: coriolis coefficient 
    3023   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   wght   !: weight of the 4 neighbours to compute averages 
    3124 
     
    4437      !!------------------------------------------------------------------- 
    4538      ! 
    46       ALLOCATE( fcor(jpi,jpj)                   ,      & 
    47          &      covrai(jpi,jpj) , area(jpi,jpj) ,      & 
    48          &      tms   (jpi,jpj) , tmi (jpi,jpj) ,      & 
    49          &      tmu   (jpi,jpj) , tmv (jpi,jpj) ,      & 
    50          &      tmf   (jpi,jpj) ,                      & 
    51          &      wght(jpi,jpj,2,2)               , STAT = dom_ice_alloc ) 
     39      ALLOCATE( fcor(jpi,jpj), wght(jpi,jpj,2,2), STAT = dom_ice_alloc ) 
    5240      ! 
    5341      IF( dom_ice_alloc /= 0 )   CALL ctl_warn( 'dom_ice_alloc: failed to allocate arrays.' ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4990 r5123  
    1111   !!   'key_lim3'                                      LIM-3 sea-ice model 
    1212   !!---------------------------------------------------------------------- 
    13    USE par_ice        ! LIM sea-ice parameters 
    1413   USE in_out_manager ! I/O manager 
    1514   USE lib_mpp        ! MPP library 
     
    1817   PRIVATE 
    1918 
    20    PUBLIC    ice_alloc  !  Called in iceini.F90 
     19   PUBLIC    ice_alloc  !  Called in sbc_lim_init 
    2120 
    2221   !!====================================================================== 
     
    110109   !! smv_i       |      -      |    Sea ice salt content         | ppt.m | 
    111110   !! oa_i        !      -      !    Sea ice areal age content    | day   | 
    112    !! e_i         !      -      !    Ice enthalpy                 | 10^9 J|  
     111   !! e_i         !      -      !    Ice enthalpy                 | J/m2  |  
    113112   !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  |  
    114    !! e_s         !      -      !    Snow enthalpy                | 10^9 J|  
     113   !! e_s         !      -      !    Snow enthalpy                | J/m2  |  
    115114   !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  |  
    116115   !!                                                                     | 
     
    148147   !! tm_i        |      -      |    Mean sea ice temperature     | K     | 
    149148   !! ot_i        !      -      !    Sea ice areal age content    | day   | 
    150    !! et_i        !      -      !    Total ice enthalpy           | 10^9 J|  
    151    !! et_s        !      -      !    Total snow enthalpy          | 10^9 J|  
     149   !! et_i        !      -      !    Total ice enthalpy           | J/m2  |  
     150   !! et_s        !      -      !    Total snow enthalpy          | J/m2  |  
    152151   !! bv_i        !      -      !    Mean relative brine volume   | ???   |  
    153152   !!===================================================================== 
     
    165164   REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice 
    166165 
    167    !                                     !!** ice-dynamic namelist (namicedyn) ** 
    168    INTEGER , PUBLIC ::   nevp             !: number of iterations for subcycling 
    169    REAL(wp), PUBLIC ::   epsd             !: tolerance parameter for dynamic 
    170    REAL(wp), PUBLIC ::   om               !: relaxation constant 
    171    REAL(wp), PUBLIC ::   cw               !: drag coefficient for oceanic stress 
    172    REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79 
    173    REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength 
    174    REAL(wp), PUBLIC ::   creepl           !: creep limit : has to be under 1.0e-9 
    175    REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve 
    176    REAL(wp), PUBLIC ::   ahi0             !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    177    REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s) 
    178    REAL(wp), PUBLIC ::   relast           !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
    179    REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses  
    180    REAL(wp), PUBLIC ::   hminrhg          !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity 
     166   !                                     !!** ice-thickness distribution namelist (namiceitd) ** 
     167   INTEGER , PUBLIC ::   nn_catbnd        !: categories distribution following: tanh function (1), or h^(-alpha) function (2) 
     168   REAL(wp), PUBLIC ::   rn_himean        !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only) 
     169 
     170   !                                     !!** ice-dynamics namelist (namicedyn) ** 
     171   LOGICAL , PUBLIC ::   ln_icestr_bvf    !: use brine volume to diminish ice strength 
     172   INTEGER , PUBLIC ::   nn_icestr        !: ice strength parameterization (0=Hibler79 1=Rothrock75) 
     173   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
     174   INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 
     175   REAL(wp), PUBLIC ::   rn_pe_rdg        !: ridging work divided by pot. energy change in ridging, nn_icestr = 1 
     176   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress 
     177   REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength (N/M), Hibler JPO79 
     178   REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength 
     179   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9 
     180   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve 
     181   REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
     182   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
    181183 
    182184   !                                     !!** ice-salinity namelist (namicesal) ** 
    183    REAL(wp), PUBLIC ::   s_i_max          !: maximum ice salinity [PSU] 
    184    REAL(wp), PUBLIC ::   s_i_min          !: minimum ice salinity [PSU] 
    185    REAL(wp), PUBLIC ::   s_i_0            !: 1st sal. value for the computation of sal .prof. [PSU] 
    186    REAL(wp), PUBLIC ::   s_i_1            !: 2nd sal. value for the computation of sal .prof. [PSU] 
    187    REAL(wp), PUBLIC ::   sal_G            !: restoring salinity for gravity drainage [PSU] 
    188    REAL(wp), PUBLIC ::   sal_F            !: restoring salinity for flushing [PSU] 
    189    REAL(wp), PUBLIC ::   time_G           !: restoring time constant for gravity drainage (= 20 days) [s] 
    190    REAL(wp), PUBLIC ::   time_F           !: restoring time constant for gravity drainage (= 10 days) [s] 
    191    REAL(wp), PUBLIC ::   bulk_sal         !: bulk salinity (ppt) in case of constant salinity 
     185   REAL(wp), PUBLIC ::   rn_simax         !: maximum ice salinity [PSU] 
     186   REAL(wp), PUBLIC ::   rn_simin         !: minimum ice salinity [PSU] 
     187   REAL(wp), PUBLIC ::   rn_sal_gd        !: restoring salinity for gravity drainage [PSU] 
     188   REAL(wp), PUBLIC ::   rn_sal_fl        !: restoring salinity for flushing [PSU] 
     189   REAL(wp), PUBLIC ::   rn_time_gd       !: restoring time constant for gravity drainage (= 20 days) [s] 
     190   REAL(wp), PUBLIC ::   rn_time_fl       !: restoring time constant for gravity drainage (= 10 days) [s] 
     191   REAL(wp), PUBLIC ::   rn_icesal        !: bulk salinity (ppt) in case of constant salinity 
    192192 
    193193   !                                     !!** ice-salinity namelist (namicesal) ** 
    194    INTEGER , PUBLIC ::   num_sal             !: salinity configuration used in the model 
     194   INTEGER , PUBLIC ::   nn_icesal           !: salinity configuration used in the model 
    195195   !                                         ! 1 - constant salinity in both space and time 
    196196   !                                         ! 2 - prognostic salinity (s(z,t)) 
    197197   !                                         ! 3 - salinity profile, constant in time 
    198    INTEGER , PUBLIC ::   thcon_i_swi         !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
     198   INTEGER , PUBLIC ::   nn_ice_thcon        !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
     199   INTEGER , PUBLIC ::   nn_monocat          !: virtual ITD mono-category parameterizations (1) or not (0) 
    199200 
    200201   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    201    REAL(wp), PUBLIC ::   Cs               !: fraction of shearing energy contributing to ridging             
    202    REAL(wp), PUBLIC ::   Cf               !: ratio of ridging work to PE loss 
    203    REAL(wp), PUBLIC ::   fsnowrdg         !: fractional snow loss to the ocean during ridging 
    204    REAL(wp), PUBLIC ::   fsnowrft         !: fractional snow loss to the ocean during ridging 
    205    REAL(wp), PUBLIC ::   Gstar            !: fractional area of young ice contributing to ridging 
    206    REAL(wp), PUBLIC ::   astar            !: equivalent of G* for an exponential participation function 
    207    REAL(wp), PUBLIC ::   Hstar            !: thickness that determines the maximal thickness of ridged ice 
    208    REAL(wp), PUBLIC ::   hparmeter        !: threshold thickness (m) for rafting / ridging  
    209    REAL(wp), PUBLIC ::   Craft            !: coefficient for smoothness of the hyperbolic tangent in rafting 
    210    REAL(wp), PUBLIC ::   ridge_por        !: initial porosity of ridges (0.3 regular value) 
    211    REAL(wp), PUBLIC ::   betas            !: coef. for partitioning of snowfall between leads and sea ice 
    212    REAL(wp), PUBLIC ::   kappa_i          !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
    213    REAL(wp), PUBLIC ::   nconv_i_thd      !: maximal number of iterations for heat diffusion 
    214    REAL(wp), PUBLIC ::   maxer_i_thd      !: maximal tolerated error (C) for heat diffusion 
     202   REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging             
     203   REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging 
     204   REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging 
     205   REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging 
     206   REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function 
     207   REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice 
     208   REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging  
     209   REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting 
     210   REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value) 
     211   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice 
     212   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
     213   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion 
     214   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion 
    215215 
    216216   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    217    INTEGER , PUBLIC ::   ridge_scheme_swi !: scheme used for ice ridging 
    218    INTEGER , PUBLIC ::   raft_swi         !: rafting of ice or not                         
    219    INTEGER , PUBLIC ::   partfun_swi      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
    220    INTEGER , PUBLIC ::   brinstren_swi    !: use brine volume to diminish ice strength 
    221  
    222    REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( ecc * ecc ) 
    223    REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cw 
    224  
     217   LOGICAL , PUBLIC ::   ln_rafting      !: rafting of ice or not                         
     218   INTEGER , PUBLIC ::   nn_partfun      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
     219 
     220   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( rn_ecc * rn_ecc ) 
     221   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cio 
     222   REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i 
     223   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s  
     224   ! 
    225225   !                                     !!** switch for presence of ice or not  
    226226   REAL(wp), PUBLIC ::   rswitch 
    227  
     227   ! 
    228228   !                                     !!** define some parameters  
    229    REAL(wp), PUBLIC, PARAMETER ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
    230229   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number  
    231230   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number  
     
    266265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2] 
    267266 
     267   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total) [s-1] 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1] 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics) [s-1] 
     270 
    268271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    269272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     
    296299 
    297300   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice 
    298  
    299    ! temporary arrays for dummy version of the code 
    300    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, q_s 
    301301 
    302302   !!-------------------------------------------------------------------------- 
     
    333333       
    334334   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K] 
    335    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents [Giga J] 
     335   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents    [J/m2] 
    336336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i        !: ice salinities          [PSU] 
    337337 
     
    356356   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
    357357   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
    358        
    359  
    360    !!-------------------------------------------------------------------------- 
    361    !! * Increment of global variables 
    362    !!-------------------------------------------------------------------------- 
     358             
     359   !!-------------------------------------------------------------------------- 
     360   !! * Ice thickness distribution variables 
     361   !!-------------------------------------------------------------------------- 
     362   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
     363   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
     364 
     365   !!-------------------------------------------------------------------------- 
     366   !! * Ice Run 
     367   !!-------------------------------------------------------------------------- 
     368   !                                                  !!: ** Namelist namicerun read in sbc_lim_init ** 
     369   INTEGER          , PUBLIC ::   jpl             !: number of ice  categories  
     370   INTEGER          , PUBLIC ::   nlay_i          !: number of ice  layers  
     371   INTEGER          , PUBLIC ::   nlay_s          !: number of snow layers  
     372   CHARACTER(len=32), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
     373   CHARACTER(len=32), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
     374   LOGICAL          , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
     375   LOGICAL          , PUBLIC ::   ln_nicep        !: flag for sea-ice points output (T) or not (F) 
     376   REAL(wp)         , PUBLIC ::   rn_amax         !: maximum ice concentration 
     377   ! 
     378   !!-------------------------------------------------------------------------- 
     379   !! * Ice diagnostics 
     380   !!-------------------------------------------------------------------------- 
     381   ! Increment of global variables 
    363382   ! thd refers to changes induced by thermodynamics 
    364383   ! trp   ''         ''     ''       advection (transport of ice) 
    365    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_a_i_thd  , d_a_i_trp                 !: icefractions                   
    366    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_s_thd  , d_v_s_trp                 !: snow volume 
    367    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_i_thd  , d_v_i_trp                 !: ice  volume 
    368    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_smv_i_thd, d_smv_i_trp               !:      
    369    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_fl  , d_sm_i_gd                 !: 
    370    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_se  , d_sm_i_si  , d_sm_i_la    !: 
    371    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp                !: 
    372  
    373    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !: 
    374    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_i_thd  , d_e_i_trp     !: 
    375    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   d_u_ice_dyn, d_v_ice_dyn   !: ice velocity  
    376        
    377    !!-------------------------------------------------------------------------- 
    378    !! * Ice thickness distribution variables 
    379    !!-------------------------------------------------------------------------- 
    380    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    381    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
    382  
    383    !!-------------------------------------------------------------------------- 
    384    !! * Ice Run 
    385    !!-------------------------------------------------------------------------- 
    386    !                                                  !!: ** Namelist namicerun read in iceini ** 
    387    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
    388    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
    389    LOGICAL               , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
    390    LOGICAL               , PUBLIC ::   ln_nicep        !: flag for sea-ice points output (T) or not (F) 
    391    REAL(wp)              , PUBLIC ::   cai             !: atmospheric drag over sea ice 
    392    REAL(wp)              , PUBLIC ::   cao             !: atmospheric drag over ocean 
    393    REAL(wp)              , PUBLIC ::   amax            !: maximum ice concentration 
     384   LOGICAL , PUBLIC                                        ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
     385   LOGICAL , PUBLIC                                        ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
     386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vi   !: transport of ice volume 
     387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vs   !: transport of snw volume 
     388   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_ei   !: transport of ice enthalpy (W/m2) 
     389   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_es   !: transport of snw enthalpy (W/m2) 
     390   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_smv  !: transport of salt content 
    394391   ! 
    395    !!-------------------------------------------------------------------------- 
    396    !! * Ice diagnostics 
    397    !!-------------------------------------------------------------------------- 
    398    !! Check if everything down here is necessary 
    399    LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
    400    LOGICAL , PUBLIC                                      ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
    401    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd     !: thermodynamic growth rates  
    402    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   !: transport of ice volume 
    403    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   !: transport of snw volume 
    404    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_ei   !: transport of ice enthalpy (W/m2) 
    405    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_es   !: transport of snw enthalpy (W/m2) 
    406    ! 
    407    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2]  
     392   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2]  
    408393   ! 
    409394   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
     
    422407      INTEGER :: ice_alloc 
    423408      ! 
    424       INTEGER :: ierr(19), ii 
     409      INTEGER :: ierr(17), ii 
    425410      !!----------------------------------------------------------------- 
    426411 
     
    439424 
    440425      ii = ii + 1 
    441       ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,      & 
    442          &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,      & 
    443          &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,    & 
     426      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,                        & 
     427         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,                        & 
     428         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,                        & 
    444429         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     & 
    445          &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,  qlead  (jpi,jpj) ,     & 
    446          &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl) ,      & 
    447          &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,      & 
    448          &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,   & 
     430         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     & 
     431         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) ,                        & 
     432         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead  (jpi,jpj) ,                     & 
     433         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,                        & 
     434         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    & 
    449435         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 
    450          &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,  & 
    451          &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & 
     436         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,                           & 
     437         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,    & 
    452438         &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) ) 
    453439 
     
    464450         &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) ) 
    465451      ii = ii + 1 
    466       ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) ,                            & 
    467          &      e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
     452      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
    468453      ii = ii + 1 
    469454      ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) ) 
     
    489474      ii = ii + 1 
    490475      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     & 
    491          &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) ,     & 
    492          &      oa_i_b (jpi,jpj,jpl)                                                        ,     & 
    493          &      u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)                                   , STAT=ierr(ii) ) 
    494  
    495       ! * Increment of global variables 
    496       ii = ii + 1 
    497       ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd  (jpi,jpj,jpl) , d_v_s_trp  (jpi,jpj,jpl) ,   & 
    498          &      d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) ,   &      
    499          &      d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se  (jpi,jpj,jpl) , d_sm_i_si  (jpi,jpj,jpl) ,   & 
    500          &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) ,   & 
    501          &     STAT=ierr(ii) ) 
    502       ii = ii + 1 
    503       ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) ,     & 
    504          &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 
     476         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) ,  & 
     477         &      oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)             , STAT=ierr(ii) ) 
    505478       
    506479      ! * Ice thickness distribution variables 
     
    510483      ! * Ice diagnostics 
    511484      ii = ii + 1 
    512       ALLOCATE( dv_dt_thd(jpi,jpj,jpl),    & 
    513          &      diag_trp_vi(jpi,jpj), diag_trp_vs  (jpi,jpj), diag_trp_ei(jpi,jpj),   &  
    514          &      diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj),  STAT=ierr(ii) ) 
     485      ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei  (jpi,jpj),   &  
     486         &      diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat_dhc(jpi,jpj),  STAT=ierr(ii) ) 
    515487 
    516488      ice_alloc = MAXVAL( ierr(:) ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r4990 r5123  
    6363      !!  
    6464      INTEGER  ::   ji, jj                               ! dummy loop indices 
    65       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! local scalars 
     65      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars 
    6666      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      - 
    6767      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      - 
     
    8585            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    8686               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    87             zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     87            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    8888 
    8989            ps0 (ji,jj) = zslpmax   
    90             psx (ji,jj) = zs1new      * zin0 
    91             psxx(ji,jj) = zs2new      * zin0 
    92             psy (ji,jj) = psy (ji,jj) * zin0 
    93             psyy(ji,jj) = psyy(ji,jj) * zin0 
    94             psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0 
     90            psx (ji,jj) = zs1new      * rswitch 
     91            psxx(ji,jj) = zs2new      * rswitch 
     92            psy (ji,jj) = psy (ji,jj) * rswitch 
     93            psyy(ji,jj) = psyy(ji,jj) * rswitch 
     94            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 
    9595         END DO 
    9696      END DO 
    9797 
    9898      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
    99       psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
     99      psm (:,:)  = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
    100100 
    101101      !  Calculate fluxes and moments between boxes i<-->i+1               
     
    248248      !! 
    249249      INTEGER  ::   ji, jj                               ! dummy loop indices 
    250       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars 
     250      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars 
    251251      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    252252      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
     
    270270            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    271271               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    272             zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     272            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    273273            ! 
    274274            ps0 (ji,jj) = zslpmax   
    275             psx (ji,jj) = psx (ji,jj) * zin0 
    276             psxx(ji,jj) = psxx(ji,jj) * zin0 
    277             psy (ji,jj) = zs1new * zin0 
    278             psyy(ji,jj) = zs2new * zin0 
    279             psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0 
     275            psx (ji,jj) = psx (ji,jj) * rswitch 
     276            psxx(ji,jj) = psxx(ji,jj) * rswitch 
     277            psy (ji,jj) = zs1new * rswitch 
     278            psyy(ji,jj) = zs2new * rswitch 
     279            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 
    280280         END DO 
    281281      END DO 
    282282 
    283283      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    284       psm(:,:)  = MAX(  pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
     284      psm(:,:)  = MAX(  pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
    285285 
    286286      !  Calculate fluxes and moments between boxes j<-->j+1               
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r4873 r5123  
    66   !! History :   -   ! Original code from William H. Lipscomb, LANL 
    77   !!            3.0  ! 2004-06  (M. Vancoppenolle)   Energy Conservation  
    8    !!            4.0  ! 2011-02  (G. Madec)  add mpp considerations 
     8   !!            3.5  ! 2011-02  (G. Madec)  add mpp considerations 
    99   !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm 
    1010   !!---------------------------------------------------------------------- 
     
    1616   !!---------------------------------------------------------------------- 
    1717   USE phycst         ! physical constants 
    18    USE par_ice        ! LIM-3 parameter 
    1918   USE ice            ! LIM-3 variables 
    2019   USE dom_ice        ! LIM-3 domain 
     
    168167      REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft 
    169168      REAL(wp)                        :: zvmin, zamin, zamax  
     169      REAL(wp)                        :: zconv 
     170 
     171      zconv = 1.e-9 
    170172 
    171173      IF( icount == 0 ) THEN 
    172174 
    173          zvi_b  = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 
    174          zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    175          zei_b  = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 
    176          zfw_b  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    177             &                   wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
    178             &             ) * area(:,:) * tms(:,:) ) 
    179          zfs_b  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    180             &                   sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
    181             &                 ) * area(:,:) * tms(:,:) ) 
    182          zft_b  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    183             &                 - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    184             &                  ) * area(:,:) / unit_fac * tms(:,:) ) 
     175         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     176            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
     177            &                ) *  e12t(:,:) * tmask(:,:,1) ) 
     178 
     179         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
     180            &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     181            &                ) *  e12t(:,:) * tmask(:,:,1) ) 
     182 
     183         zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     184            &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
     185            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
     186 
     187         zvi_b  = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * e12t(:,:) * tmask(:,:,1) ) 
     188 
     189         zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) 
     190 
     191         zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
     192            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
     193                            ) * e12t(:,:) * tmask(:,:,1) * zconv ) 
    185194 
    186195      ELSEIF( icount == 1 ) THEN 
    187196 
    188          zfs  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    189             &                 sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &  
    190             &                ) * area(:,:) * tms(:,:) ) - zfs_b 
    191          zfw  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    192             &                 wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
    193             &                ) * area(:,:) * tms(:,:) ) - zfw_b 
    194          zft  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    195             &               - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    196             &                ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b 
     197         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     198            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &  
     199            &              ) * e12t(:,:) * tmask(:,:,1) ) - zfs_b 
     200 
     201         zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
     202            &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     203            &              ) * e12t(:,:) * tmask(:,:,1) ) - zfw_b 
     204 
     205         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     206            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
     207            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zft_b 
    197208  
    198          zvi  = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw  
    199          zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zsmv_b ) * r1_rdtice + ( zfs / rhoic ) 
    200          zei  =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zei_b * r1_rdtice + zft 
    201  
    202          zvmin = glob_min(v_i) 
    203          zamax = glob_max(SUM(a_i,dim=3)) 
    204          zamin = glob_min(a_i) 
     209         zvi  = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 )  & 
     210            &                    * e12t(:,:) * tmask(:,:,1) ) - zvi_b ) * r1_rdtice - zfw  
     211 
     212         zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) - zsmv_b ) * r1_rdtice + ( zfs * r1_rhoic ) 
     213 
     214         zei  =   glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
     215            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
     216            &                ) * e12t(:,:) * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 
     217 
     218         zvmin = glob_min( v_i ) 
     219         zamax = glob_max( SUM( a_i, dim=3 ) ) 
     220         zamin = glob_min( a_i ) 
    205221        
    206222         IF(lwp) THEN 
    207223            IF ( ABS( zvi    ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (',cd_routine,') = ',(zvi * rday) 
    208224            IF ( ABS( zsmv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday) 
    209             IF ( ABS( zei    ) >  1.    ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (',cd_routine,') = ',(zei) 
    210             IF ( zvmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin) 
    211             IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN 
     225            IF ( ABS( zei    ) >  1.e-4 ) WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',(zei) 
     226            IF ( zvmin <  -epsi10       ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin) 
     227            IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > rn_amax+epsi10 ) THEN 
    212228                                          WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
    213229            ENDIF 
    214             IF ( zamin <  0.            ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
     230            IF ( zamin <  -epsi10       ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
    215231         ENDIF 
    216232 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r4990 r5123  
    1414   !!---------------------------------------------------------------------- 
    1515   USE ice             ! LIM-3: sea-ice variable 
    16    USE par_ice         ! LIM-3: ice parameters 
    1716   USE dom_ice         ! LIM-3: sea-ice domain 
    1817   USE dom_oce         ! ocean domain 
     
    3231 
    3332   PUBLIC   lim_diahsb        ! routine called by ice_step.F90 
    34    !!PUBLIC   lim_diahsb_init   ! routine called by ice_init.F90 
    35    !!PUBLIC   lim_diahsb_rst   ! routine called by ice_init.F90 
    3633 
    3734   real(wp) ::   frc_sal, frc_vol   ! global forcing trends 
     
    7471 
    7572      ! 1/area 
    76       z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
    77  
    78       rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 
     73      z1_area = 1._wp / MAX( glob_sum( e12t(:,:) * tmask(:,:,1) ), epsi06 ) 
     74 
     75      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e12t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 
    7976      ! ----------------------- ! 
    8077      ! 1 -  Content variations ! 
    8178      ! ----------------------- ! 
    82       zbg_ivo = glob_sum( vt_i(:,:) * area(:,:) * tms(:,:) ) ! volume ice  
    83       zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow 
    84       zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area 
    85       zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )       ! mean salt content 
    86       zbg_tem = glob_sum( ( tm_i(:,:) - rtt ) * vt_i(:,:) * area(:,:) * tms(:,:) )  ! mean temp content 
    87  
    88       !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 
    89       !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
     79      zbg_ivo = glob_sum( vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume ice  
     80      zbg_svo = glob_sum( vt_s(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume snow 
     81      zbg_are = glob_sum( at_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! area 
     82      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) )       ! mean salt content 
     83      zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e12t(:,:) * tmask(:,:,1) )  ! mean temp content 
     84 
     85      !zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 
     86      !zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
    9087 
    9188      ! Volume 
    9289      ztmp = rswitch * z1_area * r1_rau0 * rday 
    93       zbg_vfx     = ztmp * glob_sum(     emp(:,:) * area(:,:) * tms(:,:) ) 
    94       zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) 
    95       zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) 
    96       zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) 
    97       zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) 
    98       zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) 
    99       zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) 
    100       zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) 
    101       zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) 
    102       zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) 
    103       zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) 
     90      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     91      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     92      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     93      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     94      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     95      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     96      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     97      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     98      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     99      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     100      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    104101 
    105102      ! Salt 
    106       zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) 
    107       zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) 
    108       zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) 
    109       zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) 
    110  
    111       zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) 
    112       zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) 
    113       zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) 
    114       zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) 
    115       zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) 
     103      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     104      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     105      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     106      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     107 
     108      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     109      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     110      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     111      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     112      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    116113 
    117114      ! Heat budget 
    118       zbg_ihc      = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content  [1.e-20 J] 
    119       zbg_shc      = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J] 
    120       zbg_hfx_dhc  = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    121       zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    122  
    123       zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    124       zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    125       zbg_hfx_res  = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    126       zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    127       zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    128       zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    129       zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    130       zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    131       zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    132       zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    133       zbg_hfx_out  = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    134       zbg_hfx_in   = glob_sum(  hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     115      zbg_ihc      = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content  [1.e20 J] 
     116      zbg_shc      = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 
     117      zbg_hfx_dhc  = glob_sum( diag_heat_dhc(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     118      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     119 
     120      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     121      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     122      zbg_hfx_res  = glob_sum( hfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     123      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     124      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     125      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     126      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     127      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     128      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     129      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     130      zbg_hfx_out  = glob_sum( hfx_out(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     131      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    135132     
    136133      ! --------------------------------------------- ! 
    137134      ! 2 - Trends due to forcing and ice growth/melt ! 
    138135      ! --------------------------------------------- ! 
    139       z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 
    140       z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes 
     136      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 
     137      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) ! salt fluxes 
    141138      z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
    142                           &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 
     139                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 
     140                          &     wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 
    143141      ! 
    144142      frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4990 r5123  
    66   !! history :  1.0  ! 2002-08  (C. Ethe, G. Madec)  original VP code  
    77   !!            3.0  ! 2007-03  (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle)  LIM3: EVP-Cgrid 
    8    !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
     8   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_lim3 
     
    2020   USE sbc_ice          ! Surface boundary condition: ice   fields 
    2121   USE ice              ! LIM-3 variables 
    22    USE par_ice          ! LIM-3 parameters 
    2322   USE dom_ice          ! LIM-3 domain 
    2423   USE limrhg           ! LIM-3 rheology 
     
    3130   USE timing          ! Timing 
    3231   USE limcons        ! conservation tests 
     32   USE limvar 
    3333 
    3434   IMPLICIT NONE 
     
    7676      CALL wrk_alloc( jpj, zswitch, zmsk ) 
    7777 
     78      CALL lim_var_agg(1)             ! aggregate ice categories 
     79 
    7880      IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    7981 
     
    8385         IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    8486 
    85          u_ice_b(:,:) = u_ice(:,:) * tmu(:,:) 
    86          v_ice_b(:,:) = v_ice(:,:) * tmv(:,:) 
     87         u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 
     88         v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 
    8789 
    8890         ! Rheology (ice dynamics) 
     
    101103            DO jj = 1, jpj 
    102104               zswitch(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line 
    103                zmsk(jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line 
     105               zmsk   (jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line 
    104106            END DO 
    105107 
     
    157159         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    158160         ! frictional velocity at T-point 
    159          zcoef = 0.5_wp * cw 
     161         zcoef = 0.5_wp * rn_cio 
    160162         DO jj = 2, jpjm1  
    161163            DO ji = fs_2, fs_jpim1   ! vector opt. 
    162164               ust2s(ji,jj) = zcoef * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    163                   &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj) 
     165                  &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tmask(ji,jj,1) 
    164166            END DO 
    165167         END DO 
     
    170172      ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
    171173         ! 
    172          zcoef = SQRT( 0.5_wp ) / rau0 
     174         zcoef = SQRT( 0.5_wp ) * r1_rau0 
    173175         DO jj = 2, jpjm1 
    174176            DO ji = fs_2, fs_jpim1   ! vector opt. 
    175177               ust2s(ji,jj) = zcoef * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    176                   &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1)   ) * tms(ji,jj) 
     178                  &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tmask(ji,jj,1) 
    177179            END DO 
    178180         END DO 
     
    189191         CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :') 
    190192         CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :') 
    191          CALL prt_ctl(tab2d_1=area      , clinfo1=' lim_dyn  : cell area :') 
     193         CALL prt_ctl(tab2d_1=e12t      , clinfo1=' lim_dyn  : cell area :') 
    192194         CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :') 
    193195         CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :') 
     
    241243      !!------------------------------------------------------------------- 
    242244      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    243       NAMELIST/namicedyn/ epsd, om, cw, pstar,   & 
    244          &                c_rhg, creepl, ecc, ahi0,     & 
    245          &                nevp, relast, alphaevp, hminrhg 
     245      NAMELIST/namicedyn/ nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio,  rn_creepl, rn_ecc, & 
     246         &                nn_nevp, rn_relast, nn_ahi0, rn_ahi0_ref 
     247      INTEGER  ::   ji, jj 
     248      REAL(wp) ::   za00, zd_max 
    246249      !!------------------------------------------------------------------- 
    247250 
     
    259262         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics ' 
    260263         WRITE(numout,*) '~~~~~~~~~~~~' 
    261          WRITE(numout,*) '   tolerance parameter                              epsd   = ', epsd 
    262          WRITE(numout,*) '   relaxation constant                              om     = ', om 
    263          WRITE(numout,*) '   drag coefficient for oceanic stress              cw     = ', cw 
    264          WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar 
    265          WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg 
    266          WRITE(numout,*) '   creep limit                                      creepl = ', creepl 
    267          WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc 
    268          WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
    269          WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp 
    270          WRITE(numout,*) '   ratio of elastic timescale over ice time step    relast = ', relast 
    271          WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp 
    272          WRITE(numout,*) '   min ice thickness for rheology calculations     hminrhg = ', hminrhg 
     264         WRITE(numout,*)'    ice strength parameterization (0=Hibler 1=Rothrock)  nn_icestr     = ', nn_icestr  
     265         WRITE(numout,*)'    Including brine volume in ice strength comp.         ln_icestr_bvf = ', ln_icestr_bvf 
     266         WRITE(numout,*)'   Ratio of ridging work to PotEner change in ridging    rn_pe_rdg     = ', rn_pe_rdg  
     267         WRITE(numout,*) '   drag coefficient for oceanic stress                  rn_cio        = ', rn_cio 
     268         WRITE(numout,*) '   first bulk-rheology parameter                        rn_pstar      = ', rn_pstar 
     269         WRITE(numout,*) '   second bulk-rhelogy parameter                        rn_crhg       = ', rn_crhg 
     270         WRITE(numout,*) '   creep limit                                          rn_creepl     = ', rn_creepl 
     271         WRITE(numout,*) '   eccentricity of the elliptical yield curve           rn_ecc        = ', rn_ecc 
     272         WRITE(numout,*) '   number of iterations for subcycling                  nn_nevp       = ', nn_nevp 
     273         WRITE(numout,*) '   ratio of elastic timescale over ice time step        rn_relast     = ', rn_relast 
     274         WRITE(numout,*) '   horizontal diffusivity calculation                   nn_ahi0       = ', nn_ahi0 
     275         WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)           rn_ahi0_ref   = ', rn_ahi0_ref 
    273276      ENDIF 
    274277      ! 
    275       usecc2 = 1._wp / ( ecc * ecc ) 
    276       rhoco  = rau0  * cw 
    277  
    278       ! elastic damping 
    279       telast = relast * rdt_ice 
    280  
    281       !  Diffusion coefficients. 
    282       ahiu(:,:) = ahi0 * umask(:,:,1) 
    283       ahiv(:,:) = ahi0 * vmask(:,:,1) 
    284       ! 
     278      usecc2 = 1._wp / ( rn_ecc * rn_ecc ) 
     279      rhoco  = rau0  * rn_cio 
     280      ! 
     281      !  Diffusion coefficients 
     282      SELECT CASE( nn_ahi0 ) 
     283 
     284      CASE( 0 ) 
     285         ahiu(:,:) = rn_ahi0_ref 
     286         ahiv(:,:) = rn_ahi0_ref 
     287 
     288         IF(lwp) WRITE(numout,*) '' 
     289         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim constant = rn_ahi0_ref' 
     290 
     291      CASE( 1 )  
     292 
     293         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
     294         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain 
     295          
     296         ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60° latitude in orca2 
     297                                                        !                    (60° = min latitude for ice cover)   
     298         ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 
     299 
     300         IF(lwp) WRITE(numout,*) '' 
     301         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')' 
     302         IF(lwp) WRITE(numout,*) '   value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp  
     303          
     304      CASE( 2 )  
     305 
     306         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
     307         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain 
     308          
     309         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60° latitude in orca2 
     310                                                 !                    (60° = min latitude for ice cover)   
     311         DO jj = 1, jpj 
     312            DO ji = 1, jpi 
     313               ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 
     314               ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 
     315            END DO 
     316         END DO 
     317         ! 
     318         IF(lwp) WRITE(numout,*) '' 
     319         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1' 
     320         IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 
     321          
     322      END SELECT 
     323 
    285324   END SUBROUTINE lim_dyn_init 
    286325 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r4990 r5123  
    2626   PRIVATE 
    2727 
    28    PUBLIC   lim_hdf     ! called by lim_tra 
     28   PUBLIC   lim_hdf     ! called by lim_trp 
    2929 
    30    LOGICAL  ::   linit = .TRUE.              ! initialization flag (set to flase after the 1st call) 
    31    REAL(wp) ::   epsi04 = 1.e-04              ! constant 
     30   LOGICAL  ::   linit = .TRUE.                             ! initialization flag (set to flase after the 1st call) 
    3231   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient 
    3332 
     
    5453      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   ptab    ! Field on which the diffusion is applied 
    5554      ! 
    56       INTEGER  ::  ji, jj                   ! dummy loop indices 
    57       INTEGER  ::  its, iter, ierr          ! local integers 
    58       REAL(wp) ::   zalfa, zrlxint, zconv   ! local scalars 
    59       REAL(wp), POINTER, DIMENSION(:,:) ::   zrlx, zflu, zflv, zdiv0, zdiv, ztab0 
    60       CHARACTER(lc) ::   charout   ! local character 
     55      INTEGER                           ::  ji, jj                    ! dummy loop indices 
     56      INTEGER                           ::  iter, ierr           ! local integers 
     57      REAL(wp)                          ::  zrlxint, zconv     ! local scalars 
     58      REAL(wp), POINTER, DIMENSION(:,:) ::  zrlx, zflu, zflv, zdiv0, zdiv, ztab0 
     59      CHARACTER(lc)                     ::  charout                   ! local character 
     60      REAL(wp), PARAMETER               ::  zrelax = 0.5_wp           ! relaxation constant for iterative procedure 
     61      REAL(wp), PARAMETER               ::  zalfa  = 0.5_wp           ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 
     62      INTEGER , PARAMETER               ::  its    = 100              ! Maximum number of iteration 
    6163      !!------------------------------------------------------------------- 
    6264       
     
    7173         DO jj = 2, jpjm1   
    7274            DO ji = fs_2 , fs_jpim1   ! vector opt. 
    73                efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) ) 
     75               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj) 
    7476            END DO 
    7577         END DO 
     
    7779      ENDIF 
    7880      !                             ! Time integration parameters 
    79       zalfa = 0.5_wp                      ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 
    80       its   = 100                         ! Maximum number of iteration 
    8181      ! 
    8282      ztab0(:, : ) = ptab(:,:)      ! Arrays initialization 
     
    9191      iter  = 0 
    9292      ! 
    93       DO WHILE( zconv > ( 2._wp * epsi04 ) .AND. iter <= its )   ! Sub-time step loop 
     93      DO WHILE( zconv > ( 2._wp * 1.e-04 ) .AND. iter <= its )   ! Sub-time step loop 
    9494         ! 
    9595         iter = iter + 1                                 ! incrementation of the sub-time step number 
     
    9797         DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    9898            DO ji = 1 , fs_jpim1   ! vector opt. 
    99                zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
    100                zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
     99               zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
     100               zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
    101101            END DO 
    102102         END DO 
     
    104104         DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    105105            DO ji = fs_2 , fs_jpim1   ! vector opt.  
    106                zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   & 
    107                   &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) ) 
     106               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
    108107            END DO 
    109108         END DO 
     
    115114               zrlxint = (   ztab0(ji,jj)    & 
    116115                  &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) )   & 
    117                   &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )  )                             &  
    118                   &    / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 
    119                zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) ) 
     116                  &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )                               &  
     117                  &      ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 
     118               zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) ) 
    120119            END DO 
    121120         END DO 
     
    138137      DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    139138         DO ji = 1 , fs_jpim1   ! vector opt. 
    140             zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
    141             zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
     139            zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
     140            zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
    142141         END DO 
    143142      END DO 
     
    145144      DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    146145         DO ji = fs_2 , fs_jpim1   ! vector opt.  
    147             zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   & 
    148                  &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) ) 
     146            zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
    149147            ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 
    150148         END DO 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4990 r5123  
    2222   USE eosbn2           ! equation of state 
    2323   USE ice              ! sea-ice variables 
    24    USE par_ice          ! ice parameters 
    2524   USE par_oce          ! ocean parameters 
    2625   USE dom_ice          ! sea-ice domain 
     
    3635 
    3736   !                          !!** init namelist (namiceini) ** 
    38    REAL(wp) ::   thres_sst   ! threshold water temperature for initial sea ice 
    39    REAL(wp) ::   hts_ini_n   ! initial snow thickness in the north 
    40    REAL(wp) ::   hts_ini_s   ! initial snow thickness in the south 
    41    REAL(wp) ::   hti_ini_n   ! initial ice thickness in the north 
    42    REAL(wp) ::   hti_ini_s   ! initial ice thickness in the south 
    43    REAL(wp) ::   ati_ini_n   ! initial leads area in the north 
    44    REAL(wp) ::   ati_ini_s   ! initial leads area in the south 
    45    REAL(wp) ::   smi_ini_n   ! initial salinity  
    46    REAL(wp) ::   smi_ini_s   ! initial salinity 
    47    REAL(wp) ::   tmi_ini_n   ! initial temperature 
    48    REAL(wp) ::   tmi_ini_s   ! initial temperature 
    49  
    50    LOGICAL  ::  ln_limini    ! initialization or not 
     37   REAL(wp) ::   rn_thres_sst   ! threshold water temperature for initial sea ice 
     38   REAL(wp) ::   rn_hts_ini_n   ! initial snow thickness in the north 
     39   REAL(wp) ::   rn_hts_ini_s   ! initial snow thickness in the south 
     40   REAL(wp) ::   rn_hti_ini_n   ! initial ice thickness in the north 
     41   REAL(wp) ::   rn_hti_ini_s   ! initial ice thickness in the south 
     42   REAL(wp) ::   rn_ati_ini_n   ! initial leads area in the north 
     43   REAL(wp) ::   rn_ati_ini_s   ! initial leads area in the south 
     44   REAL(wp) ::   rn_smi_ini_n   ! initial salinity  
     45   REAL(wp) ::   rn_smi_ini_s   ! initial salinity 
     46   REAL(wp) ::   rn_tmi_ini_n   ! initial temperature 
     47   REAL(wp) ::   rn_tmi_ini_s   ! initial temperature 
     48 
     49   LOGICAL  ::  ln_iceini    ! initialization or not 
    5150   !!---------------------------------------------------------------------- 
    5251   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
     
    8786      !! * Local variables 
    8887      INTEGER    :: ji, jj, jk, jl             ! dummy loop indices 
    89       REAL(wp)   :: epsi20, ztmelts, zdh 
     88      REAL(wp)   :: ztmelts, zdh 
    9089      INTEGER    :: i_hemis, i_fill, jl0   
    9190      REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 
     
    101100      CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    102101 
    103       epsi20   = 1.e-20_wp 
    104  
    105102      IF(lwp) WRITE(numout,*) 
    106103      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
     
    115112      ! surface temperature 
    116113      DO jl = 1, jpl ! loop over categories 
    117          t_su  (:,:,jl) = rtt * tms(:,:) 
    118          tn_ice(:,:,jl) = rtt * tms(:,:) 
     114         t_su  (:,:,jl) = rt0 * tmask(:,:,1) 
     115         tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 
    119116      END DO 
    120117 
    121118      ! basal temperature (considered at freezing point) 
    122       t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:)  
    123  
    124       IF( ln_limini ) THEN 
     119      t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tmask(:,:,1)  
     120 
     121      IF( ln_iceini ) THEN 
    125122 
    126123      !-------------------------------------------------------------------- 
     
    130127      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    131128         DO ji = 1, jpi 
    132             IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN  
    133                zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice 
     129            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
     130               zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice 
    134131            ELSE                                                                                    
    135                zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice 
     132               zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice 
    136133            ENDIF 
    137134         END DO 
     
    158155      !----------------------------- 
    159156      ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
    160       zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s  ! ice thickness 
    161       zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s  ! snow depth 
    162       zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s  ! ice concentration 
    163       zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s  ! bulk ice salinity 
    164       ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s  ! temperature (ice and snow) 
     157      zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s  ! ice thickness 
     158      zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s  ! snow depth 
     159      zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s  ! ice concentration 
     160      zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s  ! bulk ice salinity 
     161      ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s  ! temperature (ice and snow) 
    165162 
    166163      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume 
     
    197194               !--- Ice thicknesses in the i_fill - 1 first categories 
    198195               DO jl = 1, i_fill - 1 
    199                   zh_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
     196                  zh_i_ini(jl,i_hemis) = hi_mean(jl) 
    200197               END DO 
    201198                
    202199               !--- jl0: most likely index where cc will be maximum 
    203200               DO jl = 1, jpl 
    204                   IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
    205                      ( zht_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
     201                  IF ( ( zht_i_ini(i_hemis) > hi_max(jl-1) ) .AND. & 
     202                     & ( zht_i_ini(i_hemis) <= hi_max(jl)   ) ) THEN 
    206203                     jl0 = jl 
    207204                  ENDIF 
     
    267264 
    268265            ! Test 3: thickness of the last category is in-bounds ? 
    269             IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
     266            IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN 
    270267               ztest_3 = 1 
    271268            ELSE 
     
    319316               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
    320317               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth 
    321                sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity 
     318               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin ! salinity 
    322319               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 
    323                t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp 
     320               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 
    324321 
    325322               ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
     
    329326               ! recompute ht_i, ht_s avoiding out of bounds values 
    330327               ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh ) 
    331                ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic / rhosn ) 
     328               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn ) 
    332329 
    333330               ! ice volume, salt content, age content 
     
    345342            DO jj = 1, jpj 
    346343               DO ji = 1, jpi 
    347                    t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 
     344                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 
    348345                   ! Snow energy of melting 
    349                    e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    350                    ! Change dimensions 
    351                    e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    352                    ! Multiply by volume, so that heat content in Joules 
    353                    e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
     346                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
     347 
     348                   ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 
     349                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
    354350               END DO ! ji 
    355351            END DO ! jj 
     
    362358            DO jj = 1, jpj 
    363359               DO ji = 1, jpi 
    364                    t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt  
    365                    s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min 
    366                    ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
     360                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0  
     361                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin 
     362                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 
    367363 
    368364                   ! heat content per unit volume 
    369365                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    370                       +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
    371                       -   rcp     * ( ztmelts - rtt ) ) 
    372  
    373                    ! Correct dimensions to avoid big values 
    374                    e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    375  
    376                    ! Mutliply by ice volume, and divide by number of layers to get heat content in J 
    377                    e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 
     366                      +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
     367                      -   rcp     * ( ztmelts - rt0 ) ) 
     368 
     369                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
     370                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
    378371               END DO ! ji 
    379372            END DO ! jj 
     
    384377 
    385378      ELSE  
    386          ! if ln_limini=false 
     379         ! if ln_iceini=false 
    387380         a_i  (:,:,:) = 0._wp 
    388381         v_i  (:,:,:) = 0._wp 
     
    400393         DO jl = 1, jpl 
    401394            DO jk = 1, nlay_i 
    402                t_i(:,:,jk,jl) = rtt * tms(:,:) 
     395               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    403396            END DO 
    404397            DO jk = 1, nlay_s 
    405                t_s(:,:,jk,jl) = rtt * tms(:,:) 
     398               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    406399            END DO 
    407400         END DO 
    408401       
    409       ENDIF ! ln_limini 
     402      ENDIF ! ln_iceini 
    410403       
    411404      at_i (:,:) = 0.0_wp 
     
    481474      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    482475      !!----------------------------------------------------------------------------- 
    483       NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s,  & 
    484          &                                      ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s 
     476      NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s,  & 
     477         &                                      rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s 
    485478      INTEGER :: ios                 ! Local integer output status for namelist read 
    486479      !!----------------------------------------------------------------------------- 
     
    502495         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    503496         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    504          WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini   = ', ln_limini 
    505          WRITE(numout,*) '   threshold water temp. for initial sea-ice    thres_sst  = ', thres_sst 
    506          WRITE(numout,*) '   initial snow thickness in the north          hts_ini_n  = ', hts_ini_n 
    507          WRITE(numout,*) '   initial snow thickness in the south          hts_ini_s  = ', hts_ini_s  
    508          WRITE(numout,*) '   initial ice thickness  in the north          hti_ini_n  = ', hti_ini_n 
    509          WRITE(numout,*) '   initial ice thickness  in the south          hti_ini_s  = ', hti_ini_s 
    510          WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_n  = ', ati_ini_n 
    511          WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_s  = ', ati_ini_s 
    512          WRITE(numout,*) '   initial  ice salinity  in the north          smi_ini_n  = ', smi_ini_n 
    513          WRITE(numout,*) '   initial  ice salinity  in the south          smi_ini_s  = ', smi_ini_s 
    514          WRITE(numout,*) '   initial  ice/snw temp  in the north          tmi_ini_n  = ', tmi_ini_n 
    515          WRITE(numout,*) '   initial  ice/snw temp  in the south          tmi_ini_s  = ', tmi_ini_s 
     497         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini 
     498         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst 
     499         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n 
     500         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s  
     501         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n 
     502         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s 
     503         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n 
     504         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s 
     505         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n 
     506         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s 
     507         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n 
     508         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s 
    516509      ENDIF 
    517510 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4990 r5123  
    1818   USE thd_ice          ! LIM thermodynamics 
    1919   USE ice              ! LIM variables 
    20    USE par_ice          ! LIM parameters 
    2120   USE dom_ice          ! LIM domain 
    2221   USE limthd_lac       ! LIM 
     
    2726   USE wrk_nemo         ! work arrays 
    2827   USE prtctl           ! Print control 
    29   ! Check budget (Rousset) 
     28 
    3029   USE iom              ! I/O manager 
    3130   USE lib_fortran      ! glob_sum 
     
    4039   PUBLIC   lim_itd_me_icestrength 
    4140   PUBLIC   lim_itd_me_init 
    42    PUBLIC   lim_itd_me_zapsmall 
    43    PUBLIC   lim_itd_me_alloc        ! called by iceini.F90 
     41   PUBLIC   lim_itd_me_alloc        ! called by sbc_lim_init  
    4442 
    4543   !----------------------------------------------------------------------- 
     
    125123      !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged 
    126124      !!--------------------------------------------------------------------! 
    127       INTEGER ::   ji, jj, jk, jl   ! dummy loop index 
    128       INTEGER ::   niter, nitermax = 20   ! local integer  
    129       LOGICAL  ::   asum_error            ! flag for asum .ne. 1 
     125      INTEGER  ::   ji, jj, jk, jl        ! dummy loop index 
     126      INTEGER  ::   niter                 ! local integer  
    130127      INTEGER  ::   iterate_ridging       ! if true, repeat the ridging 
    131       REAL(wp) ::   w1, tmpfac            ! local scalar 
     128      REAL(wp) ::   za, zfac              ! local scalar 
    132129      CHARACTER (len = 15) ::   fieldid 
    133130      REAL(wp), POINTER, DIMENSION(:,:) ::   closing_net     ! net rate at which area is removed    (1/s) 
     
    140137      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
    141138      ! 
     139      INTEGER, PARAMETER ::   nitermax = 20     
     140      ! 
    142141      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    143142      !!----------------------------------------------------------------------------- 
     
    159158      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 
    160159      !-----------------------------------------------------------------------------! 
    161       Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0                ! proport const for PE 
     160      Cp = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0                ! proport const for PE 
    162161      ! 
    163162      CALL lim_itd_me_ridgeprep                                    ! prepare ridging 
     
    193192            !  (thick, newly ridged ice). 
    194193 
    195             closing_net(ji,jj) = Cs * 0.5 * ( Delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp ) 
     194            closing_net(ji,jj) = rn_cs * 0.5 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp ) 
    196195 
    197196            ! 2.2 divu_adv 
     
    237236               ! Reduce the closing rate if more than 100% of the open water  
    238237               ! would be removed.  Reduce the opening rate proportionately. 
    239                IF ( ato_i(ji,jj) .GT. epsi10 .AND. athorn(ji,jj,0) .GT. 0.0 ) THEN 
    240                   w1 = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
    241                   IF ( w1 .GT. ato_i(ji,jj)) THEN 
    242                      tmpfac = ato_i(ji,jj) / w1 
    243                      closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 
    244                      opning(ji,jj) = opning(ji,jj) * tmpfac 
    245                   ENDIF !w1 
    246                ENDIF !at0i and athorn 
    247  
    248             END DO ! ji 
    249          END DO ! jj 
     238               IF ( ato_i(ji,jj) > epsi10 .AND. athorn(ji,jj,0) > 0.0 ) THEN 
     239                  za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
     240                  IF ( za > ato_i(ji,jj)) THEN 
     241                     zfac = ato_i(ji,jj) / za 
     242                     closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
     243                     opning(ji,jj) = opning(ji,jj) * zfac 
     244                  ENDIF 
     245               ENDIF 
     246 
     247            END DO 
     248         END DO 
    250249 
    251250         ! correction to closing rate / opening if excessive ice removal 
     
    258257               DO ji = 1, jpi 
    259258                  IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN 
    260                      w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
    261                      IF ( w1  >  a_i(ji,jj,jl) ) THEN 
    262                         tmpfac = a_i(ji,jj,jl) / w1 
    263                         closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 
    264                         opning       (ji,jj) = opning       (ji,jj) * tmpfac 
     259                     za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
     260                     IF ( za  >  a_i(ji,jj,jl) ) THEN 
     261                        zfac = a_i(ji,jj,jl) / za 
     262                        closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
     263                        opning       (ji,jj) = opning       (ji,jj) * zfac 
    265264                     ENDIF 
    266265                  ENDIF 
    267                END DO !ji 
    268             END DO ! jj 
    269          END DO !jl 
     266               END DO 
     267            END DO 
     268         END DO 
    270269 
    271270         ! 3.3 Redistribute area, volume, and energy. 
     
    288287         DO jj = 1, jpj 
    289288            DO ji = 1, jpi 
    290                IF (ABS(asum(ji,jj) - kamax ) .LT. epsi10) THEN 
     289               IF (ABS(asum(ji,jj) - kamax ) < epsi10) THEN 
    291290                  closing_net(ji,jj) = 0._wp 
    292291                  opning     (ji,jj) = 0._wp 
     
    324323      ! Convert ridging rate diagnostics to correct units. 
    325324      ! Update fresh water and heat fluxes due to snow melt. 
    326  
    327       asum_error = .false.  
    328  
    329325      DO jj = 1, jpj 
    330326         DO ji = 1, jpi 
    331  
    332             IF(ABS(asum(ji,jj) - kamax) > epsi10 ) asum_error = .true. 
    333327 
    334328            dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice 
     
    341335            !-----------------------------------------------------------------------------! 
    342336            wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
    343             hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice  ! heat sink for ocean (<0, W.m-2) 
     337            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean (<0, W.m-2) 
    344338 
    345339         END DO 
     
    359353                  WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl) 
    360354               END DO 
    361             ENDIF  ! asum 
    362  
    363          END DO !ji 
    364       END DO !jj 
     355            ENDIF 
     356         END DO 
     357      END DO 
    365358 
    366359      ! Conservation check 
     
    375368      !-----------------------------------------------------------------------------! 
    376369      CALL lim_var_glo2eqv 
    377       CALL lim_itd_me_zapsmall 
     370      CALL lim_var_zapsmall 
     371      CALL lim_var_agg( 1 )  
    378372 
    379373 
     
    382376         CALL prt_ctl_info(' - Cell values : ') 
    383377         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    384          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_me  : cell area :') 
     378         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_me  : cell area :') 
    385379         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :') 
    386380         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :') 
     
    436430      !!---------------------------------------------------------------------- 
    437431      INTEGER, INTENT(in) ::   kstrngth    ! = 1 for Rothrock formulation, 0 for Hibler (1979) 
    438  
    439       INTEGER ::   ji,jj, jl   ! dummy loop indices 
    440       INTEGER ::   ksmooth     ! smoothing the resistance to deformation 
    441       INTEGER ::   numts_rm    ! number of time steps for the P smoothing 
    442       REAL(wp) ::   hi, zw1, zp, zdummy, zzc, z1_3   ! local scalars 
     432      INTEGER             ::   ji,jj, jl   ! dummy loop indices 
     433      INTEGER             ::   ksmooth     ! smoothing the resistance to deformation 
     434      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing 
     435      REAL(wp)            ::   zhi, zp, z1_3  ! local scalars 
    443436      REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here 
    444437      !!---------------------------------------------------------------------- 
     
    466459                  ! 
    467460                  IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN 
    468                      hi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     461                     zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    469462                     !---------------------------- 
    470463                     ! PE loss from deforming ice 
    471464                     !---------------------------- 
    472                      strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * hi * hi 
     465                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * zhi * zhi 
    473466 
    474467                     !-------------------------- 
    475468                     ! PE gain from rafting ice 
    476469                     !-------------------------- 
    477                      strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * hi * hi 
     470                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * zhi * zhi 
    478471 
    479472                     !---------------------------- 
     
    481474                     !---------------------------- 
    482475                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl)/krdg(ji,jj,jl)     & 
    483                         * z1_3 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) / ( hrmax(ji,jj,jl)-hrmin(ji,jj,jl) )    
    484 !!gm Optimization:  (a**3-b**3)/(a-b) = a*a+ab+b*b   ==> less costly operations even if a**3 is replaced by a*a*a...                     
    485                   ENDIF            ! aicen > epsi10 
     476                        * z1_3 * ( hrmax(ji,jj,jl)**2 + hrmin(ji,jj,jl)**2 +  hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )   
     477                        !!(a**3-b**3)/(a-b) = a*a+ab+b*b                       
     478                  ENDIF 
    486479                  ! 
    487                END DO ! ji 
    488             END DO !jj 
    489          END DO !jl 
    490  
    491          zzc = Cf * Cp     ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and Cf accounts for frictional dissipation 
    492          strength(:,:) = zzc * strength(:,:) / aksum(:,:) 
    493  
     480               END DO 
     481            END DO 
     482         END DO 
     483    
     484         strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) 
     485                         ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 
    494486         ksmooth = 1 
    495487 
     
    499491      ELSE                      ! kstrngth ne 1:  Hibler (1979) form 
    500492         ! 
    501          strength(:,:) = Pstar * vt_i(:,:) * EXP( - C_rhg * ( 1._wp - at_i(:,:) )  ) 
     493         strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  ) 
    502494         ! 
    503495         ksmooth = 1 
     
    511503      ! CAN BE REMOVED 
    512504      ! 
    513       IF ( brinstren_swi == 1 ) THEN 
     505      IF( ln_icestr_bvf ) THEN 
    514506 
    515507         DO jj = 1, jpj 
    516508            DO ji = 1, jpi 
    517                IF ( bv_i(ji,jj) .GT. 0.0 ) THEN 
    518                   zdummy = MIN ( bv_i(ji,jj), 0.10 ) * MIN( bv_i(ji,jj), 0.10 ) 
    519                ELSE 
    520                   zdummy = 0.0 
    521                ENDIF 
    522509               strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv_i(ji,jj),0.0))) 
    523             END DO              ! j 
    524          END DO                 ! i 
     510            END DO 
     511         END DO 
    525512 
    526513      ENDIF 
     
    538525         CALL lbc_lnk( strength, 'T', 1. ) 
    539526 
    540          DO jj = 2, jpj - 1 
    541             DO ji = 2, jpi - 1 
    542                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN ! ice is 
    543                   ! present 
     527         DO jj = 2, jpjm1 
     528            DO ji = 2, jpim1 
     529               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN ! ice is present 
    544530                  zworka(ji,jj) = 4.0 * strength(ji,jj)              & 
    545                      &          + strength(ji-1,jj) * tms(ji-1,jj) &   
    546                      &          + strength(ji+1,jj) * tms(ji+1,jj) &   
    547                      &          + strength(ji,jj-1) * tms(ji,jj-1) &   
    548                      &          + strength(ji,jj+1) * tms(ji,jj+1)     
    549  
    550                   zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1) 
    551                   zworka(ji,jj) = zworka(ji,jj) / zw1 
     531                     &          + strength(ji-1,jj) * tmask(ji-1,jj,1) &   
     532                     &          + strength(ji+1,jj) * tmask(ji+1,jj,1) &   
     533                     &          + strength(ji,jj-1) * tmask(ji,jj-1,1) &   
     534                     &          + strength(ji,jj+1) * tmask(ji,jj+1,1)     
     535 
     536                  zworka(ji,jj) = zworka(ji,jj) /  & 
     537                     &           ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 
    552538               ELSE 
    553539                  zworka(ji,jj) = 0._wp 
     
    556542         END DO 
    557543 
    558          DO jj = 2, jpj - 1 
    559             DO ji = 2, jpi - 1 
     544         DO jj = 2, jpjm1 
     545            DO ji = 2, jpim1 
    560546               strength(ji,jj) = zworka(ji,jj) 
    561547            END DO 
     
    563549         CALL lbc_lnk( strength, 'T', 1. ) 
    564550 
    565       ENDIF ! ksmooth 
     551      ENDIF 
    566552 
    567553      !-------------------- 
     
    580566         DO jj = 1, jpj - 1 
    581567            DO ji = 1, jpi - 1 
    582                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN       ! ice is present 
     568               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN       ! ice is present 
    583569                  numts_rm = 1 ! number of time steps for the running mean 
    584                   IF ( strp1(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1 
    585                   IF ( strp2(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1 
     570                  IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 
     571                  IF ( strp2(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 
    586572                  zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm 
    587573                  strp2(ji,jj) = strp1(ji,jj) 
     
    612598      !!---------------------------------------------------------------------! 
    613599      INTEGER ::   ji,jj, jl    ! dummy loop indices 
    614       REAL(wp) ::   Gstari, astari, hi, hrmean, zdummy   ! local scalar 
     600      REAL(wp) ::   Gstari, astari, zhi, hrmean, zdummy   ! local scalar 
    615601      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here 
    616602      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n 
     
    620606      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
    621607 
    622       Gstari     = 1.0/Gstar     
    623       astari     = 1.0/astar     
     608      Gstari     = 1.0/rn_gstar     
     609      astari     = 1.0/rn_astar     
    624610      aksum(:,:)    = 0.0 
    625611      athorn(:,:,:) = 0.0 
     
    632618 
    633619      !     ! Zero out categories with very small areas 
    634       CALL lim_itd_me_zapsmall 
     620      CALL lim_var_zapsmall 
    635621 
    636622      !------------------------------------------------------------------------------! 
     
    662648         DO jj = 1, jpj  
    663649            DO ji = 1, jpi 
    664                IF( a_i(ji,jj,jl) .GT. epsi10 ) THEN   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 
    665                ELSE                                   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 
     650               IF( a_i(ji,jj,jl) > epsi10 ) THEN   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 
     651               ELSE                                ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 
    666652               ENDIF 
    667653            END DO 
     
    687673      !----------------------------------------------------------------- 
    688674 
    689       IF( partfun_swi == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
     675      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    690676         DO jl = 0, jpl     
    691677            DO jj = 1, jpj  
    692678               DO ji = 1, jpi 
    693                   IF( Gsum(ji,jj,jl) < Gstar) THEN 
     679                  IF( Gsum(ji,jj,jl) < rn_gstar) THEN 
    694680                     athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * & 
    695681                        (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari) 
    696                   ELSEIF (Gsum(ji,jj,jl-1) < Gstar) THEN 
    697                      athorn(ji,jj,jl) = Gstari * (Gstar-Gsum(ji,jj,jl-1)) *  & 
    698                         (2.0 - (Gsum(ji,jj,jl-1)+Gstar)*Gstari) 
     682                  ELSEIF (Gsum(ji,jj,jl-1) < rn_gstar) THEN 
     683                     athorn(ji,jj,jl) = Gstari * (rn_gstar-Gsum(ji,jj,jl-1)) *  & 
     684                        (2.0 - (Gsum(ji,jj,jl-1)+rn_gstar)*Gstari) 
    699685                  ELSE 
    700686                     athorn(ji,jj,jl) = 0.0 
    701687                  ENDIF 
    702                END DO ! ji 
    703             END DO ! jj 
    704          END DO ! jl  
     688               END DO 
     689            END DO 
     690         END DO 
    705691 
    706692      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007) 
     
    715701         END DO 
    716702         ! 
    717       ENDIF ! partfun_swi 
    718  
    719       IF( raft_swi == 1 ) THEN      ! Ridging and rafting ice participation functions 
     703      ENDIF ! nn_partfun 
     704 
     705      IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions 
    720706         ! 
    721707         DO jl = 1, jpl 
    722708            DO jj = 1, jpj  
    723709               DO ji = 1, jpi 
    724                   IF ( athorn(ji,jj,jl) .GT. 0._wp ) THEN 
     710                  IF ( athorn(ji,jj,jl) > 0._wp ) THEN 
    725711!!gm  TANH( -X ) = - TANH( X )  so can be computed only 1 time.... 
    726                      aridge(ji,jj,jl) = ( TANH (  Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 
    727                      araft (ji,jj,jl) = ( TANH ( -Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 
     712                     aridge(ji,jj,jl) = ( TANH (  rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 
     713                     araft (ji,jj,jl) = ( TANH ( -rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 
    728714                     IF ( araft(ji,jj,jl) < epsi06 )   araft(ji,jj,jl)  = 0._wp 
    729715                     aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 ) 
    730                   ENDIF ! athorn 
    731                END DO ! ji 
    732             END DO ! jj 
    733          END DO ! jl 
    734  
    735       ELSE  ! raft_swi = 0 
     716                  ENDIF 
     717               END DO 
     718            END DO 
     719         END DO 
     720 
     721      ELSE 
    736722         ! 
    737723         DO jl = 1, jpl 
     
    741727      ENDIF 
    742728 
    743       IF ( raft_swi == 1 ) THEN 
    744  
    745          IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN 
     729      IF( ln_rafting ) THEN 
     730 
     731         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) > epsi10 ) THEN 
    746732            DO jl = 1, jpl 
    747733               DO jj = 1, jpj 
    748734                  DO ji = 1, jpi 
    749                      IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. epsi10 ) THEN 
     735                     IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) > epsi10 ) THEN 
    750736                        WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 
    751737                        WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl 
     
    793779            DO ji = 1, jpi 
    794780 
    795                IF (a_i(ji,jj,jl) .GT. epsi10 .AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN 
    796                   hi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    797                   hrmean          = MAX(SQRT(Hstar*hi), hi*krdgmin) 
    798                   hrmin(ji,jj,jl) = MIN(2.0*hi, 0.5*(hrmean + hi)) 
     781               IF (a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0.0 ) THEN 
     782                  zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     783                  hrmean          = MAX(SQRT(rn_hstar*zhi), zhi*krdgmin) 
     784                  hrmin(ji,jj,jl) = MIN(2.0*zhi, 0.5*(hrmean + zhi)) 
    799785                  hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl) 
    800                   hraft(ji,jj,jl) = kraft*hi 
    801                   krdg(ji,jj,jl)  = hrmean / hi 
     786                  hraft(ji,jj,jl) = kraft*zhi 
     787                  krdg(ji,jj,jl)  = hrmean / zhi 
    802788               ELSE 
    803789                  hraft(ji,jj,jl) = 0.0 
     
    847833      INTEGER ::   ij                ! horizontal index, combines i and j loops 
    848834      INTEGER ::   icells            ! number of cells with aicen > puny 
    849       REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration 
     835      REAL(wp) ::   hL, hR, farea, ztmelts    ! left and right limits of integration 
    850836      REAL(wp) ::   zsstK            ! SST in Kelvin 
    851837 
     
    989975         large_afrft = .false. 
    990976 
    991 !CDIR NODEP 
    992977         DO ij = 1, icells 
    993978            ji = indxi(ij) 
     
    10311016            !-------------------------------------------------------------------------- 
    10321017            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 
    1033             vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 
    1034             vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por 
     1018            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + rn_por_rdg ) 
     1019            vsw  (ji,jj) = vrdg1(ji,jj) * rn_por_rdg 
    10351020 
    10361021            vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     
    10621047            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
    10631048 
    1064             !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
     1049            !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
    10651050             
    10661051            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
     
    10911076            !           ij looping 1-icells 
    10921077 
    1093             msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg)   &   ! rafting included 
    1094                &                                + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 
    1095  
    1096             ! in 1e-9 Joules (same as e_s) 
    1097             esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
    1098                &                                - esrft(ji,jj)*(1.0-fsnowrft)           
     1078            msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-rn_fsnowrdg)   &   ! rafting included 
     1079               &                                + rhosn*vsrft(ji,jj)*(1.0-rn_fsnowrft) 
     1080 
     1081            ! in J/m2 (same as e_s) 
     1082            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-rn_fsnowrdg)         &   !rafting included 
     1083               &                                - esrft(ji,jj)*(1.0-rn_fsnowrft)           
    10991084 
    11001085            !----------------------------------------------------------------- 
     
    11161101         !-------------------------------------------------------------------- 
    11171102         DO jk = 1, nlay_i 
    1118 !CDIR NODEP 
    11191103            DO ij = 1, icells 
    11201104               ji = indxi(ij) 
     
    11291113               ! clem: if sst>0, then ersw <0 (is that possible?) 
    11301114               zsstK  = sst_m(ji,jj) + rt0 
    1131                ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i ) 
     1115               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) * r1_nlay_i 
    11321116 
    11331117               ! heat flux to the ocean 
    11341118               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux  
    11351119 
    1136                ! Correct dimensions to avoid big values 
    1137                ersw(ji,jj,jk)   = ersw(ji,jj,jk) / unit_fac 
    1138  
    1139                ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J 
    1140                ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean  
    1141                !! MV HC 2014 
    1142                ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) 
    1143  
     1120               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 
    11441121               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
    11451122 
     
    11501127         IF( con_i ) THEN 
    11511128            DO jk = 1, nlay_i 
    1152 !CDIR NODEP 
    11531129               DO ij = 1, icells 
    11541130                  ji = indxi(ij) 
     
    11601136 
    11611137         IF( large_afrac ) THEN   ! there is a bug 
    1162 !CDIR NODEP 
    11631138            DO ij = 1, icells 
    11641139               ji = indxi(ij) 
     
    11721147         ENDIF 
    11731148         IF( large_afrft ) THEN  ! there is a bug 
    1174 !CDIR NODEP 
    11751149            DO ij = 1, icells 
    11761150               ji = indxi(ij) 
     
    11901164         DO jl2  = 1, jpl  
    11911165            ! over categories to which ridged ice is transferred 
    1192 !CDIR NODEP 
    11931166            DO ij = 1, icells 
    11941167               ji = indxi(ij) 
     
    12141187               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ardg2 (ji,jj) * farea 
    12151188               v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj) 
    1216                v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 
    1217                e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 
     1189               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg 
     1190               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg 
    12181191               smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + srdg2 (ji,jj) * fvol(ji,jj) 
    12191192               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea 
     
    12231196            ! Transfer ice energy to category jl2 by ridging 
    12241197            DO jk = 1, nlay_i 
    1225 !CDIR NODEP 
    12261198               DO ij = 1, icells 
    12271199                  ji = indxi(ij) 
     
    12351207         DO jl2 = 1, jpl  
    12361208 
    1237 !CDIR NODEP 
    12381209            DO ij = 1, icells 
    12391210               ji = indxi(ij) 
     
    12461217                  a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + arft2 (ji,jj) 
    12471218                  v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + virft (ji,jj) 
    1248                   v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * fsnowrft 
    1249                   e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * fsnowrft 
     1219                  v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * rn_fsnowrft 
     1220                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft 
    12501221                  smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)     
    12511222                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)     
    1252                ENDIF ! hraft 
     1223               ENDIF 
    12531224               ! 
    1254             END DO ! ij 
     1225            END DO 
    12551226 
    12561227            ! Transfer rafted ice energy to category jl2  
    12571228            DO jk = 1, nlay_i 
    1258 !CDIR NODEP 
    12591229               DO ij = 1, icells 
    12601230                  ji = indxi(ij) 
     
    12641234                     e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk) 
    12651235                  ENDIF 
    1266                END DO           ! ij 
    1267             END DO !jk 
    1268  
    1269          END DO ! jl2 
     1236               END DO 
     1237            END DO 
     1238 
     1239         END DO 
    12701240 
    12711241      END DO ! jl1 (deforming categories) 
     
    13391309      !!------------------------------------------------------------------- 
    13401310      INTEGER :: ios                 ! Local integer output status for namelist read 
    1341       NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,              &  
    1342         &                   Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, & 
    1343         &                   partfun_swi, brinstren_swi 
     1311      NAMELIST/namiceitdme/ rn_cs, rn_fsnowrdg, rn_fsnowrft,              &  
     1312        &                   rn_gstar, rn_astar, rn_hstar, ln_rafting, rn_hraft, rn_craft, rn_por_rdg, & 
     1313        &                   nn_partfun 
    13441314      !!------------------------------------------------------------------- 
    13451315      ! 
     
    13571327         WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution ' 
    13581328         WRITE(numout,*)' ~~~~~~~~~~~~~~~' 
    1359          WRITE(numout,*)'   Switch choosing the ice redistribution scheme           ridge_scheme_swi', ridge_scheme_swi  
    1360          WRITE(numout,*)'   Fraction of shear energy contributing to ridging        Cs              ', Cs  
    1361          WRITE(numout,*)'   Ratio of ridging work to PotEner change in ridging      Cf              ', Cf  
    1362          WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrdg        ', fsnowrdg  
    1363          WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrft        ', fsnowrft  
    1364          WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  Gstar           ', Gstar 
    1365          WRITE(numout,*)'   Equivalent to G* for an exponential part function       astar           ', astar 
    1366          WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     Hstar           ', Hstar 
    1367          WRITE(numout,*)'   Rafting of ice sheets or not                            raft_swi        ', raft_swi 
    1368          WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       hparmeter       ', hparmeter 
    1369          WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  Craft           ', Craft   
    1370          WRITE(numout,*)'   Initial porosity of ridges                              ridge_por       ', ridge_por 
    1371          WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    partfun_swi     ', partfun_swi 
    1372          WRITE(numout,*)'   Switch for including brine volume in ice strength comp. brinstren_swi   ', brinstren_swi 
     1329         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        rn_cs       = ', rn_cs  
     1330         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg  
     1331         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft  
     1332         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar 
     1333         WRITE(numout,*)'   Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar 
     1334         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar 
     1335         WRITE(numout,*)'   Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting 
     1336         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft 
     1337         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  rn_craft    = ', rn_craft   
     1338         WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg 
     1339         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun 
    13731340      ENDIF 
    13741341      ! 
    13751342   END SUBROUTINE lim_itd_me_init 
    1376  
    1377  
    1378    SUBROUTINE lim_itd_me_zapsmall 
    1379       !!------------------------------------------------------------------- 
    1380       !!                   ***  ROUTINE lim_itd_me_zapsmall *** 
    1381       !! 
    1382       !! ** Purpose :   Remove too small sea ice areas and correct salt fluxes 
    1383       !! 
    1384       !! history : 
    1385       !! author: William H. Lipscomb, LANL 
    1386       !! Nov 2003:  Modified by Julie Schramm to conserve volume and energy 
    1387       !! Sept 2004: Modified by William Lipscomb; replaced normalize_state with 
    1388       !!            additions to local freshwater, salt, and heat fluxes 
    1389       !!  9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code 
    1390       !!------------------------------------------------------------------- 
    1391       INTEGER ::   ji, jj, jl, jk   ! dummy loop indices 
    1392       INTEGER ::   icells           ! number of cells with ice to zap 
    1393  
    1394       REAL(wp), POINTER, DIMENSION(:,:) ::   zmask   ! 2D workspace 
    1395       REAL(wp)                          ::   zmask_glo, zsal, zvi, zvs, zei, zes 
    1396 !!gm      REAL(wp) ::   xtmp      ! temporary variable 
    1397       !!------------------------------------------------------------------- 
    1398  
    1399       CALL wrk_alloc( jpi, jpj, zmask ) 
    1400  
    1401       ! to be sure that at_i is the sum of a_i(jl) 
    1402       at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    1403  
    1404       DO jl = 1, jpl 
    1405          !----------------------------------------------------------------- 
    1406          ! Count categories to be zapped. 
    1407          !----------------------------------------------------------------- 
    1408          icells = 0 
    1409          zmask(:,:)  = 0._wp 
    1410          DO jj = 1, jpj 
    1411             DO ji = 1, jpi 
    1412                IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN 
    1413                   zmask(ji,jj) = 1._wp 
    1414                ENDIF 
    1415             END DO 
    1416          END DO 
    1417          !zmask_glo = glob_sum(zmask) 
    1418          !IF( ln_nicep .AND. lwp ) WRITE(numout,*) zmask_glo, ' cells of ice zapped in the ocean ' 
    1419  
    1420          !----------------------------------------------------------------- 
    1421          ! Zap ice energy and use ocean heat to melt ice 
    1422          !----------------------------------------------------------------- 
    1423  
    1424          DO jk = 1, nlay_i 
    1425             DO jj = 1 , jpj 
    1426                DO ji = 1 , jpi 
    1427                   zei  = e_i(ji,jj,jk,jl) 
    1428                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 
    1429                   t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj) 
    1430                   ! update exchanges with ocean 
    1431                   hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    1432                END DO 
    1433             END DO 
    1434          END DO 
    1435  
    1436          DO jj = 1 , jpj 
    1437             DO ji = 1 , jpi 
    1438                 
    1439                zsal = smv_i(ji,jj,jl) 
    1440                zvi  = v_i(ji,jj,jl) 
    1441                zvs  = v_s(ji,jj,jl) 
    1442                zes  = e_s(ji,jj,1,jl) 
    1443                !----------------------------------------------------------------- 
    1444                ! Zap snow energy and use ocean heat to melt snow 
    1445                !----------------------------------------------------------------- 
    1446                !           xtmp = esnon(i,j,n) / dt ! < 0 
    1447                !           fhnet(i,j)      = fhnet(i,j)      + xtmp 
    1448                !           fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp 
    1449                ! xtmp is greater than 0 
    1450                ! fluxes are positive to the ocean 
    1451                ! here the flux has to be negative for the ocean 
    1452                t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
    1453  
    1454                !----------------------------------------------------------------- 
    1455                ! zap ice and snow volume, add water and salt to ocean 
    1456                !----------------------------------------------------------------- 
    1457                ato_i(ji,jj)    = a_i  (ji,jj,jl) *           zmask(ji,jj)   + ato_i(ji,jj) 
    1458                a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1459                v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1460                v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1461                t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj) 
    1462                oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1463                smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1464                e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
    1465                ! additional condition 
    1466                IF( v_s(ji,jj,jl) <= epsi10 ) THEN 
    1467                   v_s(ji,jj,jl)   = 0._wp 
    1468                   e_s(ji,jj,1,jl) = 0._wp 
    1469                ENDIF 
    1470                ! update exchanges with ocean 
    1471                sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
    1472                wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice 
    1473                wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice 
    1474                hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    1475             END DO 
    1476          END DO 
    1477       END DO ! jl  
    1478  
    1479       ! to be sure that at_i is the sum of a_i(jl) 
    1480       at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    1481       ! 
    1482       CALL wrk_dealloc( jpi, jpj, zmask ) 
    1483       ! 
    1484    END SUBROUTINE lim_itd_me_zapsmall 
    14851343 
    14861344#else 
     
    14971355   SUBROUTINE lim_itd_me_init 
    14981356   END SUBROUTINE lim_itd_me_init 
    1499    SUBROUTINE lim_itd_me_zapsmall 
    1500    END SUBROUTINE lim_itd_me_zapsmall 
    15011357#endif 
    15021358   !!====================================================================== 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r4990 r5123  
    1313   !!   'key_lim3' :                                   LIM3 sea-ice model 
    1414   !!---------------------------------------------------------------------- 
    15    !!   lim_itd_th       : thermodynamics of ice thickness distribution 
    1615   !!   lim_itd_th_rem   : 
    1716   !!   lim_itd_th_reb   : 
     
    2524   USE thd_ice          ! LIM-3 thermodynamic variables 
    2625   USE ice              ! LIM-3 variables 
    27    USE par_ice          ! LIM-3 parameters 
    28    USE limthd_lac       ! LIM-3 lateral accretion 
    2926   USE limvar           ! LIM-3 variables 
    3027   USE limcons          ! LIM-3 conservation 
     
    3431   USE wrk_nemo         ! work arrays 
    3532   USE lib_fortran      ! to use key_nosignedzero 
    36    USE timing          ! Timing 
    37    USE limcons        ! conservation tests 
     33   USE limcons          ! conservation tests 
    3834 
    3935   IMPLICIT NONE 
    4036   PRIVATE 
    4137 
    42    PUBLIC   lim_itd_th         ! called by ice_stp 
    4338   PUBLIC   lim_itd_th_rem 
    4439   PUBLIC   lim_itd_th_reb 
     
    5247   !!---------------------------------------------------------------------- 
    5348CONTAINS 
    54  
    55    SUBROUTINE lim_itd_th( kt ) 
    56       !!------------------------------------------------------------------ 
    57       !!                ***  ROUTINE lim_itd_th *** 
    58       !! 
    59       !! ** Purpose :   computes the thermodynamics of ice thickness distribution 
    60       !! 
    61       !! ** Method  : 
    62       !!------------------------------------------------------------------ 
    63       INTEGER, INTENT(in) ::   kt   ! time step index 
    64       ! 
    65       INTEGER ::   ji, jj, jk, jl   ! dummy loop index          
    66       ! 
    67       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    68       !!------------------------------------------------------------------ 
    69       IF( nn_timing == 1 )  CALL timing_start('limitd_th') 
    70  
    71       ! conservation test 
    72       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    73  
    74       IF( kt == nit000 .AND. lwp ) THEN 
    75          WRITE(numout,*) 
    76          WRITE(numout,*) 'lim_itd_th  : Thermodynamics of the ice thickness distribution' 
    77          WRITE(numout,*) '~~~~~~~~~~~' 
    78       ENDIF 
    79  
    80       !------------------------------------------------------------------------------| 
    81       !  1) Transport of ice between thickness categories.                           | 
    82       !------------------------------------------------------------------------------| 
    83       ! Given thermodynamic growth rates, transport ice between 
    84       ! thickness categories. 
    85       IF( jpl > 1 )   CALL lim_itd_th_rem( 1, jpl, kt ) 
    86       ! 
    87       CALL lim_var_glo2eqv    ! only for info 
    88       CALL lim_var_agg(1) 
    89  
    90       !------------------------------------------------------------------------------| 
    91       !  3) Add frazil ice growing in leads. 
    92       !------------------------------------------------------------------------------| 
    93       CALL lim_thd_lac 
    94       CALL lim_var_glo2eqv    ! only for info 
    95       
    96       IF(ln_ctl) THEN   ! Control print 
    97          CALL prt_ctl_info(' ') 
    98          CALL prt_ctl_info(' - Cell values : ') 
    99          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    100          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_th  : cell area :') 
    101          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :') 
    102          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :') 
    103          CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :') 
    104          DO jl = 1, jpl 
    105             CALL prt_ctl_info(' ') 
    106             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    107             CALL prt_ctl_info('   ~~~~~~~~~~') 
    108             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ') 
    109             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ') 
    110             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ') 
    111             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ') 
    112             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ') 
    113             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ') 
    114             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ') 
    115             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ') 
    116             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ') 
    117             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ') 
    118             DO jk = 1, nlay_i 
    119                CALL prt_ctl_info(' ') 
    120                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    121                CALL prt_ctl_info('   ~~~~~~~') 
    122                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ') 
    123                CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ') 
    124             END DO 
    125          END DO 
    126       ENDIF 
    127       ! 
    128       ! conservation test 
    129       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    130       ! 
    131      IF( nn_timing == 1 )  CALL timing_stop('limitd_th') 
    132    END SUBROUTINE lim_itd_th 
    133    ! 
    13449 
    13550   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt ) 
     
    15368      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars 
    15469      REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      - 
    155       REAL(wp) ::   zx3,             zareamin          !   -      - 
     70      REAL(wp) ::   zx3         
    15671      CHARACTER (len = 15) :: fieldid 
    15772 
     
    188103      CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 
    189104 
    190       zareamin = epsi10   !minimum area in thickness categories tolerated by the conceptors of the model 
    191  
    192105      !!---------------------------------------------------------------------------------------------- 
    193106      !! 0) Conservation checkand changes in each ice category 
     
    216129         DO jj = 1, jpj 
    217130            DO ji = 1, jpi 
    218                rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes 
     131               rswitch           = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes 
    219132               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch 
    220                rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 
     133               rswitch           = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 
    221134               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 
    222135               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)  
     
    239152      DO jj = 1, jpj 
    240153         DO ji = 1, jpi 
    241             IF ( at_i(ji,jj) .gt. zareamin ) THEN 
     154            IF ( at_i(ji,jj) > epsi10 ) THEN 
    242155               nbrem         = nbrem + 1 
    243156               nind_i(nbrem) = ji 
     
    247160               zremap_flag(ji,jj) = 0 
    248161            ENDIF 
    249          END DO !ji 
    250       END DO !jj 
     162         END DO 
     163      END DO 
    251164 
    252165      !----------------------------------------------------------------------------------------------- 
     
    254167      !----------------------------------------------------------------------------------------------- 
    255168      !- 4.1 Compute category boundaries 
    256       ! Tricky trick see limitd_me.F90 
    257       ! will be soon removed, CT 
    258       ! hi_max(kubnd) = 99. 
    259169      zhbnew(:,:,:) = 0._wp 
    260170 
     
    291201         END DO 
    292202 
    293       END DO !jl 
     203      END DO 
    294204 
    295205      !----------------------------------------------------------------------------------------------- 
     
    334244      !----------------------------------------------------------------------------------------------- 
    335245      !- 7.1 g(h) for category 1 at start of time step 
    336       CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd),         & 
    337          &                  g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   & 
     246      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   & 
    338247         &                  hR(:,:,klbnd), zremap_flag ) 
    339248 
     
    344253 
    345254         !ji 
    346          IF (a_i(ii,ij,klbnd) .gt. epsi10) THEN 
     255         IF( a_i(ii,ij,klbnd) > epsi10 ) THEN 
    347256            zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category 
    348257            ! ji, a_i > epsi10 
    349             IF (zdh0 .lt. 0.0) THEN !remove area from category 1 
     258            IF( zdh0 < 0.0 ) THEN !remove area from category 1 
    350259               ! ji, a_i > epsi10; zdh0 < 0 
    351                zdh0 = MIN(-zdh0,hi_max(klbnd)) 
     260               zdh0 = MIN( -zdh0, hi_max(klbnd) ) 
    352261 
    353262               !Integrate g(1) from 0 to dh0 to estimate area melted 
    354                zetamax = MIN(zdh0,hR(ii,ij,klbnd)) - hL(ii,ij,klbnd) 
    355                IF (zetamax.gt.0.0) THEN 
     263               zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd) 
     264               IF( zetamax > 0.0 ) THEN 
    356265                  zx1  = zetamax 
    357                   zx2  = 0.5 * zetamax*zetamax  
     266                  zx2  = 0.5 * zetamax * zetamax  
    358267                  zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed 
    359268                  ! Constrain new thickness <= ht_i 
    360                   zdamax = a_i(ii,ij,klbnd) * &  
    361                      (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0 
     269                  zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! zdamax > 0 
    362270                  !ice area lost due to melting of thin ice 
    363                   zda0   = MIN(zda0, zdamax) 
     271                  zda0   = MIN( zda0, zdamax ) 
    364272 
    365273                  ! Remove area, conserving volume 
    366                   ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) &  
    367                      * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) 
     274                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) 
    368275                  a_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) - zda0 
    369                   v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd)*ht_i(ii,ij,klbnd) ! clem-useless ? 
    370                ENDIF     ! zetamax > 0 
     276                  v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) * ht_i(ii,ij,klbnd) ! clem-useless ? 
     277               ENDIF 
    371278               ! ji, a_i > epsi10 
    372279 
    373280            ELSE ! if ice accretion 
    374281               ! ji, a_i > epsi10; zdh0 > 0 
    375                zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
     282               zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) )  
    376283               ! zhbnew was 0, and is shifted to the right to account for thin ice 
    377284               ! growth in openwater (F0 = f1) 
     
    385292      !- 7.3 g(h) for each thickness category   
    386293      DO jl = klbnd, kubnd 
    387          CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 
    388             g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag) 
     294         CALL lim_itd_fitline( jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 
     295            &                  g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag ) 
    389296      END DO 
    390297 
     
    406313            ij = nind_j(ji) 
    407314 
    408             IF (zhbnew(ii,ij,jl) .gt. hi_max(jl)) THEN ! transfer from jl to jl+1 
     315            IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1 
    409316 
    410317               ! left and right integration limits in eta space 
    411                zvetamin(ji) = MAX(hi_max(jl), hL(ii,ij,jl)) - hL(ii,ij,jl) 
    412                zvetamax(ji) = MIN(zhbnew(ii,ij,jl), hR(ii,ij,jl)) - hL(ii,ij,jl) 
     318               zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl) 
     319               zvetamax(ji) = MIN (zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl) 
    413320               zdonor(ii,ij,jl) = jl 
    414321 
     
    417324               ! left and right integration limits in eta space 
    418325               zvetamin(ji) = 0.0 
    419                zvetamax(ji) = MIN(hi_max(jl), hR(ii,ij,jl+1)) - hL(ii,ij,jl+1) 
     326               zvetamax(ji) = MIN( hi_max(jl), hR(ii,ij,jl+1) ) - hL(ii,ij,jl+1) 
    420327               zdonor(ii,ij,jl) = jl + 1 
    421328 
    422329            ENDIF  ! zhbnew(jl) > hi_max(jl) 
    423330 
    424             zetamax = MAX(zvetamax(ji), zvetamin(ji)) ! no transfer if etamax < etamin 
     331            zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin 
    425332            zetamin = zvetamin(ji) 
    426333 
    427334            zx1  = zetamax - zetamin 
    428             zwk1 = zetamin*zetamin 
    429             zwk2 = zetamax*zetamax 
    430             zx2  = 0.5 * (zwk2 - zwk1) 
     335            zwk1 = zetamin * zetamin 
     336            zwk2 = zetamax * zetamax 
     337            zx2  = 0.5 * ( zwk2 - zwk1 ) 
    431338            zwk1 = zwk1 * zetamin 
    432339            zwk2 = zwk2 * zetamax 
    433             zx3  = 1.0/3.0 * (zwk2 - zwk1) 
     340            zx3  = 1.0 / 3.0 * ( zwk2 - zwk1 ) 
    434341            nd   = zdonor(ii,ij,jl) 
    435342            zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 
    436343            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 
    437344 
    438          END DO ! ji 
     345         END DO 
    439346      END DO ! jl klbnd -> kubnd - 1 
    440347 
     
    451358         ii = nind_i(ji) 
    452359         ij = nind_j(ji) 
    453          IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN 
    454             a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim  
    455             ht_i(ii,ij,1) = hiclim 
     360         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < rn_himin ) THEN 
     361            a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin  
     362            ht_i(ii,ij,1) = rn_himin 
    456363         ENDIF 
    457       END DO !ji 
     364      END DO 
    458365 
    459366      !!---------------------------------------------------------------------------------------------- 
     
    491398 
    492399 
    493    SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice,   & 
    494       &                        g0, g1, hL, hR, zremap_flag ) 
     400   SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag ) 
    495401      !!------------------------------------------------------------------ 
    496402      !!                ***  ROUTINE lim_itd_fitline *** 
     
    532438               ! Change hL or hR if hice falls outside central third of range 
    533439 
    534                zh13 = 1.0/3.0 * (2.0*hL(ji,jj) + hR(ji,jj)) 
    535                zh23 = 1.0/3.0 * (hL(ji,jj) + 2.0*hR(ji,jj)) 
     440               zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) ) 
     441               zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) ) 
    536442 
    537443               IF    ( hice(ji,jj) < zh13 ) THEN   ;   hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj) 
     
    544450               zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr 
    545451               zwk2 = ( hice(ji,jj) - hL(ji,jj) ) * zdhr 
    546                g0(ji,jj) = zwk1 * ( 2._wp/3._wp - zwk2 ) 
    547                g1(ji,jj) = 2._wp * zdhr * zwk1 * (zwk2 - 0.5) 
     452               g0(ji,jj) = zwk1 * ( 2._wp / 3._wp - zwk2 ) 
     453               g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 ) 
    548454               ! 
    549455            ELSE                   ! remap_flag = .false. or a_i < epsi10  
     
    606512 
    607513      DO jl = klbnd, kubnd 
    608          zaTsfn(:,:,jl) = a_i(:,:,jl)*t_su(:,:,jl) 
     514         zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl) 
    609515      END DO 
    610516 
     
    629535            DO ji = 1, jpi 
    630536 
    631                IF (zdonor(ji,jj,jl) .GT. 0) THEN 
     537               IF (zdonor(ji,jj,jl) > 0) THEN 
    632538                  jl1 = zdonor(ji,jj,jl) 
    633539 
    634                   IF (zdaice(ji,jj,jl) .LT. 0.0) THEN 
    635                      IF (zdaice(ji,jj,jl) .GT. -epsi10) THEN 
    636                         IF ( ( jl1.EQ.jl   .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) )           & 
    637                            .OR.                                      & 
    638                            ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) )           &   
    639                            ) THEN                                                              
     540                  IF (zdaice(ji,jj,jl) < 0.0) THEN 
     541                     IF (zdaice(ji,jj,jl) > -epsi10) THEN 
     542                        IF ( ( jl1 == jl   .AND. ht_i(ji,jj,jl1) >  hi_max(jl) ) .OR.  & 
     543                             ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN 
    640544                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category 
    641545                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
     
    649553                  ENDIF 
    650554 
    651                   IF (zdvice(ji,jj,jl) .LT. 0.0) THEN 
    652                      IF (zdvice(ji,jj,jl) .GT. -epsi10 ) THEN 
    653                         IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) )     & 
    654                            .OR.                                     & 
    655                            ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) & 
    656                            ) THEN 
     555                  IF (zdvice(ji,jj,jl) < 0.0) THEN 
     556                     IF (zdvice(ji,jj,jl) > -epsi10 ) THEN 
     557                        IF ( ( jl1 == jl   .AND. ht_i(ji,jj,jl1) >  hi_max(jl) ) .OR.  & 
     558                             ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN 
    657559                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category 
    658560                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
     
    667569 
    668570                  ! If daice is close to aicen, set daice = aicen. 
    669                   IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - epsi10 ) THEN 
    670                      IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+epsi10) THEN 
     571                  IF (zdaice(ji,jj,jl) > a_i(ji,jj,jl1) - epsi10 ) THEN 
     572                     IF (zdaice(ji,jj,jl) < a_i(ji,jj,jl1)+epsi10) THEN 
    671573                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    672574                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
     
    676578                  ENDIF 
    677579 
    678                   IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)-epsi10) THEN 
    679                      IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+epsi10) THEN 
     580                  IF (zdvice(ji,jj,jl) > v_i(ji,jj,jl1)-epsi10) THEN 
     581                     IF (zdvice(ji,jj,jl) < v_i(ji,jj,jl1)+epsi10) THEN 
    680582                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    681583                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
     
    686588 
    687589               ENDIF               ! donor > 0 
    688             END DO                   ! i 
    689          END DO                 ! j 
    690  
    691       END DO !jl 
     590            END DO 
     591         END DO 
     592 
     593      END DO 
    692594 
    693595      !------------------------------------------------------------------------------- 
     
    699601         DO jj = 1, jpj 
    700602            DO ji = 1, jpi 
    701                IF (zdaice(ji,jj,jl) .GT. 0.0 ) THEN ! daice(n) can be < puny 
     603               IF (zdaice(ji,jj,jl) > 0.0 ) THEN ! daice(n) can be < puny 
    702604                  nbrem = nbrem + 1 
    703605                  nind_i(nbrem) = ji 
    704606                  nind_j(nbrem) = jj 
    705                ENDIF ! tmask 
     607               ENDIF 
    706608            END DO 
    707609         END DO 
     
    712614 
    713615            jl1 = zdonor(ii,ij,jl) 
    714             rswitch             = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) ) 
    715             zworka(ii,ij)   = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * rswitch 
     616            rswitch       = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) ) 
     617            zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch 
    716618            IF( jl1 == jl) THEN   ;   jl2 = jl1+1 
    717             ELSE                    ;   jl2 = jl  
     619            ELSE                  ;   jl2 = jl  
    718620            ENDIF 
    719621 
     
    772674            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf  
    773675 
    774          END DO                 ! ji 
     676         END DO 
    775677 
    776678         !------------------ 
     
    779681 
    780682         DO jk = 1, nlay_i 
    781 !CDIR NODEP 
    782683            DO ji = 1, nbrem 
    783684               ii = nind_i(ji) 
     
    785686 
    786687               jl1 = zdonor(ii,ij,jl) 
    787                IF (jl1 .EQ. jl) THEN 
     688               IF (jl1 == jl) THEN 
    788689                  jl2 = jl+1 
    789690               ELSE             ! n1 = n+1 
     
    794695               e_i(ii,ij,jk,jl1) =  e_i(ii,ij,jk,jl1) - zdeice 
    795696               e_i(ii,ij,jk,jl2) =  e_i(ii,ij,jk,jl2) + zdeice  
    796             END DO              ! ji 
    797          END DO                 ! jk 
     697            END DO 
     698         END DO 
    798699 
    799700      END DO                   ! boundaries, 1 to ncat-1 
     
    809710                  ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl)  
    810711                  t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl)  
    811                   rswitch         =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes 
     712                  rswitch         =  1.0 - MAX( 0.0, SIGN( 1.0, -v_s(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 
    812713               ELSE 
    813714                  ht_i(ji,jj,jl)  = 0._wp 
    814                   t_su(ji,jj,jl)  = rtt 
     715                  t_su(ji,jj,jl)  = rt0 
    815716               ENDIF 
    816             END DO                 ! ji 
    817          END DO                 ! jj 
    818       END DO                    ! jl 
     717            END DO 
     718         END DO 
     719      END DO 
    819720      ! 
    820721      CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn ) 
     
    926827                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi10 ) 
    927828               ENDIF 
    928             END DO                 ! ji 
    929          END DO                 ! jj 
     829            END DO 
     830         END DO 
    930831         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
    931832 
     
    951852         zshiftflag = 0 
    952853 
    953 !clem-change 
    954854         DO jj = 1, jpj 
    955855            DO ji = 1, jpi 
     
    961861                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
    962862               ENDIF 
    963             END DO                 ! ji 
    964          END DO                 ! jj 
     863            END DO 
     864         END DO 
    965865 
    966866         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
     
    973873            zdvice(:,:,jl) = 0._wp 
    974874         ENDIF 
    975 !clem-change 
    976875 
    977876!         ! clem-change begin: why not doing that? 
     
    982881!                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    983882!               ENDIF 
    984 !            END DO                 ! ji 
    985 !         END DO                 ! jj 
     883!            END DO 
     884!         END DO 
    986885         ! clem-change end 
    987886 
    988       END DO                    ! jl 
     887      END DO 
    989888 
    990889      !------------------------------------------------------------------------------ 
     
    1013912   !!---------------------------------------------------------------------- 
    1014913CONTAINS 
    1015    SUBROUTINE lim_itd_th           ! Empty routines 
    1016    END SUBROUTINE lim_itd_th 
    1017    SUBROUTINE lim_itd_th_ini 
    1018    END SUBROUTINE lim_itd_th_ini 
    1019914   SUBROUTINE lim_itd_th_rem 
    1020915   END SUBROUTINE lim_itd_th_rem 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90

    r4161 r5123  
    2323   PRIVATE 
    2424 
    25    PUBLIC   lim_msh   ! routine called by ice_ini.F90 
     25   PUBLIC   lim_msh   ! routine called by sbcice_lim.F90 
    2626 
    2727   !!---------------------------------------------------------------------- 
     
    4141      !!              - Definition of some constants linked with the grid 
    4242      !!              - Definition of the metric coef. for the sea/ice 
    43       !!              - Initialization of the ice masks (tmsk, umsk) 
    4443      !!  
    4544      !! Reference  : Deleersnijder et al. Ocean Modelling 100, 7-10  
     
    103102!!gm end 
    104103 
    105       !                           !==  ice masks  ==! 
    106       tms(:,:) = tmask(:,:,1)             ! ice T-point  : use surface tmask 
    107       tmu(:,:) = umask(:,:,1)             ! ice U-point  : use surface umask  (C-grid EVP) 
    108       tmv(:,:) = vmask(:,:,1)             ! ice V-point  : use surface vmask  (C-grid EVP) 
    109       DO jj = 1, jpjm1                    ! ice F-point  : recompute fmask (due to nn_shlat) 
    110          DO ji = 1 , jpim1   ! NO vector opt. 
    111             tmf(ji,jj) =  tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * tms(ji+1,jj+1) 
    112          END DO 
    113       END DO 
    114       CALL lbc_lnk( tmf(:,:), 'F', 1. )           ! lateral boundary conditions 
    115  
    116       !                           !==  unmasked and masked area of T-grid cell 
    117       area(:,:) = e1t(:,:) * e2t(:,:) 
    118104      ! 
    119105   END SUBROUTINE lim_msh 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r4990 r5123  
    102102      !!                 and charge ellipse. 
    103103      !!                 The user should make sure that the parameters 
    104       !!                 nevp, telast and creepl maintain stress state 
     104      !!                 nn_nevp, elastic time scale and rn_creepl maintain stress state 
    105105      !!                 on the charge ellipse for plastic flow 
    106106      !!                 e.g. in the Canadian Archipelago 
     
    108108      !! References : Hunke and Dukowicz, JPO97 
    109109      !!              Bouillon et al., Ocean Modelling 2009 
    110       !!              Vancoppenolle et al., Ocean Modelling 2008 
    111110      !!------------------------------------------------------------------- 
    112111      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation 
     
    117116      CHARACTER (len=50) ::   charout 
    118117      REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         ! 
    119       REAL(wp) ::   za, zstms, zmask   ! local scalars 
    120       REAL(wp) ::   zc1, zc2, zc3             ! ice mass 
    121  
    122       REAL(wp) ::   dtevp              ! time step for subcycling 
    123       REAL(wp) ::   dtotel, ecc2, ecci ! square of yield ellipse eccenticity 
    124       REAL(wp) ::   z0, zr, zcca, zccb ! temporary scalars 
    125       REAL(wp) ::   zu_ice2, zv_ice1   ! 
    126       REAL(wp) ::   zddc, zdtc         ! delta on corners and on centre 
    127       REAL(wp) ::   zdst               ! shear at the center of the grid point 
    128       REAL(wp) ::   zdsshx, zdsshy     ! term for the gradient of ocean surface 
    129       REAL(wp) ::   sigma1, sigma2     ! internal ice stress 
     118      REAL(wp) ::   za, zstms          ! local scalars 
     119      REAL(wp) ::   zc1, zc2, zc3      ! ice mass 
     120 
     121      REAL(wp) ::   dtevp , z1_dtevp              ! time step for subcycling 
     122      REAL(wp) ::   dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity 
     123      REAL(wp) ::   z0, zr, zcca, zccb            ! temporary scalars 
     124      REAL(wp) ::   zu_ice2, zv_ice1              ! 
     125      REAL(wp) ::   zddc, zdtc                    ! delta on corners and on centre 
     126      REAL(wp) ::   zdst                          ! shear at the center of the grid point 
     127      REAL(wp) ::   zdsshx, zdsshy                ! term for the gradient of ocean surface 
     128      REAL(wp) ::   sigma1, sigma2                ! internal ice stress 
    130129 
    131130      REAL(wp) ::   zresm         ! Maximal error on ice velocity 
    132       REAL(wp) ::   zdummy        ! dummy argument 
    133131      REAL(wp) ::   zintb, zintn  ! dummy argument 
    134132 
     
    139137      REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points 
    140138      REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays 
    141       REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                            
    142       REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2, v_oce2   ! ocean u/v component on V points 
     139      REAL(wp), POINTER, DIMENSION(:,:) ::   v_oce1           ! ocean u/v component on U points                            
     140      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2           ! ocean u/v component on V points 
    143141      REAL(wp), POINTER, DIMENSION(:,:) ::   u_ice2, v_ice1   ! ice u/v component on V/U point 
    144142      REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses 
     143      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask            ! mask ocean grid points 
    145144       
    146145      REAL(wp), POINTER, DIMENSION(:,:) ::   zdt              ! tension at centre of grid cells 
     
    152151                                                              !   ocean surface (ssh_m) if ice is not embedded 
    153152                                                              !   ice top surface if ice is embedded    
     153 
     154      REAL(wp), PARAMETER               ::   zepsi = 1.0e-20_wp ! tolerance parameter 
     155      REAL(wp), PARAMETER               ::   zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity 
    154156      !!------------------------------------------------------------------- 
    155157 
    156158      CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 
    157       CALL wrk_alloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                ) 
     159      CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               ) 
    158160      CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
    159161      CALL wrk_alloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
     
    161163#if  defined key_lim2 && ! defined key_lim2_vp 
    162164# if defined key_agrif 
    163      USE ice_2, vt_s => hsnm 
    164      USE ice_2, vt_i => hicm 
     165      USE ice_2, vt_s => hsnm 
     166      USE ice_2, vt_i => hicm 
    165167# else 
    166      vt_s => hsnm 
    167      vt_i => hicm 
     168      vt_s => hsnm 
     169      vt_i => hicm 
    168170# endif 
    169      at_i(:,:) = 1. - frld(:,:) 
     171      at_i(:,:) = 1. - frld(:,:) 
    170172#endif 
    171173#if defined key_agrif && defined key_lim2  
    172     CALL agrif_rhg_lim2_load      ! First interpolation of coarse values 
     174      CALL agrif_rhg_lim2_load      ! First interpolation of coarse values 
    173175#endif 
    174176      ! 
     
    186188 
    187189#if defined key_lim3 
    188       CALL lim_itd_me_icestrength( ridge_scheme_swi )      ! LIM-3: Ice strength on T-points 
    189 #endif 
    190  
    191 !CDIR NOVERRCHK 
     190      CALL lim_itd_me_icestrength( nn_icestr )      ! LIM-3: Ice strength on T-points 
     191#endif 
     192 
    192193      DO jj = k_j1 , k_jpj       ! Ice mass and temp variables 
    193 !CDIR NOVERRCHK 
    194194         DO ji = 1 , jpi 
    195195#if defined key_lim3 
    196             zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj) 
     196            zpresh(ji,jj) = tmask(ji,jj,1) *  strength(ji,jj) 
    197197#endif 
    198198#if defined key_lim2 
    199             zpresh(ji,jj) = tms(ji,jj) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) ) 
    200 #endif 
    201             ! tmi = 1 where there is ice or on land 
    202             tmi(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - epsd ) ) ) * tms(ji,jj) 
     199            zpresh(ji,jj) = tmask(ji,jj,1) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) ) 
     200#endif 
     201            ! zmask = 1 where there is ice or on land 
     202            zmask(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1) 
    203203         END DO 
    204204      END DO 
     
    206206      ! Ice strength on grid cell corners (zpreshc) 
    207207      ! needed for calculation of shear stress  
    208 !CDIR NOVERRCHK 
    209208      DO jj = k_j1+1, k_jpj-1 
    210 !CDIR NOVERRCHK 
    211209         DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1) 
    212             zstms          =  tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
    213                &              tms(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
    214                &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + & 
    215                &              tms(ji,jj)     * wght(ji+1,jj+1,1,1) 
    216             zpreshc(ji,jj) = (  zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
    217                &                zpresh(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
    218                &                zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &  
    219                &                zpresh(ji,jj)     * wght(ji+1,jj+1,1,1)   & 
    220                &             ) / MAX( zstms, epsd ) 
     210            zstms          =  tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) +   & 
     211               &              tmask(ji+1,jj,1)   * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1)   * wght(ji+1,jj+1,1,1) 
     212            zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) +   & 
     213               &               zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + zpresh(ji,jj)   * wght(ji+1,jj+1,1,1)     & 
     214               &             ) / MAX( zstms, zepsi ) 
    221215         END DO 
    222216      END DO 
    223  
    224217      CALL lbc_lnk( zpreshc(:,:), 'F', 1. ) 
    225218      ! 
     
    236229      !  zcorl2: Coriolis parameter on V-points                             
    237230      !  (ztagnx,ztagny): wind stress on U/V points                        
    238       !  u_oce1: ocean u component on u points                            
    239231      !  v_oce1: ocean v component on u points                           
    240232      !  u_oce2: ocean u component on v points                          
    241       !  v_oce2: ocean v component on v points                         
    242233 
    243234      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
    244           !                                             
    245           ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
    246           !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 
     235         !                                             
     236         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
     237         !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 
    247238         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp      
    248           ! 
    249           ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
    250           !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
     239         ! 
     240         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
     241         !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
    251242         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    252           ! 
     243         ! 
    253244         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0 
    254           ! 
     245         ! 
    255246      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
    256247         zpice(:,:) = ssh_m(:,:) 
     
    260251         DO ji = fs_2, fs_jpim1 
    261252 
    262             zc1 = tms(ji  ,jj  ) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) ) 
    263             zc2 = tms(ji+1,jj  ) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) ) 
    264             zc3 = tms(ji  ,jj+1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) ) 
    265  
    266             zt11 = tms(ji  ,jj) * e1t(ji  ,jj) 
    267             zt12 = tms(ji+1,jj) * e1t(ji+1,jj) 
    268             zt21 = tms(ji,jj  ) * e2t(ji,jj  ) 
    269             zt22 = tms(ji,jj+1) * e2t(ji,jj+1) 
     253            zc1 = tmask(ji  ,jj  ,1) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) ) 
     254            zc2 = tmask(ji+1,jj  ,1) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) ) 
     255            zc3 = tmask(ji  ,jj+1,1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) ) 
     256 
     257            zt11 = tmask(ji  ,jj,1) * e1t(ji  ,jj) 
     258            zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj) 
     259            zt21 = tmask(ji,jj  ,1) * e2t(ji,jj  ) 
     260            zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1) 
    270261 
    271262            ! Leads area. 
    272             zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd ) 
    273             zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd ) 
     263            zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi ) 
     264            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi ) 
    274265 
    275266            ! Mass, coriolis coeff. and currents 
    276             zmass1(ji,jj) = ( zt12*zc1 + zt11*zc2 ) / (zt11+zt12+epsd) 
    277             zmass2(ji,jj) = ( zt22*zc1 + zt21*zc3 ) / (zt21+zt22+epsd) 
    278             zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) )   & 
    279                &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd ) 
    280             zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1)*fcor(ji,jj) + e2t(ji,jj)*fcor(ji,jj+1) )   & 
    281                &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 
     267            zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi ) 
     268            zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi ) 
     269            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) )   & 
     270               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi ) 
     271            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) )   & 
     272               &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi ) 
    282273            ! 
    283             u_oce1(ji,jj)  = u_oce(ji,jj) 
    284             v_oce2(ji,jj)  = v_oce(ji,jj) 
    285  
    286274            ! Ocean has no slip boundary condition 
    287             v_oce1(ji,jj)  = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)    & 
    288                &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) & 
    289                &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj 
    290  
    291             u_oce2(ji,jj)  = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)     & 
    292                &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) & 
    293                &                / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
     275            v_oce1(ji,jj)  = 0.5 * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji,jj)      & 
     276               &                   + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 
     277               &                   / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1 
     278 
     279            u_oce2(ji,jj)  = 0.5 * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj)      & 
     280               &                   + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 
     281               &                   / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
    294282 
    295283            ! Wind stress at U,V-point 
     
    303291            ! include it later 
    304292 
    305             zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 
    306             zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj) 
     293            zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 
     294            zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 
    307295 
    308296            za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx 
     
    318306      ! 
    319307      ! Time step for subcycling 
    320       dtevp  = rdt_ice / nevp 
     308      dtevp  = rdt_ice / nn_nevp 
     309#if defined key_lim3 
     310      dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice ) 
     311#else 
    321312      dtotel = dtevp / ( 2._wp * telast ) 
    322  
     313#endif 
     314      z1_dtotel = 1._wp / ( 1._wp + dtotel ) 
     315      z1_dtevp  = 1._wp / dtevp 
    323316      !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter) 
    324       ecc2 = ecc * ecc 
     317      ecc2 = rn_ecc * rn_ecc 
    325318      ecci = 1. / ecc2 
    326319 
     
    331324 
    332325      !                                               !----------------------! 
    333       DO jter = 1 , nevp                              !    loop over jter    ! 
     326      DO jter = 1 , nn_nevp                           !    loop over jter    ! 
    334327         !                                            !----------------------!         
    335328         DO jj = k_j1, k_jpj-1 
     
    339332 
    340333         DO jj = k_j1+1, k_jpj-1 
    341             DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi 
     334            DO ji = fs_2, fs_jpim1   !RB bug no vect opt due to zmask 
    342335 
    343336               !   
     
    360353               ! 
    361354               ! 
    362                divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    363                   &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
    364                   &             +e1v(ji,jj)*v_ice(ji,jj)                      & 
    365                   &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
    366                   &             )                                             & 
    367                   &            / area(ji,jj) 
    368  
    369                zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
    370                   &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                & 
    371                   &           )*e2t(ji,jj)*e2t(ji,jj)                      & 
    372                   &          -( v_ice(ji,jj)/e1v(ji,jj)                    & 
    373                   &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                & 
    374                   &           )*e1t(ji,jj)*e1t(ji,jj)                      & 
    375                   &         )                                              & 
    376                   &        / area(ji,jj) 
     355               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     356                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     357                  &            ) * r1_e12t(ji,jj) 
     358 
     359               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
     360                  &         - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     361                  &         ) * r1_e12t(ji,jj) 
    377362 
    378363               ! 
    379                zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1)                & 
    380                   &            -u_ice(ji,jj)/e1u(ji,jj)                    & 
    381                   &           )*e1f(ji,jj)*e1f(ji,jj)                      & 
    382                   &          +( v_ice(ji+1,jj)/e2v(ji+1,jj)                & 
    383                   &            -v_ice(ji,jj)/e2v(ji,jj)                    & 
    384                   &           )*e2f(ji,jj)*e2f(ji,jj)                      & 
    385                   &         )                                              & 
    386                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 
    387                   &        * tmi(ji,jj) * tmi(ji,jj+1)                     & 
    388                   &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
    389  
    390  
    391                v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    392                   &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    393                   &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)  
    394  
    395                u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
    396                   &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
    397                   &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    398  
    399             END DO 
    400          END DO 
    401          CALL lbc_lnk( v_ice1, 'U', -1. )   ;   CALL lbc_lnk( u_ice2, 'V', -1. )      ! lateral boundary cond. 
    402  
    403 !CDIR NOVERRCHK 
     364               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
     365                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
     366                  &         ) * r1_e12f(ji,jj) * ( 2._wp - fmask(ji,jj,1) )   & 
     367                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 
     368 
     369 
     370               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     & 
     371                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   & 
     372                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)  
     373 
     374               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     & 
     375                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   & 
     376                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
     377            END DO 
     378         END DO 
     379         CALL lbc_lnk( v_ice1  , 'U', -1. )   ;   CALL lbc_lnk( u_ice2  , 'V', -1. )      ! lateral boundary cond. 
     380 
    404381         DO jj = k_j1+1, k_jpj-1 
    405 !CDIR NOVERRCHK 
    406382            DO ji = fs_2, fs_jpim1 
    407383 
    408384               !- Calculate Delta at centre of grid cells 
    409                zdst      = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          & 
    410                   &          - e2u(ji-1, jj) * v_ice1(ji-1,jj)          & 
    411                   &          + e1v(ji, jj  ) * u_ice2(ji,jj  )          & 
    412                   &          - e1v(ji, jj-1) * u_ice2(ji,jj-1)          & 
    413                   &          )                                          & 
    414                   &         / area(ji,jj) 
    415  
    416                delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )   
    417                delta_i(ji,jj) = delta + creepl 
    418                !-Calculate stress tensor components zs1 and zs2  
    419                !-at centre of grid cells (see section 3.5 of CICE user's guide). 
    420                zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( divu_i(ji,jj) / delta_i(ji,jj) - delta / delta_i(ji,jj) )  & 
    421                   &         * zpresh(ji,jj) ) ) / ( 1._wp + dtotel ) 
    422                zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) ) )  & 
    423                   &         / ( 1._wp + dtotel ) 
    424  
    425             END DO 
    426          END DO 
    427  
    428          CALL lbc_lnk( zs1(:,:), 'T', 1. ) 
    429          CALL lbc_lnk( zs2(:,:), 'T', 1. ) 
    430  
    431 !CDIR NOVERRCHK 
    432          DO jj = k_j1+1, k_jpj-1 
    433 !CDIR NOVERRCHK 
    434             DO ji = fs_2, fs_jpim1 
     385               zdst          = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )   & 
     386                  &            + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1)   & 
     387                  &            ) * r1_e12t(ji,jj) 
     388 
     389               delta          = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )   
     390               delta_i(ji,jj) = delta + rn_creepl 
     391 
    435392               !- Calculate Delta on corners 
    436                zddc  =      ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
    437                   &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
    438                   &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
    439                   &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
    440                   &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
    441                   &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
    442                   &         )                                               & 
    443                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
    444  
    445                zdtc  =      (-( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
    446                   &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
    447                   &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
    448                   &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
    449                   &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
    450                   &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
    451                   &         )                                               & 
    452                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
    453  
    454                zddc = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl 
    455  
    456                !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide). 
    457                zs12(ji,jj) = ( zs12(ji,jj) + dtotel *  & 
    458                   &          ( ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) ) )  & 
    459                   &          / ( 1.0 + dtotel )  
    460  
    461             END DO ! ji 
    462          END DO ! jj 
    463  
    464          CALL lbc_lnk( zs12(:,:), 'F', 1. ) 
     393               zddc  = (  ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  & 
     394                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
     395                  &    ) * r1_e12f(ji,jj) 
     396 
     397               zdtc  = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  & 
     398                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
     399                  &    ) * r1_e12f(ji,jj) 
     400 
     401               zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl 
     402 
     403               !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide). 
     404               zs1(ji,jj)  = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj)   * zpresh(ji,jj)   & 
     405                  &          ) * z1_dtotel 
     406               zs2(ji,jj)  = ( zs2 (ji,jj) + dtotel *         ecci * zdt(ji,jj) / delta_i(ji,jj)   * zpresh(ji,jj)   & 
     407                  &          ) * z1_dtotel 
     408               !-Calculate stress tensor component zs12 at corners 
     409               zs12(ji,jj) = ( zs12(ji,jj) + dtotel *         ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj)  & 
     410                  &          ) * z1_dtotel  
     411 
     412            END DO 
     413         END DO 
     414         CALL lbc_lnk( zs1 , 'T', 1. )   ;   CALL lbc_lnk( zs2, 'T', 1. ) 
     415         CALL lbc_lnk( zs12, 'F', 1. ) 
    465416 
    466417         ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 
     
    468419            DO ji = fs_2, fs_jpim1 
    469420               !- contribution of zs1, zs2 and zs12 to zf1 
    470                zf1(ji,jj) = 0.5*( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj) & 
    471                   &              +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj) & 
    472                   &              +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj) & 
    473                   &             ) / ( e1u(ji,jj)*e2u(ji,jj) ) 
     421               zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 
     422                  &             + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj)          & 
     423                  &             + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) & 
     424                  &                ) * r1_e12u(ji,jj) 
    474425               ! contribution of zs1, zs2 and zs12 to zf2 
    475                zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) & 
    476                   &              -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) & 
    477                   &              + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 -    & 
    478                   zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) & 
    479                   &             ) / ( e1v(ji,jj)*e2v(ji,jj) ) 
     426               zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)  & 
     427                  &             - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj)          & 
     428                  &             + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj)  & 
     429                  &               )  * r1_e12v(ji,jj) 
    480430            END DO 
    481431         END DO 
     
    487437         IF (MOD(jter,2).eq.0) THEN  
    488438 
    489 !CDIR NOVERRCHK 
    490439            DO jj = k_j1+1, k_jpj-1 
    491 !CDIR NOVERRCHK 
    492440               DO ji = fs_2, fs_jpim1 
    493                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    494                   z0           = zmass1(ji,jj)/dtevp 
     441                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 
     442                  z0           = zmass1(ji,jj) * z1_dtevp 
    495443 
    496444                  ! SB modif because ocean has no slip boundary condition 
    497                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)         & 
    498                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
    499                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    500                   za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
    501                      (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj)) 
    502                   zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    503                      za*(u_oce1(ji,jj)) 
    504                   zcca         = z0+za 
     445                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji  ,jj)     & 
     446                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   & 
     447                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
     448                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  & 
     449                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 
     450                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 
     451                  zcca         = z0 + za 
    505452                  zccb         = zcorl1(ji,jj) 
    506                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    507  
     453                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
    508454               END DO 
    509455            END DO 
     
    511457            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    512458#if defined key_agrif && defined key_lim2 
    513             CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     459            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
    514460#endif 
    515461#if defined key_bdy 
     
    517463#endif          
    518464 
    519 !CDIR NOVERRCHK 
    520465            DO jj = k_j1+1, k_jpj-1 
    521 !CDIR NOVERRCHK 
    522466               DO ji = fs_2, fs_jpim1 
    523467 
    524                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    525                   z0           = zmass2(ji,jj)/dtevp 
     468                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 
     469                  z0           = zmass2(ji,jj) * z1_dtevp 
    526470                  ! SB modif because ocean has no slip boundary condition 
    527                   zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)     & 
    528                      &                 + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
    529                      &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    530                   za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &  
    531                      (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    532                   zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    533                      za2ct(ji,jj) + za*(v_oce2(ji,jj)) 
    534                   zcca         = z0+za 
     471                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       & 
     472                     &                 + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   & 
     473                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
     474                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  &  
     475                     &                         ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) ) 
     476                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 
     477                  zcca         = z0 + za 
    535478                  zccb         = zcorl2(ji,jj) 
    536                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    537  
     479                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    538480               END DO 
    539481            END DO 
     
    541483            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    542484#if defined key_agrif && defined key_lim2 
    543             CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
     485            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    544486#endif 
    545487#if defined key_bdy 
     
    548490 
    549491         ELSE  
    550 !CDIR NOVERRCHK 
    551492            DO jj = k_j1+1, k_jpj-1 
    552 !CDIR NOVERRCHK 
    553493               DO ji = fs_2, fs_jpim1 
    554                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    555                   z0           = zmass2(ji,jj)/dtevp 
     494                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 
     495                  z0           = zmass2(ji,jj) * z1_dtevp 
    556496                  ! SB modif because ocean has no slip boundary condition 
    557                   zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)      & 
    558                      &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
    559                      &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)    
    560  
    561                   za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 
    562                      (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    563                   zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    564                      za2ct(ji,jj) + za*(v_oce2(ji,jj)) 
    565                   zcca         = z0+za 
     497                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       & 
     498                     &                  +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   & 
     499                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)    
     500 
     501                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  & 
     502                     &                         ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) ) 
     503                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 
     504                  zcca         = z0 + za 
    566505                  zccb         = zcorl2(ji,jj) 
    567                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    568  
     506                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    569507               END DO 
    570508            END DO 
     
    572510            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    573511#if defined key_agrif && defined key_lim2 
    574             CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
     512            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    575513#endif 
    576514#if defined key_bdy 
     
    578516#endif          
    579517 
    580 !CDIR NOVERRCHK 
    581518            DO jj = k_j1+1, k_jpj-1 
    582 !CDIR NOVERRCHK 
    583519               DO ji = fs_2, fs_jpim1 
    584                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    585                   z0           = zmass1(ji,jj)/dtevp 
    586                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      & 
    587                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
    588                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    589  
    590                   za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
    591                      (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj)) 
    592                   zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    593                      za*(u_oce1(ji,jj)) 
    594                   zcca         = z0+za 
     520                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 
     521                  z0           = zmass1(ji,jj) * z1_dtevp 
     522                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji,jj)       & 
     523                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   & 
     524                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
     525 
     526                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  & 
     527                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 
     528                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 
     529                  zcca         = z0 + za 
    595530                  zccb         = zcorl1(ji,jj) 
    596                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    597                END DO ! ji 
    598             END DO ! jj 
     531                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
     532               END DO 
     533            END DO 
    599534 
    600535            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    601536#if defined key_agrif && defined key_lim2 
    602             CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     537            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
    603538#endif 
    604539#if defined key_bdy 
     
    611546            !---  Convergence test. 
    612547            DO jj = k_j1+1 , k_jpj-1 
    613                zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) ,           & 
    614                   ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    615             END DO 
    616             zresm = MAXVAL( zresr( 1:jpi , k_j1+1:k_jpj-1 ) ) 
     548               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
     549            END DO 
     550            zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) ) 
    617551            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain 
    618552         ENDIF 
     
    625559      ! 4) Prevent ice velocities when the ice is thin 
    626560      !------------------------------------------------------------------------------! 
    627       ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 
    628       ! ocean velocity,  
    629       ! This prevents high velocity when ice is thin 
    630 !CDIR NOVERRCHK 
     561      ! If the ice volume is below zvmin then ice velocity should equal the 
     562      ! ocean velocity. This prevents high velocity when ice is thin 
    631563      DO jj = k_j1+1, k_jpj-1 
    632 !CDIR NOVERRCHK 
    633564         DO ji = fs_2, fs_jpim1 
    634             zdummy = vt_i(ji,jj) 
    635             IF ( zdummy .LE. hminrhg ) THEN 
     565            IF ( vt_i(ji,jj) <= zvmin ) THEN 
    636566               u_ice(ji,jj) = u_oce(ji,jj) 
    637567               v_ice(ji,jj) = v_oce(ji,jj) 
    638             ENDIF ! zdummy 
     568            ENDIF 
    639569         END DO 
    640570      END DO 
     
    643573      CALL lbc_lnk( v_ice(:,:), 'V', -1. )  
    644574#if defined key_agrif && defined key_lim2 
    645       CALL agrif_rhg_lim2( nevp , nevp, 'U' ) 
    646       CALL agrif_rhg_lim2( nevp , nevp, 'V' ) 
     575      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' ) 
     576      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' ) 
    647577#endif 
    648578#if defined key_bdy 
     
    653583      DO jj = k_j1+1, k_jpj-1  
    654584         DO ji = fs_2, fs_jpim1 
    655             zdummy = vt_i(ji,jj) 
    656             IF ( zdummy .LE. hminrhg ) THEN 
    657                v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    658                   &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    659                   &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    660  
    661                u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
    662                   &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
    663                   &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    664             ENDIF ! zdummy 
     585            IF ( vt_i(ji,jj) <= zvmin ) THEN 
     586               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji,  jj-1) ) * e1t(ji+1,jj)     & 
     587                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   & 
     588                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
     589 
     590               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     & 
     591                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   & 
     592                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
     593            ENDIF  
    665594         END DO 
    666595      END DO 
     
    670599 
    671600      ! Recompute delta, shear and div, inputs for mechanical redistribution  
    672 !CDIR NOVERRCHK 
    673601      DO jj = k_j1+1, k_jpj-1 
    674 !CDIR NOVERRCHK 
    675          DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi 
     602         DO ji = fs_2, jpim1   !RB bug no vect opt due to zmask 
    676603            !- divu_i(:,:), zdt(:,:): divergence and tension at centre  
    677604            !- zds(:,:): shear on northeast corner of grid cells 
    678             zdummy = vt_i(ji,jj) 
    679             IF ( zdummy .LE. hminrhg ) THEN 
    680  
    681                divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    682                   &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
    683                   &             +e1v(ji,jj)*v_ice(ji,jj)                      & 
    684                   &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
    685                   &            )                                              & 
    686                   &            / area(ji,jj) 
    687  
    688                zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
    689                   &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                & 
    690                   &           )*e2t(ji,jj)*e2t(ji,jj)                      & 
    691                   &          -( v_ice(ji,jj)/e1v(ji,jj)                    & 
    692                   &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                & 
    693                   &           )*e1t(ji,jj)*e1t(ji,jj)                      & 
    694                   &         )                                              & 
    695                   &        / area(ji,jj) 
     605            IF ( vt_i(ji,jj) <= zvmin ) THEN 
     606 
     607               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj  ) * u_ice(ji-1,jj  )   & 
     608                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji  ,jj-1) * v_ice(ji  ,jj-1)   & 
     609                  &            ) * r1_e12t(ji,jj) 
     610 
     611               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)  & 
     612                  &          -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)  & 
     613                  &         ) * r1_e12t(ji,jj) 
    696614               ! 
    697615               ! SB modif because ocean has no slip boundary condition  
    698                zds(ji,jj) = ( ( u_ice(ji,jj+1) / e1u(ji,jj+1)              & 
    699                   &           - u_ice(ji,jj)   / e1u(ji,jj) )              & 
    700                   &           * e1f(ji,jj) * e1f(ji,jj)                    & 
    701                   &          + ( v_ice(ji+1,jj) / e2v(ji+1,jj)             & 
    702                   &            - v_ice(ji,jj)  / e2v(ji,jj) )              & 
    703                   &           * e2f(ji,jj) * e2f(ji,jj) )                  & 
    704                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 
    705                   &        * tmi(ji,jj) * tmi(ji,jj+1)                     & 
    706                   &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
    707  
    708                zdst = (  e2u( ji  , jj   ) * v_ice1(ji  ,jj  )    & 
    709                   &           - e2u( ji-1, jj   ) * v_ice1(ji-1,jj  )    & 
    710                   &           + e1v( ji  , jj   ) * u_ice2(ji  ,jj  )    & 
    711                   &           - e1v( ji  , jj-1 ) * u_ice2(ji  ,jj-1)  ) / area(ji,jj) 
    712  
    713                delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )   
    714                delta_i(ji,jj) = delta + creepl 
     616               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  & 
     617                  &          +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
     618                  &         ) * r1_e12f(ji,jj) * ( 2.0 - fmask(ji,jj,1) )                                     & 
     619                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 
     620 
     621               zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )    & 
     622                  &   + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1) ) * r1_e12t(ji,jj) 
     623 
     624               delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )   
     625               delta_i(ji,jj) = delta + rn_creepl 
    715626             
    716             ENDIF ! zdummy 
    717  
    718          END DO !jj 
    719       END DO !ji 
     627            ENDIF 
     628         END DO 
     629      END DO 
    720630      ! 
    721631      !------------------------------------------------------------------------------! 
    722632      ! 5) Store stress tensor and its invariants 
    723633      !------------------------------------------------------------------------------! 
    724       ! 
    725634      ! * Invariants of the stress tensor are required for limitd_me 
    726635      !   (accelerates convergence and improves stability) 
    727636      DO jj = k_j1+1, k_jpj-1 
    728637         DO ji = fs_2, fs_jpim1 
    729             ! begin TECLIM change  
    730             zdst= (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &    
    731                &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         &    
    732                &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           &    
    733                &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) / area(ji,jj)  
     638            zdst           = (  e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)  &    
     639               &              + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e12t(ji,jj)  
    734640            shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 
    735             ! end TECLIM change 
    736641         END DO 
    737642      END DO 
     
    772677            DO jj = k_j1+1, k_jpj-1 
    773678               DO ji = 2, jpim1 
    774                   IF (zpresh(ji,jj) .GT. 1.0) THEN 
     679                  IF (zpresh(ji,jj) > 1.0) THEN 
    775680                     sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )  
    776681                     sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 
     
    786691      ! 
    787692      CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 
    788       CALL wrk_dealloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                ) 
     693      CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               ) 
    789694      CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
    790695      CALL wrk_dealloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r4990 r5123  
    1818   USE ice            ! sea-ice variables 
    1919   USE oce     , ONLY :  snwice_mass, snwice_mass_b 
    20    USE par_ice        ! sea-ice parameters 
    2120   USE dom_oce        ! ocean domain 
    2221   USE sbc_oce        ! Surface boundary condition: ocean fields 
     
    2726   USE wrk_nemo       ! work arrays 
    2827   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     28   USE limctl 
    2929 
    3030   IMPLICIT NONE 
     
    3333   PUBLIC   lim_rst_opn    ! routine called by icestep.F90 
    3434   PUBLIC   lim_rst_write  ! routine called by icestep.F90 
    35    PUBLIC   lim_rst_read   ! routine called by iceini.F90 
     35   PUBLIC   lim_rst_read   ! routine called by sbc_lim_init 
    3636 
    3737   LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write  
     
    8686      ENDIF 
    8787      ! 
     88      IF( ln_nicep )   CALL lim_prt( kt, jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print 
    8889   END SUBROUTINE lim_rst_opn 
    8990 
     
    165166      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  ) 
    166167      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i'   , stress12_i ) 
    167       CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )   !clem modif 
    168       CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) !clem modif 
     168      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass ) 
     169      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) 
    169170 
    170171      DO jl = 1, jpl  
     
    395396      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  ) 
    396397      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i ) 
    397       CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )   !clem modif 
    398       CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) !clem modif 
     398      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass ) 
     399      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) 
    399400 
    400401      DO jl = 1, jpl  
     
    521522      ! 
    522523      ! clem: I do not understand why the following IF is needed 
    523       !       I suspect something inconsistent in the main code with option num_sal=1 
    524       IF( num_sal == 1 ) THEN 
     524      !       I suspect something inconsistent in the main code with option nn_icesal=1 
     525      IF( nn_icesal == 1 ) THEN 
    525526         DO jl = 1, jpl  
    526             sm_i(:,:,jl) = bulk_sal 
     527            sm_i(:,:,jl) = rn_icesal 
    527528            DO jk = 1, nlay_i  
    528                s_i(:,:,jk,jl) = bulk_sal 
     529               s_i(:,:,jk,jl) = rn_icesal 
    529530            END DO 
    530531         END DO 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r5020 r5123  
    2525   USE par_oce          ! ocean parameters 
    2626   USE phycst           ! physical constants 
    27    USE par_ice          ! ice parameters 
    2827   USE dom_oce          ! ocean domain 
    29    USE dom_ice,    ONLY : tms, area 
    3028   USE ice              ! LIM sea-ice variables 
    3129   USE sbc_ice          ! Surface boundary condition: sea-ice fields 
     
    4038   USE prtctl           ! Print control 
    4139   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    42    USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget 
     40   USE traqsr           ! add penetration of solar flux in the calculation of heat budget 
    4341   USE iom 
    4442   USE domvvl           ! Variable volume 
     43   USE limctl 
    4544 
    4645   IMPLICIT NONE 
    4746   PRIVATE 
    4847 
    49    PUBLIC   lim_sbc_init   ! called by ice_init 
     48   PUBLIC   lim_sbc_init   ! called by sbc_lim_init 
    5049   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim 
    5150   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
     
    9998      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
    10099      !!              These refs are now obsolete since everything has been revised 
    101       !!              The ref should be Rousset et al., 2015? 
     100      !!              The ref should be Rousset et al., 2015 
    102101      !!--------------------------------------------------------------------- 
    103102      INTEGER, INTENT(in) ::   kt                                   ! number of iteration 
    104       ! 
    105103      INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices 
    106       ! 
    107       REAL(wp) ::   zemp                                            !  local scalars 
     104      REAL(wp) ::   zemp                                            ! local scalars 
    108105      REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    109106      REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean 
     
    172169               zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
    173170                  &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean 
    174                   &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas )       ! except solid precip intercepted by sea-ice 
     171                  &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**rn_betas )       ! except solid precip intercepted by sea-ice 
    175172            ENDIF 
    176173 
     
    199196         snwice_mass_b(:,:) = snwice_mass(:,:)                   
    200197         ! new mass per unit area 
    201          snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
     198         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
    202199         ! time evolution of snow+ice mass 
    203200         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
     
    225222      ENDIF 
    226223 
     224      IF( ln_nicep )   CALL lim_prt( kt, jiindx, jjindx, 3, ' - Final state lim_sbc - ' )   ! control print 
    227225 
    228226      IF(ln_ctl) THEN 
     
    270268      ! 
    271269      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    272 !CDIR NOVERRCHK 
    273270         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point) 
    274 !CDIR NOVERRCHK 
    275271            DO ji = fs_2, fs_jpim1 
    276272               !                                               ! 2*(U_ice-U_oce) at T-point 
     
    322318      !! ** input   : Namelist namicedia 
    323319      !!------------------------------------------------------------------- 
    324       REAL(wp) :: zsum, zarea 
    325       ! 
    326320      INTEGER  ::   ji, jj, jk                       ! dummy loop indices 
    327321      REAL(wp) ::   zcoefu, zcoefv, zcoeff          ! local scalar 
     
    343337         END WHERE 
    344338      ENDIF 
    345       ! clem modif 
     339       
    346340      IF( .NOT. ln_rstart ) THEN 
    347341         fraqsr_1lev(:,:) = 1._wp 
    348342      ENDIF 
    349343      ! 
    350       ! clem: snwice_mass in the restart file now 
    351344      IF( .NOT. ln_rstart ) THEN 
    352345         !                                      ! embedded sea ice 
    353346         IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    354             snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
     347            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
    355348            snwice_mass_b(:,:) = snwice_mass(:,:) 
    356349         ELSE 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4990 r5123  
    2424   USE oce     , ONLY : fraqsr_1lev  
    2525   USE ice            ! LIM: sea-ice variables 
    26    USE par_ice        ! LIM: sea-ice parameters 
    2726   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2827   USE sbc_ice        ! Surface boundary condition: ice fields 
     
    3433   USE limthd_sal     ! LIM: thermodynamics, ice salinity 
    3534   USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution 
     35   USE limthd_lac     ! LIM-3 lateral accretion 
     36   USE limitd_th      ! remapping thickness distribution 
    3637   USE limtab         ! LIM: 1D <==> 2D transformation 
    3738   USE limvar         ! LIM: sea-ice variables 
     
    4445   USE timing         ! Timing 
    4546   USE limcons        ! conservation tests 
     47   USE limctl 
    4648 
    4749   IMPLICIT NONE 
     
    4951 
    5052   PUBLIC   lim_thd        ! called by limstp module 
    51    PUBLIC   lim_thd_init   ! called by iceini module 
     53   PUBLIC   lim_thd_init   ! called by sbc_lim_init 
    5254 
    5355   !! * Substitutions 
     
    8082      !! ** References :  
    8183      !!--------------------------------------------------------------------- 
    82       INTEGER, INTENT(in) ::   kt    ! number of iteration 
     84      INTEGER, INTENT(in) :: kt    ! number of iteration 
    8385      !! 
    8486      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    85       INTEGER  :: nbpb             ! nb of icy pts for thermo. cal. 
     87      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations 
    8688      INTEGER  :: ii, ij           ! temporary dummy loop index 
    87       REAL(wp) :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04) 
    88       REAL(wp) :: zch        = 0.0057_wp    ! heat transfer coefficient 
    89       REAL(wp) :: zareamin  
    9089      REAL(wp) :: zfric_u, zqld, zqfr 
    91       ! 
    9290      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     91      REAL(wp), PARAMETER :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04) 
     92      REAL(wp), PARAMETER :: zch        = 0.0057_wp    ! heat transfer coefficient 
    9393      ! 
    9494      REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns 
     
    106106      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice 
    107107 
    108  
    109108      !-------------------- 
    110109      ! 1.2) Heat content     
    111110      !-------------------- 
    112       ! Change the units of heat content; from global units to J.m3 
     111      ! Change the units of heat content; from J/m2 to J/m3 
    113112      DO jl = 1, jpl 
    114113         DO jk = 1, nlay_i 
     
    116115               DO ji = 1, jpi 
    117116                  !0 if no ice and 1 if yes 
    118                   rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  ) 
     117                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi20 )  ) 
    119118                  !Energy of melting q(S,T) [J.m-3] 
    120                   e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 
    121                   !convert units ! very important that this line is here         
    122                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac  
     119                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i ) 
    123120               END DO 
    124121            END DO 
     
    128125               DO ji = 1, jpi 
    129126                  !0 if no ice and 1 if yes 
    130                   rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  ) 
     127                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi20 )  ) 
    131128                  !Energy of melting q(S,T) [J.m-3] 
    132                   e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 
    133                   !convert units ! very important that this line is here 
    134                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac  
     129                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s ) 
    135130               END DO 
    136131            END DO 
     
    161156      ENDIF 
    162157 
    163 !CDIR NOVERRCHK 
    164158      DO jj = 1, jpj 
    165 !CDIR NOVERRCHK 
    166159         DO ji = 1, jpi 
    167             rswitch          = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 
     160            rswitch  = tmask(ji,jj,1) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 
    168161            ! 
    169162            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
     
    178171            ! precip is included in qns but not in qns_ice 
    179172            IF ( lk_cpl ) THEN 
    180                zqld =  tms(ji,jj) * rdt_ice *  & 
     173               zqld =  tmask(ji,jj,1) * rdt_ice *  & 
    181174                  &    (   zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj)               &   ! pfrld already included in coupled mode 
    182                   &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *     &   ! heat content of precip 
    183                   &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )   & 
    184                   &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     175                  &    + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *     &   ! heat content of precip 
     176                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )   & 
     177                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 
    185178            ELSE 
    186                zqld =  tms(ji,jj) * rdt_ice *  & 
     179               zqld =  tmask(ji,jj,1) * rdt_ice *  & 
    187180                  &      ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) )    & 
    188                   &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *             &  ! heat content of precip 
    189                   &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )           & 
    190                   &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     181                  &    + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *             &  ! heat content of precip 
     182                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )           & 
     183                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 
    191184            ENDIF 
    192185 
    193             !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
    194             zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     186            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     187            zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     188 
     189            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 
     190            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
     191            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
     192            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     193            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
     194            !                        the freezing point, so that we do not have SST < T_freeze 
     195            !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
    195196 
    196197            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 
    197             qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )  
     198            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
    198199 
    199200            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting  
    200             IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN 
    201                fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90 
     201            IF( zqld > 0._wp ) THEN 
     202               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 limthd_dh.F90 
    202203               qlead(ji,jj) = 0._wp 
    203204            ELSE 
     
    205206            ENDIF 
    206207            ! 
    207             !-- Energy from the turbulent oceanic heat flux --- ! 
    208             !clem zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) 
    209             zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
    210             fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2  
    211             ! upper bound for fhtur: we do not want SST to drop below Tfreeze.  
    212             ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)    
    213             ! This is not a clean budget, so that should be corrected at some point 
    214             fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
    215  
    216208            ! ----------------------------------------- 
    217209            ! Net heat flux on top of ice-ocean [W.m-2] 
     
    223215               &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  & 
    224216               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    225                &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
    226                &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) 
     217               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )  & 
     218               &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) 
    227219 
    228220            ! ----------------------------------------------------------------------------- 
     
    236228               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                            & 
    237229               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    238                &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)       & 
    239                &         * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
    240                &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )       & 
     230               &    +      ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj)       & 
     231               &         * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus )  & 
     232               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 )       & 
    241233               ! heat flux taken from the ocean where there is open water ice formation 
    242234               &    -      qlead(ji,jj) * r1_rdtice                                                                               & 
     
    259251         ENDIF 
    260252 
    261          zareamin = epsi10 
    262253         nbpb = 0 
    263254         DO jj = 1, jpj 
    264255            DO ji = 1, jpi 
    265                IF ( a_i(ji,jj,jl) .gt. zareamin ) THEN      
     256               IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
    266257                  nbpb      = nbpb  + 1 
    267258                  npb(nbpb) = (jj - 1) * jpi + ji 
     
    289280         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing. 
    290281 
    291             !------------------------- 
    292             ! 4.1 Move to 1D arrays 
    293             !------------------------- 
    294  
    295             CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
    296             CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
    297             CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    298             CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    299  
    300             CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    301             CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    302             DO jk = 1, nlay_s 
    303                CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    304                CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    305             END DO 
    306             DO jk = 1, nlay_i 
    307                CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    308                CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    309                CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    310             END DO 
    311  
    312             CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:)   , jpi, jpj, npb(1:nbpb) ) 
    313             CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    314             CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
    315             CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) ) 
    316             CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    317             CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    318             IF( .NOT. lk_cpl ) THEN 
    319                CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    320                CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    321             ENDIF 
    322             CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    323             CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
    324             CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) )  
    325             CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) ) 
    326             CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
    327             CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
    328  
    329             CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
    330             CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
    331  
    332             CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    333             CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
    334             CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) ) 
    335             CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) ) 
    336             CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) ) 
    337             CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) ) 
    338  
    339             CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    340             CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
    341             CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) ) 
    342             CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) ) 
    343             CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    344             CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
    345  
    346             CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
    347             CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
    348             CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) ) 
    349             CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) ) 
    350             CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    351             CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) ) 
    352             CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) ) 
    353             CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) ) 
    354             CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) ) 
    355             CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) ) 
    356             CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) ) 
    357             CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
    358  
    359             !-------------------------------- 
    360             ! 4.3) Thermodynamic processes 
    361             !-------------------------------- 
     282            !-------------------------! 
     283            ! --- Move to 1D arrays --- 
     284            !-------------------------! 
     285            CALL lim_thd_1d2d( nbpb, jl, 1 ) 
     286 
     287            !--------------------------------------! 
     288            ! --- Ice/Snow Temperature profile --- ! 
     289            !--------------------------------------! 
     290            CALL lim_thd_dif( 1, nbpb ) 
    362291 
    363292            !---------------------------------! 
    364             ! Ice/Snow Temperature profile    ! 
    365             !---------------------------------! 
    366             CALL lim_thd_dif( 1, nbpb ) 
    367  
    368             !---------------------------------! 
    369             ! Ice/Snow thicnkess              ! 
     293            ! --- Ice/Snow thickness ---      ! 
    370294            !---------------------------------! 
    371295            CALL lim_thd_dh( 1, nbpb )     
     
    375299                                             
    376300            !---------------------------------! 
    377             ! --- Ice salinity --- ! 
     301            ! --- Ice salinity ---            ! 
    378302            !---------------------------------! 
    379303            CALL lim_thd_sal( 1, nbpb )     
    380304 
    381305            !---------------------------------! 
    382             ! --- temperature update --- ! 
     306            ! --- temperature update ---      ! 
    383307            !---------------------------------! 
    384308            CALL lim_thd_temp( 1, nbpb ) 
    385309 
    386             !-------------------------------- 
    387             ! 4.4) Move 1D to 2D vectors 
    388             !-------------------------------- 
    389  
    390                CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj ) 
    391                CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj ) 
    392                CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj ) 
    393                CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj ) 
    394                CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj ) 
    395                CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj ) 
    396             DO jk = 1, nlay_s 
    397                CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj) 
    398                CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj) 
    399             END DO 
    400             DO jk = 1, nlay_i 
    401                CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj) 
    402                CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj) 
    403                CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj) 
    404             END DO 
    405                CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
    406  
    407                CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
    408                CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
    409  
    410                CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    411                CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
    412                CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj ) 
    413                CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj ) 
    414                CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj ) 
    415                CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj ) 
    416  
    417                CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    418                CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
    419                CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj ) 
    420                CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj ) 
    421                CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
    422                CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
    423  
    424               CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
    425               CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
    426               CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj ) 
    427               CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj ) 
    428               CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    429               CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj ) 
    430               CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj ) 
    431               CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj ) 
    432               CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj ) 
    433               CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj ) 
    434               CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
    435               CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj ) 
    436             ! 
    437               CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
    438               CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
     310            !------------------------------------! 
     311            ! --- lateral melting if monocat --- ! 
     312            !------------------------------------! 
     313            IF ( ( ( nn_monocat == 1 ) .OR. ( nn_monocat == 4 ) ) .AND. ( jpl == 1 ) ) THEN 
     314               CALL lim_thd_lam( 1, nbpb ) 
     315            END IF 
     316 
     317            !-------------------------! 
     318            ! --- Move to 2D arrays --- 
     319            !-------------------------! 
     320            CALL lim_thd_1d2d( nbpb, jl, 2 ) 
     321 
    439322            ! 
    440323            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
     
    448331 
    449332      !------------------------ 
    450       ! 5.1) Ice heat content               
     333      ! Ice heat content               
    451334      !------------------------ 
    452       ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
     335      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    453336      DO jl = 1, jpl 
    454337         DO jk = 1, nlay_i 
    455             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) ) 
     338            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 
    456339         END DO 
    457340      END DO 
    458341 
    459342      !------------------------ 
    460       ! 5.2) Snow heat content               
     343      ! Snow heat content               
    461344      !------------------------ 
    462       ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
     345      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    463346      DO jl = 1, jpl 
    464347         DO jk = 1, nlay_s 
    465             e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) ) 
     348            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 
    466349         END DO 
    467350      END DO 
     351  
     352      !------------------------ 
     353      ! Ice natural aging               
     354      !------------------------ 
     355      oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice /rday 
    468356 
    469357      !---------------------------------- 
    470       ! 5.3) Change thickness to volume 
     358      ! Change thickness to volume 
    471359      !---------------------------------- 
    472360      CALL lim_var_eqv2glo 
    473361 
    474362      !-------------------------------------------- 
    475       ! 5.4) Diagnostic thermodynamic growth rates 
     363      ! Diagnostic thermodynamic growth rates 
    476364      !-------------------------------------------- 
     365      IF( ln_nicep )   CALL lim_prt( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print 
     366 
    477367      IF(ln_ctl) THEN            ! Control print 
    478368         CALL prt_ctl_info(' ') 
    479369         CALL prt_ctl_info(' - Cell values : ') 
    480370         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    481          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_thd  : cell area :') 
     371         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd  : cell area :') 
    482372         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :') 
    483373         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :') 
     
    510400      CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 
    511401 
    512       ! 
     402      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     403      !------------------------------------------------------------------------------| 
     404      !  6) Transport of ice between thickness categories.                           | 
     405      !------------------------------------------------------------------------------| 
     406      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     407 
     408      ! Given thermodynamic growth rates, transport ice between thickness categories. 
     409      IF( jpl > 1 )   CALL lim_itd_th_rem( 1, jpl, kt ) 
     410      ! 
     411      CALL lim_var_glo2eqv    ! only for info 
     412      CALL lim_var_agg(1) 
     413 
     414      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     415      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     416      !------------------------------------------------------------------------------| 
     417      !  7) Add frazil ice growing in leads. 
     418      !------------------------------------------------------------------------------| 
     419      CALL lim_thd_lac 
     420      CALL lim_var_glo2eqv    ! only for info 
     421       
    513422      ! conservation test 
    514       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     423      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     424 
     425      IF(ln_ctl) THEN   ! Control print 
     426         CALL prt_ctl_info(' ') 
     427         CALL prt_ctl_info(' - Cell values : ') 
     428         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
     429         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_th  : cell area :') 
     430         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :') 
     431         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :') 
     432         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :') 
     433         DO jl = 1, jpl 
     434            CALL prt_ctl_info(' ') 
     435            CALL prt_ctl_info(' - Category : ', ivar1=jl) 
     436            CALL prt_ctl_info('   ~~~~~~~~~~') 
     437            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ') 
     438            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ') 
     439            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ') 
     440            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ') 
     441            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ') 
     442            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ') 
     443            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ') 
     444            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ') 
     445            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ') 
     446            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ') 
     447            DO jk = 1, nlay_i 
     448               CALL prt_ctl_info(' ') 
     449               CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
     450               CALL prt_ctl_info('   ~~~~~~~') 
     451               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ') 
     452               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ') 
     453            END DO 
     454         END DO 
     455      ENDIF 
    515456      ! 
    516457      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
     
    534475      DO jk = 1, nlay_i 
    535476         DO ji = kideb, kiut 
    536             ztmelts       =  -tmut * s_i_1d(ji,jk) + rtt 
     477            ztmelts       =  -tmut * s_i_1d(ji,jk) + rt0 
    537478            ! Conversion q(S,T) -> T (second order equation) 
    538479            zaaa          =  cpic 
    539             zbbb          =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus 
    540             zccc          =  lfus * ( ztmelts - rtt ) 
     480            zbbb          =  ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus 
     481            zccc          =  lfus * ( ztmelts - rt0 ) 
    541482            zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 
    542             t_i_1d(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 
     483            t_i_1d(ji,jk) =  rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 
    543484             
    544485            ! mask temperature 
    545486            rswitch       =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )  
    546             t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rtt 
     487            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0 
    547488         END DO  
    548489      END DO  
    549490 
    550491   END SUBROUTINE lim_thd_temp 
     492 
     493   SUBROUTINE lim_thd_lam( kideb, kiut ) 
     494      !!----------------------------------------------------------------------- 
     495      !!                   ***  ROUTINE lim_thd_lam ***  
     496      !!                  
     497      !! ** Purpose :   Lateral melting in case monocategory 
     498      !!                          ( dA = A/2h dh ) 
     499      !!----------------------------------------------------------------------- 
     500      INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop 
     501      INTEGER             ::   ji                 ! dummy loop indices 
     502      REAL(wp)            ::   zhi_bef            ! ice thickness before thermo 
     503      REAL(wp)            ::   zdh_mel, zda_mel   ! net melting 
     504      REAL(wp)            ::   zv                 ! ice volume  
     505 
     506      DO ji = kideb, kiut 
     507         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 
     508         IF( zdh_mel < 0._wp )  THEN 
     509            zv         = a_i_1d(ji) * ht_i_1d(ji) 
     510            ! lateral melting = concentration change 
     511            zhi_bef     = ht_i_1d(ji) - zdh_mel 
     512            zda_mel     =  a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi10 ) ) 
     513            a_i_1d(ji)  = MAX( 0._wp, a_i_1d(ji) + zda_mel )  
     514            ! adjust thickness 
     515            rswitch     = 1._wp - MAX( 0._wp , SIGN( 1._wp , - a_i_1d(ji) + epsi20 ) ) 
     516            ht_i_1d(ji) = rswitch * zv / MAX( a_i_1d(ji), epsi20 ) 
     517            ! retrieve total concentration 
     518            at_i_1d(ji) = a_i_1d(ji) 
     519         END IF 
     520      END DO 
     521       
     522   END SUBROUTINE lim_thd_lam 
     523 
     524   SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) 
     525      !!----------------------------------------------------------------------- 
     526      !!                   ***  ROUTINE lim_thd_1d2d ***  
     527      !!                  
     528      !! ** Purpose :   move arrays from 1d to 2d and the reverse 
     529      !!----------------------------------------------------------------------- 
     530      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D 
     531                                        ! 2= from 1D to 2D 
     532      INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays 
     533      INTEGER, INTENT(in) ::   jl       ! ice cat 
     534      INTEGER             ::   jk       ! dummy loop indices 
     535 
     536      SELECT CASE( kn ) 
     537 
     538      CASE( 1 ) 
     539 
     540         CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
     541         CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
     542         CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     543         CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     544          
     545         CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     546         CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     547         DO jk = 1, nlay_s 
     548            CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     549            CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     550         END DO 
     551         DO jk = 1, nlay_i 
     552            CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     553            CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     554            CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     555         END DO 
     556          
     557         CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:)   , jpi, jpj, npb(1:nbpb) ) 
     558         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     559         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
     560         CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) ) 
     561         CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     562         CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     563         IF( .NOT. lk_cpl ) THEN 
     564            CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     565            CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     566         ENDIF 
     567         CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     568         CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
     569         CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) )  
     570         CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) ) 
     571         CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
     572         CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
     573          
     574         CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     575         CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     576          
     577         CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     578         CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     579         CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     580         CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) ) 
     581         CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) ) 
     582         CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     583          
     584         CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     585         CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     586         CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     587         CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) ) 
     588         CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
     589         CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
     590          
     591         CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     592         CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     593         CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     594         CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     595         CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     596         CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) ) 
     597         CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) ) 
     598         CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     599         CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     600         CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) ) 
     601         CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) ) 
     602         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
     603 
     604      CASE( 2 ) 
     605 
     606         CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj ) 
     607         CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj ) 
     608         CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj ) 
     609         CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj ) 
     610         CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj ) 
     611         CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj ) 
     612         DO jk = 1, nlay_s 
     613            CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj) 
     614            CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj) 
     615         END DO 
     616         DO jk = 1, nlay_i 
     617            CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj) 
     618            CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj) 
     619            CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj) 
     620         END DO 
     621         CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
     622          
     623         CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     624         CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     625          
     626         CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     627         CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     628         CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     629         CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     630         CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj ) 
     631         CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     632          
     633         CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     634         CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     635         CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     636         CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     637         CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
     638         CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
     639          
     640         CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
     641         CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     642         CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     643         CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     644         CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     645         CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj ) 
     646         CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj ) 
     647         CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     648         CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     649         CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj ) 
     650         CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
     651         CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj ) 
     652         ! 
     653         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
     654         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
     655                   
     656      END SELECT 
     657 
     658   END SUBROUTINE lim_thd_1d2d 
     659 
    551660 
    552661   SUBROUTINE lim_thd_init 
     
    563672  &n