New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

Ignore:
Timestamp:
2015-08-12T17:46:45+02:00 (9 years ago)
Author:
mattmartin
Message:

OBS simplification changes committed to branch after running SETTE tests to make sure we get the same results as the trunk for ORCA2_LIM_OBS.

Location:
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3
Files:
3 deleted
27 edited
1 copied

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90

    r4161 r5682  
    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.' ) 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4990 r5682  
    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) 
     200   LOGICAL , PUBLIC ::   ln_it_qnsice        !: iterate surface flux with changing surface temperature or not (F) 
    199201 
    200202   !                                     !!** 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 
     203   REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging             
     204   REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging 
     205   REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging 
     206   REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging 
     207   REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function 
     208   REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice 
     209   REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging  
     210   REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting 
     211   REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value) 
     212   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice 
     213   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
     214   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion 
     215   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion 
    215216 
    216217   !                                     !!** 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  
     218   LOGICAL , PUBLIC ::   ln_rafting      !: rafting of ice or not                         
     219   INTEGER , PUBLIC ::   nn_partfun      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
     220 
     221   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( rn_ecc * rn_ecc ) 
     222   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cio 
     223   REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i 
     224   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s  
     225   ! 
    225226   !                                     !!** switch for presence of ice or not  
    226227   REAL(wp), PUBLIC ::   rswitch 
    227  
     228   ! 
    228229   !                                     !!** define some parameters  
    229    REAL(wp), PUBLIC, PARAMETER ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
    230230   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number  
    231231   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number  
    … …  
    266266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2] 
    267267 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total) [s-1] 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1] 
     270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics) [s-1] 
     271 
    268272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    269273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    … …  
    282286   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt  
    283287   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion  
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux 
    284289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping  
    285290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations  
    … …  
    296301 
    297302   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 
    301303 
    302304   !!-------------------------------------------------------------------------- 
    … …  
    333335       
    334336   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] 
     337   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents    [J/m2] 
    336338   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i        !: ice salinities          [PSU] 
    337339 
    … …  
    356358   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
    357359   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
    358        
    359  
    360    !!-------------------------------------------------------------------------- 
    361    !! * Increment of global variables 
    362    !!-------------------------------------------------------------------------- 
     360             
     361   !!-------------------------------------------------------------------------- 
     362   !! * Ice thickness distribution variables 
     363   !!-------------------------------------------------------------------------- 
     364   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
     365   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
     366 
     367   !!-------------------------------------------------------------------------- 
     368   !! * Ice Run 
     369   !!-------------------------------------------------------------------------- 
     370   !                                                  !!: ** Namelist namicerun read in sbc_lim_init ** 
     371   INTEGER          , PUBLIC ::   jpl             !: number of ice  categories  
     372   INTEGER          , PUBLIC ::   nlay_i          !: number of ice  layers  
     373   INTEGER          , PUBLIC ::   nlay_s          !: number of snow layers  
     374   CHARACTER(len=32), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
     375   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory 
     376   CHARACTER(len=32), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
     377   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory 
     378   LOGICAL          , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
     379   LOGICAL          , PUBLIC ::   ln_icectl       !: flag for sea-ice points output (T) or not (F) 
     380   REAL(wp)         , PUBLIC ::   rn_amax         !: maximum ice concentration 
     381   INTEGER          , PUBLIC ::   iiceprt         !: debug i-point 
     382   INTEGER          , PUBLIC ::   jiceprt         !: debug j-point 
     383   ! 
     384   !!-------------------------------------------------------------------------- 
     385   !! * Ice diagnostics 
     386   !!-------------------------------------------------------------------------- 
     387   ! Increment of global variables 
    363388   ! thd refers to changes induced by thermodynamics 
    364389   ! 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 
     390   LOGICAL , PUBLIC                                        ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
     391   LOGICAL , PUBLIC                                        ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
     392   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vi   !: transport of ice volume 
     393   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vs   !: transport of snw volume 
     394   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_ei   !: transport of ice enthalpy (W/m2) 
     395   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_es   !: transport of snw enthalpy (W/m2) 
     396   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_smv  !: transport of salt content 
    394397   ! 
    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) 
     398   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat     !: snw/ice heat content variation   [W/m2]  
     399   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_smvi     !: ice salt content variation   []  
     400   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vice     !: ice volume variation   [m/s]  
     401   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vsnw     !: snw volume variation   [m/s]  
    406402   ! 
    407    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2]  
    408    ! 
    409    INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    410  
    411403   !!---------------------------------------------------------------------- 
    412404   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
    … …  
    422414      INTEGER :: ice_alloc 
    423415      ! 
    424       INTEGER :: ierr(19), ii 
     416      INTEGER :: ierr(17), ii 
    425417      !!----------------------------------------------------------------- 
    426418 
    … …  
    439431 
    440432      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) ,    & 
     433      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,                        & 
     434         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,                        & 
     435         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,                        & 
    444436         &      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) ,   & 
    449          &      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) , & 
     437         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     & 
     438         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) ,                        & 
     439         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead  (jpi,jpj) ,                     & 
     440         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,                        & 
     441         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    & 
     442         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     &  
     443         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) ,                                   & 
     444         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,                           & 
     445         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,    & 
    452446         &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) ) 
    453447 
    … …  
    464458         &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) ) 
    465459      ii = ii + 1 
    466       ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) ,                            & 
    467          &      e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
    468       ii = ii + 1 
    469       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) ) 
     460      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
     461      ii = ii + 1 
     462      ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 
    470463 
    471464      ! * Moments for advection 
    … …  
    483476         &      STAT=ierr(ii) ) 
    484477      ii = ii + 1 
    485       ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) ,     & 
    486          &      syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl)                           , STAT=ierr(ii) ) 
     478      ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) ,     & 
     479         &      syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl)                            , STAT=ierr(ii) ) 
    487480 
    488481      ! * Old values of global variables 
    489482      ii = ii + 1 
    490483      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) ) 
     484         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,     & 
     485         &      oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)          , STAT=ierr(ii) ) 
    505486       
    506487      ! * Ice thickness distribution variables 
    … …  
    510491      ! * Ice diagnostics 
    511492      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) ) 
     493      ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj),   &  
     494         &      diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat  (jpi,jpj),   & 
     495         &      diag_smvi  (jpi,jpj), diag_vice   (jpi,jpj), diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
    515496 
    516497      ice_alloc = MAXVAL( ierr(:) ) 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r4990 r5682  
    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               
    … …  
    207207 
    208208      !-- Lateral boundary conditions 
    209       CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. ) 
    210       CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes 
    211       CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. ) 
    212       CALL lbc_lnk( psxy, 'T',  1. ) 
     209      CALL lbc_lnk_multi( psm , 'T',  1., ps0 , 'T',  1.   & 
     210         &              , psx , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     211         &              , psxx, 'T',  1., psyy, 'T',  1.   & 
     212         &              , psxy, 'T',  1. ) 
    213213 
    214214      IF(ln_ctl) THEN 
    … …  
    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               
    … …  
    393393 
    394394      !-- Lateral boundary conditions 
    395       CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. ) 
    396       CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes 
    397       CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. ) 
    398       CALL lbc_lnk( psxy, 'T',  1. ) 
     395      CALL lbc_lnk_multi( psm , 'T',  1.,  ps0 , 'T',  1.   & 
     396         &              , psx , 'T', -1.,  psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     397         &              , psxx, 'T',  1.,  psyy, 'T',  1.   & 
     398         &              , psxy, 'T',  1. ) 
    399399 
    400400      IF(ln_ctl) THEN 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r4873 r5682  
    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 
     10   !!             -   ! 2015-03  (C. Rousset) add lim_cons_final 
    1011   !!---------------------------------------------------------------------- 
    1112#if defined key_lim3 
    … …  
    1617   !!---------------------------------------------------------------------- 
    1718   USE phycst         ! physical constants 
    18    USE par_ice        ! LIM-3 parameter 
    1919   USE ice            ! LIM-3 variables 
    2020   USE dom_ice        ! LIM-3 domain 
    … …  
    2323   USE lib_mpp        ! MPP library 
    2424   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     25   USE sbc_oce , ONLY : sfx  ! Surface boundary condition: ocean fields 
    2526 
    2627   IMPLICIT NONE 
    … …  
    3132   PUBLIC   lim_cons_check 
    3233   PUBLIC   lim_cons_hsm 
     34   PUBLIC   lim_cons_final 
    3335 
    3436   !!---------------------------------------------------------------------- 
    … …  
    7375      !! ** Method  : Arithmetics 
    7476      !!--------------------------------------------------------------------- 
    75       INTEGER                                  , INTENT(in   ) ::   ksum   !: number of categories 
    76       INTEGER                                  , INTENT(in   ) ::   klay   !: number of vertical layers 
    77       REAL(wp), DIMENSION(jpi,jpj,nlay_i+1,jpl), INTENT(in   ) ::   pin   !: input field 
    78       REAL(wp), DIMENSION(jpi,jpj)             , INTENT(  out) ::   pout   !: output field 
     77      INTEGER                                , INTENT(in   ) ::   ksum   !: number of categories 
     78      INTEGER                                , INTENT(in   ) ::   klay   !: number of vertical layers 
     79      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl), INTENT(in   ) ::   pin    !: input field 
     80      REAL(wp), DIMENSION(jpi,jpj)           , INTENT(  out) ::   pout   !: output field 
    7981      ! 
    8082      INTEGER ::   jk, jl   ! dummy loop indices 
    … …  
    156158 
    157159   SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
    158       !!------------------------------------------------------------------- 
    159       !!               ***  ROUTINE lim_cons_hsm *** 
    160       !! 
    161       !! ** Purpose : Test the conservation of heat, salt and mass for each routine 
    162       !! 
    163       !! ** Method  : 
    164       !!--------------------------------------------------------------------- 
    165       INTEGER         , INTENT(in)    :: icount      ! determine wether this is the beggining of the routine (0) or the end (1) 
    166       CHARACTER(len=*), INTENT(in)    :: cd_routine  ! name of the routine 
     160      !!-------------------------------------------------------------------------------------------------------- 
     161      !!                                        ***  ROUTINE lim_cons_hsm *** 
     162      !! 
     163      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine 
     164      !!                     + test if ice concentration and volume are > 0 
     165      !! 
     166      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true 
     167      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
     168      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to 
     169      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 
     170      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
     171      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
     172      !!-------------------------------------------------------------------------------------------------------- 
     173      INTEGER         , INTENT(in)    :: icount        ! determine wether this is the beggining of the routine (0) or the end (1) 
     174      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine 
    167175      REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    168176      REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft 
    169177      REAL(wp)                        :: zvmin, zamin, zamax  
     178      REAL(wp)                        :: zvtrp, zetrp 
     179      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill 
     180      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt 
    170181 
    171182      IF( icount == 0 ) THEN 
    172183 
    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(:,:) ) 
     184         ! salt flux 
     185         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     186            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
     187            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
     188 
     189         ! water flux 
     190         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
     191            &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     192            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
     193 
     194         ! heat flux 
     195         zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     196            &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
     197            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
     198 
     199         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e12t * tmask(:,:,1) * zconv ) 
     200 
     201         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e12t * tmask(:,:,1) * zconv ) 
     202 
     203         zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
     204            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
     205                            ) * e12t * tmask(:,:,1) * zconv ) 
    185206 
    186207      ELSEIF( icount == 1 ) THEN 
    187208 
    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 
     209         ! salt flux 
     210         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     211            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &  
     212            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 
     213 
     214         ! water flux 
     215         zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
     216            &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     217            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 
     218 
     219         ! heat flux 
     220         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     221            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
     222            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zft_b 
    197223  
    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) 
    205         
     224         ! outputs 
     225         zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 )  & 
     226            &                    * e12t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday 
     227 
     228         zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 )  & 
     229            &                    * e12t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday 
     230 
     231         zei  =   glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
     232            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
     233            &                ) * e12t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 
     234 
     235         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 
     236         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e12t * tmask(:,:,1) * zconv ) * rday  
     237         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e12t * tmask(:,:,1) * zconv ) 
     238 
     239         zvmin = glob_min( v_i ) 
     240         zamax = glob_max( SUM( a_i, dim=3 ) ) 
     241         zamin = glob_min( a_i ) 
     242 
     243         ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     244         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2 
     245         zv_sill = zarea * 2.5e-5 
     246         zs_sill = zarea * 25.e-5 
     247         zh_sill = zarea * 10.e-5 
     248 
    206249         IF(lwp) THEN 
    207             IF ( ABS( zvi    ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (',cd_routine,') = ',(zvi * rday) 
    208             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 
    212                                           WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     250            IF ( ABS( zvi  ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day]     (',cd_routine,') = ',zvi 
     251            IF ( ABS( zsmv ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zsmv 
     252            IF ( ABS( zei  ) > zh_sill ) WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',zei 
     253            IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'limtrp' ) THEN 
     254                                         WRITE(numout,*) 'violation vtrp [Mt/day]       (',cd_routine,') = ',zvtrp 
     255                                         WRITE(numout,*) 'violation etrp [GW]           (',cd_routine,') = ',zetrp 
    213256            ENDIF 
    214             IF ( zamin <  0.            ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
     257            IF (     zvmin   < -epsi10 ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin 
     258            IF (     zamax   > rn_amax+epsi10 .AND. cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 
     259                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     260            ENDIF 
     261            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
    215262         ENDIF 
    216263 
    … …  
    218265 
    219266   END SUBROUTINE lim_cons_hsm 
     267 
     268   SUBROUTINE lim_cons_final( cd_routine ) 
     269      !!--------------------------------------------------------------------------------------------------------- 
     270      !!                                   ***  ROUTINE lim_cons_final *** 
     271      !! 
     272      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step 
     273      !! 
     274      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true 
     275      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
     276      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to 
     277      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 
     278      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
     279      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
     280      !!-------------------------------------------------------------------------------------------------------- 
     281      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine 
     282      REAL(wp)                        :: zhfx, zsfx, zvfx 
     283      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill 
     284      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt 
     285 
     286#if ! defined key_bdy 
     287      ! heat flux 
     288      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e12t * tmask(:,:,1) * zconv )  
     289      ! salt flux 
     290      zsfx  = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday 
     291      ! water flux 
     292      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e12t * tmask(:,:,1) * zconv ) * rday 
     293 
     294      ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     295      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2 
     296      zv_sill = zarea * 2.5e-5 
     297      zs_sill = zarea * 25.e-5 
     298      zh_sill = zarea * 10.e-5 
     299 
     300      IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx    [Mt/day]       (',cd_routine,')  = ',(zvfx) 
     301      IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx    [psu*Mt/day]   (',cd_routine,')  = ',(zsfx) 
     302      IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx    [GW]           (',cd_routine,')  = ',(zhfx) 
     303#endif 
     304 
     305   END SUBROUTINE lim_cons_final 
    220306 
    221307#else 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    • Property svn:keywords set to Id
    r4990 r5682  
    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 
    … …  
    4340   !!---------------------------------------------------------------------- 
    4441   !! NEMO/OPA 3.4 , NEMO Consortium (2012) 
    45    !! $Id: limdiahsb.F90 3294 2012-10-18 16:44:18Z rblod $ 
     42   !! $Id$ 
    4643   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4744   !!---------------------------------------------------------------------- 
    … …  
    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(:,:) * 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 
    … …  
    247245         WRITE(numout,*) '~~~~~~~~~~~~' 
    248246      ENDIF 
    249  
    250       ! ---------------------------------- ! 
    251       ! 2 - initial conservation variables ! 
    252       ! ---------------------------------- ! 
    253       !frc_vol = 0._wp                                          ! volume       trend due to forcing 
    254       !frc_sal = 0._wp                                          ! salt content   -    -   -    -          
    255       !bg_grme = 0._wp                                          ! ice growth + melt volume trend 
    256247      ! 
    257248      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4990 r5682  
    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 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r4990 r5682  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   lim_hdf       : diffusion trend on sea-ice variable 
     15   !!   lim_hdf_init  : initialisation of diffusion trend on sea-ice variable 
    1516   !!---------------------------------------------------------------------- 
    1617   USE dom_oce        ! ocean domain 
    … …  
    2627   PRIVATE 
    2728 
    28    PUBLIC   lim_hdf     ! called by lim_tra 
    29  
    30    LOGICAL  ::   linit = .TRUE.              ! initialization flag (set to flase after the 1st call) 
    31    REAL(wp) ::   epsi04 = 1.e-04              ! constant 
     29   PUBLIC   lim_hdf         ! called by lim_trp 
     30   PUBLIC   lim_hdf_init    ! called by sbc_lim_init 
     31 
     32   LOGICAL  ::   linit = .TRUE.                             ! initialization flag (set to flase after the 1st call) 
     33   INTEGER  ::   nn_convfrq                                 !:  convergence check frequency of the Crant-Nicholson scheme 
    3234   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient 
    3335 
    … …  
    5456      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   ptab    ! Field on which the diffusion is applied 
    5557      ! 
    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 
     58      INTEGER                           ::  ji, jj                    ! dummy loop indices 
     59      INTEGER                           ::  iter, ierr           ! local integers 
     60      REAL(wp)                          ::  zrlxint, zconv     ! local scalars 
     61      REAL(wp), POINTER, DIMENSION(:,:) ::  zrlx, zflu, zflv, zdiv0, zdiv, ztab0 
     62      CHARACTER(lc)                     ::  charout                   ! local character 
     63      REAL(wp), PARAMETER               ::  zrelax = 0.5_wp           ! relaxation constant for iterative procedure 
     64      REAL(wp), PARAMETER               ::  zalfa  = 0.5_wp           ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 
     65      INTEGER , PARAMETER               ::  its    = 100              ! Maximum number of iteration 
    6166      !!------------------------------------------------------------------- 
    6267       
    … …  
    7176         DO jj = 2, jpjm1   
    7277            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) ) 
     78               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj) 
    7479            END DO 
    7580         END DO 
    … …  
    7782      ENDIF 
    7883      !                             ! 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 
    8184      ! 
    8285      ztab0(:, : ) = ptab(:,:)      ! Arrays initialization 
    … …  
    9194      iter  = 0 
    9295      ! 
    93       DO WHILE( zconv > ( 2._wp * epsi04 ) .AND. iter <= its )   ! Sub-time step loop 
     96      DO WHILE( zconv > ( 2._wp * 1.e-04 ) .AND. iter <= its )   ! Sub-time step loop 
    9497         ! 
    9598         iter = iter + 1                                 ! incrementation of the sub-time step number 
    … …  
    97100         DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    98101            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) ) 
     102               zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
     103               zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
    101104            END DO 
    102105         END DO 
    … …  
    104107         DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    105108            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) ) 
     109               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
    108110            END DO 
    109111         END DO 
    … …  
    115117               zrlxint = (   ztab0(ji,jj)    & 
    116118                  &       +  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) ) 
     119                  &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )                               &  
     120                  &      ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 
     121               zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) ) 
    120122            END DO 
    121123         END DO 
    122124         CALL lbc_lnk( zrlx, 'T', 1. )                   ! lateral boundary condition 
    123125         ! 
    124          zconv = 0._wp                                   ! convergence test 
    125          DO jj = 2, jpjm1 
    126             DO ji = fs_2, fs_jpim1 
    127                zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  ) 
    128             END DO 
    129          END DO 
    130          IF( lk_mpp )   CALL mpp_max( zconv )            ! max over the global domain 
     126         IF ( MOD( iter, nn_convfrq ) == 0 )  THEN    ! convergence test every nn_convfrq iterations (perf. optimization) 
     127            zconv = 0._wp 
     128            DO jj = 2, jpjm1 
     129               DO ji = fs_2, fs_jpim1 
     130                  zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  ) 
     131               END DO 
     132            END DO 
     133            IF( lk_mpp )   CALL mpp_max( zconv )      ! max over the global domain 
     134         ENDIF 
    131135         ! 
    132136         ptab(:,:) = zrlx(:,:) 
    … …  
    138142      DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    139143         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) ) 
     144            zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
     145            zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
    142146         END DO 
    143147      END DO 
    … …  
    145149      DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    146150         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) ) 
     151            zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
    149152            ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 
    150153         END DO 
    … …  
    164167   END SUBROUTINE lim_hdf 
    165168 
     169    
     170   SUBROUTINE lim_hdf_init 
     171      !!------------------------------------------------------------------- 
     172      !!                  ***  ROUTINE lim_hdf_init  *** 
     173      !! 
     174      !! ** Purpose : Initialisation of horizontal diffusion of sea-ice  
     175      !! 
     176      !! ** Method  : Read the namicehdf namelist 
     177      !! 
     178      !! ** input   : Namelist namicehdf 
     179      !!------------------------------------------------------------------- 
     180      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     181      NAMELIST/namicehdf/ nn_convfrq 
     182      !!------------------------------------------------------------------- 
     183      ! 
     184      IF(lwp) THEN 
     185         WRITE(numout,*) 
     186         WRITE(numout,*) 'lim_hdf : Ice horizontal diffusion' 
     187         WRITE(numout,*) '~~~~~~~' 
     188      ENDIF 
     189      ! 
     190      REWIND( numnam_ice_ref )              ! Namelist namicehdf in reference namelist : Ice horizontal diffusion 
     191      READ  ( numnam_ice_ref, namicehdf, IOSTAT = ios, ERR = 901) 
     192901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in reference namelist', lwp ) 
     193 
     194      REWIND( numnam_ice_cfg )              ! Namelist namicehdf in configuration namelist : Ice horizontal diffusion 
     195      READ  ( numnam_ice_cfg, namicehdf, IOSTAT = ios, ERR = 902 ) 
     196902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in configuration namelist', lwp ) 
     197      IF(lwm) WRITE ( numoni, namicehdf ) 
     198      ! 
     199      IF(lwp) THEN                          ! control print 
     200         WRITE(numout,*) 
     201         WRITE(numout,*)'   Namelist of ice parameters for ice horizontal diffusion computation ' 
     202         WRITE(numout,*)'      convergence check frequency of the Crant-Nicholson scheme   nn_convfrq   = ', nn_convfrq 
     203      ENDIF 
     204      ! 
     205   END SUBROUTINE lim_hdf_init 
    166206#else 
    167207   !!---------------------------------------------------------------------- 
    168208   !!   Default option          Dummy module           NO LIM sea-ice model 
    169209   !!---------------------------------------------------------------------- 
    170 CONTAINS 
    171    SUBROUTINE lim_hdf         ! Empty routine 
    172    END SUBROUTINE lim_hdf 
    173210#endif 
    174211 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4990 r5682  
    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      CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 
     120      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
     121 
     122      IF( ln_iceini ) THEN 
    125123 
    126124      !-------------------------------------------------------------------- 
    … …  
    130128      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    131129         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 
     130            IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
     131               zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice 
    134132            ELSE                                                                                    
    135                zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice 
     133               zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice 
    136134            ENDIF 
    137135         END DO 
    … …  
    158156      !----------------------------- 
    159157      ! 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) 
     158      zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s  ! ice thickness 
     159      zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s  ! snow depth 
     160      zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s  ! ice concentration 
     161      zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s  ! bulk ice salinity 
     162      ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s  ! temperature (ice and snow) 
    165163 
    166164      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume 
    … …  
    197195               !--- Ice thicknesses in the i_fill - 1 first categories 
    198196               DO jl = 1, i_fill - 1 
    199                   zh_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
     197                  zh_i_ini(jl,i_hemis) = hi_mean(jl) 
    200198               END DO 
    201199                
    202200               !--- jl0: most likely index where cc will be maximum 
    203201               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 
     202                  IF ( ( zht_i_ini(i_hemis) > hi_max(jl-1) ) .AND. & 
     203                     & ( zht_i_ini(i_hemis) <= hi_max(jl)   ) ) THEN 
    206204                     jl0 = jl 
    207205                  ENDIF 
    … …  
    267265 
    268266            ! 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 
     267            IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN 
    270268               ztest_3 = 1 
    271269            ELSE 
    … …  
    317315            DO ji = 1, jpi 
    318316               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
    319                ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
     317               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))   ! ice thickness 
    320318               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 
    322                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 
     319               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj))     ! salinity 
     320               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                        ! age (1 day) 
     321               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 
    324322 
    325323               ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
    … …  
    329327               ! recompute ht_i, ht_s avoiding out of bounds values 
    330328               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 ) 
     329               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn ) 
    332330 
    333331               ! ice volume, salt content, age content 
    … …  
    336334               smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 
    337335               oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content 
    338             END DO ! ji 
    339          END DO ! jj 
    340       END DO ! jl 
     336            END DO 
     337         END DO 
     338      END DO 
    341339 
    342340      ! Snow temperature and heat content 
    … …  
    345343            DO jj = 1, jpj 
    346344               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 
     345                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 
    348346                   ! 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 
    354                END DO ! ji 
    355             END DO ! jj 
    356          END DO ! jl 
    357       END DO ! jk 
     347                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
     348 
     349                   ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 
     350                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
     351               END DO 
     352            END DO 
     353         END DO 
     354      END DO 
    358355 
    359356      ! Ice salinity, temperature and heat content 
    … …  
    362359            DO jj = 1, jpj 
    363360               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 
     361                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0  
     362                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin 
     363                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 
    367364 
    368365                   ! heat content per unit volume 
    369366                   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 
    378                END DO ! ji 
    379             END DO ! jj 
    380          END DO ! jl 
    381       END DO ! jk 
     367                      +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
     368                      -   rcp     * ( ztmelts - rt0 ) ) 
     369 
     370                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
     371                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
     372               END DO 
     373            END DO 
     374         END DO 
     375      END DO 
    382376 
    383377      tn_ice (:,:,:) = t_su (:,:,:) 
    384378 
    385379      ELSE  
    386          ! if ln_limini=false 
     380         ! if ln_iceini=false 
    387381         a_i  (:,:,:) = 0._wp 
    388382         v_i  (:,:,:) = 0._wp 
    … …  
    400394         DO jl = 1, jpl 
    401395            DO jk = 1, nlay_i 
    402                t_i(:,:,jk,jl) = rtt * tms(:,:) 
     396               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    403397            END DO 
    404398            DO jk = 1, nlay_s 
    405                t_s(:,:,jk,jl) = rtt * tms(:,:) 
     399               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    406400            END DO 
    407401         END DO 
    408402       
    409       ENDIF ! ln_limini 
     403      ENDIF ! ln_iceini 
    410404       
    411405      at_i (:,:) = 0.0_wp 
    … …  
    481475      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    482476      !!----------------------------------------------------------------------------- 
    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 
     477      NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s,  & 
     478         &                                      rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s 
    485479      INTEGER :: ios                 ! Local integer output status for namelist read 
    486480      !!----------------------------------------------------------------------------- 
    … …  
    502496         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    503497         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 
     498         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini 
     499         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst 
     500         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n 
     501         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s  
     502         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n 
     503         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s 
     504         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n 
     505         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s 
     506         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n 
     507         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s 
     508         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n 
     509         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s 
    516510      ENDIF 
    517511 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4990 r5682  
    1818   USE thd_ice          ! LIM thermodynamics 
    1919   USE ice              ! LIM variables 
    20    USE par_ice          ! LIM parameters 
    2120   USE dom_ice          ! LIM domain 
    22    USE limthd_lac       ! LIM 
    2321   USE limvar           ! LIM 
    24    USE in_out_manager   ! I/O manager 
    2522   USE lbclnk           ! lateral boundary condition - MPP exchanges 
    2623   USE lib_mpp          ! MPP library 
    2724   USE wrk_nemo         ! work arrays 
    2825   USE prtctl           ! Print control 
    29   ! Check budget (Rousset) 
     26 
     27   USE in_out_manager   ! I/O manager 
    3028   USE iom              ! I/O manager 
    3129   USE lib_fortran      ! glob_sum 
    … …  
    4038   PUBLIC   lim_itd_me_icestrength 
    4139   PUBLIC   lim_itd_me_init 
    42    PUBLIC   lim_itd_me_zapsmall 
    43    PUBLIC   lim_itd_me_alloc        ! called by iceini.F90 
     40   PUBLIC   lim_itd_me_alloc        ! called by sbc_lim_init  
    4441 
    4542   !----------------------------------------------------------------------- 
    … …  
    125122      !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged 
    126123      !!--------------------------------------------------------------------! 
    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 
     124      INTEGER  ::   ji, jj, jk, jl        ! dummy loop index 
     125      INTEGER  ::   niter                 ! local integer  
    130126      INTEGER  ::   iterate_ridging       ! if true, repeat the ridging 
    131       REAL(wp) ::   w1, tmpfac            ! local scalar 
     127      REAL(wp) ::   za, zfac              ! local scalar 
    132128      CHARACTER (len = 15) ::   fieldid 
    133       REAL(wp), POINTER, DIMENSION(:,:) ::   closing_net     ! net rate at which area is removed    (1/s) 
    134                                                              ! (ridging ice area - area of new ridges) / dt 
    135       REAL(wp), POINTER, DIMENSION(:,:) ::   divu_adv        ! divu as implied by transport scheme  (1/s) 
    136       REAL(wp), POINTER, DIMENSION(:,:) ::   opning          ! rate of opening due to divergence/shear 
    137       REAL(wp), POINTER, DIMENSION(:,:) ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
    138       REAL(wp), POINTER, DIMENSION(:,:) ::   msnow_mlt       ! mass of snow added to ocean (kg m-2) 
    139       REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    140       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
     129      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_net     ! net rate at which area is removed    (1/s) 
     130                                                               ! (ridging ice area - area of new ridges) / dt 
     131      REAL(wp), POINTER, DIMENSION(:,:)   ::   divu_adv        ! divu as implied by transport scheme  (1/s) 
     132      REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear 
     133      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
     134      REAL(wp), POINTER, DIMENSION(:,:)   ::   msnow_mlt       ! mass of snow added to ocean (kg m-2) 
     135      REAL(wp), POINTER, DIMENSION(:,:)   ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
     136      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
     137      ! 
     138      INTEGER, PARAMETER ::   nitermax = 20     
    141139      ! 
    142140      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    … …  
    144142      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    145143 
    146       CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
     144      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    147145 
    148146      IF(ln_ctl) THEN 
    … …  
    156154      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    157155 
     156      CALL lim_var_zapsmall 
     157      CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
     158 
    158159      !-----------------------------------------------------------------------------! 
    159160      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 
    160161      !-----------------------------------------------------------------------------! 
    161       Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0                ! proport const for PE 
     162      Cp = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0             ! proport const for PE 
    162163      ! 
    163164      CALL lim_itd_me_ridgeprep                                    ! prepare ridging 
    … …  
    193194            !  (thick, newly ridged ice). 
    194195 
    195             closing_net(ji,jj) = Cs * 0.5 * ( Delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp ) 
     196            closing_net(ji,jj) = rn_cs * 0.5 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp ) 
    196197 
    197198            ! 2.2 divu_adv 
    … …  
    237238               ! Reduce the closing rate if more than 100% of the open water  
    238239               ! 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 
     240               za   = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
     241               IF( za > epsi20 ) THEN 
     242                  zfac = MIN( 1._wp, ato_i(ji,jj) / za ) 
     243                  closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
     244                  opning       (ji,jj) = opning       (ji,jj) * zfac 
     245               ENDIF 
     246 
     247            END DO 
     248         END DO 
    250249 
    251250         ! correction to closing rate / opening if excessive ice removal 
    … …  
    253252         ! Reduce the closing rate if more than 100% of any ice category  
    254253         ! would be removed.  Reduce the opening rate proportionately. 
    255  
    256254         DO jl = 1, jpl 
    257255            DO jj = 1, jpj 
    258256               DO ji = 1, jpi 
    259                   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 
    265                      ENDIF 
     257                  za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
     258                  IF( za  >  epsi20 ) THEN 
     259                     zfac = MIN( 1._wp, a_i(ji,jj,jl) / za ) 
     260                     closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
     261                     opning       (ji,jj) = opning       (ji,jj) * zfac 
    266262                  ENDIF 
    267                END DO !ji 
    268             END DO ! jj 
    269          END DO !jl 
     263               END DO 
     264            END DO 
     265         END DO 
    270266 
    271267         ! 3.3 Redistribute area, volume, and energy. 
    … …  
    276272         ! 3.4 Compute total area of ice plus open water after ridging. 
    277273         !-----------------------------------------------------------------------------! 
    278  
    279          CALL lim_itd_me_asumr 
     274         ! This is in general not equal to one because of divergence during transport 
     275         asum(:,:) = ato_i(:,:) 
     276         DO jl = 1, jpl 
     277            asum(:,:) = asum(:,:) + a_i(:,:,jl) 
     278         END DO 
    280279 
    281280         ! 3.5 Do we keep on iterating ??? 
    … …  
    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 
    … …  
    347341 
    348342      ! Check if there is a ridging error 
    349       DO jj = 1, jpj 
    350          DO ji = 1, jpi 
    351             IF( ABS( asum(ji,jj) - kamax)  >  epsi10 ) THEN   ! there is a bug 
    352                WRITE(numout,*) ' ' 
    353                WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj) 
    354                WRITE(numout,*) ' limitd_me ' 
    355                WRITE(numout,*) ' POINT : ', ji, jj 
    356                WRITE(numout,*) ' jpl, a_i, athorn ' 
    357                WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0) 
    358                DO jl = 1, jpl 
    359                   WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl) 
    360                END DO 
    361             ENDIF  ! asum 
    362  
    363          END DO !ji 
    364       END DO !jj 
     343      IF( lwp ) THEN 
     344         DO jj = 1, jpj 
     345            DO ji = 1, jpi 
     346               IF( ABS( asum(ji,jj) - kamax)  >  epsi10 ) THEN   ! there is a bug 
     347                  WRITE(numout,*) ' ' 
     348                  WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj) 
     349                  WRITE(numout,*) ' limitd_me ' 
     350                  WRITE(numout,*) ' POINT : ', ji, jj 
     351                  WRITE(numout,*) ' jpl, a_i, athorn ' 
     352                  WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0) 
     353                  DO jl = 1, jpl 
     354                     WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl) 
     355                  END DO 
     356               ENDIF 
     357            END DO 
     358         END DO 
     359      END IF 
    365360 
    366361      ! Conservation check 
    … …  
    371366      ENDIF 
    372367 
     368      CALL lim_var_agg( 1 )  
     369 
    373370      !-----------------------------------------------------------------------------! 
    374       ! 6) Updating state variables and trend terms (done in limupdate) 
     371      ! control prints 
    375372      !-----------------------------------------------------------------------------! 
    376       CALL lim_var_glo2eqv 
    377       CALL lim_itd_me_zapsmall 
    378  
    379  
    380       IF(ln_ctl) THEN     ! Control print 
     373      IF(ln_ctl) THEN  
     374         CALL lim_var_glo2eqv 
     375 
    381376         CALL prt_ctl_info(' ') 
    382377         CALL prt_ctl_info(' - Cell values : ') 
    383378         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    384          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_me  : cell area :') 
     379         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_me  : cell area :') 
    385380         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :') 
    386381         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :') 
    … …  
    436431      !!---------------------------------------------------------------------- 
    437432      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 
     433      INTEGER             ::   ji,jj, jl   ! dummy loop indices 
     434      INTEGER             ::   ksmooth     ! smoothing the resistance to deformation 
     435      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing 
     436      REAL(wp)            ::   zhi, zp, z1_3  ! local scalars 
    443437      REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here 
    444438      !!---------------------------------------------------------------------- 
    … …  
    466460                  ! 
    467461                  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) 
     462                     zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    469463                     !---------------------------- 
    470464                     ! PE loss from deforming ice 
    471465                     !---------------------------- 
    472                      strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * hi * hi 
     466                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * zhi * zhi 
    473467 
    474468                     !-------------------------- 
    475469                     ! PE gain from rafting ice 
    476470                     !-------------------------- 
    477                      strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * hi * hi 
     471                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * zhi * zhi 
    478472 
    479473                     !---------------------------- 
    480474                     ! PE gain from ridging ice 
    481475                     !---------------------------- 
    482                      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                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) / krdg(ji,jj,jl)     & 
     477                        * z1_3 * ( hrmax(ji,jj,jl)**2 + hrmin(ji,jj,jl)**2 +  hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )   
     478                        !!(a**3-b**3)/(a-b) = a*a+ab+b*b                       
     479                  ENDIF 
    486480                  ! 
    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  
     481               END DO 
     482            END DO 
     483         END DO 
     484    
     485         strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) 
     486                         ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 
    494487         ksmooth = 1 
    495488 
    … …  
    499492      ELSE                      ! kstrngth ne 1:  Hibler (1979) form 
    500493         ! 
    501          strength(:,:) = Pstar * vt_i(:,:) * EXP( - C_rhg * ( 1._wp - at_i(:,:) )  ) 
     494         strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  ) 
    502495         ! 
    503496         ksmooth = 1 
    … …  
    511504      ! CAN BE REMOVED 
    512505      ! 
    513       IF ( brinstren_swi == 1 ) THEN 
     506      IF( ln_icestr_bvf ) THEN 
    514507 
    515508         DO jj = 1, jpj 
    516509            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 
    522510               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 
     511            END DO 
     512         END DO 
    525513 
    526514      ENDIF 
    … …  
    538526         CALL lbc_lnk( strength, 'T', 1. ) 
    539527 
    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 
    544                   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 
     528         DO jj = 2, jpjm1 
     529            DO ji = 2, jpim1 
     530               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
     531                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & 
     532                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &   
     533                     &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) & 
     534                     &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 
    552535               ELSE 
    553536                  zworka(ji,jj) = 0._wp 
    … …  
    556539         END DO 
    557540 
    558          DO jj = 2, jpj - 1 
    559             DO ji = 2, jpi - 1 
     541         DO jj = 2, jpjm1 
     542            DO ji = 2, jpim1 
    560543               strength(ji,jj) = zworka(ji,jj) 
    561544            END DO 
    … …  
    563546         CALL lbc_lnk( strength, 'T', 1. ) 
    564547 
    565       ENDIF ! ksmooth 
     548      ENDIF 
    566549 
    567550      !-------------------- 
    … …  
    580563         DO jj = 1, jpj - 1 
    581564            DO ji = 1, jpi - 1 
    582                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN       ! ice is present 
     565               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
    583566                  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 
     567                  IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 
     568                  IF ( strp2(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 
    586569                  zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm 
    587570                  strp2(ji,jj) = strp1(ji,jj) 
    … …  
    612595      !!---------------------------------------------------------------------! 
    613596      INTEGER ::   ji,jj, jl    ! dummy loop indices 
    614       REAL(wp) ::   Gstari, astari, hi, hrmean, zdummy   ! local scalar 
     597      REAL(wp) ::   Gstari, astari, zhi, hrmean, zdummy   ! local scalar 
    615598      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here 
    616599      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n 
    … …  
    620603      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
    621604 
    622       Gstari     = 1.0/Gstar     
    623       astari     = 1.0/astar     
     605      Gstari     = 1.0/rn_gstar     
     606      astari     = 1.0/rn_astar     
    624607      aksum(:,:)    = 0.0 
    625608      athorn(:,:,:) = 0.0 
    … …  
    632615 
    633616      !     ! Zero out categories with very small areas 
    634       CALL lim_itd_me_zapsmall 
     617      CALL lim_var_zapsmall 
    635618 
    636619      !------------------------------------------------------------------------------! 
    … …  
    639622 
    640623      ! Compute total area of ice plus open water. 
    641       CALL lim_itd_me_asumr 
    642       ! This is in general not equal to one  
    643       ! because of divergence during transport 
     624      ! This is in general not equal to one because of divergence during transport 
     625      asum(:,:) = ato_i(:,:) 
     626      DO jl = 1, jpl 
     627         asum(:,:) = asum(:,:) + a_i(:,:,jl) 
     628      END DO 
    644629 
    645630      ! Compute cumulative thickness distribution function 
    … …  
    649634 
    650635      Gsum(:,:,-1) = 0._wp 
    651  
    652       DO jj = 1, jpj 
    653          DO ji = 1, jpi 
    654             IF( ato_i(ji,jj) > epsi10 ) THEN   ;   Gsum(ji,jj,0) = ato_i(ji,jj) 
    655             ELSE                               ;   Gsum(ji,jj,0) = 0._wp 
    656             ENDIF 
    657          END DO 
    658       END DO 
     636      Gsum(:,:,0 ) = ato_i(:,:) 
    659637 
    660638      ! for each value of h, you have to add ice concentration then 
    661639      DO jl = 1, jpl 
    662          DO jj = 1, jpj  
    663             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) 
    666                ENDIF 
    667             END DO 
    668          END DO 
     640         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 
    669641      END DO 
    670642 
    … …  
    687659      !----------------------------------------------------------------- 
    688660 
    689       IF( partfun_swi == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
     661      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    690662         DO jl = 0, jpl     
    691663            DO jj = 1, jpj  
    692664               DO ji = 1, jpi 
    693                   IF( Gsum(ji,jj,jl) < Gstar) THEN 
    694                      athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * & 
    695                         (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) 
     665                  IF( Gsum(ji,jj,jl) < rn_gstar) THEN 
     666                     athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * & 
     667                        &                        ( 2.0 - (Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari ) 
     668                  ELSEIF (Gsum(ji,jj,jl-1) < rn_gstar) THEN 
     669                     athorn(ji,jj,jl) = Gstari * ( rn_gstar - Gsum(ji,jj,jl-1) ) *  & 
     670                        &                        ( 2.0 - ( Gsum(ji,jj,jl-1) + rn_gstar ) * Gstari ) 
    699671                  ELSE 
    700672                     athorn(ji,jj,jl) = 0.0 
    701673                  ENDIF 
    702                END DO ! ji 
    703             END DO ! jj 
    704          END DO ! jl  
     674               END DO 
     675            END DO 
     676         END DO 
    705677 
    706678      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007) 
    707679         !                         
    708680         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array 
    709  
    710681         DO jl = -1, jpl 
    711682            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 
    712          END DO !jl 
     683         END DO 
    713684         DO jl = 0, jpl 
    714685             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 
    715686         END DO 
    716687         ! 
    717       ENDIF ! partfun_swi 
    718  
    719       IF( raft_swi == 1 ) THEN      ! Ridging and rafting ice participation functions 
     688      ENDIF 
     689 
     690      IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions 
    720691         ! 
    721692         DO jl = 1, jpl 
    722693            DO jj = 1, jpj  
    723694               DO ji = 1, jpi 
    724                   IF ( athorn(ji,jj,jl) .GT. 0._wp ) THEN 
     695                  IF ( athorn(ji,jj,jl) > 0._wp ) THEN 
    725696!!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) 
     697                     aridge(ji,jj,jl) = ( TANH (  rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 
     698                     araft (ji,jj,jl) = ( TANH ( -rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 
    728699                     IF ( araft(ji,jj,jl) < epsi06 )   araft(ji,jj,jl)  = 0._wp 
    729700                     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 
     701                  ENDIF 
     702               END DO 
     703            END DO 
     704         END DO 
     705 
     706      ELSE 
    736707         ! 
    737708         DO jl = 1, jpl 
    … …  
    741712      ENDIF 
    742713 
    743       IF ( raft_swi == 1 ) THEN 
    744  
    745          IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN 
     714      IF( ln_rafting ) THEN 
     715 
     716         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) > epsi10 .AND. lwp ) THEN 
    746717            DO jl = 1, jpl 
    747718               DO jj = 1, jpj 
    748719                  DO ji = 1, jpi 
    749                      IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. epsi10 ) THEN 
     720                     IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) > epsi10 ) THEN 
    750721                        WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 
    751722                        WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl 
    … …  
    793764            DO ji = 1, jpi 
    794765 
    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)) 
     766               IF (a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0.0 ) THEN 
     767                  zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     768                  hrmean          = MAX(SQRT(rn_hstar*zhi), zhi*krdgmin) 
     769                  hrmin(ji,jj,jl) = MIN(2.0*zhi, 0.5*(hrmean + zhi)) 
    799770                  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 
     771                  hraft(ji,jj,jl) = kraft*zhi 
     772                  krdg(ji,jj,jl)  = hrmean / zhi 
    802773               ELSE 
    803774                  hraft(ji,jj,jl) = 0.0 
    … …  
    807778               ENDIF 
    808779 
    809             END DO ! ji 
    810          END DO ! jj 
    811       END DO ! jl 
     780            END DO 
     781         END DO 
     782      END DO 
    812783 
    813784      ! Normalization factor : aksum, ensures mass conservation 
    … …  
    841812      LOGICAL, PARAMETER ::   l_conservation_check = .true.  ! if true, check conservation (useful for debugging) 
    842813      ! 
    843       LOGICAL ::   neg_ato_i      ! flag for ato_i(i,j) < -puny 
    844       LOGICAL ::   large_afrac    ! flag for afrac > 1 
    845       LOGICAL ::   large_afrft    ! flag for afrac > 1 
    846814      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices 
    847815      INTEGER ::   ij                ! horizontal index, combines i and j loops 
    848816      INTEGER ::   icells            ! number of cells with aicen > puny 
    849       REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration 
    850       REAL(wp) ::   zsstK            ! SST in Kelvin 
     817      REAL(wp) ::   hL, hR, farea, ztmelts    ! left and right limits of integration 
    851818 
    852819      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices 
    … …  
    864831      REAL(wp), POINTER, DIMENSION(:,:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges 
    865832      REAL(wp), POINTER, DIMENSION(:,:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice 
    866       REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! areal age content of ridged & rifging ice 
    867833      REAL(wp), POINTER, DIMENSION(:,:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2 
    868834 
    … …  
    873839      REAL(wp), POINTER, DIMENSION(:,:) ::   srdg2   ! sal*volume of new ridges 
    874840      REAL(wp), POINTER, DIMENSION(:,:) ::   smsw    ! sal*volume of water trapped into ridges 
     841      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! ice age of ice ridged 
    875842 
    876843      REAL(wp), POINTER, DIMENSION(:,:) ::   afrft            ! fraction of category area rafted 
    … …  
    878845      REAL(wp), POINTER, DIMENSION(:,:) ::   virft , vsrft    ! ice & snow volume of rafting ice 
    879846      REAL(wp), POINTER, DIMENSION(:,:) ::   esrft , smrft    ! snow energy & salinity of rafting ice 
    880       REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! areal age content of rafted ice & rafting ice 
     847      REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! ice age of ice rafted 
    881848 
    882849      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eirft      ! ice energy of rafting ice 
    … …  
    886853      !!---------------------------------------------------------------------- 
    887854 
    888       CALL wrk_alloc( (jpi+1)*(jpj+1),      indxi, indxj ) 
    889       CALL wrk_alloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final ) 
    890       CALL wrk_alloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 
    891       CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    892       CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    893       CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    894       CALL wrk_alloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
    895       CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
     855      CALL wrk_alloc( (jpi+1)*(jpj+1),       indxi, indxj ) 
     856      CALL wrk_alloc( jpi, jpj,              vice_init, vice_final, eice_init, eice_final ) 
     857      CALL wrk_alloc( jpi, jpj,              afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
     858      CALL wrk_alloc( jpi, jpj,              vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
     859      CALL wrk_alloc( jpi, jpj,              afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
     860      CALL wrk_alloc( jpi, jpj, jpl,         aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     861      CALL wrk_alloc( jpi, jpj, nlay_i,      eirft, erdg1, erdg2, ersw ) 
     862      CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init ) 
    896863 
    897864      ! Conservation check 
    … …  
    901868         CALL lim_column_sum        (jpl,    v_i,       vice_init ) 
    902869         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_init ) 
    903          DO ji = mi0(jiindx), mi1(jiindx) 
    904             DO jj = mj0(jjindx), mj1(jjindx) 
     870         DO ji = mi0(iiceprt), mi1(iiceprt) 
     871            DO jj = mj0(jiceprt), mj1(jiceprt) 
    905872               WRITE(numout,*) ' vice_init  : ', vice_init(ji,jj) 
    906873               WRITE(numout,*) ' eice_init  : ', eice_init(ji,jj) 
    … …  
    912879      ! 1) Compute change in open water area due to closing and opening. 
    913880      !------------------------------------------------------------------------------- 
    914  
    915       neg_ato_i = .false. 
    916  
    917881      DO jj = 1, jpj 
    918882         DO ji = 1, jpi 
    919883            ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice        & 
    920884               &                        + opning(ji,jj)                          * rdt_ice 
    921             IF( ato_i(ji,jj) < -epsi10 ) THEN 
    922                neg_ato_i = .TRUE. 
    923             ELSEIF( ato_i(ji,jj) < 0._wp ) THEN    ! roundoff error 
     885            IF    ( ato_i(ji,jj) < -epsi10 ) THEN    ! there is a bug 
     886               IF(lwp)   WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj) 
     887            ELSEIF( ato_i(ji,jj) < 0._wp   ) THEN    ! roundoff error 
    924888               ato_i(ji,jj) = 0._wp 
    925889            ENDIF 
    926          END DO !jj 
    927       END DO !ji 
    928  
    929       ! if negative open water area alert it 
    930       IF( neg_ato_i ) THEN       ! there is a bug 
    931          DO jj = 1, jpj  
    932             DO ji = 1, jpi 
    933                IF( ato_i(ji,jj) < -epsi10 ) THEN  
    934                   WRITE(numout,*) ''   
    935                   WRITE(numout,*) 'Ridging error: ato_i < 0' 
    936                   WRITE(numout,*) 'ato_i : ', ato_i(ji,jj) 
    937                ENDIF               ! ato_i < -epsi10 
    938             END DO 
    939          END DO 
    940       ENDIF 
     890         END DO 
     891      END DO 
    941892 
    942893      !----------------------------------------------------------------- 
    943894      ! 2) Save initial state variables 
    944895      !----------------------------------------------------------------- 
    945  
    946       DO jl = 1, jpl 
    947          aicen_init(:,:,jl) = a_i(:,:,jl) 
    948          vicen_init(:,:,jl) = v_i(:,:,jl) 
    949          vsnwn_init(:,:,jl) = v_s(:,:,jl) 
    950          ! 
    951          smv_i_init(:,:,jl) = smv_i(:,:,jl) 
    952          oa_i_init (:,:,jl) = oa_i (:,:,jl) 
    953       END DO !jl 
    954  
    955       esnwn_init(:,:,:) = e_s(:,:,1,:) 
    956  
    957       DO jl = 1, jpl   
    958          DO jk = 1, nlay_i 
    959             eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl) 
    960          END DO 
    961       END DO 
     896      aicen_init(:,:,:)   = a_i  (:,:,:) 
     897      vicen_init(:,:,:)   = v_i  (:,:,:) 
     898      vsnwn_init(:,:,:)   = v_s  (:,:,:) 
     899      smv_i_init(:,:,:)   = smv_i(:,:,:) 
     900      esnwn_init(:,:,:)   = e_s  (:,:,1,:) 
     901      eicen_init(:,:,:,:) = e_i  (:,:,:,:) 
     902      oa_i_init (:,:,:)   = oa_i (:,:,:) 
    962903 
    963904      ! 
    … …  
    982923                  indxi(icells) = ji 
    983924                  indxj(icells) = jj 
    984                ENDIF ! test on a_icen_init  
    985             END DO ! ji 
    986          END DO ! jj 
    987  
    988          large_afrac = .false. 
    989          large_afrft = .false. 
    990  
    991 !CDIR NODEP 
     925               ENDIF 
     926            END DO 
     927         END DO 
     928 
    992929         DO ij = 1, icells 
    993930            ji = indxi(ij) 
    … …  
    1003940            arft2(ji,jj) = arft1(ji,jj) / kraft 
    1004941 
    1005             oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    1006             oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    1007             oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1) 
    1008             oirft2(ji,jj)= oirft1(ji,jj) / kraft 
    1009  
    1010942            !--------------------------------------------------------------- 
    1011943            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1  
    … …  
    1015947            afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 
    1016948 
    1017             IF (afrac(ji,jj) > kamax + epsi10) THEN  !riging 
    1018                large_afrac = .true. 
    1019             ELSEIF (afrac(ji,jj) > kamax) THEN  ! roundoff error 
     949            IF( afrac(ji,jj) > kamax + epsi10 ) THEN  ! there is a bug 
     950               IF(lwp)   WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 
     951            ELSEIF( afrac(ji,jj) > kamax ) THEN       ! roundoff error 
    1020952               afrac(ji,jj) = kamax 
    1021953            ENDIF 
    1022             IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting 
    1023                large_afrft = .true. 
    1024             ELSEIF (afrft(ji,jj) > kamax) THEN  ! roundoff error 
     954 
     955            IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug 
     956               IF(lwp)   WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)  
     957            ELSEIF( afrft(ji,jj) > kamax) THEN       ! roundoff error 
    1025958               afrft(ji,jj) = kamax 
    1026959            ENDIF 
    … …  
    1031964            !-------------------------------------------------------------------------- 
    1032965            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 
    1035  
    1036             vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    1037             esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    1038             srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
    1039             srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 
     966            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + rn_por_rdg ) 
     967            vsw  (ji,jj) = vrdg1(ji,jj) * rn_por_rdg 
     968 
     969            vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     970            esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     971            srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
     972            oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) 
     973            oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1)  
    1040974 
    1041975            ! rafting volumes, heat contents ... 
    1042             virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
    1043             vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    1044             esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    1045             smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
     976            virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
     977            vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     978            esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     979            smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
     980            oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj)  
     981            oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft  
    1046982 
    1047983            ! substract everything 
    1048             a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1(ji,jj)  - arft1(ji,jj) 
    1049             v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1(ji,jj)  - virft(ji,jj) 
    1050             v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg(ji,jj)  - vsrft(ji,jj) 
    1051             e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg(ji,jj)  - esrft(ji,jj) 
     984            a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1 (ji,jj) - arft1 (ji,jj) 
     985            v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1 (ji,jj) - virft (ji,jj) 
     986            v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg (ji,jj) - vsrft (ji,jj) 
     987            e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj) 
     988            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj) 
    1052989            oa_i(ji,jj,jl1)  = oa_i(ji,jj,jl1)  - oirdg1(ji,jj) - oirft1(ji,jj) 
    1053             smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj)  - smrft(ji,jj) 
    1054990 
    1055991            !----------------------------------------------------------------- 
    1056992            ! 3.5) Compute properties of new ridges 
    1057993            !----------------------------------------------------------------- 
    1058             !------------- 
     994            !--------- 
    1059995            ! Salinity 
    1060             !------------- 
     996            !--------- 
    1061997            smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014 
    1062998            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
    1063999 
    1064             !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
     1000            !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
    10651001             
    10661002            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
    1067             wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! gurvan: increase in ice volume du to seawater frozen in voids              
     1003            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! increase in ice volume du to seawater frozen in voids              
    10681004 
    10691005            !------------------------------------             
    … …  
    10911027            !           ij looping 1-icells 
    10921028 
    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)           
     1029            msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-rn_fsnowrdg)   &   ! rafting included 
     1030               &                                + rhosn*vsrft(ji,jj)*(1.0-rn_fsnowrft) 
     1031 
     1032            ! in J/m2 (same as e_s) 
     1033            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-rn_fsnowrdg)         &   !rafting included 
     1034               &                                - esrft(ji,jj)*(1.0-rn_fsnowrft)           
    10991035 
    11001036            !----------------------------------------------------------------- 
    … …  
    11091045            dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) 
    11101046 
    1111          END DO                 ! ij 
     1047         END DO 
    11121048 
    11131049         !-------------------------------------------------------------------- 
    … …  
    11161052         !-------------------------------------------------------------------- 
    11171053         DO jk = 1, nlay_i 
    1118 !CDIR NODEP 
    11191054            DO ij = 1, icells 
    11201055               ji = indxi(ij) 
    … …  
    11281063               ! enthalpy of the trapped seawater (J/m2, >0) 
    11291064               ! clem: if sst>0, then ersw <0 (is that possible?) 
    1130                zsstK  = sst_m(ji,jj) + rt0 
    1131                ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i ) 
     1065               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * sst_m(ji,jj) * r1_nlay_i 
    11321066 
    11331067               ! heat flux to the ocean 
    11341068               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux  
    11351069 
    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  
     1070               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 
    11441071               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
    11451072 
    1146             END DO ! ij 
    1147          END DO !jk 
     1073            END DO 
     1074         END DO 
    11481075 
    11491076 
    11501077         IF( con_i ) THEN 
    11511078            DO jk = 1, nlay_i 
    1152 !CDIR NODEP 
    11531079               DO ij = 1, icells 
    11541080                  ji = indxi(ij) 
    11551081                  jj = indxj(ij) 
    11561082                  eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk) 
    1157                END DO ! ij 
    1158             END DO !jk 
    1159          ENDIF 
    1160  
    1161          IF( large_afrac ) THEN   ! there is a bug 
    1162 !CDIR NODEP 
    1163             DO ij = 1, icells 
    1164                ji = indxi(ij) 
    1165                jj = indxj(ij) 
    1166                IF( afrac(ji,jj) > kamax + epsi10 ) THEN  
    1167                   WRITE(numout,*) '' 
    1168                   WRITE(numout,*) ' ardg > a_i' 
    1169                   WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 
    1170                ENDIF 
    1171             END DO 
    1172          ENDIF 
    1173          IF( large_afrft ) THEN  ! there is a bug 
    1174 !CDIR NODEP 
    1175             DO ij = 1, icells 
    1176                ji = indxi(ij) 
    1177                jj = indxj(ij) 
    1178                IF( afrft(ji,jj) > kamax + epsi10 ) THEN  
    1179                   WRITE(numout,*) '' 
    1180                   WRITE(numout,*) ' arft > a_i' 
    1181                   WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 
    1182                ENDIF 
     1083               END DO 
    11831084            END DO 
    11841085         ENDIF 
    … …  
    11901091         DO jl2  = 1, jpl  
    11911092            ! over categories to which ridged ice is transferred 
    1192 !CDIR NODEP 
    11931093            DO ij = 1, icells 
    11941094               ji = indxi(ij) 
    … …  
    11991099               ! Transfer area, volume, and energy accordingly. 
    12001100 
    1201                IF( hrmin(ji,jj,jl1) >= hi_max(jl2)  .OR.        & 
    1202                    hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN 
     1101               IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR. hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN 
    12031102                  hL = 0._wp 
    12041103                  hR = 0._wp 
    … …  
    12141113               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ardg2 (ji,jj) * farea 
    12151114               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 
     1115               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg 
     1116               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg 
    12181117               smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + srdg2 (ji,jj) * fvol(ji,jj) 
    12191118               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea 
    12201119 
    1221             END DO ! ij 
     1120            END DO 
    12221121 
    12231122            ! Transfer ice energy to category jl2 by ridging 
    12241123            DO jk = 1, nlay_i 
    1225 !CDIR NODEP 
    12261124               DO ij = 1, icells 
    12271125                  ji = indxi(ij) 
    12281126                  jj = indxj(ij) 
    1229                   e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj)*erdg2(ji,jj,jk) 
     1127                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj) * erdg2(ji,jj,jk) 
    12301128               END DO 
    12311129            END DO 
    … …  
    12351133         DO jl2 = 1, jpl  
    12361134 
    1237 !CDIR NODEP 
    12381135            DO ij = 1, icells 
    12391136               ji = indxi(ij) 
    … …  
    12421139               ! thickness category jl2, transfer area, volume, and energy accordingly. 
    12431140               ! 
    1244                IF( hraft(ji,jj,jl1) <= hi_max(jl2)  .AND.        & 
    1245                    hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN 
     1141               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN 
    12461142                  a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + arft2 (ji,jj) 
    12471143                  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 
     1144                  v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * rn_fsnowrft 
     1145                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft 
    12501146                  smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)     
    1251                   oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)     
    1252                ENDIF ! hraft 
     1147                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj) 
     1148               ENDIF 
    12531149               ! 
    1254             END DO ! ij 
     1150            END DO 
    12551151 
    12561152            ! Transfer rafted ice energy to category jl2  
    12571153            DO jk = 1, nlay_i 
    1258 !CDIR NODEP 
    12591154               DO ij = 1, icells 
    12601155                  ji = indxi(ij) 
    12611156                  jj = indxj(ij) 
    1262                   IF(  hraft(ji,jj,jl1)  <=  hi_max(jl2)   .AND.        & 
    1263                        hraft(ji,jj,jl1)  >   hi_max(jl2-1)  ) THEN 
     1157                  IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1)  ) THEN 
    12641158                     e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk) 
    12651159                  ENDIF 
    1266                END DO           ! ij 
    1267             END DO !jk 
    1268  
    1269          END DO ! jl2 
     1160               END DO 
     1161            END DO 
     1162 
     1163         END DO 
    12701164 
    12711165      END DO ! jl1 (deforming categories) 
    … …  
    12811175         CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid)  
    12821176 
    1283          DO ji = mi0(jiindx), mi1(jiindx) 
    1284             DO jj = mj0(jjindx), mj1(jjindx) 
     1177         DO ji = mi0(iiceprt), mi1(iiceprt) 
     1178            DO jj = mj0(jiceprt), mj1(jiceprt) 
    12851179               WRITE(numout,*) ' vice_init  : ', vice_init (ji,jj) 
    12861180               WRITE(numout,*) ' vice_final : ', vice_final(ji,jj) 
    … …  
    12911185      ENDIF 
    12921186      ! 
    1293       CALL wrk_dealloc( (jpi+1)*(jpj+1),      indxi, indxj ) 
    1294       CALL wrk_dealloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final ) 
    1295       CALL wrk_dealloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 
    1296       CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    1297       CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    1298       CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    1299       CALL wrk_dealloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
    1300       CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
     1187      CALL wrk_dealloc( (jpi+1)*(jpj+1),        indxi, indxj ) 
     1188      CALL wrk_dealloc( jpi, jpj,               vice_init, vice_final, eice_init, eice_final ) 
     1189      CALL wrk_dealloc( jpi, jpj,               afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
     1190      CALL wrk_dealloc( jpi, jpj,               vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
     1191      CALL wrk_dealloc( jpi, jpj,               afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
     1192      CALL wrk_dealloc( jpi, jpj, jpl,          aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     1193      CALL wrk_dealloc( jpi, jpj, nlay_i,       eirft, erdg1, erdg2, ersw ) 
     1194      CALL wrk_dealloc( jpi, jpj, nlay_i, jpl, eicen_init ) 
    13011195      ! 
    13021196   END SUBROUTINE lim_itd_me_ridgeshift 
    1303  
    1304  
    1305    SUBROUTINE lim_itd_me_asumr 
    1306       !!----------------------------------------------------------------------------- 
    1307       !!                ***  ROUTINE lim_itd_me_asumr *** 
    1308       !! 
    1309       !! ** Purpose :   finds total fractional area 
    1310       !! 
    1311       !! ** Method  :   Find the total area of ice plus open water in each grid cell. 
    1312       !!              This is similar to the aggregate_area subroutine except that the 
    1313       !!              total area can be greater than 1, so the open water area is  
    1314       !!              included in the sum instead of being computed as a residual.  
    1315       !!----------------------------------------------------------------------------- 
    1316       INTEGER ::   jl   ! dummy loop index 
    1317       !!----------------------------------------------------------------------------- 
    1318       ! 
    1319       asum(:,:) = ato_i(:,:)                    ! open water 
    1320       DO jl = 1, jpl                            ! ice categories 
    1321          asum(:,:) = asum(:,:) + a_i(:,:,jl) 
    1322       END DO 
    1323       ! 
    1324    END SUBROUTINE lim_itd_me_asumr 
    1325  
    13261197 
    13271198   SUBROUTINE lim_itd_me_init 
    … …  
    13391210      !!------------------------------------------------------------------- 
    13401211      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 
     1212      NAMELIST/namiceitdme/ rn_cs, rn_fsnowrdg, rn_fsnowrft,              &  
     1213        &                   rn_gstar, rn_astar, rn_hstar, ln_rafting, rn_hraft, rn_craft, rn_por_rdg, & 
     1214        &                   nn_partfun 
    13441215      !!------------------------------------------------------------------- 
    13451216      ! 
    … …  
    13571228         WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution ' 
    13581229         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 
     1230         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        rn_cs       = ', rn_cs  
     1231         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg  
     1232         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft  
     1233         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar 
     1234         WRITE(numout,*)'   Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar 
     1235         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar 
     1236         WRITE(numout,*)'   Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting 
     1237         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft 
     1238         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  rn_craft    = ', rn_craft   
     1239         WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg 
     1240         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun 
    13731241      ENDIF 
    13741242      ! 
    13751243   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 
    14851244 
    14861245#else 
    … …  
    14931252   SUBROUTINE lim_itd_me_icestrength 
    14941253   END SUBROUTINE lim_itd_me_icestrength 
    1495    SUBROUTINE lim_itd_me_sort 
    1496    END SUBROUTINE lim_itd_me_sort 
    14971254   SUBROUTINE lim_itd_me_init 
    14981255   END SUBROUTINE lim_itd_me_init 
    1499    SUBROUTINE lim_itd_me_zapsmall 
    1500    END SUBROUTINE lim_itd_me_zapsmall 
    15011256#endif 
    15021257   !!====================================================================== 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r4990 r5682  
    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 
    30    USE limcons          ! LIM-3 conservation 
    3127   USE prtctl           ! Print control 
    3228   USE in_out_manager   ! I/O manager 
    … …  
    3430   USE wrk_nemo         ! work arrays 
    3531   USE lib_fortran      ! to use key_nosignedzero 
    36    USE timing          ! Timing 
    37    USE limcons        ! conservation tests 
     32   USE limcons          ! conservation tests 
    3833 
    3934   IMPLICIT NONE 
    4035   PRIVATE 
    4136 
    42    PUBLIC   lim_itd_th         ! called by ice_stp 
    4337   PUBLIC   lim_itd_th_rem 
    4438   PUBLIC   lim_itd_th_reb 
    45    PUBLIC   lim_itd_fitline 
    46    PUBLIC   lim_itd_shiftice 
    4739 
    4840   !!---------------------------------------------------------------------- 
    … …  
    5345CONTAINS 
    5446 
    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    ! 
    134  
    13547   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt ) 
    13648      !!------------------------------------------------------------------ 
    … …  
    15365      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars 
    15466      REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      - 
    155       REAL(wp) ::   zx3,             zareamin          !   -      - 
     67      REAL(wp) ::   zx3         
    15668      CHARACTER (len = 15) :: fieldid 
    15769 
    … …  
    17991      !!------------------------------------------------------------------ 
    18092 
    181       CALL wrk_alloc( jpi,jpj, zremap_flag )    ! integer 
    182       CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer 
     93      CALL wrk_alloc( jpi,jpj, zremap_flag ) 
     94      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) 
    18395      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    18496      CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    18597      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    18698      CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    187       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer  
     99      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    188100      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 ) 
    189  
    190       zareamin = epsi10   !minimum area in thickness categories tolerated by the conceptors of the model 
    191101 
    192102      !!---------------------------------------------------------------------------------------------- 
    … …  
    216126         DO jj = 1, jpj 
    217127            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 
     128               rswitch           = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) )     !0 if no ice and 1 if yes 
    219129               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 
     130               rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) ) 
    221131               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 
    222                IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)  
     132               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) ! clem: useless IF statement?  
    223133            END DO 
    224134         END DO 
    … …  
    239149      DO jj = 1, jpj 
    240150         DO ji = 1, jpi 
    241             IF ( at_i(ji,jj) .gt. zareamin ) THEN 
     151            IF ( at_i(ji,jj) > epsi10 ) THEN 
    242152               nbrem         = nbrem + 1 
    243153               nind_i(nbrem) = ji 
    … …  
    247157               zremap_flag(ji,jj) = 0 
    248158            ENDIF 
    249          END DO !ji 
    250       END DO !jj 
     159         END DO 
     160      END DO 
    251161 
    252162      !----------------------------------------------------------------------------------------------- 
    … …  
    254164      !----------------------------------------------------------------------------------------------- 
    255165      !- 4.1 Compute category boundaries 
    256       ! Tricky trick see limitd_me.F90 
    257       ! will be soon removed, CT 
    258       ! hi_max(kubnd) = 99. 
    259166      zhbnew(:,:,:) = 0._wp 
    260167 
    … …  
    265172            ! 
    266173            zhbnew(ii,ij,jl) = hi_max(jl) 
    267             IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 
     174            IF    ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 
    268175               !interpolate between adjacent category growth rates 
    269176               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) ) 
    270177               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) ) 
    271             ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN 
     178            ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN 
    272179               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 
    273             ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN 
     180            ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN 
    274181               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 
    275182            ENDIF 
    … …  
    280187            ii = nind_i(ji) 
    281188            ij = nind_j(ji) 
    282             IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 
     189 
     190            ! clem: we do not want ht_i to be too close to either HR or HL otherwise a division by nearly 0 is possible  
     191            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
     192            IF    ( a_i(ii,ij,jl  ) > epsi10 .AND. ht_i(ii,ij,jl  ) > ( zhbnew(ii,ij,jl) - epsi10 ) ) THEN 
    283193               zremap_flag(ii,ij) = 0 
    284             ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 
     194            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN 
    285195               zremap_flag(ii,ij) = 0 
    286196            ENDIF 
    287197 
    288198            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max   
     199            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
    289200            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 
    290             IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
    291          END DO 
    292  
    293       END DO !jl 
     201            ! clem bug: why is not the following instead? 
     202            !!IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     203            !!IF( zhbnew(ii,ij,jl) > hi_max(jl  ) ) zremap_flag(ii,ij) = 0 
     204  
     205         END DO 
     206 
     207      END DO 
    294208 
    295209      !----------------------------------------------------------------------------------------------- 
    … …  
    312226      DO jj = 1, jpj 
    313227         DO ji = 1, jpi 
    314             zhb0(ji,jj) = hi_max(0) ! 0eme 
    315             zhb1(ji,jj) = hi_max(1) ! 1er 
    316  
    317             zhbnew(ji,jj,klbnd-1) = 0._wp 
     228            zhb0(ji,jj) = hi_max(0) 
     229            zhb1(ji,jj) = hi_max(1) 
    318230 
    319231            IF( a_i(ji,jj,kubnd) > epsi10 ) THEN 
    320                zhbnew(ji,jj,kubnd) = 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) 
     232               zhbnew(ji,jj,kubnd) = MAX( hi_max(kubnd-1), 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) ) 
    321233            ELSE 
    322                zhbnew(ji,jj,kubnd) = hi_max(kubnd)   
    323                !!? clem bug: since hi_max(jpl)=99, this limit is very high  
    324                !!? but I think it is erased in fitline subroutine  
    325             ENDIF 
    326  
    327             IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
    328  
    329          END DO !jj 
    330       END DO !jj 
     234!clem bug               zhbnew(ji,jj,kubnd) = hi_max(kubnd)   
     235               zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) ! not used anyway 
     236            ENDIF 
     237 
     238            ! clem: we do not want ht_i_b to be too close to either HR or HL otherwise a division by nearly 0 is possible  
     239            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
     240            IF    ( zht_i_b(ji,jj,klbnd) < ( zhb0(ji,jj) + epsi10 ) )  THEN 
     241               zremap_flag(ji,jj) = 0 
     242            ELSEIF( zht_i_b(ji,jj,klbnd) > ( zhb1(ji,jj) - epsi10 ) )  THEN 
     243               zremap_flag(ji,jj) = 0 
     244            ENDIF 
     245 
     246         END DO 
     247      END DO 
    331248 
    332249      !----------------------------------------------------------------------------------------------- 
    … …  
    334251      !----------------------------------------------------------------------------------------------- 
    335252      !- 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),   & 
     253      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   & 
    338254         &                  hR(:,:,klbnd), zremap_flag ) 
    339255 
    … …  
    343259         ij = nind_j(ji)  
    344260 
    345          !ji 
    346          IF (a_i(ii,ij,klbnd) .gt. epsi10) THEN 
     261         IF( a_i(ii,ij,klbnd) > epsi10 ) THEN 
     262 
    347263            zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category 
    348             ! ji, a_i > epsi10 
    349             IF (zdh0 .lt. 0.0) THEN !remove area from category 1 
    350                ! ji, a_i > epsi10; zdh0 < 0 
    351                zdh0 = MIN(-zdh0,hi_max(klbnd)) 
    352  
     264 
     265            IF( zdh0 < 0.0 ) THEN      !remove area from category 1 
     266               zdh0 = MIN( -zdh0, hi_max(klbnd) ) 
    353267               !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 
    356                   zx1  = zetamax 
    357                   zx2  = 0.5 * zetamax*zetamax  
    358                   zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed 
    359                   ! 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 
    362                   !ice area lost due to melting of thin ice 
    363                   zda0   = MIN(zda0, zdamax) 
    364  
     268               zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd) 
     269 
     270               IF( zetamax > 0.0 ) THEN 
     271                  zx1    = zetamax 
     272                  zx2    = 0.5 * zetamax * zetamax  
     273                  zda0   = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1                        ! ice area removed 
     274                  zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! Constrain new thickness <= ht_i                 
     275                  zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting  
     276                                                                                                !     of thin ice (zdamax > 0) 
    365277                  ! 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 ) 
     278                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) 
    368279                  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 
    371                ! ji, a_i > epsi10 
    372  
    373             ELSE ! if ice accretion 
    374                ! ji, a_i > epsi10; zdh0 > 0 
    375                zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
    376                ! zhbnew was 0, and is shifted to the right to account for thin ice 
    377                ! growth in openwater (F0 = f1) 
    378             ENDIF ! zdh0  
    379  
    380             ! a_i > epsi10 
    381          ENDIF ! a_i > epsi10 
    382  
    383       END DO ! ji 
     280                  v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) * ht_i(ii,ij,klbnd) ! clem-useless ? 
     281               ENDIF 
     282 
     283            ELSE ! if ice accretion zdh0 > 0 
     284               ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1) 
     285               zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) )  
     286            ENDIF 
     287 
     288         ENDIF 
     289 
     290      END DO 
    384291 
    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 
    409  
     315            IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1 
    410316               ! 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) 
     317               zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl) 
     318               zvetamax(ji) = MIN( zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl) 
    413319               zdonor(ii,ij,jl) = jl 
    414320 
    415             ELSE  ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    416  
     321            ELSE                                    ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    417322               ! left and right integration limits in eta space 
    418323               zvetamin(ji) = 0.0 
    419                zvetamax(ji) = MIN(hi_max(jl), hR(ii,ij,jl+1)) - hL(ii,ij,jl+1) 
     324               zvetamax(ji) = MIN( hi_max(jl), hR(ii,ij,jl+1) ) - hL(ii,ij,jl+1) 
    420325               zdonor(ii,ij,jl) = jl + 1 
    421326 
    422             ENDIF  ! zhbnew(jl) > hi_max(jl) 
    423  
    424             zetamax = MAX(zvetamax(ji), zvetamin(ji)) ! no transfer if etamax < etamin 
     327            ENDIF 
     328 
     329            zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin 
    425330            zetamin = zvetamin(ji) 
    426331 
    427332            zx1  = zetamax - zetamin 
    428             zwk1 = zetamin*zetamin 
    429             zwk2 = zetamax*zetamax 
    430             zx2  = 0.5 * (zwk2 - zwk1) 
     333            zwk1 = zetamin * zetamin 
     334            zwk2 = zetamax * zetamax 
     335            zx2  = 0.5 * ( zwk2 - zwk1 ) 
    431336            zwk1 = zwk1 * zetamin 
    432337            zwk2 = zwk2 * zetamax 
    433             zx3  = 1.0/3.0 * (zwk2 - zwk1) 
     338            zx3  = 1.0 / 3.0 * ( zwk2 - zwk1 ) 
    434339            nd   = zdonor(ii,ij,jl) 
    435340            zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 
    436341            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 
    437342 
    438          END DO ! ji 
    439       END DO ! jl klbnd -> kubnd - 1 
     343         END DO 
     344      END DO 
    440345 
    441346      !!---------------------------------------------------------------------------------------------- 
    … …  
    451356         ii = nind_i(ji) 
    452357         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 
     358         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < rn_himin ) THEN 
     359            a_i (ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin  
     360            ht_i(ii,ij,1) = rn_himin 
    456361         ENDIF 
    457       END DO !ji 
     362      END DO 
    458363 
    459364      !!---------------------------------------------------------------------------------------------- 
    … …  
    479384      ENDIF 
    480385 
    481       CALL wrk_dealloc( jpi,jpj, zremap_flag )    ! integer 
    482       CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer 
     386      CALL wrk_dealloc( jpi,jpj, zremap_flag ) 
     387      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) 
    483388      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    484389      CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    485390      CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    486391      CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    487       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer  
     392      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    488393      CALL wrk_dealloc( 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 ) 
    489394 
    … …  
    491396 
    492397 
    493    SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice,   & 
    494       &                        g0, g1, hL, hR, zremap_flag ) 
     398   SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag ) 
    495399      !!------------------------------------------------------------------ 
    496400      !!                ***  ROUTINE lim_itd_fitline *** 
    … …  
    511415      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) ::   zremap_flag  ! 
    512416      ! 
    513       INTEGER ::   ji,jj           ! horizontal indices 
     417      INTEGER  ::   ji,jj        ! horizontal indices 
    514418      REAL(wp) ::   zh13         ! HbL + 1/3 * (HbR - HbL) 
    515419      REAL(wp) ::   zh23         ! HbL + 2/3 * (HbR - HbL) 
    … …  
    518422      !!------------------------------------------------------------------ 
    519423      ! 
    520       ! 
    521424      DO jj = 1, jpj 
    522425         DO ji = 1, jpi 
    523426            ! 
    524427            IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10   & 
    525                &                        .AND. hice(ji,jj)        > 0._wp     ) THEN 
     428               &                        .AND. hice(ji,jj)        > 0._wp ) THEN 
    526429 
    527430               ! Initialize hL and hR 
    528  
    529431               hL(ji,jj) = HbL(ji,jj) 
    530432               hR(ji,jj) = HbR(ji,jj) 
    531433 
    532434               ! Change hL or hR if hice falls outside central third of range 
    533  
    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)) 
     435               zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) ) 
     436               zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) ) 
    536437 
    537438               IF    ( hice(ji,jj) < zh13 ) THEN   ;   hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj) 
    … …  
    540441 
    541442               ! Compute coefficients of g(eta) = g0 + g1*eta 
    542  
    543443               zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj)) 
    544444               zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr 
    545445               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) 
     446               g0(ji,jj) = zwk1 * ( 2._wp / 3._wp - zwk2 ) 
     447               g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 ) 
    548448               ! 
    549             ELSE                   ! remap_flag = .false. or a_i < epsi10  
     449            ELSE  ! remap_flag = .false. or a_i < epsi10  
    550450               hL(ji,jj) = 0._wp 
    551451               hR(ji,jj) = 0._wp 
    552452               g0(ji,jj) = 0._wp 
    553453               g1(ji,jj) = 0._wp 
    554             ENDIF                  ! a_i > epsi10 
     454            ENDIF 
    555455            ! 
    556456         END DO 
    … …  
    576476 
    577477      INTEGER ::   ji, jj, jl, jl2, jl1, jk   ! dummy loop indices 
    578       INTEGER ::   ii, ij          ! indices when changing from 2D-1D is done 
     478      INTEGER ::   ii, ij                     ! indices when changing from 2D-1D is done 
    579479 
    580480      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn 
    … …  
    589489      INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions 
    590490 
    591       INTEGER ::   nbrem             ! number of cells with ice to transfer 
    592  
    593       LOGICAL ::   zdaice_negative         ! true if daice < -puny 
    594       LOGICAL ::   zdvice_negative         ! true if dvice < -puny 
    595       LOGICAL ::   zdaice_greater_aicen    ! true if daice > aicen 
    596       LOGICAL ::   zdvice_greater_vicen    ! true if dvice > vicen 
     491      INTEGER  ::   nbrem             ! number of cells with ice to transfer 
    597492      !!------------------------------------------------------------------ 
    598493 
    599494      CALL wrk_alloc( jpi,jpj,jpl, zaTsfn ) 
    600495      CALL wrk_alloc( jpi,jpj, zworka ) 
    601       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
     496      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    602497 
    603498      !---------------------------------------------------------------------------------------------- 
    … …  
    606501 
    607502      DO jl = klbnd, kubnd 
    608          zaTsfn(:,:,jl) = a_i(:,:,jl)*t_su(:,:,jl) 
    609       END DO 
    610  
    611       !---------------------------------------------------------------------------------------------- 
    612       ! 2) Check for daice or dvice out of range, allowing for roundoff error 
    613       !---------------------------------------------------------------------------------------------- 
    614       ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl 
    615       ! has a small area, with h(n) very close to a boundary.  Then 
    616       ! the coefficients of g(h) are large, and the computed daice and 
    617       ! dvice can be in error. If this happens, it is best to transfer 
    618       ! either the entire category or nothing at all, depending on which 
    619       ! side of the boundary hice(n) lies. 
    620       !----------------------------------------------------------------- 
    621       DO jl = klbnd, kubnd-1 
    622  
    623          zdaice_negative = .false. 
    624          zdvice_negative = .false. 
    625          zdaice_greater_aicen = .false. 
    626          zdvice_greater_vicen = .false. 
    627  
    628          DO jj = 1, jpj 
    629             DO ji = 1, jpi 
    630  
    631                IF (zdonor(ji,jj,jl) .GT. 0) THEN 
    632                   jl1 = zdonor(ji,jj,jl) 
    633  
    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                                                              
    640                            zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category 
    641                            zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
    642                         ELSE 
    643                            zdaice(ji,jj,jl) = 0.0 ! shift no ice 
    644                            zdvice(ji,jj,jl) = 0.0 
    645                         ENDIF 
    646                      ELSE 
    647                         zdaice_negative = .true. 
    648                      ENDIF 
    649                   ENDIF 
    650  
    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 
    657                            zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category 
    658                            zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    659                         ELSE 
    660                            zdaice(ji,jj,jl) = 0.0    ! shift no ice 
    661                            zdvice(ji,jj,jl) = 0.0 
    662                         ENDIF 
    663                      ELSE 
    664                         zdvice_negative = .true. 
    665                      ENDIF 
    666                   ENDIF 
    667  
    668                   ! 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 
    671                         zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    672                         zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    673                      ELSE 
    674                         zdaice_greater_aicen = .true. 
    675                      ENDIF 
    676                   ENDIF 
    677  
    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 
    680                         zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    681                         zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    682                      ELSE 
    683                         zdvice_greater_vicen = .true. 
    684                      ENDIF 
    685                   ENDIF 
    686  
    687                ENDIF               ! donor > 0 
    688             END DO                   ! i 
    689          END DO                 ! j 
    690  
    691       END DO !jl 
     503         zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl) 
     504      END DO 
    692505 
    693506      !------------------------------------------------------------------------------- 
    694       ! 3) Transfer volume and energy between categories 
     507      ! 2) Transfer volume and energy between categories 
    695508      !------------------------------------------------------------------------------- 
    696509 
    … …  
    699512         DO jj = 1, jpj 
    700513            DO ji = 1, jpi 
    701                IF (zdaice(ji,jj,jl) .GT. 0.0 ) THEN ! daice(n) can be < puny 
     514               IF (zdaice(ji,jj,jl) > 0.0 ) THEN ! daice(n) can be < puny 
    702515                  nbrem = nbrem + 1 
    703516                  nind_i(nbrem) = ji 
    704517                  nind_j(nbrem) = jj 
    705                ENDIF ! tmask 
     518               ENDIF 
    706519            END DO 
    707520         END DO 
    … …  
    712525 
    713526            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 
     527            rswitch       = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi10 ) ) 
     528            zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch 
    716529            IF( jl1 == jl) THEN   ;   jl2 = jl1+1 
    717             ELSE                    ;   jl2 = jl  
     530            ELSE                  ;   jl2 = jl  
    718531            ENDIF 
    719532 
    … …  
    721534            ! Ice areas 
    722535            !-------------- 
    723  
    724536            a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl) 
    725537            a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl) 
    … …  
    728540            ! Ice volumes 
    729541            !-------------- 
    730  
    731542            v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl)  
    732543            v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl) 
    … …  
    735546            ! Snow volumes 
    736547            !-------------- 
    737  
    738548            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij) 
    739549            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 
    … …  
    743553            ! Snow heat content   
    744554            !-------------------- 
    745  
    746555            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
    747556            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow 
    … …  
    751560            ! Ice age  
    752561            !-------------- 
    753  
    754562            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
    755563            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice 
    … …  
    759567            ! Ice salinity 
    760568            !-------------- 
    761  
    762569            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij) 
    763570            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice 
    … …  
    767574            ! Surface temperature 
    768575            !--------------------- 
    769  
    770576            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
    771577            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf 
    772578            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf  
    773579 
    774          END DO                 ! ji 
     580         END DO 
    775581 
    776582         !------------------ 
    … …  
    779585 
    780586         DO jk = 1, nlay_i 
    781 !CDIR NODEP 
    782587            DO ji = 1, nbrem 
    783588               ii = nind_i(ji) 
    … …  
    785590 
    786591               jl1 = zdonor(ii,ij,jl) 
    787                IF (jl1 .EQ. jl) THEN 
     592               IF (jl1 == jl) THEN 
    788593                  jl2 = jl+1 
    789594               ELSE             ! n1 = n+1 
    … …  
    794599               e_i(ii,ij,jk,jl1) =  e_i(ii,ij,jk,jl1) - zdeice 
    795600               e_i(ii,ij,jk,jl2) =  e_i(ii,ij,jk,jl2) + zdeice  
    796             END DO              ! ji 
    797          END DO                 ! jk 
     601            END DO 
     602         END DO 
    798603 
    799604      END DO                   ! boundaries, 1 to ncat-1 
    … …  
    809614                  ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl)  
    810615                  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 
    812616               ELSE 
    813617                  ht_i(ji,jj,jl)  = 0._wp 
    814                   t_su(ji,jj,jl)  = rtt 
     618                  t_su(ji,jj,jl)  = rt0 
    815619               ENDIF 
    816             END DO                 ! ji 
    817          END DO                 ! jj 
    818       END DO                    ! jl 
     620            END DO 
     621         END DO 
     622      END DO 
    819623      ! 
    820624      CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn ) 
    821625      CALL wrk_dealloc( jpi,jpj, zworka ) 
    822       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
     626      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    823627      ! 
    824628   END SUBROUTINE lim_itd_shiftice 
    … …  
    846650      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories 
    847651      !!------------------------------------------------------------------ 
    848       !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate 
    849652       
    850653      CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger 
    … …  
    864667         DO jj = 1, jpj 
    865668            DO ji = 1, jpi  
    866                IF( a_i(ji,jj,jl) > epsi10 ) THEN  
    867                   ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    868                ELSE 
    869                   ht_i(ji,jj,jl) = 0._wp 
    870                ENDIF 
     669               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 
     670               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
    871671            END DO 
    872672         END DO 
    … …  
    874674 
    875675      !------------------------------------------------------------------------------ 
    876       ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd) 
    877       !------------------------------------------------------------------------------ 
    878       DO jj = 1, jpj  
    879          DO ji = 1, jpi  
    880             IF( a_i(ji,jj,klbnd) > epsi10 ) THEN 
    881                IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN 
    882                   a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max(0)  
    883                   ht_i(ji,jj,klbnd) = hi_max(0) 
    884                ENDIF 
    885             ENDIF 
    886          END DO 
    887       END DO 
    888  
    889       !------------------------------------------------------------------------------ 
    890       ! 3) If a category thickness is not in bounds, shift the 
     676      ! 2) If a category thickness is not in bounds, shift the 
    891677      ! entire area, volume, and energy to the neighboring category 
    892678      !------------------------------------------------------------------------------ 
    … …  
    917703                  zdonor(ji,jj,jl)  = jl  
    918704                  ! begin TECLIM change 
    919                   !zdaice(ji,jj,jl)  = a_i(ji,jj,jl) 
    920                   !zdvice(ji,jj,jl)  = v_i(ji,jj,jl) 
    921705                  !zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * 0.5_wp 
    922706                  !zdvice(ji,jj,jl)  = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1)) * 0.5_wp 
    923707                  ! end TECLIM change  
    924708                  ! clem: how much of a_i you send in cat sup is somewhat arbitrary 
    925                   zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi10 ) / ht_i(ji,jj,jl)   
    926                   zdvice(ji,jj,jl)  = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi10 ) 
     709                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi20 ) / ht_i(ji,jj,jl)   
     710                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi20 ) 
    927711               ENDIF 
    928             END DO                 ! ji 
    929          END DO                 ! jj 
     712            END DO 
     713         END DO 
    930714         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
    931715 
    … …  
    938722         ENDIF 
    939723         ! 
    940       END DO                    ! jl 
     724      END DO 
    941725 
    942726      !---------------------------- 
    … …  
    951735         zshiftflag = 0 
    952736 
    953 !clem-change 
    954737         DO jj = 1, jpj 
    955738            DO ji = 1, jpi 
    … …  
    961744                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
    962745               ENDIF 
    963             END DO                 ! ji 
    964          END DO                 ! jj 
     746            END DO 
     747         END DO 
    965748 
    966749         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
    … …  
    973756            zdvice(:,:,jl) = 0._wp 
    974757         ENDIF 
    975 !clem-change 
    976  
    977 !         ! clem-change begin: why not doing that? 
    978 !         DO jj = 1, jpj 
    979 !            DO ji = 1, jpi 
    980 !               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    981 !                  ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
    982 !                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    983 !               ENDIF 
    984 !            END DO                 ! ji 
    985 !         END DO                 ! jj 
    986          ! clem-change end 
    987  
    988       END DO                    ! jl 
     758 
     759      END DO 
    989760 
    990761      !------------------------------------------------------------------------------ 
    991       ! 4) Conservation check 
     762      ! 3) Conservation check 
    992763      !------------------------------------------------------------------------------ 
    993764 
    … …  
    1002773      ENDIF 
    1003774      ! 
    1004       CALL wrk_dealloc( jpi,jpj,jpl, zdonor )   ! interger 
     775      CALL wrk_dealloc( jpi,jpj,jpl, zdonor ) 
    1005776      CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice ) 
    1006777      CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final ) 
    … …  
    1013784   !!---------------------------------------------------------------------- 
    1014785CONTAINS 
    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 
    1019786   SUBROUTINE lim_itd_th_rem 
    1020787   END SUBROUTINE lim_itd_th_rem 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90

    r4161 r5682  
    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 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r4990 r5682  
    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 
     380         CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. )      ! lateral boundary cond. 
     381          
    404382         DO jj = k_j1+1, k_jpj-1 
    405 !CDIR NOVERRCHK 
    406383            DO ji = fs_2, fs_jpim1 
    407384 
    408385               !- 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 
     386               zdst          = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )   & 
     387                  &            + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1)   & 
     388                  &            ) * r1_e12t(ji,jj) 
     389 
     390               delta          = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )   
     391               delta_i(ji,jj) = delta + rn_creepl 
     392 
    435393               !- 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. ) 
    465  
     394               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)  & 
     395                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
     396                  &    ) * r1_e12f(ji,jj) 
     397 
     398               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)  & 
     399                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
     400                  &    ) * r1_e12f(ji,jj) 
     401 
     402               zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl 
     403 
     404               !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide). 
     405               zs1(ji,jj)  = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj)   * zpresh(ji,jj)   & 
     406                  &          ) * z1_dtotel 
     407               zs2(ji,jj)  = ( zs2 (ji,jj) + dtotel *         ecci * zdt(ji,jj) / delta_i(ji,jj)   * zpresh(ji,jj)   & 
     408                  &          ) * z1_dtotel 
     409               !-Calculate stress tensor component zs12 at corners 
     410               zs12(ji,jj) = ( zs12(ji,jj) + dtotel *         ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj)  & 
     411                  &          ) * z1_dtotel  
     412 
     413            END DO 
     414         END DO 
     415 
     416         CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 
     417  
    466418         ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 
    467419         DO jj = k_j1+1, k_jpj-1 
    468420            DO ji = fs_2, fs_jpim1 
    469421               !- 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) ) 
     422               zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 
     423                  &             + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj)          & 
     424                  &             + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) & 
     425                  &                ) * r1_e12u(ji,jj) 
    474426               ! 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) ) 
     427               zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)  & 
     428                  &             - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj)          & 
     429                  &             + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj)  & 
     430                  &               )  * r1_e12v(ji,jj) 
    480431            END DO 
    481432         END DO 
    … …  
    487438         IF (MOD(jter,2).eq.0) THEN  
    488439 
    489 !CDIR NOVERRCHK 
    490440            DO jj = k_j1+1, k_jpj-1 
    491 !CDIR NOVERRCHK 
    492441               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 
     442                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 
     443                  z0           = zmass1(ji,jj) * z1_dtevp 
    495444 
    496445                  ! 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 
     446                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji  ,jj)     & 
     447                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   & 
     448                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
     449                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  & 
     450                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 
     451                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 
     452                  zcca         = z0 + za 
    505453                  zccb         = zcorl1(ji,jj) 
    506                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    507  
     454                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
    508455               END DO 
    509456            END DO 
    … …  
    511458            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    512459#if defined key_agrif && defined key_lim2 
    513             CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     460            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
    514461#endif 
    515462#if defined key_bdy 
    … …  
    517464#endif          
    518465 
    519 !CDIR NOVERRCHK 
    520466            DO jj = k_j1+1, k_jpj-1 
    521 !CDIR NOVERRCHK 
    522467               DO ji = fs_2, fs_jpim1 
    523468 
    524                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    525                   z0           = zmass2(ji,jj)/dtevp 
     469                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 
     470                  z0           = zmass2(ji,jj) * z1_dtevp 
    526471                  ! 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 
     472                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       & 
     473                     &                 + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   & 
     474                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
     475                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  &  
     476                     &                         ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) ) 
     477                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 
     478                  zcca         = z0 + za 
    535479                  zccb         = zcorl2(ji,jj) 
    536                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    537  
     480                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    538481               END DO 
    539482            END DO 
    … …  
    541484            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    542485#if defined key_agrif && defined key_lim2 
    543             CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
     486            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    544487#endif 
    545488#if defined key_bdy 
    … …  
    548491 
    549492         ELSE  
    550 !CDIR NOVERRCHK 
    551493            DO jj = k_j1+1, k_jpj-1 
    552 !CDIR NOVERRCHK 
    553494               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 
     495                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 
     496                  z0           = zmass2(ji,jj) * z1_dtevp 
    556497                  ! 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 
     498                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       & 
     499                     &                  +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   & 
     500                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)    
     501 
     502                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  & 
     503                     &                         ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) ) 
     504                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 
     505                  zcca         = z0 + za 
    566506                  zccb         = zcorl2(ji,jj) 
    567                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    568  
     507                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    569508               END DO 
    570509            END DO 
    … …  
    572511            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    573512#if defined key_agrif && defined key_lim2 
    574             CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
     513            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    575514#endif 
    576515#if defined key_bdy 
    … …  
    578517#endif          
    579518 
    580 !CDIR NOVERRCHK 
    581519            DO jj = k_j1+1, k_jpj-1 
    582 !CDIR NOVERRCHK 
    583520               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 
     521                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 
     522                  z0           = zmass1(ji,jj) * z1_dtevp 
     523                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji,jj)       & 
     524                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   & 
     525                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
     526 
     527                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  & 
     528                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 
     529                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 
     530                  zcca         = z0 + za 
    595531                  zccb         = zcorl1(ji,jj) 
    596                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    597                END DO ! ji 
    598             END DO ! jj 
     532                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
     533               END DO 
     534            END DO 
    599535 
    600536            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    601537#if defined key_agrif && defined key_lim2 
    602             CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     538            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
    603539#endif 
    604540#if defined key_bdy 
    … …  
    611547            !---  Convergence test. 
    612548            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 ) ) 
     549               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
     550            END DO 
     551            zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) ) 
    617552            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain 
    618553         ENDIF 
    … …  
    625560      ! 4) Prevent ice velocities when the ice is thin 
    626561      !------------------------------------------------------------------------------! 
    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 
     562      ! If the ice volume is below zvmin then ice velocity should equal the 
     563      ! ocean velocity. This prevents high velocity when ice is thin 
    631564      DO jj = k_j1+1, k_jpj-1 
    632 !CDIR NOVERRCHK 
    633565         DO ji = fs_2, fs_jpim1 
    634             zdummy = vt_i(ji,jj) 
    635             IF ( zdummy .LE. hminrhg ) THEN 
     566            IF ( vt_i(ji,jj) <= zvmin ) THEN 
    636567               u_ice(ji,jj) = u_oce(ji,jj) 
    637568               v_ice(ji,jj) = v_oce(ji,jj) 
    638             ENDIF ! zdummy 
     569            ENDIF 
    639570         END DO 
    640571      END DO 
    641572 
    642       CALL lbc_lnk( u_ice(:,:), 'U', -1. )  
    643       CALL lbc_lnk( v_ice(:,:), 'V', -1. )  
     573      CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. ) 
     574 
    644575#if defined key_agrif && defined key_lim2 
    645       CALL agrif_rhg_lim2( nevp , nevp, 'U' ) 
    646       CALL agrif_rhg_lim2( nevp , nevp, 'V' ) 
     576      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' ) 
     577      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' ) 
    647578#endif 
    648579#if defined key_bdy 
    … …  
    653584      DO jj = k_j1+1, k_jpj-1  
    654585         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 
     586            IF ( vt_i(ji,jj) <= zvmin ) THEN 
     587               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji,  jj-1) ) * e1t(ji+1,jj)     & 
     588                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   & 
     589                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
     590 
     591               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     & 
     592                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   & 
     593                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
     594            ENDIF  
    665595         END DO 
    666596      END DO 
    667597 
    668       CALL lbc_lnk( u_ice2(:,:), 'V', -1. )  
    669       CALL lbc_lnk( v_ice1(:,:), 'U', -1. ) 
     598      CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. ) 
    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 
    738643 
    739644      ! Lateral boundary condition 
    740       CALL lbc_lnk( divu_i (:,:), 'T', 1. ) 
    741       CALL lbc_lnk( delta_i(:,:), 'T', 1. ) 
    742       ! CALL lbc_lnk( shear_i(:,:), 'F', 1. ) 
    743       CALL lbc_lnk( shear_i(:,:), 'T', 1. ) 
     645      CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1.,  shear_i(:,:), 'T', 1. ) 
    744646 
    745647      ! * Store the stress tensor for the next time step 
    … …  
    772674            DO jj = k_j1+1, k_jpj-1 
    773675               DO ji = 2, jpim1 
    774                   IF (zpresh(ji,jj) .GT. 1.0) THEN 
     676                  IF (zpresh(ji,jj) > 1.0) THEN 
    775677                     sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )  
    776678                     sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 
    … …  
    786688      ! 
    787689      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                ) 
     690      CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               ) 
    789691      CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
    790692      CALL wrk_dealloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r4990 r5682  
    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  
    … …  
    5555      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    5656      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     57      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file  
    5758      !!---------------------------------------------------------------------- 
    5859      ! 
    … …  
    6465      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    & 
    6566         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    66          ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    67          IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    68          ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     67         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
     68            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
     69            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     70            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     71            ENDIF 
     72            ! create the file 
     73            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
     74            clpath = TRIM(cn_icerst_outdir)  
     75            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/' 
     76            IF(lwp) THEN 
     77               WRITE(numout,*) 
     78               SELECT CASE ( jprstlib ) 
     79               CASE ( jprstdimg ) 
     80                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname 
     81               CASE DEFAULT 
     82                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname 
     83               END SELECT 
     84               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
     85                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
     86               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
     87               ENDIF 
     88            ENDIF 
     89            ! 
     90            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
     91            lrst_ice = .TRUE. 
    6992         ENDIF 
    70          ! create the file 
    71          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
    72          IF(lwp) THEN 
    73             WRITE(numout,*) 
    74             SELECT CASE ( jprstlib ) 
    75             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname 
    76             CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname 
    77             END SELECT 
    78             IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
    79                WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
    80             ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
    81             ENDIF 
    82          ENDIF 
    83          ! 
    84          CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
    85          lrst_ice = .TRUE. 
    8693      ENDIF 
    8794      ! 
     95      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print 
    8896   END SUBROUTINE lim_rst_opn 
    8997 
    … …  
    142150         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    143151      END DO 
    144        
     152 
    145153      DO jl = 1, jpl  
    146154         WRITE(zchar,'(I1)') jl 
    … …  
    165173      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  ) 
    166174      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 
     175      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass ) 
     176      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) 
    169177 
    170178      DO jl = 1, jpl  
    … …  
    306314      !! ** purpose  :   read of sea-ice variable restart in a netcdf file 
    307315      !!---------------------------------------------------------------------- 
    308       INTEGER :: ji, jj, jk, jl, indx 
     316      INTEGER :: ji, jj, jk, jl 
    309317      REAL(wp) ::   zfice, ziter 
    310       REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha   ! local scalars used for the salinity profile 
    311       REAL(wp), POINTER, DIMENSION(:)   ::   zs_zero  
    312318      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d 
    313319      CHARACTER(len=15) ::   znam 
    … …  
    317323      !!---------------------------------------------------------------------- 
    318324 
    319       CALL wrk_alloc( nlay_i, zs_zero ) 
    320325      CALL wrk_alloc( jpi, jpj, z2d ) 
    321326 
    … …  
    329334        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    330335        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90 
    331         INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
     336        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
    332337        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    333338      ENDIF 
    334339 
    335       CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib ) 
     340      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib ) 
    336341 
    337342      CALL iom_get( numrir, 'nn_fsbc', zfice ) 
    … …  
    395400      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  ) 
    396401      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 
     402      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass ) 
     403      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) 
    399404 
    400405      DO jl = 1, jpl  
    … …  
    521526      ! 
    522527      ! 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 
     528      !       I suspect something inconsistent in the main code with option nn_icesal=1 
     529      IF( nn_icesal == 1 ) THEN 
    525530         DO jl = 1, jpl  
    526             sm_i(:,:,jl) = bulk_sal 
     531            sm_i(:,:,jl) = rn_icesal 
    527532            DO jk = 1, nlay_i  
    528                s_i(:,:,jk,jl) = bulk_sal 
     533               s_i(:,:,jk,jl) = rn_icesal 
    529534            END DO 
    530535         END DO 
    … …  
    533538      !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 
    534539      ! 
    535       CALL wrk_dealloc( nlay_i, zs_zero ) 
    536540      CALL wrk_dealloc( jpi, jpj, z2d ) 
    537541      ! 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r5020 r5682  
    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 
    3230   USE sbc_oce          ! Surface boundary condition: ocean fields 
    3331   USE sbccpl 
    34    USE oce       , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     32   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    3533   USE albedo           ! albedo parameters 
    3634   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
    … …  
    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 
     44   USE limcons 
    4545 
    4646   IMPLICIT NONE 
    4747   PRIVATE 
    4848 
    49    PUBLIC   lim_sbc_init   ! called by ice_init 
     49   PUBLIC   lim_sbc_init   ! called by sbc_lim_init 
    5050   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim 
    5151   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
    … …  
    9494      !!              - fr_i    : ice fraction 
    9595      !!              - tn_ice  : sea-ice surface temperature 
    96       !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
     96      !!              - alb_ice : sea-ice albedo (only useful in coupled mode) 
    9797      !! 
    9898      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
    9999      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
    100100      !!              These refs are now obsolete since everything has been revised 
    101       !!              The ref should be Rousset et al., 2015? 
     101      !!              The ref should be Rousset et al., 2015 
    102102      !!--------------------------------------------------------------------- 
    103       INTEGER, INTENT(in) ::   kt                                   ! number of iteration 
    104       ! 
    105       INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices 
    106       ! 
    107       REAL(wp) ::   zemp                                            !  local scalars 
    108       REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    109       REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean 
     103      INTEGER, INTENT(in) ::   kt                                  ! number of iteration 
     104      INTEGER  ::   ji, jj, jl, jk                                 ! dummy loop indices 
     105      REAL(wp) ::   zqmass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     106      REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean 
    110107      ! 
    111108      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
    … …  
    113110 
    114111      ! make calls for heat fluxes before it is modified 
    115       IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface 
    116       IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface 
    117       IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux at ice surface 
    118       IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 
    119       IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux transmitted thru ice 
    120       IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )   
    121       IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 
     112      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
     113      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface 
     114      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface 
     115      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 
     116      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice 
     117      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )   
     118      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   & 
     119         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 
     120      IF( iom_use('qemp_oce' ) )   CALL iom_put( "qemp_oce"  , qemp_oce(:,:) )   
     121      IF( iom_use('qemp_ice' ) )   CALL iom_put( "qemp_ice"  , qemp_ice(:,:) )   
    122122 
    123123      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    … …  
    128128            !      heat flux at the ocean surface      ! 
    129129            !------------------------------------------! 
    130             ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
     130            ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
    131131            !--------------------------------------------------- 
    132             IF( lk_cpl ) THEN  
    133                !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    134                zfcm1 = qsr_tot(ji,jj) 
    135                DO jl = 1, jpl 
    136                   zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 
    137                END DO 
    138             ELSE 
    139                !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
    140                zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
    141                DO jl = 1, jpl 
    142                   zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 
    143                END DO 
    144             ENDIF 
     132            zqsr = qsr_tot(ji,jj) 
     133            DO jl = 1, jpl 
     134               zqsr = zqsr - a_i_b(ji,jj,jl) * (  qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) )  
     135            END DO 
    145136 
    146137            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
    147138            !--------------------------------------------------- 
    148             zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
    149             hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 
     139            zqmass         = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     140            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 
     141 
     142            ! Add the residual from heat diffusion equation (W.m-2) 
     143            !------------------------------------------------------- 
     144            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) 
    150145 
    151146            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    152147            !--------------------------------------------------- 
    153             qsr(ji,jj) = zfcm1                                       
    154             qns(ji,jj) = hfx_out(ji,jj) - zfcm1               
     148            qsr(ji,jj) = zqsr                                       
     149            qns(ji,jj) = hfx_out(ji,jj) - zqsr               
    155150 
    156151            !------------------------------------------! 
    … …  
    165160            !                     Even if i see Ice melting as a FW and SALT flux 
    166161            !         
    167             !  computing freshwater exchanges at the ice/ocean interface 
    168             IF( lk_cpl ) THEN  
    169                zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
    170                   &   + wfx_snw(ji,jj) 
    171             ELSE 
    172                zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
    173                   &   - 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 
    175             ENDIF 
    176  
    177162            ! mass flux from ice/ocean 
    178163            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    … …  
    180165 
    181166            ! mass flux at the ocean/ice interface 
    182             fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice                    ! F/M mass flux save at least for biogeochemical model 
    183             emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)       ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     167            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice  ! F/M mass flux save at least for biogeochemical model 
     168            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    184169             
    185170         END DO 
    … …  
    199184         snwice_mass_b(:,:) = snwice_mass(:,:)                   
    200185         ! new mass per unit area 
    201          snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
     186         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
    202187         ! time evolution of snow+ice mass 
    203188         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
    … …  
    210195      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                       
    211196 
    212       !------------------------------------------------! 
    213       !    Snow/ice albedo (only if sent to coupler)   ! 
    214       !------------------------------------------------! 
    215       IF( lk_cpl ) THEN          ! coupled case 
    216  
    217             CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
    218  
    219             CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
    220  
    221             alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    222  
    223             CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
    224  
    225       ENDIF 
    226  
     197      !------------------------------------------------------------------------! 
     198      !    Snow/ice albedo (only if sent to coupler, useless in forced mode)   ! 
     199      !------------------------------------------------------------------------! 
     200      CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )     
     201      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
     202      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     203      CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
     204 
     205      ! conservation test 
     206      IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 
     207 
     208      ! control prints 
     209      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
    227210 
    228211      IF(ln_ctl) THEN 
    … …  
    270253      ! 
    271254      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    272 !CDIR NOVERRCHK 
    273255         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point) 
    274 !CDIR NOVERRCHK 
    275256            DO ji = fs_2, fs_jpim1 
    276257               !                                               ! 2*(U_ice-U_oce) at T-point 
    … …  
    322303      !! ** input   : Namelist namicedia 
    323304      !!------------------------------------------------------------------- 
    324       REAL(wp) :: zsum, zarea 
    325       ! 
    326305      INTEGER  ::   ji, jj, jk                       ! dummy loop indices 
    327306      REAL(wp) ::   zcoefu, zcoefv, zcoeff          ! local scalar 
    … …  
    343322         END WHERE 
    344323      ENDIF 
    345       ! clem modif 
    346       IF( .NOT. ln_rstart ) THEN 
    347          fraqsr_1lev(:,:) = 1._wp 
    348       ENDIF 
    349       ! 
    350       ! clem: snwice_mass in the restart file now 
     324      ! 
    351325      IF( .NOT. ln_rstart ) THEN 
    352326         !                                      ! embedded sea ice 
    353327         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(:,:)  ) 
     328            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
    355329            snwice_mass_b(:,:) = snwice_mass(:,:) 
    356330         ELSE 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4990 r5682  
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain variables 
    24    USE oce     , ONLY : fraqsr_1lev  
    2524   USE ice            ! LIM: sea-ice variables 
    26    USE par_ice        ! LIM: sea-ice parameters 
    2725   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2826   USE sbc_ice        ! Surface boundary condition: ice fields 
    2927   USE thd_ice        ! LIM thermodynamic sea-ice variables 
    3028   USE dom_ice        ! LIM sea-ice domain 
    31    USE domvvl         ! domain: variable volume level 
    3229   USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
    3330   USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
    3431   USE limthd_sal     ! LIM: thermodynamics, ice salinity 
    3532   USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution 
     33   USE limthd_lac     ! LIM-3 lateral accretion 
     34   USE limitd_th      ! remapping thickness distribution 
    3635   USE limtab         ! LIM: 1D <==> 2D transformation 
    3736   USE limvar         ! LIM: sea-ice variables 
    … …  
    4443   USE timing         ! Timing 
    4544   USE limcons        ! conservation tests 
     45   USE limctl 
    4646 
    4747   IMPLICIT NONE 
    4848   PRIVATE 
    4949 
    50    PUBLIC   lim_thd        ! called by limstp module 
    51    PUBLIC   lim_thd_init   ! called by iceini module 
     50   PUBLIC   lim_thd         ! called by limstp module 
     51   PUBLIC   lim_thd_init    ! called by sbc_lim_init 
    5252 
    5353   !! * Substitutions 
    … …  
    8080      !! ** References :  
    8181      !!--------------------------------------------------------------------- 
    82       INTEGER, INTENT(in) ::   kt    ! number of iteration 
     82      INTEGER, INTENT(in) :: kt    ! number of iteration 
    8383      !! 
    8484      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    85       INTEGER  :: nbpb             ! nb of icy pts for thermo. cal. 
     85      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations 
    8686      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  
    9087      REAL(wp) :: zfric_u, zqld, zqfr 
    91       ! 
    9288      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    93       ! 
    94       REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns 
     89      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
     90      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
     91      ! 
    9592      !!------------------------------------------------------------------- 
    96       CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 
    9793 
    9894      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    … …  
    10197      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    10298 
     99      CALL lim_var_glo2eqv 
    103100      !------------------------------------------------------------------------! 
    104101      ! 1) Initialization of some variables                                    ! 
    … …  
    106103      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice 
    107104 
    108  
    109105      !-------------------- 
    110106      ! 1.2) Heat content     
    111107      !-------------------- 
    112       ! Change the units of heat content; from global units to J.m3 
     108      ! Change the units of heat content; from J/m2 to J/m3 
    113109      DO jl = 1, jpl 
    114110         DO jk = 1, nlay_i 
    … …  
    116112               DO ji = 1, jpi 
    117113                  !0 if no ice and 1 if yes 
    118                   rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  ) 
     114                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  ) 
    119115                  !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  
     116                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i ) 
    123117               END DO 
    124118            END DO 
    … …  
    128122               DO ji = 1, jpi 
    129123                  !0 if no ice and 1 if yes 
    130                   rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  ) 
     124                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 )  ) 
    131125                  !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  
     126                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s ) 
    135127               END DO 
    136128            END DO 
    … …  
    140132      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    141133      !-----------------------------------------------------------------------------! 
    142  
    143       !--- Ocean solar and non solar fluxes to be used in zqld 
    144       IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean 
    145          ! 
    146          zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:) 
    147          ! 
    148       ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted 
    149          ! 
    150          zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:) 
    151          ! 
    152          DO jl = 1, jpl 
    153             DO jj = 1, jpj 
    154                DO ji = 1, jpi 
    155                   zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
    156                   zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
    157                END DO 
    158             END DO 
    159          END DO 
    160          ! 
    161       ENDIF 
    162  
    163 !CDIR NOVERRCHK 
    164134      DO jj = 1, jpj 
    165 !CDIR NOVERRCHK 
    166135         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 
     136            rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
    168137            ! 
    169138            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
    … …  
    173142            !           !  temperature and turbulent mixing (McPhee, 1992) 
    174143            ! 
    175  
    176144            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
    177             ! REMARK valid at least in forced mode from clem 
    178             ! precip is included in qns but not in qns_ice 
    179             IF ( lk_cpl ) THEN 
    180                zqld =  tms(ji,jj) * rdt_ice *  & 
    181                   &    (   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 ) ) 
    185             ELSE 
    186                zqld =  tms(ji,jj) * rdt_ice *  & 
    187                   &      ( 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 ) ) 
    191             ENDIF 
    192  
    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 ) ) 
     145            zqld =  tmask(ji,jj,1) * rdt_ice *  & 
     146               &    ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
     147 
     148            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     149            zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     150 
     151            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 
     152            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
     153            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
     154            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     155            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
     156            !                        the freezing point, so that we do not have SST < T_freeze 
     157            !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
    195158 
    196159            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 
    197             qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )  
     160            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
    198161 
    199162            ! 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 
     163            IF( zqld > 0._wp ) THEN 
     164               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 
    202165               qlead(ji,jj) = 0._wp 
    203166            ELSE 
    … …  
    205168            ENDIF 
    206169            ! 
    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  
    216170            ! ----------------------------------------- 
    217171            ! Net heat flux on top of ice-ocean [W.m-2] 
    218172            ! ----------------------------------------- 
    219             !     First  step here      : heat flux at the ocean surface + precip 
    220             !     Second step below     : heat flux at the ice   surface (after limthd_dif)  
    221             hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
    222                ! heat flux above the ocean 
    223                &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  & 
    224                ! 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 ) 
     173            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
    227174 
    228175            ! ----------------------------------------------------------------------------- 
    229             ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 
     176            ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
    230177            ! ----------------------------------------------------------------------------- 
    231178            !     First  step here              :  non solar + precip - qlead - qturb 
    232179            !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
    233180            !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
    234             hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                       &  
    235                ! Non solar heat flux received by the ocean 
    236                &    +        pfrld(ji,jj) * qns(ji,jj)                                                                            & 
    237                ! 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 )       & 
    241                ! heat flux taken from the ocean where there is open water ice formation 
    242                &    -      qlead(ji,jj) * r1_rdtice                                                                               & 
    243                ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 
    244                &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                             & 
    245                &    -      at_i(ji,jj) *  fhld(ji,jj) 
    246  
     181            hfx_out(ji,jj) =   pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj)  &  ! Non solar heat flux received by the ocean                
     182               &             - qlead(ji,jj) * r1_rdtice                         &  ! heat flux taken from the ocean where there is open water ice formation 
     183               &             - at_i(ji,jj) * fhtur(ji,jj)                       &  ! heat flux taken by turbulence 
     184               &             - at_i(ji,jj) *  fhld(ji,jj)                          ! heat flux taken during bottom growth/melt  
     185                                                                                   !    (fhld should be 0 while bott growth) 
    247186         END DO 
    248187      END DO 
    … …  
    259198         ENDIF 
    260199 
    261          zareamin = epsi10 
    262200         nbpb = 0 
    263201         DO jj = 1, jpj 
    264202            DO ji = 1, jpi 
    265                IF ( a_i(ji,jj,jl) .gt. zareamin ) THEN      
     203               IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
    266204                  nbpb      = nbpb  + 1 
    267205                  npb(nbpb) = (jj - 1) * jpi + ji 
    … …  
    272210         ! debug point to follow 
    273211         jiindex_1d = 0 
    274          IF( ln_nicep ) THEN 
    275             DO ji = mi0(jiindx), mi1(jiindx) 
    276                DO jj = mj0(jjindx), mj1(jjindx) 
     212         IF( ln_icectl ) THEN 
     213            DO ji = mi0(iiceprt), mi1(iiceprt) 
     214               DO jj = mj0(jiceprt), mj1(jiceprt) 
    277215                  jiindex_1d = (jj - 1) * jpi + ji 
    278216                  WRITE(numout,*) ' lim_thd : Category no : ', jl  
    … …  
    289227         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing. 
    290228 
    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             !-------------------------------- 
     229            !-------------------------! 
     230            ! --- Move to 1D arrays --- 
     231            !-------------------------! 
     232            CALL lim_thd_1d2d( nbpb, jl, 1 ) 
     233 
     234            !--------------------------------------! 
     235            ! --- Ice/Snow Temperature profile --- ! 
     236            !--------------------------------------! 
     237            CALL lim_thd_dif( 1, nbpb ) 
    362238 
    363239            !---------------------------------! 
    364             ! Ice/Snow Temperature profile    ! 
    365             !---------------------------------! 
    366             CALL lim_thd_dif( 1, nbpb ) 
    367  
    368             !---------------------------------! 
    369             ! Ice/Snow thicnkess              ! 
     240            ! --- Ice/Snow thickness ---      ! 
    370241            !---------------------------------! 
    371242            CALL lim_thd_dh( 1, nbpb )     
    … …  
    375246                                             
    376247            !---------------------------------! 
    377             ! --- Ice salinity --- ! 
     248            ! --- Ice salinity ---            ! 
    378249            !---------------------------------! 
    379250            CALL lim_thd_sal( 1, nbpb )     
    380251 
    381252            !---------------------------------! 
    382             ! --- temperature update --- ! 
     253            ! --- temperature update ---      ! 
    383254            !---------------------------------! 
    384255            CALL lim_thd_temp( 1, nbpb ) 
    385256 
    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 ) 
     257            !------------------------------------! 
     258            ! --- lateral melting if monocat --- ! 
     259            !------------------------------------! 
     260            IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
     261               CALL lim_thd_lam( 1, nbpb ) 
     262            END IF 
     263 
     264            !-------------------------! 
     265            ! --- Move to 2D arrays --- 
     266            !-------------------------! 
     267            CALL lim_thd_1d2d( nbpb, jl, 2 ) 
     268 
    439269            ! 
    440270            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
    441271         ENDIF 
    442272         ! 
    443       END DO 
     273      END DO !jl 
    444274 
    445275      !------------------------------------------------------------------------------! 
    … …  
    448278 
    449279      !------------------------ 
    450       ! 5.1) Ice heat content               
     280      ! Ice heat content               
    451281      !------------------------ 
    452       ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
     282      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    453283      DO jl = 1, jpl 
    454284         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 ) ) 
     285            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 
    456286         END DO 
    457287      END DO 
    458288 
    459289      !------------------------ 
    460       ! 5.2) Snow heat content               
     290      ! Snow heat content               
    461291      !------------------------ 
    462       ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
     292      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    463293      DO jl = 1, jpl 
    464294         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 ) ) 
     295            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 
    466296         END DO 
    467297      END DO 
    468  
     298  
    469299      !---------------------------------- 
    470       ! 5.3) Change thickness to volume 
     300      ! Change thickness to volume 
    471301      !---------------------------------- 
    472       CALL lim_var_eqv2glo 
     302      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:) 
     303      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
     304      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
     305 
     306      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 
     307      DO jl  = 1, jpl 
     308         DO jj = 1, jpj 
     309            DO ji = 1, jpi 
     310               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) ) 
     311               oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) 
     312            END DO 
     313         END DO 
     314      END DO 
     315 
     316      CALL lim_var_zapsmall 
    473317 
    474318      !-------------------------------------------- 
    475       ! 5.4) Diagnostic thermodynamic growth rates 
     319      ! Diagnostic thermodynamic growth rates 
    476320      !-------------------------------------------- 
     321      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print 
     322 
    477323      IF(ln_ctl) THEN            ! Control print 
    478324         CALL prt_ctl_info(' ') 
    479325         CALL prt_ctl_info(' - Cell values : ') 
    480326         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    481          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_thd  : cell area :') 
     327         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd  : cell area :') 
    482328         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :') 
    483329         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :') 
    … …  
    508354      ! 
    509355      ! 
    510       CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 
    511  
    512       ! 
    513       ! conservation test 
    514356      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     357 
     358      !------------------------------------------------------------------------------| 
     359      !  6) Transport of ice between thickness categories.                           | 
     360      !------------------------------------------------------------------------------| 
     361      ! Given thermodynamic growth rates, transport ice between thickness categories. 
     362      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     363 
     364      IF( jpl > 1 )      CALL lim_itd_th_rem( 1, jpl, kt ) 
     365 
     366      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     367 
     368      !------------------------------------------------------------------------------| 
     369      !  7) Add frazil ice growing in leads. 
     370      !------------------------------------------------------------------------------| 
     371      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     372 
     373      CALL lim_thd_lac 
     374       
     375      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     376 
     377      ! Control print 
     378      IF(ln_ctl) THEN 
     379         CALL lim_var_glo2eqv 
     380 
     381         CALL prt_ctl_info(' ') 
     382         CALL prt_ctl_info(' - Cell values : ') 
     383         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
     384         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_th  : cell area :') 
     385         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :') 
     386         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :') 
     387         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :') 
     388         DO jl = 1, jpl 
     389            CALL prt_ctl_info(' ') 
     390            CALL prt_ctl_info(' - Category : ', ivar1=jl) 
     391            CALL prt_ctl_info('   ~~~~~~~~~~') 
     392            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ') 
     393            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ') 
     394            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ') 
     395            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ') 
     396            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ') 
     397            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ') 
     398            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ') 
     399            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ') 
     400            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ') 
     401            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ') 
     402            DO jk = 1, nlay_i 
     403               CALL prt_ctl_info(' ') 
     404               CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
     405               CALL prt_ctl_info('   ~~~~~~~') 
     406               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ') 
     407               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ') 
     408            END DO 
     409         END DO 
     410      ENDIF 
    515411      ! 
    516412      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
    … …  
    518414   END SUBROUTINE lim_thd  
    519415 
     416  
    520417   SUBROUTINE lim_thd_temp( kideb, kiut ) 
    521418      !!----------------------------------------------------------------------- 
    … …  
    534431      DO jk = 1, nlay_i 
    535432         DO ji = kideb, kiut 
    536             ztmelts       =  -tmut * s_i_1d(ji,jk) + rtt 
     433            ztmelts       =  -tmut * s_i_1d(ji,jk) + rt0 
    537434            ! Conversion q(S,T) -> T (second order equation) 
    538435            zaaa          =  cpic 
    539             zbbb          =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus 
    540             zccc          =  lfus * ( ztmelts - rtt ) 
     436            zbbb          =  ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus 
     437            zccc          =  lfus * ( ztmelts - rt0 ) 
    541438            zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 
    542             t_i_1d(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 
     439            t_i_1d(ji,jk) =  rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 
    543440             
    544441            ! mask temperature 
    545442            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 
     443            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0 
    547444         END DO  
    548445      END DO  
    549446 
    550447   END SUBROUTINE lim_thd_temp 
     448 
     449   SUBROUTINE lim_thd_lam( kideb, kiut ) 
     450      !!----------------------------------------------------------------------- 
     451      !!                   ***  ROUTINE lim_thd_lam ***  
     452      !!                  
     453      !! ** Purpose :   Lateral melting in case monocategory 
     454      !!                          ( dA = A/2h dh ) 
     455      !!----------------------------------------------------------------------- 
     456      INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop 
     457      INTEGER             ::   ji                 ! dummy loop indices 
     458      REAL(wp)            ::   zhi_bef            ! ice thickness before thermo 
     459      REAL(wp)            ::   zdh_mel, zda_mel   ! net melting 
     460      REAL(wp)            ::   zvi, zvs           ! ice/snow volumes  
     461 
     462      DO ji = kideb, kiut 
     463         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 
     464         IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN 
     465            zvi          = a_i_1d(ji) * ht_i_1d(ji) 
     466            zvs          = a_i_1d(ji) * ht_s_1d(ji) 
     467            ! lateral melting = concentration change 
     468            zhi_bef     = ht_i_1d(ji) - zdh_mel 
     469            rswitch     = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) ) 
     470            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 
     471            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel )  
     472             ! adjust thickness 
     473            ht_i_1d(ji) = zvi / a_i_1d(ji)             
     474            ht_s_1d(ji) = zvs / a_i_1d(ji)             
     475            ! retrieve total concentration 
     476            at_i_1d(ji) = a_i_1d(ji) 
     477         END IF 
     478      END DO 
     479       
     480   END SUBROUTINE lim_thd_lam 
     481 
     482   SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) 
     483      !!----------------------------------------------------------------------- 
     484      !!                   ***  ROUTINE lim_thd_1d2d ***  
     485      !!                  
     486      !! ** Purpose :   move arrays from 1d to 2d and the reverse 
     487      !!----------------------------------------------------------------------- 
     488      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D 
     489                                        ! 2= from 1D to 2D 
     490      INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays 
     491      INTEGER, INTENT(in) ::   jl       ! ice cat 
     492      INTEGER             ::   jk       ! dummy loop indices 
     493 
     494      SELECT CASE( kn ) 
     495 
     496      CASE( 1 ) 
     497 
     498         CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
     499         CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
     500         CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     501         CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     502          
     503         CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     504         CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     505         DO jk = 1, nlay_s 
     506            CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     507            CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     508         END DO 
     509         DO jk = 1, nlay_i 
     510            CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     511            CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     512            CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     513         END DO 
     514          
     515         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 
     516         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     517         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
     518         CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) ) 
     519         CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     520         CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     521         CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     522         CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     523         CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
     524         CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) )  
     525         CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) ) 
     526         CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
     527         CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
     528          
     529         CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     530         CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     531          
     532         CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     533         CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     534         CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     535         CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) ) 
     536         CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) ) 
     537         CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     538          
     539         CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     540         CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     541         CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     542         CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) ) 
     543         CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
     544         CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
     545          
     546         CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     547         CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     548         CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     549         CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     550         CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     551         CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) ) 
     552         CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) ) 
     553         CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     554         CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     555         CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) ) 
     556         CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) ) 
     557         CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 
     558         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
     559 
     560      CASE( 2 ) 
     561 
     562         CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj ) 
     563         CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj ) 
     564         CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj ) 
     565         CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj ) 
     566         CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj ) 
     567         CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj ) 
     568         DO jk = 1, nlay_s 
     569            CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj) 
     570            CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj) 
     571         END DO 
     572         DO jk = 1, nlay_i 
     573            CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj) 
     574            CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj) 
     575            CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj) 
     576         END DO 
     577         CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
     578          
     579         CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     580         CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     581          
     582         CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     583         CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     584         CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     585         CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     586         CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj ) 
     587         CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     588          
     589         CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     590         CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     591         CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     592         CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     593         CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
     594         CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
     595          
     596         CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
     597         CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     598         CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     599         CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     600         CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     601         CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj ) 
     602         CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj ) 
     603         CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     604         CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     605         CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj ) 
     606         CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
     607         CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj ) 
     608         CALL tab_1d_2d( nbpb, hfx_err_dif   , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj ) 
     609         ! 
     610         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
     611         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
     612         !          
     613      END SELECT 
     614 
     615   END SUBROUTINE lim_thd_1d2d 
     616 
    551617 
    552618   SUBROUTINE lim_thd_init 
    … …  
    563629      !!------------------------------------------------------------------- 
    564630      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    565       NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   & 
    566          &                hiclim, hnzst, parsub, betas,                          &  
    567          &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi 
     631      NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                       & 
     632         &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 
     633         &                nn_monocat, ln_it_qnsice 
    568634      !!------------------------------------------------------------------- 
    569635      ! 
    … …  
    582648902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 
    583649      IF(lwm) WRITE ( numoni, namicethd ) 
    584  
    585       IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
     650      ! 
     651      IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN  
     652         nn_monocat = 0 
     653         IF(lwp) WRITE(numout, *) '   nn_monocat must be 0 in multi-category case ' 
     654      ENDIF 
     655 
    586656      ! 
    587657      IF(lwp) THEN                          ! control print 
    588658         WRITE(numout,*) 
    589659         WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation ' 
    590          WRITE(numout,*)'      maximum melting at the bottom                           hmelt        = ', hmelt 
    591          WRITE(numout,*)'      ice thick. for lateral accretion                        hiccrit      = ', hiccrit 
    592          WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       fraz_swi     = ', fraz_swi 
    593          WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   maxfrazb     = ', maxfrazb 
    594          WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  vfrazb       = ', vfrazb 
    595          WRITE(numout,*)'      Squeezing coefficient for collection of frazil          Cfrazb       = ', Cfrazb 
    596          WRITE(numout,*)'      minimum ice thickness                                   hiclim       = ', hiclim  
     660         WRITE(numout,*)'      ice thick. for lateral accretion                        rn_hnewice   = ', rn_hnewice 
     661         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       ln_frazil    = ', ln_frazil 
     662         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   rn_maxfrazb  = ', rn_maxfrazb 
     663         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  rn_vfrazb    = ', rn_vfrazb 
     664         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          rn_Cfrazb    = ', rn_Cfrazb 
     665         WRITE(numout,*)'      minimum ice thickness                                   rn_himin     = ', rn_himin  
    597666         WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice ' 
    598          WRITE(numout,*)'      thickness of the surf. layer in temp. computation       hnzst        = ', hnzst 
    599          WRITE(numout,*)'      switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub   
    600          WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          betas        = ', betas 
    601          WRITE(numout,*)'      extinction radiation parameter in sea ice (1.0)         kappa_i      = ', kappa_i 
    602          WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nconv_i_thd  = ', nconv_i_thd 
    603          WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd 
    604          WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     thcon_i_swi  = ', thcon_i_swi 
     667         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas 
     668         WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i 
     669         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nn_conv_dif  = ', nn_conv_dif 
     670         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif 
     671         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon 
    605672         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
     673         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat 
     674         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice 
    606675      ENDIF 
    607676      ! 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r4990 r5682  
    2020   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2121   USE ice            ! LIM variables 
    22    USE par_ice        ! LIM parameters 
    2322   USE thd_ice        ! LIM thermodynamics 
    2423   USE in_out_manager ! I/O manager 
    … …  
    3029   PRIVATE 
    3130 
    32    PUBLIC   lim_thd_dh   ! called by lim_thd 
     31   PUBLIC   lim_thd_dh      ! called by lim_thd 
     32   PUBLIC   lim_thd_snwblow ! called in sbcblk/sbcclio/sbccpl and here 
     33 
     34   INTERFACE lim_thd_snwblow 
     35      MODULE PROCEDURE lim_thd_snwblow_1d, lim_thd_snwblow_2d 
     36   END INTERFACE 
    3337 
    3438   !!---------------------------------------------------------------------- 
    … …  
    7074 
    7175      REAL(wp) ::   ztmelts             ! local scalar 
    72       REAL(wp) ::   zdh, zfdum  ! 
     76      REAL(wp) ::   zfdum        
    7377      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment 
    74       REAL(wp) ::   zcoeff       ! dummy argument for snowfall partitioning over ice and leads 
    75       REAL(wp) ::   zs_snic  ! snow-ice salinity 
     78      REAL(wp) ::   zs_snic      ! snow-ice salinity 
    7679      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity 
    7780      REAL(wp) ::   zswi12       ! switch for computation of bottom salinity 
    … …  
    8790      REAL(wp) ::   zsstK        ! SST in Kelvin 
    8891 
    89       REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness 
    9092      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3) 
    9193      REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2) 
    9294      REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2) 
    93       REAL(wp), POINTER, DIMENSION(:) ::   zq_1cat     ! corrected heat in case 1-cat and hmelt>15cm (J.m-2) 
    9495      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2) 
    95       REAL(wp), POINTER, DIMENSION(:) ::   zf_tt     ! Heat budget to determine melting or freezing(W.m-2) 
    96       INTEGER , POINTER, DIMENSION(:) ::   icount      ! number of layers vanished by melting  
     96      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2) 
    9797 
    9898      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt  
    … …  
    102102      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah 
    103103      REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness 
     104      INTEGER , POINTER, DIMENSION(:,:) ::   icount    ! number of layers vanished by melting  
    104105 
    105106      REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2) 
    106107      REAL(wp), POINTER, DIMENSION(:) ::   zqh_s       ! total snow heat content (J.m-2) 
    107108      REAL(wp), POINTER, DIMENSION(:) ::   zq_s        ! total snow enthalpy     (J.m-3) 
    108  
    109       ! mass and salt flux (clem) 
    110       REAL(wp) :: zdvres, zswitch_sal 
     109      REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing 
     110 
     111      REAL(wp) :: zswitch_sal 
    111112 
    112113      ! Heat conservation  
    … …  
    115116      !!------------------------------------------------------------------ 
    116117 
    117       ! Discriminate between varying salinity (num_sal=2) and prescribed cases (other values) 
    118       SELECT CASE( num_sal )                       ! varying salinity or not 
     118      ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 
     119      SELECT CASE( nn_icesal )                       ! varying salinity or not 
    119120         CASE( 1, 3, 4 ) ;   zswitch_sal = 0       ! prescribed salinity profile 
    120121         CASE( 2 )       ;   zswitch_sal = 1       ! varying salinity profile 
    121122      END SELECT 
    122123 
    123       CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 
     124      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw ) 
    124125      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
    125       CALL wrk_alloc( jpij, nlay_i+1, zdeltah, zh_i ) 
    126       CALL wrk_alloc( jpij, icount ) 
    127        
     126      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 
     127      CALL wrk_alloc( jpij, nlay_i, icount ) 
     128        
    128129      dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp 
    129130      dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp    
    130   
    131       zqprec (:) = 0._wp ; zq_su  (:) = 0._wp ; zq_bo  (:) = 0._wp ; zf_tt  (:) = 0._wp 
    132       zq_1cat(:) = 0._wp ; zq_rema(:) = 0._wp 
    133  
    134       zh_s     (:) = 0._wp        
    135       zdh_s_pre(:) = 0._wp 
    136       zdh_s_mel(:) = 0._wp 
    137       zdh_s_sub(:) = 0._wp 
    138       zqh_s    (:) = 0._wp       
    139       zqh_i    (:) = 0._wp    
    140  
    141       zh_i      (:,:) = 0._wp        
    142       zdeltah   (:,:) = 0._wp        
    143       icount    (:)   = 0 
     131 
     132      zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp 
     133      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp 
     134      zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp 
     135      zqh_s    (:) = 0._wp ; zq_s     (:) = 0._wp      
     136 
     137      zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp        
     138      icount (:,:) = 0 
     139 
     140 
     141      ! Initialize enthalpy at nlay_i+1 
     142      DO ji = kideb, kiut 
     143         q_i_1d(ji,nlay_i+1) = 0._wp 
     144      END DO 
    144145 
    145146      ! initialize layer thicknesses and enthalpies 
    … …  
    148149      DO jk = 1, nlay_i 
    149150         DO ji = kideb, kiut 
    150             h_i_old (ji,jk) = ht_i_1d(ji) / REAL( nlay_i ) 
     151            h_i_old (ji,jk) = ht_i_1d(ji) * r1_nlay_i 
    151152            qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk) 
    152153         ENDDO 
    … …  
    158159      ! 
    159160      DO ji = kideb, kiut 
    160          rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 
    161          ztmelts       = rswitch * rtt + ( 1._wp - rswitch ) * rtt 
    162  
    163161         zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
    164162         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
    165163 
    166          zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts ) ) 
     164         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 
    167165         zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 
    168166      END DO 
    … …  
    174172      !------------------------------------------------------------------------------! 
    175173      DO ji = kideb, kiut 
    176          IF( t_s_1d(ji,1) > rtt ) THEN !!! Internal melting 
     174         IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting 
    177175            ! Contribution to heat flux to the ocean [W.m-2], < 0   
    178176            hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice 
    … …  
    182180            ht_s_1d(ji)   = 0._wp 
    183181            q_s_1d (ji,1) = 0._wp 
    184             t_s_1d (ji,1) = rtt 
     182            t_s_1d (ji,1) = rt0 
    185183         END IF 
    186184      END DO 
    … …  
    190188      !------------------------------------------------------------! 
    191189      ! 
    192       DO ji = kideb, kiut      
    193          zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s ) 
    194       END DO 
    195       ! 
    196190      DO jk = 1, nlay_s 
    197191         DO ji = kideb, kiut 
    198             zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * zh_s(ji) 
     192            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s 
    199193         END DO 
    200194      END DO 
    … …  
    202196      DO jk = 1, nlay_i 
    203197         DO ji = kideb, kiut 
    204             zh_i(ji,jk) = ht_i_1d(ji) / REAL( nlay_i ) 
     198            zh_i(ji,jk) = ht_i_1d(ji) * r1_nlay_i 
    205199            zqh_i(ji)   = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk) 
    206200         END DO 
    … …  
    225219      ! Martin Vancoppenolle, December 2006 
    226220 
     221      CALL lim_thd_snwblow( 1. - at_i_1d(kideb:kiut), zsnw(kideb:kiut) ) ! snow distribution over ice after wind blowing 
     222 
     223      zdeltah(:,:) = 0._wp 
    227224      DO ji = kideb, kiut 
    228225         !----------- 
    … …  
    230227         !----------- 
    231228         ! thickness change 
    232          zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**betas ) / at_i_1d(ji)  
    233          zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn 
    234          ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 
    235          zqprec   (ji) = rhosn * ( cpic * ( rtt - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus )    
     229         zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji) 
     230         ! enthalpy of the precip (>0, J.m-3) 
     231         zqprec   (ji) = - qprec_ice_1d(ji)    
    236232         IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 
    237233         ! heat flux from snow precip (>0, W.m-2) 
    … …  
    239235         ! mass flux, <0 
    240236         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice 
    241          ! update thickness 
    242          ht_s_1d    (ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) ) 
    243237 
    244238         !--------------------- 
    … …  
    246240         !--------------------- 
    247241         ! thickness change 
    248          IF( zdh_s_pre(ji) > 0._wp ) THEN 
    249          rswitch        = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) ) 
    250          zdh_s_mel (ji) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 
    251          zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting  
     242         rswitch        = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) ) 
     243         zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 
     244         zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting  
    252245         ! heat used to melt snow (W.m-2, >0) 
    253          hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 
     246         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 
    254247         ! snow melting only = water into the ocean (then without snow precip), >0 
    255          wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_mel(ji) * r1_rdtice 
    256           
    257          ! updates available heat + thickness 
    258          zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) )       
    259          ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) ) 
    260          zh_s  (ji) = ht_s_1d(ji) / REAL( nlay_s ) 
    261  
    262          ENDIF 
    263       END DO 
    264  
    265       ! If heat still available, then melt more snow 
    266       zdeltah(:,:) = 0._wp ! important 
     248         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice     
     249         ! updates available heat + precipitations after melting 
     250         zq_su     (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) )       
     251         zdh_s_pre (ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
     252 
     253         ! update thickness 
     254         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) ) 
     255      END DO 
     256 
     257      ! If heat still available (zq_su > 0), then melt more snow 
     258      zdeltah(:,:) = 0._wp 
    267259      DO jk = 1, nlay_s 
    268260         DO ji = kideb, kiut 
    269261            ! thickness change 
    270262            rswitch          = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )  
    271             rswitch          = rswitch * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_1d(ji,jk) + epsi20 ) ) )  
     263            rswitch          = rswitch * ( MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,jk) - epsi20 ) ) )  
    272264            zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 ) 
    273             zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting 
     265            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - ht_s_1d(ji) ) ! bound melting 
    274266            zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)     
    275267            ! heat used to melt snow(W.m-2, >0) 
    … …  
    277269            ! snow melting only = water into the ocean (then without snow precip) 
    278270            wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
    279  
    280271            ! updates available heat + thickness 
    281             zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) ) 
     272            zq_su (ji)  = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) ) 
    282273            ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) ) 
    283  
    284274         END DO 
    285275      END DO 
    … …  
    289279      !---------------------- 
    290280      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
    291       ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean) 
     281      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean) 
    292282      ! clem comment: ice should also sublimate 
    293       IF( lk_cpl ) THEN 
    294          ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 
    295          zdh_s_sub(:)      =  0._wp  
    296       ELSE 
    297          ! forced  mode: snow thickness change due to sublimation 
    298          DO ji = kideb, kiut 
    299             zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 
    300             ! Heat flux by sublimation [W.m-2], < 0 
    301             !      sublimate first snow that had fallen, then pre-existing snow 
    302             zcoeff         =      ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) )   * zqprec(ji) +   & 
    303                &  ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_1d(ji,1) )  & 
    304                &  * a_i_1d(ji) * r1_rdtice 
    305             hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff 
    306             ! Mass flux by sublimation 
    307             wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 
    308             ! new snow thickness 
    309             ht_s_1d(ji)     =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 
    310          END DO 
    311       ENDIF 
    312  
     283      zdeltah(:,:) = 0._wp 
     284      ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice 
     285      ! forced  mode: snow thickness change due to sublimation 
     286      DO ji = kideb, kiut 
     287         zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 
     288         ! Heat flux by sublimation [W.m-2], < 0 
     289         !      sublimate first snow that had fallen, then pre-existing snow 
     290         zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 
     291         hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  & 
     292            &                              ) * a_i_1d(ji) * r1_rdtice 
     293         ! Mass flux by sublimation 
     294         wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 
     295         ! new snow thickness 
     296         ht_s_1d(ji)    =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 
     297         ! update precipitations after sublimation and correct sublimation 
     298         zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
     299         zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 
     300      END DO 
     301       
    313302      ! --- Update snow diags --- ! 
    314303      DO ji = kideb, kiut 
    315          dh_s_tot(ji)   = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
    316          zh_s(ji)       = ht_s_1d(ji) / REAL( nlay_s ) 
    317       END DO ! ji 
     304         dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
     305      END DO 
    318306 
    319307      !------------------------------------------- 
    … …  
    324312      DO jk = 1, nlay_s 
    325313         DO ji = kideb,kiut 
    326             rswitch       =  MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) + epsi20 )  ) 
    327             q_s_1d(ji,jk) = ( 1._wp - rswitch ) / MAX( ht_s_1d(ji), epsi20 ) *             & 
    328               &            ( (   MAX( 0._wp, dh_s_tot(ji) )              ) * zqprec(ji) +  & 
    329               &              ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) ) 
     314            rswitch       = MAX(  0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 )  ) 
     315            q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *                          & 
     316              &            ( (   zdh_s_pre(ji)             ) * zqprec(ji) +  & 
     317              &              (   ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 
    330318            zq_s(ji)     =  zq_s(ji) + q_s_1d(ji,jk) 
    331319         END DO 
    … …  
    337325      zdeltah(:,:) = 0._wp ! important 
    338326      DO jk = 1, nlay_i 
    339          DO ji = kideb, kiut  
    340             zEi            = - q_i_1d(ji,jk) / rhoic                ! Specific enthalpy of layer k [J/kg, <0] 
    341  
    342             ztmelts        = - tmut * s_i_1d(ji,jk) + rtt           ! Melting point of layer k [K] 
    343  
    344             zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0] 
    345  
    346             zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0 
    347  
    348             zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0] 
    349  
    350             zdeltah(ji,jk) = - zfmdt / rhoic                       ! Melt of layer jk [m, <0] 
    351  
    352             zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
    353  
    354             zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 
    355  
    356             dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt 
    357  
    358             zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
    359  
    360             zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
    361  
    362             ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
    363             sfx_sum_1d(ji)   = sfx_sum_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
    364  
    365             ! Contribution to heat flux [W.m-2], < 0 
    366             hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
    367  
    368             ! Total heat flux used in this process [W.m-2], > 0   
    369             hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
    370  
    371             ! Contribution to mass flux 
    372             wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
    373             
     327         DO ji = kideb, kiut 
     328            ztmelts           = - tmut * s_i_1d(ji,jk) + rt0          ! Melting point of layer k [K] 
     329             
     330            IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting 
     331 
     332               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]        
     333               zdE            = 0._wp                                 ! Specific enthalpy difference   (J/kg, <0) 
     334                                                                      ! set up at 0 since no energy is needed to melt water...(it is already melted) 
     335               zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing      
     336                                                                      ! this should normally not happen, but sometimes, heat diffusion leads to this 
     337               zfmdt          = - zdeltah(ji,jk) * rhoic              ! Mass flux x time step > 0 
     338                          
     339               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt 
     340                
     341               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
     342 
     343               ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean)  
     344               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice 
     345                
     346               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     347               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
     348                
     349               ! Contribution to mass flux 
     350               wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     351 
     352            ELSE                                !!! Surface melting 
     353                
     354               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0] 
     355               zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0] 
     356               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0 
     357                
     358               zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0] 
     359                
     360               zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0] 
     361                
     362               zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
     363                
     364               zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 
     365                
     366               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt 
     367                
     368               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
     369                
     370               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
     371                
     372               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     373               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
     374                
     375               ! Contribution to heat flux [W.m-2], < 0 
     376               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
     377                
     378               ! Total heat flux used in this process [W.m-2], > 0   
     379               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
     380                
     381               ! Contribution to mass flux 
     382               wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     383                
     384            END IF 
    374385            ! record which layers have disappeared (for bottom melting)  
    375386            !    => icount=0 : no layer has vanished 
    376387            !    => icount=5 : 5 layers have vanished 
    377             rswitch     = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )  
    378             icount(ji)  = icount(ji) + NINT( rswitch ) 
    379             zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 
     388            rswitch       = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )  
     389            icount(ji,jk) = NINT( rswitch ) 
     390            zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 
    380391 
    381392            ! update heat content (J.m-2) and layer thickness 
    … …  
    408419      ! -> need for an iterative procedure, which converges quickly 
    409420 
    410       IF ( num_sal == 2 ) THEN 
    411          num_iter_max = 5 
    412       ELSE 
    413          num_iter_max = 1 
    414       ENDIF 
    415  
    416       !clem debug. Just to be sure that enthalpy at nlay_i+1 is null 
    417       DO ji = kideb, kiut 
    418          q_i_1d(ji,nlay_i+1) = 0._wp 
    419       END DO 
     421      num_iter_max = 1 
     422      IF( nn_icesal == 2 ) num_iter_max = 5 
    420423 
    421424      ! Iterative procedure 
    … …  
    440443                                  + ( 1. - zswitch_sal ) * sm_i_1d(ji)  
    441444               ! New ice growth 
    442                ztmelts            = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K) 
     445               ztmelts            = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K) 
    443446 
    444447               zt_i_new           = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
    445448                
    446449               zEi                = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)       
    447                   &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   & 
    448                   &               + rcp  * ( ztmelts-rtt )           
     450                  &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   & 
     451                  &               + rcp  * ( ztmelts-rt0 )           
    449452 
    450453               zEw                = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0) 
    … …  
    456459               q_i_1d(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0) 
    457460                
    458             ENDIF ! fc_bo_i 
    459          END DO ! ji 
    460       END DO ! iter 
     461            ENDIF 
     462         END DO 
     463      END DO 
    461464 
    462465      ! Contribution to Energy and Salt Fluxes 
    … …  
    467470            zfmdt          = - rhoic * dh_i_bott(ji)             ! Mass flux x time step (kg/m2, < 0) 
    468471 
    469             ztmelts        = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K) 
     472            ztmelts        = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K) 
    470473             
    471474            zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
    472475             
    473476            zEi            = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)       
    474                &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   & 
    475                &               + rcp  * ( ztmelts-rtt )           
     477               &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   & 
     478               &               + rcp  * ( ztmelts-rt0 )           
    476479             
    477480            zEw            = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0) 
    … …  
    486489             
    487490            ! Contribution to salt flux, <0 
    488             sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_1d(ji) * zfmdt * r1_rdtice 
     491            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice 
    489492 
    490493            ! Contribution to mass flux, <0 
    … …  
    503506      DO jk = nlay_i, 1, -1 
    504507         DO ji = kideb, kiut 
    505             IF(  zf_tt(ji)  >=  0._wp  .AND. jk > icount(ji) ) THEN   ! do not calculate where layer has already disappeared from surface melting  
    506  
    507                ztmelts = - tmut * s_i_1d(ji,jk) + rtt  ! Melting point of layer jk (K) 
     508            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting  
     509 
     510               ztmelts = - tmut * s_i_1d(ji,jk) + rt0  ! Melting point of layer jk (K) 
    508511 
    509512               IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting 
    510513 
    511                   zEi               = - q_i_1d(ji,jk) / rhoic        ! Specific enthalpy of melting ice (J/kg, <0) 
    512  
    513                   !!zEw               = rcp * ( t_i_1d(ji,jk) - rtt )  ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0) 
    514  
     514                  zEi               = - q_i_1d(ji,jk) * r1_rhoic    ! Specific enthalpy of melting ice (J/kg, <0) 
    515515                  zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
    516516                                                                    ! set up at 0 since no energy is needed to melt water...(it is already melted) 
    517  
    518                   zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing      
    519                                                                    ! this should normally not happen, but sometimes, heat diffusion leads to this 
     517                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing      
     518                                                                    ! this should normally not happen, but sometimes, heat diffusion leads to this 
    520519 
    521520                  dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk) 
    522521 
    523                   zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
     522                  zfmdt             = - zdeltah(ji,jk) * rhoic      ! Mass flux x time step > 0 
    524523 
    525524                  ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean)  
    … …  
    527526 
    528527                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
    529                   sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     528                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
    530529                                     
    531530                  ! Contribution to mass flux 
    … …  
    538537               ELSE                               !!! Basal melting 
    539538 
    540                   zEi               = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0) 
    541  
    542                   zEw               = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0) 
    543  
    544                   zdE               = zEi - zEw              ! Specific enthalpy difference   (J/kg, <0) 
    545  
    546                   zfmdt             = - zq_bo(ji) / zdE  ! Mass flux x time step (kg/m2, >0) 
    547  
    548                   zdeltah(ji,jk)    = - zfmdt / rhoic        ! Gross thickness change 
    549  
    550                   zdeltah(ji,jk)    = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 
     539                  zEi             = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0) 
     540                  zEw             = rcp * ( ztmelts - rt0 )    ! Specific enthalpy of meltwater (J/kg, <0) 
     541                  zdE             = zEi - zEw                  ! Specific enthalpy difference   (J/kg, <0) 
     542 
     543                  zfmdt           = - zq_bo(ji) / zdE          ! Mass flux x time step (kg/m2, >0) 
     544 
     545                  zdeltah(ji,jk)  = - zfmdt * r1_rhoic         ! Gross thickness change 
     546 
     547                  zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 
    551548                   
    552                   zq_bo(ji)         = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 
    553  
    554                   dh_i_bott(ji)     = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt 
    555  
    556                   zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
    557  
    558                   zQm               = zfmdt * zEw         ! Heat exchanged with ocean 
     549                  zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 
     550 
     551                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt 
     552 
     553                  zfmdt           = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
     554 
     555                  zQm             = zfmdt * zEw         ! Heat exchanged with ocean 
    559556 
    560557                  ! Contribution to heat flux to the ocean [W.m-2], <0   
    561                   hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
     558                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
    562559 
    563560                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
    564                   sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     561                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoic *  a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
    565562                   
    566563                  ! Total heat flux used in this process [W.m-2], >0   
    567                   hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
     564                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
    568565                   
    569566                  ! Contribution to mass flux 
    570                   wfx_bom_1d(ji) =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     567                  wfx_bom_1d(ji)  =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
    571568 
    572569                  ! update heat content (J.m-2) and layer thickness 
    … …  
    576573            
    577574            ENDIF 
    578          END DO ! ji 
    579       END DO ! jk 
    580  
    581       !------------------------------------------------------------------------------! 
    582       ! Excessive ablation in a 1-category model 
    583       !     in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 
    584       !------------------------------------------------------------------------------! 
    585       ! ??? keep ??? 
    586       ! clem bug: I think this should be included above, so we would not have to  
    587       !           track heat/salt/mass fluxes backwards 
    588 !      IF( jpl == 1 ) THEN 
    589 !         DO ji = kideb, kiut 
    590 !            IF(  zf_tt(ji)  >=  0._wp  ) THEN 
    591 !               zdh            = MAX( hmelt , dh_i_bott(ji) ) 
    592 !               zdvres         = zdh - dh_i_bott(ji) ! >=0 
    593 !               dh_i_bott(ji)  = zdh 
    594 ! 
    595 !               ! excessive energy is sent to lateral ablation 
    596 !               rswitch = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_1d(ji) - epsi20 ) ) 
    597 !               zq_1cat(ji) =  rswitch * rhoic * lfus * at_i_1d(ji) / MAX( 1._wp - at_i_1d(ji) , epsi20 ) * zdvres ! J.m-2 >=0 
    598 ! 
    599 !               ! correct salt and mass fluxes 
    600 !               sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation 
    601 !               wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdvres * r1_rdtice 
    602 !            ENDIF 
    603 !         END DO 
    604 !      ENDIF 
     575         END DO 
     576      END DO 
    605577 
    606578      !------------------------------------------- 
    … …  
    619591      DO ji = kideb, kiut 
    620592         zq_rema(ji)     = zq_su(ji) + zq_bo(ji)  
    621 !         zindh           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow 
    622 !         zindq           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) ) 
    623 !         zdeltah  (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 ) 
    624 !         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting 
    625 !         zdh_s_mel(ji)   = zdh_s_mel(ji) + zdeltah(ji,1)     
    626 !         dh_s_tot (ji)   = dh_s_tot(ji) + zdeltah(ji,1) 
    627 !         ht_s_1d   (ji)   = ht_s_1d(ji)   + zdeltah(ji,1) 
    628 !         
    629 !         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji)                ! update available heat (J.m-2) 
    630 !         ! heat used to melt snow 
    631 !         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0) 
    632 !         ! Contribution to mass flux 
    633 !         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice 
    634 !     
     593         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow 
     594         rswitch         = rswitch * MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,1) - epsi20 ) ) 
     595         zdeltah  (ji,1) = - rswitch * zq_rema(ji) / MAX( q_s_1d(ji,1), epsi20 ) 
     596         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting 
     597         dh_s_tot (ji)   = dh_s_tot(ji)  + zdeltah(ji,1) 
     598         ht_s_1d   (ji)  = ht_s_1d(ji)   + zdeltah(ji,1) 
     599         
     600         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * q_s_1d(ji,1)                ! update available heat (J.m-2) 
     601         ! heat used to melt snow 
     602         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * q_s_1d(ji,1) * r1_rdtice ! W.m-2 (>0) 
     603         ! Contribution to mass flux 
     604         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice 
     605         !     
    635606         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    636607         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 
    637          hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 
    638  
    639          IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
     608         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 
     609 
     610         IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
    640611      END DO 
    641612       
    … …  
    650621         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  ) 
    651622 
    652          ht_i_1d(ji)     = ht_i_1d(ji) + dh_snowice(ji) 
    653          ht_s_1d(ji)     = ht_s_1d(ji) - dh_snowice(ji) 
     623         ht_i_1d(ji)    = ht_i_1d(ji) + dh_snowice(ji) 
     624         ht_s_1d(ji)    = ht_s_1d(ji) - dh_snowice(ji) 
    654625 
    655626         ! Salinity of snow ice 
    656627         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    657          zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
     628         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
    658629 
    659630         ! entrapment during snow ice formation 
    660          ! new salinity difference stored (to be used in limthd_ent.F90) 
    661          IF (  num_sal == 2  ) THEN 
    662             rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi10 ) ) 
     631         ! new salinity difference stored (to be used in limthd_sal.F90) 
     632         IF (  nn_icesal == 2  ) THEN 
     633            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 
    663634            ! salinity dif due to snow-ice formation 
    664             dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch      
     635            dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch      
    665636            ! salinity dif due to bottom growth  
    666637            IF (  zf_tt(ji)  < 0._wp ) THEN 
    667                dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch 
     638               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch 
    668639            ENDIF 
    669640         ENDIF 
    … …  
    691662         h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 
    692663          
    693          ! Total ablation (to debug) 
    694          IF( ht_i_1d(ji) <= 0._wp )   a_i_1d(ji) = 0._wp 
    695  
    696       END DO !ji 
     664      END DO 
    697665 
    698666      ! 
    … …  
    700668      ! Update temperature, energy 
    701669      !------------------------------------------- 
    702       !clem bug: we should take snow into account here 
    703670      DO ji = kideb, kiut 
    704671         rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )  
    705          t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rtt 
    706       END DO  ! ji 
     672         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0 
     673      END DO 
    707674 
    708675      DO jk = 1, nlay_s 
    709676         DO ji = kideb,kiut 
    710677            ! mask enthalpy 
    711             rswitch       = MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  ) 
    712             q_s_1d(ji,jk) = ( 1.0 - rswitch ) * q_s_1d(ji,jk) 
     678            rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  ) 
     679            q_s_1d(ji,jk) = rswitch * q_s_1d(ji,jk) 
    713680            ! recalculate t_s_1d from q_s_1d 
    714             t_s_1d(ji,jk) = rtt + ( 1._wp - rswitch ) * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic ) 
     681            t_s_1d(ji,jk) = rt0 + rswitch * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic ) 
    715682         END DO 
    716683      END DO 
    717684 
    718       CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 
     685      ! --- ensure that a_i = 0 where ht_i = 0 --- 
     686      WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp 
     687       
     688      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw ) 
    719689      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
    720       CALL wrk_dealloc( jpij, nlay_i+1, zdeltah, zh_i ) 
    721       CALL wrk_dealloc( jpij, icount ) 
     690      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 
     691      CALL wrk_dealloc( jpij, nlay_i, icount ) 
    722692      ! 
    723693      ! 
    724694   END SUBROUTINE lim_thd_dh 
     695 
     696 
     697   !!-------------------------------------------------------------------------- 
     698   !! INTERFACE lim_thd_snwblow 
     699   !! ** Purpose :   Compute distribution of precip over the ice 
     700   !!-------------------------------------------------------------------------- 
     701   SUBROUTINE lim_thd_snwblow_2d( pin, pout ) 
     702      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( pfrld or (1. - a_i_b) ) 
     703      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout 
     704      pout = ( 1._wp - ( pin )**rn_betas ) 
     705   END SUBROUTINE lim_thd_snwblow_2d 
     706 
     707   SUBROUTINE lim_thd_snwblow_1d( pin, pout ) 
     708      REAL(wp), DIMENSION(:), INTENT(in   ) :: pin 
     709      REAL(wp), DIMENSION(:), INTENT(inout) :: pout 
     710      pout = ( 1._wp - ( pin )**rn_betas ) 
     711   END SUBROUTINE lim_thd_snwblow_1d 
     712 
    725713    
    726714#else 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r4990 r5682  
    1919   USE phycst         ! physical constants (ocean directory)  
    2020   USE ice            ! LIM-3 variables 
    21    USE par_ice        ! LIM-3 parameters 
    2221   USE thd_ice        ! LIM-3: thermodynamics 
    2322   USE in_out_manager ! I/O manager 
    … …  
    2524   USE wrk_nemo       ! work arrays 
    2625   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    27    USE sbc_oce, ONLY : lk_cpl 
    2826 
    2927   IMPLICIT NONE 
    … …  
    10098      INTEGER ::   nconv       ! number of iterations in iterative procedure 
    10199      INTEGER ::   minnumeqmin, maxnumeqmax 
     100       
    102101      INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation 
    103102      INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation 
    104       INTEGER, POINTER, DIMENSION(:) ::   isnow      ! switch for presence (1) or absence (0) of snow 
     103       
    105104      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
    106105      REAL(wp) ::   zg1       =  2._wp        ! 
    … …  
    112111      REAL(wp) ::   ztmelt_i    ! ice melting temperature 
    113112      REAL(wp) ::   zerritmax   ! current maximal error on temperature  
    114       REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! ice melting point 
    115       REAL(wp), POINTER, DIMENSION(:) ::   ztsub       ! old surface temperature (before the iterative procedure ) 
    116       REAL(wp), POINTER, DIMENSION(:) ::   ztsubit     ! surface temperature at previous iteration 
    117       REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness 
    118       REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness 
    119       REAL(wp), POINTER, DIMENSION(:) ::   zfsw        ! solar radiation absorbed at the surface 
    120       REAL(wp), POINTER, DIMENSION(:) ::   zf          ! surface flux function 
    121       REAL(wp), POINTER, DIMENSION(:) ::   dzf         ! derivative of the surface flux function 
    122       REAL(wp), POINTER, DIMENSION(:) ::   zerrit      ! current error on temperature 
    123       REAL(wp), POINTER, DIMENSION(:) ::   zdifcase    ! case of the equation resolution (1->4) 
    124       REAL(wp), POINTER, DIMENSION(:) ::   zftrice     ! solar radiation transmitted through the ice 
    125       REAL(wp), POINTER, DIMENSION(:) ::   zihic, zhsu 
    126       REAL(wp), POINTER, DIMENSION(:,:) ::   ztcond_i    ! Ice thermal conductivity 
    127       REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_i    ! Radiation transmitted through the ice 
    128       REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_i    ! Radiation absorbed in the ice 
    129       REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_i    ! Kappa factor in the ice 
    130       REAL(wp), POINTER, DIMENSION(:,:) ::   ztib        ! Old temperature in the ice 
    131       REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_i      ! Eta factor in the ice 
    132       REAL(wp), POINTER, DIMENSION(:,:) ::   ztitemp     ! Temporary temperature in the ice to check the convergence 
    133       REAL(wp), POINTER, DIMENSION(:,:) ::   zspeche_i   ! Ice specific heat 
    134       REAL(wp), POINTER, DIMENSION(:,:) ::   z_i         ! Vertical cotes of the layers in the ice 
    135       REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_s    ! Radiation transmited through the snow 
    136       REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_s    ! Radiation absorbed in the snow 
    137       REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_s    ! Kappa factor in the snow 
    138       REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_s      ! Eta factor in the snow 
    139       REAL(wp), POINTER, DIMENSION(:,:) ::   ztstemp     ! Temporary temperature in the snow to check the convergence 
    140       REAL(wp), POINTER, DIMENSION(:,:) ::   ztsb        ! Temporary temperature in the snow 
    141       REAL(wp), POINTER, DIMENSION(:,:) ::   z_s         ! Vertical cotes of the layers in the snow 
    142       REAL(wp), POINTER, DIMENSION(:,:) ::   zswiterm    ! Independent term 
    143       REAL(wp), POINTER, DIMENSION(:,:) ::   zswitbis    ! temporary independent term 
    144       REAL(wp), POINTER, DIMENSION(:,:) ::   zdiagbis 
    145       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid     ! tridiagonal system terms 
     113      REAL(wp) ::   zhsu 
     114       
     115      REAL(wp), POINTER, DIMENSION(:)     ::   isnow       ! switch for presence (1) or absence (0) of snow 
     116      REAL(wp), POINTER, DIMENSION(:)     ::   ztsub       ! old surface temperature (before the iterative procedure ) 
     117      REAL(wp), POINTER, DIMENSION(:)     ::   ztsubit     ! surface temperature at previous iteration 
     118      REAL(wp), POINTER, DIMENSION(:)     ::   zh_i        ! ice layer thickness 
     119      REAL(wp), POINTER, DIMENSION(:)     ::   zh_s        ! snow layer thickness 
     120      REAL(wp), POINTER, DIMENSION(:)     ::   zfsw        ! solar radiation absorbed at the surface 
     121      REAL(wp), POINTER, DIMENSION(:)     ::   zqns_ice_b  ! solar radiation absorbed at the surface 
     122      REAL(wp), POINTER, DIMENSION(:)     ::   zf          ! surface flux function 
     123      REAL(wp), POINTER, DIMENSION(:)     ::   dzf         ! derivative of the surface flux function 
     124      REAL(wp), POINTER, DIMENSION(:)     ::   zerrit      ! current error on temperature 
     125      REAL(wp), POINTER, DIMENSION(:)     ::   zdifcase    ! case of the equation resolution (1->4) 
     126      REAL(wp), POINTER, DIMENSION(:)     ::   zftrice     ! solar radiation transmitted through the ice 
     127      REAL(wp), POINTER, DIMENSION(:)     ::   zihic 
     128       
     129      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztcond_i    ! Ice thermal conductivity 
     130      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_i    ! Radiation transmitted through the ice 
     131      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_i    ! Radiation absorbed in the ice 
     132      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_i    ! Kappa factor in the ice 
     133      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztib        ! Old temperature in the ice 
     134      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_i      ! Eta factor in the ice 
     135      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztitemp     ! Temporary temperature in the ice to check the convergence 
     136      REAL(wp), POINTER, DIMENSION(:,:)   ::   zspeche_i   ! Ice specific heat 
     137      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_i         ! Vertical cotes of the layers in the ice 
     138      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_s    ! Radiation transmited through the snow 
     139      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_s    ! Radiation absorbed in the snow 
     140      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_s    ! Kappa factor in the snow 
     141      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_s      ! Eta factor in the snow 
     142      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztstemp     ! Temporary temperature in the snow to check the convergence 
     143      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztsb        ! Temporary temperature in the snow 
     144      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_s         ! Vertical cotes of the layers in the snow 
     145      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindterm    ! 'Ind'ependent term 
     146      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindtbis    ! Temporary 'ind'ependent term 
     147      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdiagbis    ! Temporary 'dia'gonal term 
     148      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid       ! Tridiagonal system terms 
     149       
    146150      ! diag errors on heat 
    147       REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 
     151      REAL(wp), POINTER, DIMENSION(:)     :: zdq, zq_ini, zhfx_err 
     152       
     153      ! Mono-category 
     154      REAL(wp)                            :: zepsilon      ! determines thres. above which computation of G(h) is done 
     155      REAL(wp)                            :: zratio_s      ! dummy factor 
     156      REAL(wp)                            :: zratio_i      ! dummy factor 
     157      REAL(wp)                            :: zh_thres      ! thickness thres. for G(h) computation 
     158      REAL(wp)                            :: zhe           ! dummy factor 
     159      REAL(wp)                            :: zkimean       ! mean sea ice thermal conductivity 
     160      REAL(wp)                            :: zfac          ! dummy factor 
     161      REAL(wp)                            :: zihe          ! dummy factor 
     162      REAL(wp)                            :: zheshth       ! dummy factor 
     163       
     164      REAL(wp), POINTER, DIMENSION(:)     :: zghe          ! G(he), th. conduct enhancement factor, mono-cat 
     165       
    148166      !!------------------------------------------------------------------      
    149167      !  
    150       CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow ) 
    151       CALL wrk_alloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
    152       CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 
    153       CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0) 
    154       CALL wrk_alloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0) 
    155       CALL wrk_alloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis  ) 
    156       CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid ) 
     168      CALL wrk_alloc( jpij, numeqmin, numeqmax ) 
     169      CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
     170      CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe ) 
     171      CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 ) 
     172      CALL wrk_alloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 ) 
     173      CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis  ) 
     174      CALL wrk_alloc( jpij,nlay_i+3,3, ztrid ) 
    157175 
    158176      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 
    … …  
    161179      zdq(:) = 0._wp ; zq_ini(:) = 0._wp       
    162180      DO ji = kideb, kiut 
    163          zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  & 
    164             &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) )  
     181         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  & 
     182            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s )  
    165183      END DO 
    166184 
    … …  
    168186      ! 1) Initialization                                                            ! 
    169187      !------------------------------------------------------------------------------! 
    170       ! clem clean: replace just ztfs by rtt 
    171188      DO ji = kideb , kiut 
    172          ! is there snow or not 
    173          isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  ) 
    174          ! surface temperature of fusion 
    175          ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 
     189         isnow(ji)= 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  ! is there snow or not 
    176190         ! layer thickness 
    177          zh_i(ji) = ht_i_1d(ji) / REAL( nlay_i ) 
    178          zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s ) 
     191         zh_i(ji) = ht_i_1d(ji) * r1_nlay_i 
     192         zh_s(ji) = ht_s_1d(ji) * r1_nlay_s 
    179193      END DO 
    180194 
    … …  
    188202      DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
    189203         DO ji = kideb , kiut 
    190             z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) / REAL( nlay_s ) 
     204            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) * r1_nlay_s 
    191205         END DO 
    192206      END DO 
    … …  
    194208      DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
    195209         DO ji = kideb , kiut 
    196             z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) / REAL( nlay_i ) 
     210            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) * r1_nlay_i 
    197211         END DO 
    198212      END DO 
    199213      ! 
    200214      !------------------------------------------------------------------------------| 
    201       ! 2) Radiations                                                                | 
     215      ! 2) Radiation                                                       | 
    202216      !------------------------------------------------------------------------------| 
    203217      ! 
    … …  
    212226      ! zftrice = io.qsr_ice       is below the surface  
    213227      ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
    214  
     228      ! fr1_i0_1d = i0 for a thin ice cover, fr1_i0_2d = i0 for a thick ice cover 
     229      zhsu = 0.1_wp ! threshold for the computation of i0 
    215230      DO ji = kideb , kiut 
    216231         ! switches 
    217          isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) )  
     232         isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )  
    218233         ! hs > 0, isnow = 1 
    219          zhsu (ji) = hnzst  ! threshold for the computation of i0 
    220          zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu(ji) ) )      
    221  
    222          i0(ji)    = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
    223          !fr1_i0_1d = i0 for a thin ice surface 
    224          !fr1_i0_2d = i0 for a thick ice surface 
    225          !            a function of the cloud cover 
    226          ! 
    227          !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_1d(ji)+10.0) 
    228          !formula used in Cice 
     234         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu ) )      
     235 
     236         i0(ji)    = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
    229237      END DO 
    230238 
    … …  
    234242      !------------------------------------------------------- 
    235243      DO ji = kideb , kiut 
    236          zfsw   (ji) =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface 
    237          zftrice(ji) =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer 
    238          dzf    (ji) = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux  
     244         zfsw   (ji)    =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface 
     245         zftrice(ji)    =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer 
     246         dzf    (ji)    = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux  
     247         zqns_ice_b(ji) = qns_ice_1d(ji)                     ! store previous qns_ice_1d value 
    239248      END DO 
    240249 
    … …  
    257266 
    258267      DO ji = kideb, kiut           ! ice initialization 
    259          zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * REAL( isnow(ji) ) + zftrice(ji) * REAL( 1 - isnow(ji) ) 
     268         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) ) 
    260269      END DO 
    261270 
    … …  
    263272         DO ji = kideb, kiut 
    264273            !                             ! radiation transmitted below the layer-th ice layer 
    265             zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) ) 
     274            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) ) 
    266275            !                             ! radiation absorbed by the layer-th ice layer 
    267276            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) 
    … …  
    273282      END DO 
    274283 
    275       ! 
    276284      !------------------------------------------------------------------------------| 
    277285      !  3) Iterative procedure begins                                               | 
    … …  
    281289         ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr. 
    282290         ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter 
    283          t_su_1d   (ji) =  MIN( t_su_1d(ji), ztfs(ji) - ztsu_err )  ! necessary 
    284          zerrit   (ji) =  1000._wp                                ! initial value of error 
     291         t_su_1d(ji) =  MIN( t_su_1d(ji), rt0 - ztsu_err )       ! necessary 
     292         zerrit (ji) =  1000._wp                                 ! initial value of error 
    285293      END DO 
    286294 
    … …  
    300308      zerritmax =  1000._wp    ! maximal value of error on all points 
    301309 
    302       DO WHILE ( zerritmax > maxer_i_thd .AND. nconv < nconv_i_thd ) 
     310      DO WHILE ( zerritmax > rn_terr_dif .AND. nconv < nn_conv_dif ) 
    303311         ! 
    304312         nconv = nconv + 1 
    … …  
    308316         !------------------------------------------------------------------------------| 
    309317         ! 
    310          IF( thcon_i_swi == 0 ) THEN      ! Untersteiner (1964) formula 
    311             DO ji = kideb , kiut 
    312                ztcond_i(ji,0)        = rcdic + zbeta*s_i_1d(ji,1) / MIN(-epsi10,t_i_1d(ji,1)-rtt) 
    313                ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin) 
     318         IF( nn_ice_thcon == 0 ) THEN      ! Untersteiner (1964) formula 
     319            DO ji = kideb , kiut 
     320               ztcond_i(ji,0) = rcdic + zbeta * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 ) 
     321               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 
    314322            END DO 
    315323            DO jk = 1, nlay_i-1 
    316324               DO ji = kideb , kiut 
    317                   ztcond_i(ji,jk) = rcdic + zbeta*( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  & 
    318                      MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt) 
    319                   ztcond_i(ji,jk) = MAX(ztcond_i(ji,jk),zkimin) 
     325                  ztcond_i(ji,jk) = rcdic + zbeta * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  & 
     326                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0) 
     327                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin ) 
    320328               END DO 
    321329            END DO 
    322330         ENDIF 
    323331 
    324          IF( thcon_i_swi == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T 
    325             DO ji = kideb , kiut 
    326                ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1)-rtt )   & 
    327                   &                   - 0.011_wp * ( t_i_1d(ji,1) - rtt )   
     332         IF( nn_ice_thcon == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T 
     333            DO ji = kideb , kiut 
     334               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )   & 
     335                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rt0 )   
    328336               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 
    329337            END DO 
    330338            DO jk = 1, nlay_i-1 
    331339               DO ji = kideb , kiut 
    332                   ztcond_i(ji,jk) = rcdic +                                                                     &  
    333                      &                 0.090_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                          & 
    334                      &                 / MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)   & 
    335                      &               - 0.0055_wp* ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0*rtt )   
     340                  ztcond_i(ji,jk) = rcdic +                                                                       &  
     341                     &                 0.09_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                              & 
     342                     &                 / MIN( -2._wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0 )   & 
     343                     &               - 0.0055_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0 * rt0 )   
    336344                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin ) 
    337345               END DO 
    338346            END DO 
    339347            DO ji = kideb , kiut 
    340                ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN(-epsi10,t_bo_1d(ji)-rtt)   & 
    341                   &                        - 0.011_wp * ( t_bo_1d(ji) - rtt )   
     348               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 )   & 
     349                  &                        - 0.011_wp * ( t_bo_1d(ji) - rt0 )   
    342350               ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin ) 
    343351            END DO 
    344352         ENDIF 
    345          ! 
    346          !------------------------------------------------------------------------------| 
    347          !  5) kappa factors                                                            | 
    348          !------------------------------------------------------------------------------| 
    349          ! 
     353          
     354         ! 
     355         !------------------------------------------------------------------------------| 
     356         !  5) G(he) - enhancement of thermal conductivity in mono-category case        | 
     357         !------------------------------------------------------------------------------| 
     358         ! 
     359         ! Computation of effective thermal conductivity G(h) 
     360         ! Used in mono-category case only to simulate an ITD implicitly 
     361         ! Fichefet and Morales Maqueda, JGR 1997 
     362 
     363         zghe(:) = 1._wp 
     364 
     365         SELECT CASE ( nn_monocat ) 
     366 
     367         CASE (1,3) ! LIM3 
     368 
     369            zepsilon = 0.1_wp 
     370            zh_thres = EXP( 1._wp ) * zepsilon * 0.5_wp 
     371 
     372            DO ji = kideb, kiut 
     373    
     374               ! Mean sea ice thermal conductivity 
     375               zkimean  = SUM( ztcond_i(ji,0:nlay_i) ) / REAL( nlay_i+1, wp ) 
     376 
     377               ! Effective thickness he (zhe) 
     378               zfac     = 1._wp / ( rcdsn + zkimean ) 
     379               zratio_s = rcdsn   * zfac 
     380               zratio_i = zkimean * zfac 
     381               zhe      = zratio_s * ht_i_1d(ji) + zratio_i * ht_s_1d(ji) 
     382 
     383               ! G(he) 
     384               rswitch  = MAX( 0._wp , SIGN( 1._wp , zhe - zh_thres ) )  ! =0 if zhe < zh_thres, if > 
     385               zghe(ji) = ( 1._wp - rswitch ) + rswitch * 0.5_wp * ( 1._wp + LOG( 2._wp * zhe / zepsilon ) ) 
     386    
     387               ! Impose G(he) < 2. 
     388               zghe(ji) = MIN( zghe(ji), 2._wp ) 
     389 
     390            END DO 
     391 
     392         END SELECT 
     393 
     394         ! 
     395         !------------------------------------------------------------------------------| 
     396         !  6) kappa factors                                                            | 
     397         !------------------------------------------------------------------------------| 
     398         ! 
     399         !--- Snow 
    350400         DO ji = kideb, kiut 
    351  
    352             !-- Snow kappa factors 
    353             zkappa_s(ji,0)         = rcdsn / MAX(epsi10,zh_s(ji)) 
    354             zkappa_s(ji,nlay_s)    = rcdsn / MAX(epsi10,zh_s(ji)) 
     401            zfac                  =  1. / MAX( epsi10 , zh_s(ji) ) 
     402            zkappa_s(ji,0)        = zghe(ji) * rcdsn * zfac 
     403            zkappa_s(ji,nlay_s)   = zghe(ji) * rcdsn * zfac 
    355404         END DO 
    356405 
    357406         DO jk = 1, nlay_s-1 
    358407            DO ji = kideb , kiut 
    359                zkappa_s(ji,jk)  = 2.0 * rcdsn / & 
    360                   MAX(epsi10,2.0*zh_s(ji)) 
    361             END DO 
    362          END DO 
    363  
     408               zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rcdsn / MAX( epsi10, 2.0 * zh_s(ji) ) 
     409            END DO 
     410         END DO 
     411 
     412         !--- Ice 
    364413         DO jk = 1, nlay_i-1 
    365414            DO ji = kideb , kiut 
    366                !-- Ice kappa factors 
    367                zkappa_i(ji,jk)  = 2.0*ztcond_i(ji,jk)/ & 
    368                   MAX(epsi10,2.0*zh_i(ji))  
    369             END DO 
    370          END DO 
    371  
    372          DO ji = kideb , kiut 
    373             zkappa_i(ji,0)        = ztcond_i(ji,0)/MAX(epsi10,zh_i(ji)) 
    374             zkappa_i(ji,nlay_i)   = ztcond_i(ji,nlay_i) / MAX(epsi10,zh_i(ji)) 
    375             !-- Interface 
    376             zkappa_s(ji,nlay_s)   = 2.0*rcdsn*ztcond_i(ji,0)/MAX(epsi10, & 
    377                (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji))) 
    378             zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*REAL( isnow(ji) ) & 
    379                + zkappa_i(ji,0)*REAL( 1 - isnow(ji) ) 
    380          END DO 
    381          ! 
    382          !------------------------------------------------------------------------------| 
    383          ! 6) Sea ice specific heat, eta factors                                        | 
     415               zkappa_i(ji,jk)    = zghe(ji) * 2.0 * ztcond_i(ji,jk) / MAX( epsi10 , 2.0 * zh_i(ji) ) 
     416            END DO 
     417         END DO 
     418 
     419         !--- Snow-ice interface 
     420         DO ji = kideb , kiut 
     421            zfac                  = 1./ MAX( epsi10 , zh_i(ji) ) 
     422            zkappa_i(ji,0)        = zghe(ji) * ztcond_i(ji,0) * zfac 
     423            zkappa_i(ji,nlay_i)   = zghe(ji) * ztcond_i(ji,nlay_i) * zfac 
     424            zkappa_s(ji,nlay_s)   = zghe(ji) * zghe(ji) * 2.0 * rcdsn * ztcond_i(ji,0) / &  
     425           &                        MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rcdsn * zh_i(ji) ) ) 
     426            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) ) 
     427         END DO 
     428 
     429         ! 
     430         !------------------------------------------------------------------------------| 
     431         ! 7) Sea ice specific heat, eta factors                                        | 
    384432         !------------------------------------------------------------------------------| 
    385433         ! 
    … …  
    387435            DO ji = kideb , kiut 
    388436               ztitemp(ji,jk)   = t_i_1d(ji,jk) 
    389                zspeche_i(ji,jk) = cpic + zgamma*s_i_1d(ji,jk)/ & 
    390                   MAX((t_i_1d(ji,jk)-rtt)*(ztib(ji,jk)-rtt),epsi10) 
    391                zeta_i(ji,jk)    = rdt_ice / MAX(rhoic*zspeche_i(ji,jk)*zh_i(ji), & 
    392                   epsi10) 
     437               zspeche_i(ji,jk) = cpic + zgamma * s_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztib(ji,jk) - rt0 ), epsi10 ) 
     438               zeta_i(ji,jk)    = rdt_ice / MAX( rhoic * zspeche_i(ji,jk) * zh_i(ji), epsi10 ) 
    393439            END DO 
    394440         END DO 
    … …  
    397443            DO ji = kideb , kiut 
    398444               ztstemp(ji,jk) = t_s_1d(ji,jk) 
    399                zeta_s(ji,jk)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10) 
    400             END DO 
    401          END DO 
    402          ! 
    403          !------------------------------------------------------------------------------| 
    404          ! 7) surface flux computation                                                  | 
    405          !------------------------------------------------------------------------------| 
    406          ! 
    407          IF( .NOT. lk_cpl ) THEN   !--- forced atmosphere case 
     445               zeta_s(ji,jk)  = rdt_ice / MAX( rhosn * cpic * zh_s(ji), epsi10 ) 
     446            END DO 
     447         END DO 
     448 
     449         ! 
     450         !------------------------------------------------------------------------------| 
     451         ! 8) surface flux computation                                                  | 
     452         !------------------------------------------------------------------------------| 
     453         ! 
     454         IF ( ln_it_qnsice ) THEN  
    408455            DO ji = kideb , kiut 
    409456               ! update of the non solar flux according to the update in T_su 
    … …  
    415462         DO ji = kideb , kiut 
    416463            ! update incoming flux 
    417             zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    418                + qns_ice_1d(ji)                   ! non solar total flux  
    419             ! (LWup, LWdw, SH, LH) 
    420          END DO 
    421  
    422          ! 
    423          !------------------------------------------------------------------------------| 
    424          ! 8) tridiagonal system terms                                                  | 
     464            zf(ji)    =          zfsw(ji)              & ! net absorbed solar radiation 
     465               &         + qns_ice_1d(ji)                ! non solar total flux (LWup, LWdw, SH, LH) 
     466         END DO 
     467 
     468         ! 
     469         !------------------------------------------------------------------------------| 
     470         ! 9) tridiagonal system terms                                                  | 
    425471         !------------------------------------------------------------------------------| 
    426472         ! 
    … …  
    437483               ztrid(ji,numeq,2) = 0. 
    438484               ztrid(ji,numeq,3) = 0. 
    439                zswiterm(ji,numeq)= 0. 
    440                zswitbis(ji,numeq)= 0. 
     485               zindterm(ji,numeq)= 0. 
     486               zindtbis(ji,numeq)= 0. 
    441487               zdiagbis(ji,numeq)= 0. 
    442488            ENDDO 
    … …  
    445491         DO numeq = nlay_s + 2, nlay_s + nlay_i  
    446492            DO ji = kideb , kiut 
    447                jk              = numeq - nlay_s - 1 
    448                ztrid(ji,numeq,1)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk-1) 
    449                ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk)*(zkappa_i(ji,jk-1) + & 
    450                   zkappa_i(ji,jk)) 
    451                ztrid(ji,numeq,3)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk) 
    452                zswiterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk)* & 
    453                   zradab_i(ji,jk) 
     493               jk                 = numeq - nlay_s - 1 
     494               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk-1) 
     495               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk) * ( zkappa_i(ji,jk-1) + zkappa_i(ji,jk) ) 
     496               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk) 
     497               zindterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk) * zradab_i(ji,jk) 
    454498            END DO 
    455499         ENDDO 
    … …  
    459503            !!ice bottom term 
    460504            ztrid(ji,numeq,1)  =  - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)    
    461             ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i)*( zkappa_i(ji,nlay_i)*zg1 & 
    462                +  zkappa_i(ji,nlay_i-1) ) 
     505            ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i) * zg1 + zkappa_i(ji,nlay_i-1) ) 
    463506            ztrid(ji,numeq,3)  =  0.0 
    464             zswiterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i)* & 
    465                ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 & 
    466                *  t_bo_1d(ji) )  
     507            zindterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i) *  & 
     508               &                  ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 *  t_bo_1d(ji) )  
    467509         ENDDO 
    468510 
    469511 
    470512         DO ji = kideb , kiut 
    471             IF ( ht_s_1d(ji).gt.0.0 ) THEN 
     513            IF ( ht_s_1d(ji) > 0.0 ) THEN 
    472514               ! 
    473515               !------------------------------------------------------------------------------| 
    … …  
    477519               !!snow interior terms (bottom equation has the same form as the others) 
    478520               DO numeq = 3, nlay_s + 1 
    479                   jk =  numeq - 1 
    480                   ztrid(ji,numeq,1)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk-1) 
    481                   ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk)*( zkappa_s(ji,jk-1) + & 
    482                      zkappa_s(ji,jk) ) 
     521                  jk                  =  numeq - 1 
     522                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk) * zkappa_s(ji,jk-1) 
     523                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk) * ( zkappa_s(ji,jk-1) + zkappa_s(ji,jk) ) 
    483524                  ztrid(ji,numeq,3)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk) 
    484                   zswiterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk)* & 
    485                      zradab_s(ji,jk) 
     525                  zindterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk) 
    486526               END DO 
    487527 
    … …  
    489529               IF ( nlay_i.eq.1 ) THEN 
    490530                  ztrid(ji,nlay_s+2,3)    =  0.0 
    491                   zswiterm(ji,nlay_s+2)   =  zswiterm(ji,nlay_s+2) + zkappa_i(ji,1)* & 
    492                      t_bo_1d(ji)  
     531                  zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1) * t_bo_1d(ji)  
    493532               ENDIF 
    494533 
    495                IF ( t_su_1d(ji) .LT. rtt ) THEN 
     534               IF ( t_su_1d(ji) < rt0 ) THEN 
    496535 
    497536                  !------------------------------------------------------------------------------| 
    … …  
    503542 
    504543                  !!surface equation 
    505                   ztrid(ji,1,1) = 0.0 
    506                   ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0) 
    507                   ztrid(ji,1,3) = zg1s*zkappa_s(ji,0) 
    508                   zswiterm(ji,1) = dzf(ji)*t_su_1d(ji)  - zf(ji) 
     544                  ztrid(ji,1,1)  = 0.0 
     545                  ztrid(ji,1,2)  = dzf(ji) - zg1s * zkappa_s(ji,0) 
     546                  ztrid(ji,1,3)  = zg1s * zkappa_s(ji,0) 
     547                  zindterm(ji,1) = dzf(ji) * t_su_1d(ji) - zf(ji) 
    509548 
    510549                  !!first layer of snow equation 
    511                   ztrid(ji,2,1)  =  - zkappa_s(ji,0)*zg1s*zeta_s(ji,1) 
    512                   ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s) 
     550                  ztrid(ji,2,1)  =  - zkappa_s(ji,0) * zg1s * zeta_s(ji,1) 
     551                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s ) 
    513552                  ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1) 
    514                   zswiterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1)*zradab_s(ji,1) 
     553                  zindterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1) * zradab_s(ji,1) 
    515554 
    516555               ELSE  
    … …  
    526565                  !!first layer of snow equation 
    527566                  ztrid(ji,2,1)  =  0.0 
    528                   ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + & 
    529                      zkappa_s(ji,0) * zg1s ) 
     567                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s ) 
    530568                  ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1)  
    531                   zswiterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *            & 
    532                      ( zradab_s(ji,1) +                         & 
    533                      zkappa_s(ji,0) * zg1s * t_su_1d(ji) )  
     569                  zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *  & 
     570                     &             ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) )  
    534571               ENDIF 
    535572            ELSE 
    … …  
    539576               !------------------------------------------------------------------------------| 
    540577               ! 
    541                IF (t_su_1d(ji) .LT. rtt) THEN 
     578               IF ( t_su_1d(ji) < rt0 ) THEN 
    542579                  ! 
    543580                  !------------------------------------------------------------------------------| 
    … …  
    553590                  ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1     
    554591                  ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1 
    555                   zswiterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji) 
     592                  zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji) 
    556593 
    557594                  !!first layer of ice equation 
    558595                  ztrid(ji,numeqmin(ji)+1,1) =  - zkappa_i(ji,0) * zg1 * zeta_i(ji,1) 
    559                   ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) &  
    560                      + zkappa_i(ji,0) * zg1 ) 
    561                   ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1)*zkappa_i(ji,1)   
    562                   zswiterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)   
     596                  ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 ) 
     597                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1) * zkappa_i(ji,1)   
     598                  zindterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)   
    563599 
    564600                  !!case of only one layer in the ice (surface & ice equations are altered) 
    565601 
    566                   IF (nlay_i.eq.1) THEN 
     602                  IF ( nlay_i == 1 ) THEN 
    567603                     ztrid(ji,numeqmin(ji),1)    =  0.0 
    568                      ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0)*2.0 
    569                      ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0)*2.0 
    570                      ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0)*2.0*zeta_i(ji,1) 
    571                      ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 
    572                         zkappa_i(ji,1)) 
     604                     ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0) * 2.0 
     605                     ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0) * 2.0 
     606                     ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0) * 2.0 * zeta_i(ji,1) 
     607                     ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) ) 
    573608                     ztrid(ji,numeqmin(ji)+1,3)  =  0.0 
    574609 
    575                      zswiterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1)* & 
    576                         ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji) ) 
     610                     zindterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1) * & 
     611                        &                          ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) ) 
    577612                  ENDIF 
    578613 
    … …  
    590625                  !!first layer of ice equation 
    591626                  ztrid(ji,numeqmin(ji),1)      =  0.0 
    592                   ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,1) + zkappa_i(ji,0)* & 
    593                      zg1)   
     627                  ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )   
    594628                  ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1) 
    595                   zswiterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + & 
    596                      zkappa_i(ji,0) * zg1 * t_su_1d(ji) )  
     629                  zindterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1) * & 
     630                     &                             ( zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji) )  
    597631 
    598632                  !!case of only one layer in the ice (surface & ice equations are altered) 
    599                   IF (nlay_i.eq.1) THEN 
     633                  IF ( nlay_i == 1 ) THEN 
    600634                     ztrid(ji,numeqmin(ji),1)  =  0.0 
    601                      ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 
    602                         zkappa_i(ji,1)) 
     635                     ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) ) 
    603636                     ztrid(ji,numeqmin(ji),3)  =  0.0 
    604                      zswiterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1)* & 
    605                         (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji)) & 
    606                         + t_su_1d(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0 
     637                     zindterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )  & 
     638                        &                       + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2.0 
    607639                  ENDIF 
    608640 
    … …  
    614646         ! 
    615647         !------------------------------------------------------------------------------| 
    616          ! 9) tridiagonal system solving                                                | 
     648         ! 10) tridiagonal system solving                                               | 
    617649         !------------------------------------------------------------------------------| 
    618650         ! 
    … …  
    626658 
    627659         DO ji = kideb , kiut 
    628             zswitbis(ji,numeqmin(ji)) =  zswiterm(ji,numeqmin(ji)) 
     660            zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji)) 
    629661            zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2) 
    630662            minnumeqmin               =  MIN(numeqmin(ji),minnumeqmin) 
    … …  
    635667            DO ji = kideb , kiut 
    636668               numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji)) 
    637                zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* & 
    638                   ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1) 
    639                zswitbis(ji,numeq)  =  zswiterm(ji,numeq) - ztrid(ji,numeq,1)* & 
    640                   zswitbis(ji,numeq-1)/zdiagbis(ji,numeq-1) 
     669               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2)  - ztrid(ji,numeq,1) * ztrid(ji,numeq-1,3)  / zdiagbis(ji,numeq-1) 
     670               zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1) * zindtbis(ji,numeq-1) / zdiagbis(ji,numeq-1) 
    641671            END DO 
    642672         END DO 
    … …  
    644674         DO ji = kideb , kiut 
    645675            ! ice temperatures 
    646             t_i_1d(ji,nlay_i)    =  zswitbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji)) 
    647          END DO 
    648  
    649          DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1 
     676            t_i_1d(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji)) / zdiagbis(ji,numeqmax(ji)) 
     677         END DO 
     678 
     679         DO numeq = nlay_i + nlay_s, nlay_s + 2, -1 
    650680            DO ji = kideb , kiut 
    651681               jk    =  numeq - nlay_s - 1 
    652                t_i_1d(ji,jk)  =  (zswitbis(ji,numeq) - ztrid(ji,numeq,3)* & 
    653                   t_i_1d(ji,jk+1))/zdiagbis(ji,numeq) 
     682               t_i_1d(ji,jk)  =  ( zindtbis(ji,numeq) - ztrid(ji,numeq,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,numeq) 
    654683            END DO 
    655684         END DO 
    … …  
    657686         DO ji = kideb , kiut 
    658687            ! snow temperatures       
    659             IF (ht_s_1d(ji).GT.0._wp) & 
    660                t_s_1d(ji,nlay_s)     =  (zswitbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
    661                *  t_i_1d(ji,1))/zdiagbis(ji,nlay_s+1) & 
    662                *        MAX(0.0,SIGN(1.0,ht_s_1d(ji)))  
     688            IF (ht_s_1d(ji) > 0._wp) & 
     689               t_s_1d(ji,nlay_s)     =  ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) )  & 
     690               &                        / zdiagbis(ji,nlay_s+1) * MAX( 0.0, SIGN( 1.0, ht_s_1d(ji) ) )  
    663691 
    664692            ! surface temperature 
    665             isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_1d(ji) )  ) ) 
     693            isnow(ji)   = 1._wp - MAX( 0._wp , SIGN( 1._wp , -ht_s_1d(ji) ) ) 
    666694            ztsubit(ji) = t_su_1d(ji) 
    667             IF( t_su_1d(ji) < ztfs(ji) ) & 
    668                t_su_1d(ji) = ( zswitbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_1d(ji,1)   & 
    669                &          + REAL( 1 - isnow(ji) )*t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
     695            IF( t_su_1d(ji) < rt0 ) & 
     696               t_su_1d(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3) *  & 
     697               &             ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
    670698         END DO 
    671699         ! 
    672700         !-------------------------------------------------------------------------- 
    673          !  10) Has the scheme converged ?, end of the iterative procedure         | 
     701         !  11) Has the scheme converged ?, end of the iterative procedure         | 
    674702         !-------------------------------------------------------------------------- 
    675703         ! 
    676704         ! check that nowhere it has started to melt 
    677          ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd 
    678          DO ji = kideb , kiut 
    679             t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , ztfs(ji) ) , 190._wp  ) 
    680             zerrit(ji) =  ABS( t_su_1d(ji) - ztsubit(ji) )      
     705         ! zerrit(ji) is a measure of error, it has to be under terr_dif 
     706         DO ji = kideb , kiut 
     707            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , rt0 ) , 190._wp  ) 
     708            zerrit(ji)  =  ABS( t_su_1d(ji) - ztsubit(ji) )      
    681709         END DO 
    682710 
    683711         DO jk  =  1, nlay_s 
    684712            DO ji = kideb , kiut 
    685                t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rtt ), 190._wp  ) 
    686                zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_1d(ji,jk) - ztstemp(ji,jk))) 
     713               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rt0 ), 190._wp  ) 
     714               zerrit(ji)    = MAX( zerrit(ji), ABS( t_s_1d(ji,jk) - ztstemp(ji,jk) ) ) 
    687715            END DO 
    688716         END DO 
    … …  
    690718         DO jk  =  1, nlay_i 
    691719            DO ji = kideb , kiut 
    692                ztmelt_i        = -tmut * s_i_1d(ji,jk) + rtt  
    693                t_i_1d(ji,jk) =  MAX(MIN(t_i_1d(ji,jk),ztmelt_i), 190._wp) 
    694                zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_1d(ji,jk) - ztitemp(ji,jk))) 
     720               ztmelt_i      = -tmut * s_i_1d(ji,jk) + rt0  
     721               t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelt_i ), 190._wp ) 
     722               zerrit(ji)    =  MAX( zerrit(ji), ABS( t_i_1d(ji,jk) - ztitemp(ji,jk) ) ) 
    695723            END DO 
    696724         END DO 
    … …  
    706734      END DO  ! End of the do while iterative procedure 
    707735 
    708       IF( ln_nicep .AND. lwp ) THEN 
     736      IF( ln_icectl .AND. lwp ) THEN 
    709737         WRITE(numout,*) ' zerritmax : ', zerritmax 
    710738         WRITE(numout,*) ' nconv     : ', nconv 
    … …  
    713741      ! 
    714742      !-------------------------------------------------------------------------! 
    715       !   11) Fluxes at the interfaces                                          ! 
     743      !   12) Fluxes at the interfaces                                          ! 
    716744      !-------------------------------------------------------------------------! 
    717745      DO ji = kideb, kiut 
    718          ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux)  
    719          IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) ) 
    720746         !                                ! surface ice conduction flux 
    721          isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ) ) 
    722          fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   & 
    723             &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji)) 
     747         isnow(ji)       = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ) 
     748         fc_su(ji)       =  -           isnow(ji)  * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   & 
     749            &               - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji)) 
    724750         !                                ! bottom ice conduction flux 
    725751         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) ) 
    726752      END DO 
     753 
     754      ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 
     755      CALL lim_thd_enmelt( kideb, kiut ) 
     756 
     757      ! --- diagnose the change in non-solar flux due to surface temperature change --- ! 
     758      IF ( ln_it_qnsice ) THEN 
     759         DO ji = kideb, kiut 
     760            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji)  - zqns_ice_b(ji) ) * a_i_1d(ji)  
     761         END DO 
     762      END IF 
     763 
     764      ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 
     765      DO ji = kideb, kiut 
     766         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  & 
     767            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s ) 
     768         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC 
     769            zhfx_err(ji) = qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice  
     770         ELSE                          ! case T_su = 0degC 
     771            zhfx_err(ji) = fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice  
     772         ENDIF 
     773         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 
     774 
     775         ! total heat that is sent to the ocean (i.e. not used in the heat diffusion equation) 
     776         hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 
     777      END DO  
    727778 
    728779      !----------------------------------------- 
    … …  
    730781      !----------------------------------------- 
    731782      DO ji = kideb, kiut 
    732          IF( t_su_1d(ji) < rtt ) THEN  ! case T_su < 0degC 
     783         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC 
    733784            hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   & 
    734785               &            ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 
    735          ELSE                         ! case T_su = 0degC 
     786         ELSE                          ! case T_su = 0degC 
    736787            hfx_dif_1d(ji) = hfx_dif_1d(ji) +    & 
    737788               &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 
    738789         ENDIF 
    739       END DO 
    740  
    741       ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 
    742       CALL lim_thd_enmelt( kideb, kiut ) 
    743  
    744       ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 
    745       DO ji = kideb, kiut 
    746          zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  & 
    747             &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 
    748          zhfx_err(ji)   = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
    749          hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 
    750       END DO  
    751  
    752       ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 
    753       IF( .NOT. lk_cpl ) THEN   ! --- forced case: qns_ice and fc_su are diagnosed 
    754          ! 
    755          DO ji = kideb, kiut 
    756             qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 
    757             fc_su     (ji) = fc_su(ji)      - zhfx_err(ji) 
    758          END DO 
    759          ! 
    760       ELSE                      ! --- coupled case: ocean turbulent heat flux is diagnosed 
    761          ! 
    762          DO ji = kideb, kiut 
    763             fhtur_1d  (ji) = fhtur_1d(ji)   - zhfx_err(ji) 
    764          END DO 
    765          ! 
    766       ENDIF 
    767  
    768       ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2) 
    769       DO ji = kideb, kiut 
    770          ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    771          hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 
    772       END DO 
    773     
     790         ! correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation 
     791         hfx_dif_1d(ji) = hfx_dif_1d(ji) - zhfx_err(ji) * a_i_1d(ji) 
     792      END DO    
    774793      ! 
    775       CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow ) 
    776       CALL wrk_dealloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
    777       CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 
    778       CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i,   & 
    779          &              ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 
    780       CALL wrk_dealloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 
    781       CALL wrk_dealloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis ) 
    782       CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid ) 
     794      CALL wrk_dealloc( jpij, numeqmin, numeqmax ) 
     795      CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
     796      CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe ) 
     797      CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 
     798      CALL wrk_dealloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 
     799      CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis ) 
     800      CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid ) 
    783801      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 
    784802 
    … …  
    801819      DO jk = 1, nlay_i             ! Sea ice energy of melting 
    802820         DO ji = kideb, kiut 
    803             ztmelts      = - tmut  * s_i_1d(ji,jk) + rtt  
    804             rswitch      = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rtt) - epsi10 ) ) 
    805             q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                                             & 
    806                &                   + lfus * ( 1.0 - rswitch * ( ztmelts-rtt ) / MIN( t_i_1d(ji,jk)-rtt, -epsi10 ) )   & 
    807                &                   - rcp  *                 ( ztmelts-rtt )  )  
     821            ztmelts      = - tmut  * s_i_1d(ji,jk) + rt0 
     822            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts ) ! Force t_i_1d to be lower than melting point 
     823                                                          !   (sometimes dif scheme produces abnormally high temperatures)    
     824            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                           & 
     825               &                    + lfus * ( 1.0 - ( ztmelts-rt0 ) / ( t_i_1d(ji,jk) - rt0 ) )   & 
     826               &                    - rcp  *         ( ztmelts-rt0 )  )  
    808827         END DO 
    809828      END DO 
    810829      DO jk = 1, nlay_s             ! Snow energy of melting 
    811830         DO ji = kideb, kiut 
    812             q_s_1d(ji,jk) = rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) 
     831            q_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) 
    813832         END DO 
    814833      END DO 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

    r4990 r5682  
    2525   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2626   USE ice            ! LIM variables 
    27    USE par_ice        ! LIM parameters 
    2827   USE thd_ice        ! LIM thermodynamics 
    2928   USE limvar         ! LIM variables 
    … …  
    8786 
    8887      !-------------------------------------------------------------------------- 
    89       !  1) Cumulative integral of old enthalpy * thicnkess and layers interfaces 
     88      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces 
    9089      !-------------------------------------------------------------------------- 
    9190      zqh_cum0(:,0:nlay_i+2) = 0._wp  
    … …  
    103102      ! new layer thickesses 
    104103      DO ji = kideb, kiut 
    105          zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) / REAL( nlay_i )   
     104         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i   
    106105      ENDDO 
    107106 
    … …  
    133132      DO jk1 = 1, nlay_i 
    134133         DO ji = kideb, kiut 
    135             rswitch      = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) )  
    136             qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 ) 
     134            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) )  
     135            qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) 
    137136         ENDDO 
    138137      ENDDO 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r4990 r5682  
    2222   USE thd_ice        ! LIM thermodynamics 
    2323   USE dom_ice        ! LIM domain 
    24    USE par_ice        ! LIM parameters 
    2524   USE ice            ! LIM variables 
    2625   USE limtab         ! LIM 2D <==> 1D 
    … …  
    3231   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3332   USE limthd_ent 
     33   USE limvar 
    3434 
    3535   IMPLICIT NONE 
    … …  
    106106      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i 
    107107      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i 
    108       REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_1d  ! 1-D version of oa_i 
    109108      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i 
    110109 
    … …  
    112111 
    113112      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity 
     113 
     114      REAL(wp) :: zcai = 1.4e-3_wp 
    114115      !!-----------------------------------------------------------------------! 
    115116 
    … …  
    117118      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    118119      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
    119       CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
    120       CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     120      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d ) 
     121      CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d ) 
    121122      CALL wrk_alloc( jpi,jpj, zvrel ) 
    122123 
     124      CALL lim_var_agg(1) 
     125      CALL lim_var_glo2eqv 
    123126      !------------------------------------------------------------------------------| 
    124127      ! 2) Convert units for ice internal energy 
    … …  
    129132               DO ji = 1, jpi 
    130133                  !Energy of melting q(S,T) [J.m-3] 
    131                   rswitch          = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes 
    132                   e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) & 
    133                       &   / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i, wp ) 
    134                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 
     134                  rswitch          = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )   !0 if no ice 
     135                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl), epsi20 ) * REAL( nlay_i, wp ) 
    135136               END DO 
    136137            END DO 
    … …  
    155156 
    156157      ! Default new ice thickness  
    157       hicol(:,:) = hiccrit 
    158  
    159       IF( fraz_swi == 1 ) THEN 
     158      hicol(:,:) = rn_hnewice 
     159 
     160      IF( ln_frazil ) THEN 
    160161 
    161162         !-------------------- 
    … …  
    166167         zhicrit = 0.04 ! frazil ice thickness 
    167168         ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav 
    168          zsqcd   = 1.0 / SQRT( 1.3 * cai ) ! 1/SQRT(airdensity*drag) 
     169         zsqcd   = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag) 
    169170         zgamafr = 0.03 
    170171 
    … …  
    176177                  !------------- 
    177178                  ! C-grid wind stress components 
    178                   ztaux         = ( utau_ice(ji-1,jj  ) * tmu(ji-1,jj  )   & 
    179                      &          +   utau_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) * 0.5_wp 
    180                   ztauy         = ( vtau_ice(ji  ,jj-1) * tmv(ji  ,jj-1)   & 
    181                      &          +   vtau_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) * 0.5_wp 
     179                  ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   & 
     180                     &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp 
     181                  ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   & 
     182                     &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp 
    182183                  ! Square root of wind stress 
    183184                  ztenagm       =  SQRT( SQRT( ztaux**2 + ztauy**2 ) ) 
    … …  
    195196                  ! C-grid ice velocity 
    196197                  rswitch = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  ) 
    197                   zvgx    = rswitch * ( u_ice(ji-1,jj  ) * tmu(ji-1,jj  )  + u_ice(ji,jj) * tmu(ji,jj) ) * 0.5_wp 
    198                   zvgy    = rswitch * ( v_ice(ji  ,jj-1) * tmv(ji  ,jj-1)  + v_ice(ji,jj) * tmv(ji,jj) ) * 0.5_wp 
     198                  zvgx    = rswitch * ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 
     199                  zvgy    = rswitch * ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 
    199200 
    200201                  !----------------------------------- 
    … …  
    222223                  iterate_frazil = .true. 
    223224 
    224                   DO WHILE ( iter .LT. 100 .AND. iterate_frazil )  
     225                  DO WHILE ( iter < 100 .AND. iterate_frazil )  
    225226                     zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) & 
    226227                        - hicol(ji,jj) * zhicrit * ztwogp * zvrel2 
    … …  
    266267      ! debug point to follow 
    267268      jiindex_1d = 0 
    268       IF( ln_nicep ) THEN 
    269          DO ji = mi0(jiindx), mi1(jiindx) 
    270             DO jj = mj0(jjindx), mj1(jjindx) 
     269      IF( ln_icectl ) THEN 
     270         DO ji = mi0(iiceprt), mi1(iiceprt) 
     271            DO jj = mj0(jiceprt), mj1(jiceprt) 
    271272               IF ( qlead(ji,jj)  <  0._wp ) THEN 
    272273                  jiindex_1d = (jj - 1) * jpi + ji 
    … …  
    276277      ENDIF 
    277278    
    278       IF( ln_nicep ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
     279      IF( ln_icectl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
    279280 
    280281      !------------------------------ 
    … …  
    290291            CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    291292            CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    292             CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    293293            CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    294294            DO jk = 1, nlay_i 
    295295               CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
    296             END DO ! jk 
    297          END DO ! jl 
     296            END DO 
     297         END DO 
    298298 
    299299         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) ) 
    … …  
    320320         !---------------------- 
    321321         DO ji = 1, nbpac 
    322             zh_newice(ji) = hiccrit 
    323          END DO 
    324          IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 
     322            zh_newice(ji) = rn_hnewice 
     323         END DO 
     324         IF( ln_frazil ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 
    325325 
    326326         !---------------------- 
    327327         ! Salinity of new ice  
    328328         !---------------------- 
    329          SELECT CASE ( num_sal ) 
     329         SELECT CASE ( nn_icesal ) 
    330330         CASE ( 1 )                    ! Sice = constant  
    331             zs_newice(1:nbpac) = bulk_sal 
     331            zs_newice(1:nbpac) = rn_icesal 
    332332         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)] 
    333333            DO ji = 1, nbpac 
    334334               ii =   MOD( npac(ji) - 1 , jpi ) + 1 
    335335               ij =      ( npac(ji) - 1 ) / jpi + 1 
    336                zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , s_i_max , 0.5 * sss_m(ii,ij)  ) 
     336               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_m(ii,ij)  ) 
    337337            END DO 
    338338         CASE ( 3 )                    ! Sice = F(z) [multiyear ice] 
    … …  
    345345         ! We assume that new ice is formed at the seawater freezing point 
    346346         DO ji = 1, nbpac 
    347             ztmelts       = - tmut * zs_newice(ji) + rtt                  ! Melting point (K) 
     347            ztmelts       = - tmut * zs_newice(ji) + rt0                  ! Melting point (K) 
    348348            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                             & 
    349                &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) )   & 
    350                &                       - rcp  *         ( ztmelts - rtt )  ) 
    351          END DO ! ji 
     349               &                       + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) )   & 
     350               &                       - rcp  *         ( ztmelts - rt0 )  ) 
     351         END DO 
    352352 
    353353         !---------------- 
    … …  
    356356         DO ji = 1, nbpac 
    357357            zo_newice(ji) = 0._wp 
    358          END DO ! ji 
     358         END DO 
    359359 
    360360         !------------------- 
    … …  
    363363         DO ji = 1, nbpac 
    364364 
    365             zEi           = - ze_newice(ji) / rhoic                ! specific enthalpy of forming ice [J/kg] 
    366  
    367             zEw           = rcp * ( t_bo_1d(ji) - rt0 )             ! specific enthalpy of seawater at t_bo_1d [J/kg] 
     365            zEi           = - ze_newice(ji) * r1_rhoic             ! specific enthalpy of forming ice [J/kg] 
     366 
     367            zEw           = rcp * ( t_bo_1d(ji) - rt0 )            ! specific enthalpy of seawater at t_bo_1d [J/kg] 
    368368                                                                   ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied)  
    369369                                                                    
    … …  
    372372            zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0)  
    373373                                                                   ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point    
    374             zv_newice(ji) = - zfmdt / rhoic 
     374            zv_newice(ji) = - zfmdt * r1_rhoic 
    375375 
    376376            zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux   
    … …  
    387387            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    388388            rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 
    389             zfrazb        = rswitch * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 
     389            zfrazb        = rswitch * ( TANH ( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb 
    390390            zv_frazb(ji)  =         zfrazb   * zv_newice(ji) 
    391391            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
    … …  
    409409         ! we keep the excessive volume in memory and attribute it later to bottom accretion 
    410410         DO ji = 1, nbpac 
    411             IF ( za_newice(ji) >  ( amax - zat_i_1d(ji) ) ) THEN 
    412                zda_res(ji)   = za_newice(ji) - ( amax - zat_i_1d(ji) ) 
     411            IF ( za_newice(ji) >  ( rn_amax - zat_i_1d(ji) ) ) THEN 
     412               zda_res(ji)   = za_newice(ji) - ( rn_amax - zat_i_1d(ji) ) 
    413413               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji)  
    414414               za_newice(ji) = za_newice(ji) - zda_res  (ji) 
    … …  
    459459            DO jk = 1, nlay_i 
    460460               DO ji = 1, nbpac 
    461                   h_i_old (ji,jk) = zv_i_1d(ji,jl) / REAL( nlay_i ) 
     461                  h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i 
    462462                  qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk) 
    463463               END DO 
    … …  
    478478         ENDDO 
    479479 
    480          !------------ 
    481          ! Update age  
    482          !------------ 
    483          DO jl = 1, jpl 
    484             DO ji = 1, nbpac 
    485                rswitch          = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) )  ! 0 if no ice and 1 if yes 
    486                zoa_i_1d(ji,jl)  = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * rswitch    
    487             END DO  
    488          END DO    
    489  
    490480         !----------------- 
    491481         ! Update salinity 
    … …  
    504494            CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 
    505495            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 
    506             CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj ) 
    507496            CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 
    508497            DO jk = 1, nlay_i 
    … …  
    525514            DO jj = 1, jpj 
    526515               DO ji = 1, jpi 
    527                   ! heat content in Joules 
    528                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac )  
     516                  ! heat content in J/m2 
     517                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i  
    529518               END DO 
    530519            END DO 
    … …  
    536525      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    537526      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
    538       CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
    539       CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     527      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d ) 
     528      CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d ) 
    540529      CALL wrk_dealloc( jpi,jpj, zvrel ) 
    541530      ! 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r4872 r5682  
    1818   USE sbc_oce        ! Surface boundary condition: ocean fields 
    1919   USE ice            ! LIM variables 
    20    USE par_ice        ! LIM parameters 
    2120   USE thd_ice        ! LIM thermodynamics 
    2221   USE limvar         ! LIM variables 
    … …  
    3029 
    3130   PUBLIC   lim_thd_sal        ! called by limthd module 
    32    PUBLIC   lim_thd_sal_init   ! called by iceini module 
     31   PUBLIC   lim_thd_sal_init   ! called by sbc_lim_init 
    3332 
    3433   !!---------------------------------------------------------------------- 
    … …  
    4645      !! 
    4746      !! ** Method  :  3 possibilities 
    48       !!               -> num_sal = 1 -> Sice = cst    [ice salinity constant in both time & space]  
    49       !!               -> num_sal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005] 
    50       !!               -> num_sal = 3 -> Sice = S(z)   [multiyear ice] 
     47      !!               -> nn_icesal = 1 -> Sice = cst    [ice salinity constant in both time & space]  
     48      !!               -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005] 
     49      !!               -> nn_icesal = 3 -> Sice = S(z)   [multiyear ice] 
    5150      !!--------------------------------------------------------------------- 
    5251      INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index 
    … …  
    6665      ! 1) Constant salinity, constant in time                                       | 
    6766      !------------------------------------------------------------------------------| 
    68 !!gm comment: if num_sal = 1 s_i_new, s_i_1d and sm_i_1d can be set to bulk_sal one for all in the initialisation phase !! 
    69 !!gm           ===>>>   simplification of almost all test on num_sal value 
    70       IF(  num_sal == 1  ) THEN 
    71             s_i_1d (kideb:kiut,1:nlay_i) =  bulk_sal 
    72             sm_i_1d(kideb:kiut)          =  bulk_sal  
    73             s_i_new(kideb:kiut)          =  bulk_sal 
     67!!gm comment: if nn_icesal = 1 s_i_new, s_i_1d and sm_i_1d can be set to rn_icesal one for all in the initialisation phase !! 
     68!!gm           ===>>>   simplification of almost all test on nn_icesal value 
     69      IF(  nn_icesal == 1  ) THEN 
     70            s_i_1d (kideb:kiut,1:nlay_i) =  rn_icesal 
     71            sm_i_1d(kideb:kiut)          =  rn_icesal  
     72            s_i_new(kideb:kiut)          =  rn_icesal 
    7473      ENDIF 
    7574 
    … …  
    7776      !  Module 2 : Constant salinity varying in time                                | 
    7877      !------------------------------------------------------------------------------| 
    79       IF(  num_sal == 2  ) THEN 
     78      IF(  nn_icesal == 2  ) THEN 
    8079 
    8180         DO ji = kideb, kiut 
    … …  
    8382            ! Switches  
    8483            !---------- 
    85             iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rtt )        )     ! =1 if summer  
     84            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 )        )     ! =1 if summer  
    8685            igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )    ! =1 if t_su < t_bo 
    8786 
    … …  
    9089            !--------------------- 
    9190            ! drainage by gravity drainage 
    92             dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - sal_G , 0._wp ) / time_G * rdt_ice  
     91            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice  
    9392            ! drainage by flushing   
    94             dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - sal_F , 0._wp ) / time_F * rdt_ice 
     93            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice 
    9594 
    9695            !----------------- 
    … …  
    116115      !  Module 3 : Profile of salinity, constant in time                            | 
    117116      !------------------------------------------------------------------------------| 
    118       IF(  num_sal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
     117      IF(  nn_icesal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
    119118 
    120119      ! 
    … …  
    134133      !!------------------------------------------------------------------- 
    135134      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    136       NAMELIST/namicesal/ num_sal, bulk_sal, sal_G, time_G, sal_F, time_F,   & 
    137          &                s_i_max, s_i_min, s_i_0, s_i_1 
     135      NAMELIST/namicesal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl,   & 
     136         &                rn_simax, rn_simin  
    138137      !!------------------------------------------------------------------- 
    139138      ! 
    … …  
    151150         WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity ' 
    152151         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    153          WRITE(numout,*) ' switch for salinity num_sal        : ', num_sal 
    154          WRITE(numout,*) ' bulk salinity value if num_sal = 1 : ', bulk_sal 
    155          WRITE(numout,*) ' restoring salinity for GD          : ', sal_G 
    156          WRITE(numout,*) ' restoring time for GD              : ', time_G 
    157          WRITE(numout,*) ' restoring salinity for flushing    : ', sal_F 
    158          WRITE(numout,*) ' restoring time for flushing        : ', time_F 
    159          WRITE(numout,*) ' Maximum tolerated ice salinity     : ', s_i_max 
    160          WRITE(numout,*) ' Minimum tolerated ice salinity     : ', s_i_min 
    161          WRITE(numout,*) ' 1st salinity for salinity profile  : ', s_i_0 
    162          WRITE(numout,*) ' 2nd salinity for salinity profile  : ', s_i_1 
     152         WRITE(numout,*) '   switch for salinity nn_icesal        = ', nn_icesal 
     153         WRITE(numout,*) '   bulk salinity value if nn_icesal = 1 = ', rn_icesal 
     154         WRITE(numout,*) '   restoring salinity for GD            = ', rn_sal_gd 
     155         WRITE(numout,*) '   restoring time for GD                = ', rn_time_gd 
     156         WRITE(numout,*) '   restoring salinity for flushing      = ', rn_sal_fl 
     157         WRITE(numout,*) '   restoring time for flushing          = ', rn_time_fl 
     158         WRITE(numout,*) '   Maximum tolerated ice salinity       = ', rn_simax 
     159         WRITE(numout,*) '   Minimum tolerated ice salinity       = ', rn_simin 
    163160      ENDIF 
    164161      ! 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r4990 r5682  
    1717   USE dom_oce        ! ocean domain 
    1818   USE sbc_oce        ! ocean surface boundary condition 
    19    USE par_ice        ! ice parameter 
    2019   USE dom_ice        ! ice domain 
    2120   USE ice            ! ice variables 
    2221   USE limadv         ! ice advection 
    2322   USE limhdf         ! ice horizontal diffusion 
     23   USE limvar         !  
     24   ! 
    2425   USE in_out_manager ! I/O manager 
    2526   USE lbclnk         ! lateral boundary conditions -- MPP exchanges 
    … …  
    2829   USE prtctl         ! Print control 
    2930   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    30    USE limvar          ! clem for ice thickness correction 
    31    USE timing          ! Timing 
     31   USE timing         ! Timing 
    3232   USE limcons        ! conservation tests 
     33   USE limctl         ! control prints 
    3334 
    3435   IMPLICIT NONE 
    3536   PRIVATE 
    3637 
    37    PUBLIC   lim_trp    ! called by ice_step 
     38   PUBLIC   lim_trp    ! called by sbcice_lim 
     39 
     40   INTEGER  ::   ncfl                 ! number of ice time step with CFL>1/2   
    3841 
    3942   !! * Substitution 
    … …  
    5861      !! ** action : 
    5962      !!--------------------------------------------------------------------- 
    60       INTEGER, INTENT(in) ::   kt   ! number of iteration 
     63      INTEGER, INTENT(in) ::   kt           ! number of iteration 
    6164      ! 
    62       INTEGER  ::   ji, jj, jk, jl, jn      ! dummy loop indices 
     65      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices 
    6366      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    6467      REAL(wp) ::   zcfl , zusnit           !   -      - 
     68      CHARACTER(len=80) ::   cltmp 
    6569      ! 
    66       REAL(wp), POINTER, DIMENSION(:,:)      ::   zui_u, zvi_v, zsm, zs0at, zs0ow 
    67       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 
    68       REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e 
    69       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zviold, zvsold   ! old ice volume... 
    70       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zaiold, zhimax   ! old ice concentration and thickness 
    71       REAL(wp), POINTER, DIMENSION(:,:)      ::   zeiold, zesold   ! old enthalpies 
    72       REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei 
    73       ! 
    74       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     70      REAL(wp), POINTER, DIMENSION(:,:)      ::   zsm 
     71      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0ice, z0snw, z0ai, z0es , z0smi , z0oi 
     72      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0opw 
     73      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   z0ei 
     74      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zviold, zvsold, zsmvold  ! old ice volume... 
     75      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax                   ! old ice thickness 
     76      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold   ! old concentration, enthalpies 
     77      REAL(wp) ::    zdv, zvi, zvs, zsmv, zes, zei 
     78      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
    7579      !!--------------------------------------------------------------------- 
    7680      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
    7781 
    78       CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 
    79       CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    80       CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, zs0e ) 
    81  
    82       CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold )   ! clem 
     82      CALL wrk_alloc( jpi,jpj,            zsm, zatold, zeiold, zesold ) 
     83      CALL wrk_alloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
     84      CALL wrk_alloc( jpi,jpj,1,          z0opw ) 
     85      CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 
     86      CALL wrk_alloc( jpi,jpj,jpl,        zhimax, zviold, zvsold, zsmvold ) 
    8387 
    8488      IF( numit == nstart .AND. lwp ) THEN 
    … …  
    8892         ENDIF 
    8993         WRITE(numout,*) '~~~~~~~~~~~~' 
     94         ncfl = 0                ! nb of time step with CFL > 1/2 
    9095      ENDIF 
     96 
     97      zsm(:,:) = e12t(:,:) 
    9198       
    92       zsm(:,:) = area(:,:) 
    93  
    9499      !                             !-------------------------------------! 
    95100      IF( ln_limdyn ) THEN          !   Advection of sea ice properties   ! 
    … …  
    97102 
    98103         ! conservation test 
    99          IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    100  
    101          ! mass and salt flux init (clem) 
     104         IF( ln_limdiahsb )   CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     105 
     106         ! mass and salt flux init 
    102107         zviold(:,:,:)  = v_i(:,:,:) 
    103          zeiold(:,:)  = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )  
    104          zesold(:,:)  = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )  
    105  
    106          !--- Thickness correction init. (clem) ------------------------------- 
    107          CALL lim_var_glo2eqv 
    108          zaiold(:,:,:) = a_i(:,:,:) 
     108         zvsold(:,:,:)  = v_s(:,:,:) 
     109         zsmvold(:,:,:) = smv_i(:,:,:) 
     110         zeiold(:,:)    = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )  
     111         zesold(:,:)    = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )  
     112 
     113         !--- Thickness correction init. ------------------------------- 
     114         zatold(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     115         DO jl = 1, jpl 
     116            DO jj = 1, jpj 
     117               DO ji = 1, jpi 
     118                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
     119                  ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     120                  ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     121               END DO 
     122            END DO 
     123         END DO 
    109124         !--------------------------------------------------------------------- 
    110          ! Record max of the surrounding ice thicknesses for correction in limupdate 
     125         ! Record max of the surrounding ice thicknesses for correction 
    111126         ! in case advection creates ice too thick. 
    112127         !--------------------------------------------------------------------- 
    113          zhimax(:,:,:) = ht_i(:,:,:) 
     128         zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 
    114129         DO jl = 1, jpl 
    115130            DO jj = 2, jpjm1 
    116131               DO ji = 2, jpim1 
    117                   zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) ) 
    118                   !zhimax(ji,jj,jl) = ( ht_i(ji  ,jj  ,jl) * tmask(ji,  jj  ,1) + ht_i(ji-1,jj-1,jl) * tmask(ji-1,jj-1,1) + ht_i(ji+1,jj+1,jl) * tmask(ji+1,jj+1,1) & 
    119                   !     &             + ht_i(ji-1,jj  ,jl) * tmask(ji-1,jj  ,1) + ht_i(ji  ,jj-1,jl) * tmask(ji  ,jj-1,1) & 
    120                   !     &             + ht_i(ji+1,jj  ,jl) * tmask(ji+1,jj  ,1) + ht_i(ji  ,jj+1,jl) * tmask(ji  ,jj+1,1) & 
    121                   !     &             + ht_i(ji-1,jj+1,jl) * tmask(ji-1,jj+1,1) + ht_i(ji+1,jj-1,jl) * tmask(ji+1,jj-1,1) ) 
     132                  zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) ) 
    122133               END DO 
    123134            END DO 
    … …  
    125136         END DO 
    126137          
     138         !=============================! 
     139         !==      Prather scheme     ==! 
     140         !=============================! 
     141 
     142         ! If ice drift field is too fast, use an appropriate time step for advection.          
     143         zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )         ! CFL test for stability 
     144         zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
     145         IF(lk_mpp )   CALL mpp_max( zcfl ) 
     146 
     147         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
     148         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
     149         ENDIF 
     150 
     151         IF( zcfl > 0.5_wp .AND. lwp )   ncfl = ncfl + 1 
     152!!         IF( lwp ) THEN 
     153!!            IF( ncfl > 0 ) THEN    
     154!!               WRITE(cltmp,'(i6.1)') ncfl 
     155!!               CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 
     156!!            ELSE 
     157!!            !  WRITE(numout,*) 'lim_trp : CFL criterion for ice advection is always smaller than 1/2 ' 
     158!!            ENDIF 
     159!!         ENDIF 
     160 
    127161         !------------------------- 
    128162         ! transported fields                                         
    129163         !------------------------- 
    130          ! Snow vol, ice vol, salt and age contents, area 
    131          zs0ow(:,:) = ato_i(:,:) * area(:,:)               ! Open water area  
    132          DO jl = 1, jpl 
    133             zs0sn (:,:,jl)   = v_s  (:,:,jl) * area(:,:)    ! Snow volume 
    134             zs0ice(:,:,jl)   = v_i  (:,:,jl) * area(:,:)    ! Ice  volume 
    135             zs0a  (:,:,jl)   = a_i  (:,:,jl) * area(:,:)    ! Ice area 
    136             zs0sm (:,:,jl)   = smv_i(:,:,jl) * area(:,:)    ! Salt content 
    137             zs0oi (:,:,jl)   = oa_i (:,:,jl) * area(:,:)    ! Age content 
    138             zs0c0 (:,:,jl)   = e_s  (:,:,1,jl)              ! Snow heat content 
    139             zs0e  (:,:,:,jl) = e_i  (:,:,:,jl)              ! Ice  heat content 
    140          END DO 
    141  
    142          !-------------------------- 
    143          ! Advection of Ice fields  (Prather scheme)                                             
    144          !-------------------------- 
    145          ! If ice drift field is too fast, use an appropriate time step for advection.          
    146          ! CFL test for stability 
    147          zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice / e1u(:,:) ) 
    148          zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) ) 
    149          IF(lk_mpp )   CALL mpp_max( zcfl ) 
    150 !!gm more readability: 
    151 !         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
    152 !         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
    153 !         ENDIF 
    154 !!gm end 
    155          initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 
    156          zusnit = 1.0 / REAL( initad )  
    157          IF( zcfl > 0.5 .AND. lwp )   & 
    158             WRITE(numout,*) 'lim_trp   : CFL violation at day ', nday, ', cfl = ', zcfl,   & 
    159                &                        ': the ice time stepping is split in two' 
     164         z0opw(:,:,1) = ato_i(:,:) * e12t(:,:)             ! Open water area  
     165         DO jl = 1, jpl 
     166            z0snw (:,:,jl)  = v_s  (:,:,jl) * e12t(:,:)    ! Snow volume 
     167            z0ice(:,:,jl)   = v_i  (:,:,jl) * e12t(:,:)    ! Ice  volume 
     168            z0ai  (:,:,jl)  = a_i  (:,:,jl) * e12t(:,:)    ! Ice area 
     169            z0smi (:,:,jl)  = smv_i(:,:,jl) * e12t(:,:)    ! Salt content 
     170            z0oi (:,:,jl)   = oa_i (:,:,jl) * e12t(:,:)    ! Age content 
     171            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e12t(:,:)  ! Snow heat content 
     172            DO jk = 1, nlay_i 
     173               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e12t(:,:) ! Ice  heat content 
     174            END DO 
     175         END DO 
     176 
    160177 
    161178         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==! 
    162             DO jn = 1,initad 
    163                CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    164                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    165                CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   & 
    166                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     179            DO jt = 1, initad 
     180               CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
     181                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     182               CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:),   & 
     183                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    167184               DO jl = 1, jpl 
    168                   CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     185                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    169186                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    170                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     187                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   & 
    171188                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    172                   CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     189                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    173190                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    174                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     191                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   & 
    175192                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    176                   CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     193                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    177194                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    178                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     195                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   & 
    179196                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    180                   CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---      
     197                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---      
    181198                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    182                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     199                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0oi (:,:,jl), sxage(:,:,jl),   & 
    183200                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    184                   CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     201                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations --- 
    185202                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    186                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &  
     203                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &  
    187204                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    188                   CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     205                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &    !--- snow heat contents --- 
    189206                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    190                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     207                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0es (:,:,jl), sxc0 (:,:,jl),   & 
    191208                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    192                   DO jk = 1, nlay_i                                                           !--- ice heat contents --- 
    193                      CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     209                  DO jk = 1, nlay_i                                                                !--- ice heat contents --- 
     210                     CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
    194211                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
    195212                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    196                      CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     213                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
    197214                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
    198215                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    … …  
    201218            END DO 
    202219         ELSE 
    203             DO jn = 1, initad 
    204                CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    205                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    206                CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   & 
    207                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     220            DO jt = 1, initad 
     221               CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
     222                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     223               CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:),   & 
     224                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    208225               DO jl = 1, jpl 
    209                   CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     226                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    210227                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    211                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     228                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   & 
    212229                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    213                   CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     230                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    214231                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    215                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     232                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   & 
    216233                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    217                   CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     234                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    218235                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    219                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     236                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   & 
    220237                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    221  
    222                   CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
     238                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    223239                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    224                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     240                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0oi (:,:,jl), sxage(:,:,jl),   & 
    225241                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    226                   CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     242                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    227243                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    228                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
     244                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
    229245                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    230                   CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     246                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0es (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    231247                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    232                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     248                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0es (:,:,jl), sxc0 (:,:,jl),   & 
    233249                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    234250                  DO jk = 1, nlay_i                                                           !--- ice heat contents --- 
    235                      CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     251                     CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
    236252                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
    237253                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    238                      CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     254                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
    239255                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
    240256                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    … …  
    247263         ! Recover the properties from their contents 
    248264         !------------------------------------------- 
    249          zs0ow(:,:) = zs0ow(:,:) / area(:,:) 
    250          DO jl = 1, jpl 
    251             zs0ice(:,:,jl) = zs0ice(:,:,jl) / area(:,:) 
    252             zs0sn (:,:,jl) = zs0sn (:,:,jl) / area(:,:) 
    253             zs0sm (:,:,jl) = zs0sm (:,:,jl) / area(:,:) 
    254             zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:) 
    255             zs0a  (:,:,jl) = zs0a  (:,:,jl) / area(:,:) 
    256             ! 
     265         ato_i(:,:) = z0opw(:,:,1) * r1_e12t(:,:) 
     266         DO jl = 1, jpl 
     267            v_i  (:,:,jl)   = z0ice(:,:,jl) * r1_e12t(:,:) 
     268            v_s  (:,:,jl)   = z0snw(:,:,jl) * r1_e12t(:,:) 
     269            smv_i(:,:,jl)   = z0smi(:,:,jl) * r1_e12t(:,:) 
     270            oa_i (:,:,jl)   = z0oi (:,:,jl) * r1_e12t(:,:) 
     271            a_i  (:,:,jl)   = z0ai (:,:,jl) * r1_e12t(:,:) 
     272            e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e12t(:,:) 
     273            DO jk = 1, nlay_i 
     274               e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e12t(:,:) 
     275            END DO 
     276         END DO 
     277 
     278         at_i(:,:) = a_i(:,:,1)      ! total ice fraction 
     279         DO jl = 2, jpl 
     280            at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    257281         END DO 
    258282 
    259283         !------------------------------------------------------------------------------! 
    260          ! 4) Diffusion of Ice fields                   
     284         ! Diffusion of Ice fields                   
    261285         !------------------------------------------------------------------------------! 
    262286 
     287         ! 
    263288         !-------------------------------- 
    264289         !  diffusion of open water area 
    265290         !-------------------------------- 
    266          zs0at(:,:) = zs0a(:,:,1)      ! total ice fraction 
    267          DO jl = 2, jpl 
    268             zs0at(:,:) = zs0at(:,:) + zs0a(:,:,jl) 
    269          END DO 
    270          ! 
    271291         !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points 
    272292         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    273293            DO ji = 1 , fs_jpim1   ! vector opt. 
    274                pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji  ,jj) ) ) )   & 
    275                   &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    276                pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj  ) ) ) )   & 
    277                   &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 
     294               pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   & 
     295                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 
     296               pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   & 
     297                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 
    278298            END DO 
    279299         END DO 
    280300         ! 
    281          CALL lim_hdf( zs0ow (:,:) )   ! Diffusion 
     301         CALL lim_hdf( ato_i (:,:) ) 
    282302 
    283303         !------------------------------------ 
    … …  
    288308            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    289309               DO ji = 1 , fs_jpim1   ! vector opt. 
    290                   pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji  ,jj,jl) ) ) )   & 
    291                      &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
    292                   pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj  ,jl) ) ) )   & 
    293                      &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
    294                END DO 
    295             END DO 
    296  
    297             CALL lim_hdf( zs0ice (:,:,jl) ) 
    298             CALL lim_hdf( zs0sn  (:,:,jl) ) 
    299             CALL lim_hdf( zs0sm  (:,:,jl) ) 
    300             CALL lim_hdf( zs0oi  (:,:,jl) ) 
    301             CALL lim_hdf( zs0a   (:,:,jl) ) 
    302             CALL lim_hdf( zs0c0  (:,:,jl) ) 
     310                  pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,jl) ) ) )   & 
     311                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
     312                  pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj  ,jl) ) ) )   & 
     313                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
     314               END DO 
     315            END DO 
     316 
     317            CALL lim_hdf( v_i  (:,:,  jl) ) 
     318            CALL lim_hdf( v_s  (:,:,  jl) ) 
     319            CALL lim_hdf( smv_i(:,:,  jl) ) 
     320            CALL lim_hdf( oa_i (:,:,  jl) ) 
     321            CALL lim_hdf( a_i  (:,:,  jl) ) 
     322            CALL lim_hdf( e_s  (:,:,1,jl) ) 
    303323            DO jk = 1, nlay_i 
    304                CALL lim_hdf( zs0e (:,:,jk,jl) ) 
     324               CALL lim_hdf( e_i(:,:,jk,jl) ) 
    305325            END DO 
    306326         END DO 
    307327 
    308328         !------------------------------------------------------------------------------! 
    309          ! 5) Update and limit ice properties after transport                            
     329         ! limit ice properties after transport                            
    310330         !------------------------------------------------------------------------------! 
    311  
    312          !-------------------------------------------------- 
    313          ! 5.1) Recover mean values over the grid squares. 
    314          !-------------------------------------------------- 
    315          zs0at(:,:) = 0._wp 
     331!!gm & cr   :  MAX should not be active if adv scheme is positive ! 
    316332         DO jl = 1, jpl 
    317333            DO jj = 1, jpj 
    318334               DO ji = 1, jpi 
    319                   zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) ) 
    320                   zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) ) 
    321                   zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) ) 
    322                   zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) ) 
    323                   zs0a  (ji,jj,jl) = MAX( 0._wp, zs0a  (ji,jj,jl) ) 
    324                   zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) ) 
    325                   zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl) 
    326                END DO 
    327             END DO 
    328          END DO 
    329  
    330          !--------------------------------------------------------- 
    331          ! 5.2) Update and mask variables 
    332          !--------------------------------------------------------- 
    333          DO jl = 1, jpl           
    334             DO jj = 1, jpj 
    335                DO ji = 1, jpi 
    336                   rswitch = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 
    337  
    338                   zvi  = zs0ice(ji,jj,jl) 
    339                   zvs  = zs0sn (ji,jj,jl) 
    340                   zes  = zs0c0 (ji,jj,jl)       
    341                   zsmv = zs0sm (ji,jj,jl) 
    342                   ! 
    343                   ! Remove very small areas 
    344                   v_s(ji,jj,jl)   = rswitch * zs0sn (ji,jj,jl)  
    345                   v_i(ji,jj,jl)   = rswitch * zs0ice(ji,jj,jl) 
    346                   a_i(ji,jj,jl)   = rswitch * zs0a  (ji,jj,jl) 
    347                   e_s(ji,jj,1,jl) = rswitch * zs0c0 (ji,jj,jl)       
    348                   ! Ice salinity and age 
    349                   IF(  num_sal == 2  ) THEN 
    350                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 
    351                   ENDIF 
    352                   oa_i(ji,jj,jl) = MAX( rswitch * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl) 
    353  
    354                  ! Update fluxes 
    355                   wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice  
    356                   wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
    357                   sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
    358                   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 
    359               END DO 
    360             END DO 
    361          END DO 
    362  
    363          DO jl = 1, jpl 
     335                  v_s  (ji,jj,jl)   = MAX( 0._wp, v_s  (ji,jj,jl) ) 
     336                  v_i  (ji,jj,jl)   = MAX( 0._wp, v_i  (ji,jj,jl) ) 
     337                  smv_i(ji,jj,jl)   = MAX( 0._wp, smv_i(ji,jj,jl) ) 
     338                  oa_i (ji,jj,jl)   = MAX( 0._wp, oa_i (ji,jj,jl) ) 
     339                  a_i  (ji,jj,jl)   = MAX( 0._wp, a_i  (ji,jj,jl) ) 
     340                  e_s  (ji,jj,1,jl) = MAX( 0._wp, e_s  (ji,jj,1,jl) ) 
     341               END DO 
     342            END DO 
     343 
    364344            DO jk = 1, nlay_i 
    365345               DO jj = 1, jpj 
    366346                  DO ji = 1, jpi 
    367                      rswitch          = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 
    368                      zei              = zs0e(ji,jj,jk,jl)       
    369                      e_i(ji,jj,jk,jl) = rswitch * MAX( 0._wp, zs0e(ji,jj,jk,jl) ) 
    370                      ! Update fluxes 
    371                      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 
    372                   END DO !ji 
    373                END DO ! jj 
    374             END DO ! jk 
    375          END DO ! jl 
    376  
    377          !--- Thickness correction in case too high (clem) -------------------------------------------------------- 
    378          CALL lim_var_glo2eqv 
     347                     e_i(ji,jj,jk,jl) = MAX( 0._wp, e_i(ji,jj,jk,jl) ) 
     348                  END DO 
     349               END DO 
     350            END DO 
     351         END DO 
     352!!gm & cr  
     353 
     354         ! --- diags --- 
     355         DO jj = 1, jpj 
     356            DO ji = 1, jpi 
     357               diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 
     358               diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 
     359 
     360               diag_trp_vi (ji,jj) = SUM(   v_i(ji,jj,:) -  zviold(ji,jj,:) ) * r1_rdtice 
     361               diag_trp_vs (ji,jj) = SUM(   v_s(ji,jj,:) -  zvsold(ji,jj,:) ) * r1_rdtice 
     362               diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice 
     363            END DO 
     364         END DO 
     365 
     366         ! zap small areas 
     367         CALL lim_var_zapsmall 
     368 
     369         !--- Thickness correction in case too high -------------------------------------------------------- 
    379370         DO jl = 1, jpl 
    380371            DO jj = 1, jpj 
    … …  
    382373 
    383374                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
     375 
     376                     rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
     377                     ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     378                     ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     379                      
    384380                     zvi  = v_i  (ji,jj,jl) 
    385381                     zvs  = v_s  (ji,jj,jl) 
    … …  
    387383                     zes  = e_s  (ji,jj,1,jl) 
    388384                     zei  = SUM( e_i(ji,jj,1:nlay_i,jl) ) 
    389                      zdv  = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
    390                      !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)    
    391                       
    392                      rswitch = 1._wp 
    393                      IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. & 
    394                         & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                           
    395                         ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 
    396                         rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 
    397                         a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 
    398                      ELSE 
    399                         ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 
    400                         rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 
    401                         a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 
     385 
     386                     zdv  = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl)   
     387 
     388                     IF ( ( zdv >  0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. & 
     389                        & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN 
     390 
     391                        rswitch        = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) ) 
     392                        a_i(ji,jj,jl)  = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 ) 
     393 
     394                        ! small correction due to *rswitch for a_i 
     395                        v_i  (ji,jj,jl)        = rswitch * v_i  (ji,jj,jl) 
     396                        v_s  (ji,jj,jl)        = rswitch * v_s  (ji,jj,jl) 
     397                        smv_i(ji,jj,jl)        = rswitch * smv_i(ji,jj,jl) 
     398                        e_s(ji,jj,1,jl)        = rswitch * e_s(ji,jj,1,jl) 
     399                        e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl) 
     400 
     401                        ! Update mass fluxes 
     402                        wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 
     403                        wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
     404                        sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
     405                        hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0 
     406                        hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * r1_rdtice ! W.m-2 <0 
     407 
    402408                     ENDIF 
    403409 
    404                      ! small correction due to *rswitch for a_i 
    405                      v_i  (ji,jj,jl) = rswitch * v_i  (ji,jj,jl) 
    406                      v_s  (ji,jj,jl) = rswitch * v_s  (ji,jj,jl) 
    407                      smv_i(ji,jj,jl) = rswitch * smv_i(ji,jj,jl) 
    408                      e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl) 
    409                      e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl) 
    410  
    411                      ! Update mass fluxes 
    412                      wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 
    413                      wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
    414                      sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
    415                      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 
    416                      hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    417410                  ENDIF 
     411 
    418412               END DO 
    419413            END DO 
    420414         END DO 
    421415         ! ------------------------------------------------- 
    422  
    423          ! --- diags --- 
    424          DO jj = 1, jpj 
    425             DO ji = 1, jpi 
    426                diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 
    427                diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 
    428  
    429                diag_trp_vi(ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice 
    430                diag_trp_vs(ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice 
    431             END DO 
    432          END DO 
     416          
     417         !-------------------------------------- 
     418         ! Impose a_i < amax in mono-category 
     419         !-------------------------------------- 
     420         ! 
     421         IF ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) THEN ! simple conservative piling, comparable with LIM2 
     422            DO jj = 1, jpj 
     423               DO ji = 1, jpi 
     424                  a_i(ji,jj,1)  = MIN( a_i(ji,jj,1), rn_amax ) 
     425               END DO 
     426            END DO 
     427         ENDIF 
    433428 
    434429         ! --- agglomerate variables ----------------- 
    … …  
    436431         vt_s (:,:) = 0._wp 
    437432         at_i (:,:) = 0._wp 
    438          ! 
    439433         DO jl = 1, jpl 
    440434            DO jj = 1, jpj 
    441435               DO ji = 1, jpi 
    442                   ! 
    443                   vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
    444                   vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
    445                   at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    446                END DO 
    447             END DO 
    448          END DO 
    449          ! ------------------------------------------------- 
    450  
    451          ! open water 
     436                  vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) 
     437                  vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) 
     438                  at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
     439               END DO 
     440            END DO 
     441         END DO 
     442 
     443         ! --- open water = 1 if at_i=0 -------------------------------- 
    452444         DO jj = 1, jpj 
    453445            DO ji = 1, jpi 
    454                ! open water = 1 if at_i=0 
    455446               rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 
    456                ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * zs0ow(ji,jj) 
     447               ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj) 
    457448            END DO 
    458449         END DO       
    … …  
    463454      ENDIF 
    464455 
    465       IF(ln_ctl) THEN   ! Control print 
    466          CALL prt_ctl_info(' ') 
    467          CALL prt_ctl_info(' - Cell values : ') 
    468          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    469          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_trp  : cell area :') 
    470          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_trp  : at_i      :') 
    471          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_trp  : vt_i      :') 
    472          CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_trp  : vt_s      :') 
    473          DO jl = 1, jpl 
    474             CALL prt_ctl_info(' ') 
    475             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    476             CALL prt_ctl_info('   ~~~~~~~~~~') 
    477             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_trp  : a_i      : ') 
    478             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_trp  : ht_i     : ') 
    479             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_trp  : ht_s     : ') 
    480             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_trp  : v_i      : ') 
    481             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_trp  : v_s      : ') 
    482             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_trp  : e_s      : ') 
    483             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_trp  : t_su     : ') 
    484             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_trp  : t_snow   : ') 
    485             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_trp  : sm_i     : ') 
    486             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_trp  : smv_i    : ') 
    487             DO jk = 1, nlay_i 
    488                CALL prt_ctl_info(' ') 
    489                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    490                CALL prt_ctl_info('   ~~~~~~~') 
    491                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_trp  : t_i      : ') 
    492                CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_trp  : e_i      : ') 
    493             END DO 
    494          END DO 
    495       ENDIF 
     456      ! ------------------------------------------------- 
     457      ! control prints 
     458      ! ------------------------------------------------- 
     459      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 
    496460      ! 
    497       CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 
    498       CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    499       CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, zs0e ) 
    500  
    501       CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax )   ! clem 
     461      CALL wrk_dealloc( jpi,jpj,            zsm, zatold, zeiold, zesold ) 
     462      CALL wrk_dealloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
     463      CALL wrk_dealloc( jpi,jpj,1,          z0opw ) 
     464      CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 
     465      CALL wrk_dealloc( jpi,jpj,jpl,        zviold, zvsold, zhimax, zsmvold ) 
    502466      ! 
    503467      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
     468 
    504469   END SUBROUTINE lim_trp 
    505470 
    … …  
    512477   END SUBROUTINE lim_trp 
    513478#endif 
    514  
    515479   !!====================================================================== 
    516480END MODULE limtrp 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    • Property svn:keywords set to Id
    r4990 r5682  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
    7    !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
     7   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_lim3 
    … …  
    1313   !!    lim_update1   : computes update of sea-ice global variables from trend terms 
    1414   !!---------------------------------------------------------------------- 
    15    USE limrhg          ! ice rheology 
    16  
    17    USE dom_oce 
    18    USE oce             ! dynamics and tracers variables 
    19    USE in_out_manager 
    2015   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2116   USE sbc_ice         ! Surface boundary condition: ice fields 
    2217   USE dom_ice 
     18   USE dom_oce 
    2319   USE phycst          ! physical constants 
    2420   USE ice 
    25    USE limdyn 
    26    USE limtrp 
    27    USE limthd 
    28    USE limsbc 
    29    USE limdiahsb 
    30    USE limwri 
    31    USE limrst 
    3221   USE thd_ice         ! LIM thermodynamic sea-ice variables 
    33    USE par_ice 
    3422   USE limitd_th 
    35    USE limitd_me 
    3623   USE limvar 
    37    USE prtctl           ! Print control 
    38    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    39    USE wrk_nemo         ! work arrays 
    40    USE lib_fortran     ! glob_sum 
    41    USE in_out_manager   ! I/O manager 
    42    USE iom              ! I/O manager 
    43    USE lib_mpp          ! MPP library 
     24   USE prtctl          ! Print control 
     25   USE wrk_nemo        ! work arrays 
    4426   USE timing          ! Timing 
    45    USE limcons        ! conservation tests 
     27   USE limcons         ! conservation tests 
     28   USE lib_mpp         ! MPP library 
     29   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     30   USE in_out_manager  ! I/O manager 
    4631 
    4732   IMPLICIT NONE 
    4833   PRIVATE 
    4934 
    50    PUBLIC   lim_update1   ! routine called by ice_step 
     35   PUBLIC   lim_update1 
    5136 
    5237   !! * Substitutions 
    … …  
    5439   !!---------------------------------------------------------------------- 
    5540   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    56    !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $ 
     41   !! $Id$ 
    5742   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5843   !!---------------------------------------------------------------------- 
    5944CONTAINS 
    6045 
    61    SUBROUTINE lim_update1 
     46   SUBROUTINE lim_update1( kt ) 
    6247      !!------------------------------------------------------------------- 
    6348      !!               ***  ROUTINE lim_update1  *** 
    … …  
    6752      !!                 
    6853      !!--------------------------------------------------------------------- 
     54      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    6955      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    70       INTEGER  ::   i_ice_switch 
    7156      REAL(wp) ::   zsal 
    72       ! 
    73       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     57      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7458      !!------------------------------------------------------------------- 
    7559      IF( nn_timing == 1 )  CALL timing_start('limupdate1') 
    … …  
    7761      IF( ln_limdyn ) THEN  
    7862 
     63      IF( kt == nit000 .AND. lwp ) THEN 
     64         WRITE(numout,*) ' lim_update1 '  
     65         WRITE(numout,*) ' ~~~~~~~~~~~ ' 
     66      ENDIF 
     67 
    7968      ! conservation test 
    8069      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    8170 
    82       !----------------- 
    83       ! zap small values 
    84       !----------------- 
    85       CALL lim_itd_me_zapsmall 
    86  
    87       CALL lim_var_glo2eqv 
    88       
    8971      !---------------------------------------------------- 
    90       ! Rebin categories with thickness out of bounds 
    91       !---------------------------------------------------- 
    92       IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl) 
    93  
     72      ! ice concentration should not exceed amax  
     73      !----------------------------------------------------- 
    9474      at_i(:,:) = 0._wp 
    9575      DO jl = 1, jpl 
    … …  
    9777      END DO 
    9878 
    99       !---------------------------------------------------- 
    100       ! ice concentration should not exceed amax  
    101       !----------------------------------------------------- 
    10279      DO jl  = 1, jpl 
    10380         DO jj = 1, jpj 
    10481            DO ji = 1, jpi 
    105                IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    106                   a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 
    107                   ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     82               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     83                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     84                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
    10885               ENDIF 
    10986            END DO 
    11087         END DO 
    11188      END DO 
    112  
    113       at_i(:,:) = 0._wp 
    114       DO jl = 1, jpl 
    115          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    116       END DO 
    11789     
    118       ! -------------------------------------- 
    119       ! Final thickness distribution rebinning 
    120       ! -------------------------------------- 
    121       IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 
    122  
    123       !----------------- 
    124       ! zap small values 
    125       !----------------- 
    126       CALL lim_itd_me_zapsmall 
    127  
    12890      !--------------------- 
    12991      ! Ice salinity bounds 
    13092      !--------------------- 
    131       IF (  num_sal == 2  ) THEN  
     93      IF (  nn_icesal == 2  ) THEN  
    13294         DO jl = 1, jpl 
    13395            DO jj = 1, jpj  
    13496               DO ji = 1, jpi 
    13597                  zsal            = smv_i(ji,jj,jl) 
    136                   smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    13798                  ! salinity stays in bounds 
    138                   i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
    139                   smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
     99                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     100                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) ) 
    140101                  ! associated salt flux 
    141102                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
    … …  
    145106      ENDIF 
    146107 
     108      !---------------------------------------------------- 
     109      ! Rebin categories with thickness out of bounds 
     110      !---------------------------------------------------- 
     111      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 
     112 
     113      !----------------- 
     114      ! zap small values 
     115      !----------------- 
     116      CALL lim_var_zapsmall 
     117 
    147118      ! ------------------------------------------------- 
    148119      ! Diagnostics 
    149120      ! ------------------------------------------------- 
    150       d_u_ice_dyn(:,:)     = u_ice(:,:)     - u_ice_b(:,:) 
    151       d_v_ice_dyn(:,:)     = v_ice(:,:)     - v_ice_b(:,:) 
    152       d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - a_i_b  (:,:,:) 
    153       d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - v_s_b  (:,:,:)   
    154       d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - v_i_b  (:,:,:)    
    155       d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - e_s_b  (:,:,:,:)   
    156       d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
    157       d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - oa_i_b (:,:,:) 
    158       d_smv_i_trp(:,:,:)   = 0._wp 
    159       IF(  num_sal == 2  ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
     121      DO jl  = 1, jpl 
     122         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
     123      END DO 
     124 
     125      DO jj = 1, jpj 
     126         DO ji = 1, jpi             
     127            ! heat content variation (W.m-2) 
     128            diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
     129               &                   SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
     130               &                 ) * r1_rdtice 
     131            ! salt, volume 
     132            diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 
     133            diag_vice(ji,jj) = SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice 
     134            diag_vsnw(ji,jj) = SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice 
     135         END DO 
     136      END DO 
    160137 
    161138      ! conservation test 
    162139      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    163140 
     141      ! ------------------------------------------------- 
     142      ! control prints 
     143      ! ------------------------------------------------- 
    164144      IF(ln_ctl) THEN   ! Control print 
    165145         CALL prt_ctl_info(' ') 
    166146         CALL prt_ctl_info(' - Cell values : ') 
    167147         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    168          CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update1  : cell area   :') 
     148         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update1  : cell area   :') 
    169149         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :') 
    170150         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :') 
    … …  
    172152         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update1  : strength    :') 
    173153         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    174          CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1  : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :') 
    175154         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    176155 
    … …  
    187166            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ') 
    188167            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ') 
    189             CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_a_i_trp   : ') 
    190168            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ') 
    191169            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ') 
    192             CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_i_trp   : ') 
    193170            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ') 
    194171            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ') 
    195             CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_s_trp   : ') 
    196             CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1        : ') 
    197             CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1_b      : ') 
    198             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : de_i1_trp   : ') 
    199             CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2        : ') 
    200             CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2_b      : ') 
    201             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : de_i2_trp   : ') 
     172            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1        : ') 
     173            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1_b      : ') 
     174            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2        : ') 
     175            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2_b      : ') 
    202176            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ') 
    203177            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ') 
    204             CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : d_e_s_trp   : ') 
    205178            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ') 
    206179            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ') 
    207             CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update1  : d_smv_i_trp : ') 
    208180            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ') 
    209181            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ') 
    210             CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update1  : d_oa_i_trp  : ') 
    211182 
    212183            DO jk = 1, nlay_i 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    • Property svn:keywords set to Id
    r4990 r5682  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
    7    !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
     7   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_lim3 
    … …  
    1313   !!    lim_update2   : computes update of sea-ice global variables from trend terms 
    1414   !!---------------------------------------------------------------------- 
    15    USE limrhg          ! ice rheology 
    16  
    17    USE dom_oce 
    18    USE oce             ! dynamics and tracers variables 
    19    USE in_out_manager 
    2015   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2116   USE sbc_ice         ! Surface boundary condition: ice fields 
    2217   USE dom_ice 
     18   USE dom_oce 
    2319   USE phycst          ! physical constants 
    2420   USE ice 
    25    USE limdyn 
    26    USE limtrp 
    27    USE limthd 
    28    USE limsbc 
    29    USE limdiahsb 
    30    USE limwri 
    31    USE limrst 
    3221   USE thd_ice         ! LIM thermodynamic sea-ice variables 
    33    USE par_ice 
    3422   USE limitd_th 
    35    USE limitd_me 
    3623   USE limvar 
    37    USE prtctl           ! Print control 
    38    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    39    USE wrk_nemo         ! work arrays 
    40    USE lib_fortran     ! glob_sum 
     24   USE prtctl          ! Print control 
     25   USE lbclnk          ! lateral boundary condition - MPP exchanges 
     26   USE wrk_nemo        ! work arrays 
    4127   USE timing          ! Timing 
    42    USE limcons        ! conservation tests 
     28   USE limcons         ! conservation tests 
     29   USE limctl 
     30   USE lib_mpp         ! MPP library 
     31   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     32   USE in_out_manager 
    4333 
    4434   IMPLICIT NONE 
    … …  
    5141   !!---------------------------------------------------------------------- 
    5242   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    53    !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $ 
     43   !! $Id$ 
    5444   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5545   !!---------------------------------------------------------------------- 
    5646CONTAINS 
    5747 
    58    SUBROUTINE lim_update2 
     48   SUBROUTINE lim_update2( kt ) 
    5949      !!------------------------------------------------------------------- 
    6050      !!               ***  ROUTINE lim_update2  *** 
    … …  
    6454      !! 
    6555      !!--------------------------------------------------------------------- 
    66       INTEGER  ::   ji, jj, jk, jl    ! dummy loop indices 
    67       INTEGER  ::   i_ice_switch 
    68       REAL(wp) ::   zh, zsal 
    69       ! 
    70       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     56      INTEGER, INTENT(in) ::   kt    ! number of iteration 
     57      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     58      REAL(wp) ::   zsal 
     59      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7160      !!------------------------------------------------------------------- 
    7261      IF( nn_timing == 1 )  CALL timing_start('limupdate2') 
    7362 
     63      IF( kt == nit000 .AND. lwp ) THEN 
     64         WRITE(numout,*) ' lim_update2 ' 
     65         WRITE(numout,*) ' ~~~~~~~~~~~ ' 
     66      ENDIF 
     67 
    7468      ! conservation test 
    7569      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    7670 
    77       !----------------- 
    78       ! zap small values 
    79       !----------------- 
    80       CALL lim_itd_me_zapsmall 
    81  
    82       CALL lim_var_glo2eqv 
    83  
    84       !---------------------------------------------------- 
    85       ! Rebin categories with thickness out of bounds 
    86       !---------------------------------------------------- 
    87       IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl) 
    88  
    8971      !---------------------------------------------------------------------- 
    90       ! Constrain the thickness of the smallest category above hiclim 
     72      ! Constrain the thickness of the smallest category above himin 
    9173      !---------------------------------------------------------------------- 
    9274      DO jj = 1, jpj  
    9375         DO ji = 1, jpi 
    94             IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN 
    95                zh             = hiclim / ht_i(ji,jj,1) 
    96                ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh 
    97                ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh 
    98                a_i (ji,jj,1) = a_i(ji,jj,1)  / zh 
     76            rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) )   !0 if no ice and 1 if yes 
     77            ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch 
     78            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN 
     79               a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin 
     80               oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin 
    9981            ENDIF 
    10082         END DO 
    … …  
    11294         DO jj = 1, jpj 
    11395            DO ji = 1, jpi 
    114                IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    115                   a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 
    116                   ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     96               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     97                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     98                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
    11799               ENDIF 
    118100            END DO 
    … …  
    120102      END DO 
    121103 
    122       at_i(:,:) = 0.0 
    123       DO jl = 1, jpl 
    124          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    125       END DO 
    126  
    127       ! -------------------------------------- 
    128       ! Final thickness distribution rebinning 
    129       ! -------------------------------------- 
    130       IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 
    131  
    132       !----------------- 
    133       ! zap small values 
    134       !----------------- 
    135       CALL lim_itd_me_zapsmall 
    136  
    137104      !--------------------- 
    138       ! 2.11) Ice salinity 
     105      ! Ice salinity 
    139106      !--------------------- 
    140       IF (  num_sal == 2  ) THEN  
     107      IF (  nn_icesal == 2  ) THEN  
    141108         DO jl = 1, jpl 
    142109            DO jj = 1, jpj  
    143110               DO ji = 1, jpi 
    144111                  zsal            = smv_i(ji,jj,jl) 
    145                   smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    146112                  ! salinity stays in bounds 
    147                   i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
    148                   smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
     113                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     114                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) ) 
    149115                  ! associated salt flux 
    150116                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
    151                END DO ! ji 
    152             END DO ! jj 
    153          END DO !jl 
     117               END DO 
     118            END DO 
     119         END DO 
    154120      ENDIF 
    155121 
     122      !---------------------------------------------------- 
     123      ! Rebin categories with thickness out of bounds 
     124      !---------------------------------------------------- 
     125      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 
     126 
     127      !----------------- 
     128      ! zap small values 
     129      !----------------- 
     130      CALL lim_var_zapsmall 
     131 
    156132      !------------------------------------------------------------------------------ 
    157       ! 2) Corrections to avoid wrong values                                        | 
     133      ! Corrections to avoid wrong values                                        | 
    158134      !------------------------------------------------------------------------------ 
    159135      ! Ice drift 
    … …  
    173149      CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    174150      !mask velocities 
    175       u_ice(:,:) = u_ice(:,:) * tmu(:,:) 
    176       v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
     151      u_ice(:,:) = u_ice(:,:) * umask(:,:,1) 
     152      v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 
    177153  
    178154      ! ------------------------------------------------- 
    179155      ! Diagnostics 
    180156      ! ------------------------------------------------- 
    181       d_a_i_thd(:,:,:)   = a_i(:,:,:)   - a_i_b(:,:,:)  
    182       d_v_s_thd(:,:,:)   = v_s(:,:,:)   - v_s_b(:,:,:) 
    183       d_v_i_thd(:,:,:)   = v_i(:,:,:)   - v_i_b(:,:,:)   
    184       d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:)  
    185       d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
    186       !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - oa_i_b (:,:,:) 
    187       d_smv_i_thd(:,:,:) = 0._wp 
    188       IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
    189       ! diag only (clem) 
    190       dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    191  
    192       ! heat content variation (W.m-2) 
     157      DO jl  = 1, jpl 
     158         oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday   ! ice natural aging 
     159         afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
     160      END DO 
     161      afx_tot = afx_thd + afx_dyn 
     162 
    193163      DO jj = 1, jpj 
    194164         DO ji = 1, jpi             
    195             diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) +  &  
    196                &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) )    & 
    197                &                   ) * unit_fac * r1_rdtice / area(ji,jj)    
     165            ! heat content variation (W.m-2) 
     166            diag_heat(ji,jj) = diag_heat(ji,jj) -  & 
     167               &               ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
     168               &                 SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
     169               &               ) * r1_rdtice    
     170            ! salt, volume 
     171            diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 
     172            diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice 
     173            diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice 
    198174         END DO 
    199175      END DO 
    200176 
    201177      ! conservation test 
    202       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     178      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     179 
     180      ! necessary calls (at least for coupling) 
     181      CALL lim_var_glo2eqv 
     182      CALL lim_var_agg(2) 
     183 
     184      ! ------------------------------------------------- 
     185      ! control prints 
     186      ! ------------------------------------------------- 
     187      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )   ! control print 
    203188 
    204189      IF(ln_ctl) THEN   ! Control print 
    … …  
    206191         CALL prt_ctl_info(' - Cell values : ') 
    207192         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    208          CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update2  : cell area   :') 
     193         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update2  : cell area   :') 
    209194         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update2  : at_i        :') 
    210195         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update2  : vt_i        :') 
    … …  
    226211            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ') 
    227212            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ') 
    228             CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_a_i_thd   : ') 
    229213            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ') 
    230214            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ') 
    231             CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_i_thd   : ') 
    232215            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ') 
    233216            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ') 
    234             CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_s_thd   : ') 
    235             CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1        : ') 
    236             CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1_b      : ') 
    237             CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : de_i1_thd   : ') 
    238             CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2        : ') 
    239             CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2_b      : ') 
    240             CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : de_i2_thd   : ') 
     217            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_i1        : ') 
     218            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_i1_b      : ') 
     219            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update2  : e_i2        : ') 
     220            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update2  : e_i2_b      : ') 
    241221            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ') 
    242222            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ') 
    243             CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : d_e_s_thd   : ') 
    244223            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ') 
    245224            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ') 
    246             CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update2  : d_smv_i_thd : ') 
    247225            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ') 
    248226            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ') 
    249             CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update2  : d_oa_i_thd  : ') 
    250227 
    251228            DO jk = 1, nlay_i 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r4990 r5682  
    3030   !!====================================================================== 
    3131   !! History :   -   ! 2006-01 (M. Vancoppenolle) Original code 
    32    !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     32   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
    3333   !!---------------------------------------------------------------------- 
    3434#if defined key_lim3 
    … …  
    3636   !!   'key_lim3'                                      LIM3 sea-ice model 
    3737   !!---------------------------------------------------------------------- 
    38    !!   lim_var_agg       :  
    39    !!   lim_var_glo2eqv   : 
    40    !!   lim_var_eqv2glo   : 
    41    !!   lim_var_salprof   :  
    42    !!   lim_var_salprof1d : 
    43    !!   lim_var_bv        : 
    44    !!---------------------------------------------------------------------- 
    4538   USE par_oce        ! ocean parameters 
    4639   USE phycst         ! physical constants (ocean directory)  
    4740   USE sbc_oce        ! Surface boundary condition: ocean fields 
    4841   USE ice            ! ice variables 
    49    USE par_ice        ! ice parameters 
    5042   USE thd_ice        ! ice variables (thermodynamics) 
    5143   USE dom_ice        ! ice domain 
    … …  
    5850   PRIVATE 
    5951 
    60    PUBLIC   lim_var_agg          ! 
    61    PUBLIC   lim_var_glo2eqv      ! 
    62    PUBLIC   lim_var_eqv2glo      ! 
    63    PUBLIC   lim_var_salprof      ! 
    64    PUBLIC   lim_var_icetm        ! 
    65    PUBLIC   lim_var_bv           ! 
    66    PUBLIC   lim_var_salprof1d    ! 
     52   PUBLIC   lim_var_agg           
     53   PUBLIC   lim_var_glo2eqv       
     54   PUBLIC   lim_var_eqv2glo       
     55   PUBLIC   lim_var_salprof       
     56   PUBLIC   lim_var_icetm         
     57   PUBLIC   lim_var_bv            
     58   PUBLIC   lim_var_salprof1d     
     59   PUBLIC   lim_var_zapsmall 
     60   PUBLIC   lim_var_itd 
    6761 
    6862   !!---------------------------------------------------------------------- 
    69    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     63   !! NEMO/LIM3 3.5 , UCL - NEMO Consortium (2011) 
    7064   !! $Id$ 
    7165   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    129123            DO jj = 1, jpj 
    130124               DO ji = 1, jpi 
    131                   et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content 
    132                   rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )  
    133                   smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch   ! ice salinity 
    134                   rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
    135                   ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * rswitch   ! ice age 
     125                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                           ! snow heat content 
     126                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) )  
     127                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch   ! ice salinity 
     128                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) )  
     129                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi20 ) * rswitch   ! ice age 
    136130               END DO 
    137131            END DO 
    … …  
    167161         DO jj = 1, jpj 
    168162            DO ji = 1, jpi 
    169                rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
    170                ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
    171                ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
    172                o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
    173             END DO 
    174          END DO 
    175       END DO 
    176  
    177       IF(  num_sal == 2  )THEN 
     163               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes 
     164               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     165               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     166               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     167            END DO 
     168         END DO 
     169      END DO 
     170 
     171      IF(  nn_icesal == 2  )THEN 
    178172         DO jl = 1, jpl 
    179173            DO jj = 1, jpj 
    180174               DO ji = 1, jpi 
    181                   rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
    182                   sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch 
     175                  rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes 
     176                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * rswitch 
     177                  !                                      ! bounding salinity 
     178                  sm_i(ji,jj,jl) = MAX( sm_i(ji,jj,jl), rn_simin ) 
    183179               END DO 
    184180            END DO 
    … …  
    191187      ! Ice temperatures 
    192188      !------------------- 
    193 !CDIR NOVERRCHK 
    194       DO jl = 1, jpl 
    195 !CDIR NOVERRCHK 
     189      DO jl = 1, jpl 
    196190         DO jk = 1, nlay_i 
    197 !CDIR NOVERRCHK 
    198191            DO jj = 1, jpj 
    199 !CDIR NOVERRCHK 
    200192               DO ji = 1, jpi 
    201193                  !                                                              ! Energy of melting q(S,T) [J.m-3] 
    202                   rswitch   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes 
    203                   zq_i    = rswitch * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
    204                   zq_i    = zq_i * unit_fac                             !convert units 
    205                   ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature 
     194                  rswitch = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes 
     195                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL(nlay_i,wp)  
     196                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rt0              ! Ice layer melt temperature 
    206197                  ! 
    207198                  zaaa       =  cpic                  ! Conversion q(S,T) -> T (second order equation) 
    208                   zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus 
    209                   zccc       =  lfus * (ztmelts-rtt) 
     199                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rt0 ) + zq_i * r1_rhoic - lfus 
     200                  zccc       =  lfus * (ztmelts-rt0) 
    210201                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) ) 
    211                   t_i(ji,jj,jk,jl) = rtt + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 
    212                   t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) )       ! 100-rtt < t_i < rtt 
     202                  t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 
     203                  t_i(ji,jj,jk,jl) = MIN( ztmelts, MAX( rt0 - 100._wp, t_i(ji,jj,jk,jl) ) )  ! -100 < t_i < ztmelts 
    213204               END DO 
    214205            END DO 
    … …  
    226217               DO ji = 1, jpi 
    227218                  !Energy of melting q(S,T) [J.m-3] 
    228                   rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes 
    229                   zq_s  = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
    230                   zq_s  = zq_s * unit_fac                                    ! convert units 
     219                  rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes 
     220                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL(nlay_s,wp) 
    231221                  ! 
    232                   t_s(ji,jj,jk,jl) = rtt + rswitch * ( - zfac1 * zq_s + zfac2 ) 
    233                   t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) )     ! 100-rtt < t_i < rtt 
     222                  t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 ) 
     223                  t_s(ji,jj,jk,jl) = MIN( rt0, MAX( rt0 - 100._wp , t_s(ji,jj,jk,jl) ) )     ! -100 < t_s < rt0 
    234224               END DO 
    235225            END DO 
    … …  
    240230      ! Mean temperature 
    241231      !------------------- 
     232      vt_i (:,:) = 0._wp 
     233      DO jl = 1, jpl 
     234         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
     235      END DO 
     236 
    242237      tm_i(:,:) = 0._wp 
    243238      DO jl = 1, jpl 
    … …  
    245240            DO jj = 1, jpj 
    246241               DO ji = 1, jpi 
    247                   rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    248                   tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    249                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    250                END DO 
    251             END DO 
    252          END DO 
    253       END DO 
     242                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
     243                  tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  & 
     244                     &            / MAX( vt_i(ji,jj) , epsi10 ) 
     245               END DO 
     246            END DO 
     247         END DO 
     248      END DO 
     249      tm_i = tm_i + rt0 
    254250      ! 
    255251   END SUBROUTINE lim_var_glo2eqv 
    … …  
    270266      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
    271267      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    272       oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:) 
    273268      ! 
    274269   END SUBROUTINE lim_var_eqv2glo 
    … …  
    281276      !! ** Purpose :   computes salinity profile in function of bulk salinity      
    282277      !! 
    283       !! ** Method  : If bulk salinity greater than s_i_1,  
     278      !! ** Method  : If bulk salinity greater than zsi1,  
    284279      !!              the profile is assumed to be constant (S_inf) 
    285       !!              If bulk salinity lower than s_i_0, 
     280      !!              If bulk salinity lower than zsi0, 
    286281      !!              the profile is linear with 0 at the surface (S_zero) 
    287       !!              If it is between s_i_0 and s_i_1, it is a 
     282      !!              If it is between zsi0 and zsi1, it is a 
    288283      !!              alpha-weighted linear combination of s_inf and s_zero 
    289284      !! 
    290       !! ** References : Vancoppenolle et al., 2007 (in preparation) 
     285      !! ** References : Vancoppenolle et al., 2007 
    291286      !!------------------------------------------------------------------ 
    292287      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index 
    293       REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal      ! local scalar 
    294       REAL(wp) ::   zswi0, zswi01, zswibal, zargtemp , zs_zero   !   -      - 
    295       REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha   ! 3D pointer 
     288      REAL(wp) ::   zfac0, zfac1, zsal 
     289      REAL(wp) ::   zswi0, zswi01, zargtemp , zs_zero    
     290      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha 
     291      REAL(wp), PARAMETER :: zsi0 = 3.5_wp 
     292      REAL(wp), PARAMETER :: zsi1 = 4.5_wp 
    296293      !!------------------------------------------------------------------ 
    297294 
    … …  
    301298      ! Vertically constant, constant in time 
    302299      !--------------------------------------- 
    303       IF(  num_sal == 1  )   s_i(:,:,:,:) = bulk_sal 
     300      IF(  nn_icesal == 1  )   s_i(:,:,:,:) = rn_icesal 
    304301 
    305302      !----------------------------------- 
    306303      ! Salinity profile, varying in time 
    307304      !----------------------------------- 
    308       IF(  num_sal == 2  ) THEN 
     305      IF(  nn_icesal == 2  ) THEN 
    309306         ! 
    310307         DO jk = 1, nlay_i 
    … …  
    315312            DO jj = 1, jpj 
    316313               DO ji = 1, jpi 
    317                   z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) ) 
    318                END DO 
    319             END DO 
    320          END DO 
    321          ! 
    322          dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )       ! Weighting factor between zs_zero and zs_inf 
    323          dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 ) 
     314                  rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,jl) - epsi20 ) ) 
     315                  z_slope_s(ji,jj,jl) = rswitch * 2._wp * sm_i(ji,jj,jl) / MAX( epsi20 , ht_i(ji,jj,jl) ) 
     316               END DO 
     317            END DO 
     318         END DO 
     319         ! 
     320         zfac0 = 1._wp / ( zsi0 - zsi1 )       ! Weighting factor between zs_zero and zs_inf 
     321         zfac1 = zsi1  / ( zsi1 - zsi0 ) 
    324322         ! 
    325323         zalpha(:,:,:) = 0._wp 
    … …  
    327325            DO jj = 1, jpj 
    328326               DO ji = 1, jpi 
    329                   ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise 
    330                   zswi0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) )  
    331                   ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    332                   zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) )  
    333                   ! If 2.sm_i GE sss_m then zswibal = 1 
     327                  ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise 
     328                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , zsi0 - sm_i(ji,jj,jl) ) )  
     329                  ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws  
     330                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , zsi1 - sm_i(ji,jj,jl) ) )  
     331                  ! If 2.sm_i GE sss_m then rswitch = 1 
    334332                  ! this is to force a constant salinity profile in the Baltic Sea 
    335                   zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
    336                   zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
    337                   zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal ) 
    338                END DO 
    339             END DO 
    340          END DO 
    341  
    342          dummy_fac = 1._wp / REAL( nlay_i )                   ! Computation of the profile 
     333                  rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
     334                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * zfac0 + zfac1 ) 
     335                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - rswitch ) 
     336               END DO 
     337            END DO 
     338         END DO 
     339 
     340         ! Computation of the profile 
    343341         DO jl = 1, jpl 
    344342            DO jk = 1, nlay_i 
    … …  
    346344                  DO ji = 1, jpi 
    347345                     !                                      ! linear profile with 0 at the surface 
    348                      zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * dummy_fac 
     346                     zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * r1_nlay_i 
    349347                     !                                      ! weighting the profile 
    350348                     s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) 
    351                   END DO ! ji 
    352                END DO ! jj 
    353             END DO ! jk 
    354          END DO ! jl 
    355          ! 
    356       ENDIF ! num_sal 
     349                     !                                      ! bounding salinity 
     350                     s_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( s_i(ji,jj,jk,jl), rn_simin ) ) 
     351                  END DO 
     352               END DO 
     353            END DO 
     354         END DO 
     355         ! 
     356      ENDIF ! nn_icesal 
    357357 
    358358      !------------------------------------------------------- 
    … …  
    360360      !------------------------------------------------------- 
    361361 
    362       IF(  num_sal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
     362      IF(  nn_icesal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    363363         ! 
    364364         sm_i(:,:,:) = 2.30_wp 
    365365         ! 
    366366         DO jl = 1, jpl 
    367 !CDIR NOVERRCHK 
    368367            DO jk = 1, nlay_i 
    369                zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp) 
     368               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    370369               zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
    371370               s_i(:,:,jk,jl) =  zsal 
    … …  
    373372         END DO 
    374373         ! 
    375       ENDIF ! num_sal 
     374      ENDIF ! nn_icesal 
    376375      ! 
    377376      CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha ) 
    … …  
    390389 
    391390      ! Mean sea ice temperature 
     391      vt_i (:,:) = 0._wp 
     392      DO jl = 1, jpl 
     393         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
     394      END DO 
     395 
    392396      tm_i(:,:) = 0._wp 
    393397      DO jl = 1, jpl 
    … …  
    395399            DO jj = 1, jpj 
    396400               DO ji = 1, jpi 
    397                   rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    398                   tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    399                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    400                END DO 
    401             END DO 
    402          END DO 
    403       END DO 
     401                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
     402                  tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  & 
     403                     &            / MAX( vt_i(ji,jj) , epsi10 ) 
     404               END DO 
     405            END DO 
     406         END DO 
     407      END DO 
     408      tm_i = tm_i + rt0 
    404409 
    405410   END SUBROUTINE lim_var_icetm 
    … …  
    420425      !!------------------------------------------------------------------ 
    421426      ! 
     427      vt_i (:,:) = 0._wp 
     428      DO jl = 1, jpl 
     429         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
     430      END DO 
     431 
    422432      bv_i(:,:) = 0._wp 
    423433      DO jl = 1, jpl 
    … …  
    425435            DO jj = 1, jpj 
    426436               DO ji = 1, jpi 
    427                   rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  ) 
    428                   zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   & 
    429                      &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp) 
    430                   rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    431                   bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi10 ) 
     437                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) )  ) 
     438                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 )   & 
     439                     &                   * v_i(ji,jj,jl) * r1_nlay_i 
     440                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) )  ) 
     441                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi20 ) 
    432442               END DO 
    433443            END DO 
    … …  
    448458      ! 
    449459      INTEGER  ::   ji, jk    ! dummy loop indices 
    450       INTEGER  ::   ii, ij  ! local integers 
    451       REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars 
    452       REAL(wp) ::   zalpha, zswi0, zswi01, zswibal, zs_zero              !   -      - 
     460      INTEGER  ::   ii, ij    ! local integers 
     461      REAL(wp) ::   zfac0, zfac1, zargtemp, zsal   ! local scalars 
     462      REAL(wp) ::   zalpha, zswi0, zswi01, zs_zero              !   -      - 
    453463      ! 
    454464      REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s 
     465      REAL(wp), PARAMETER :: zsi0 = 3.5_wp 
     466      REAL(wp), PARAMETER :: zsi1 = 4.5_wp 
    455467      !!--------------------------------------------------------------------- 
    456468 
    … …  
    460472      ! Vertically constant, constant in time 
    461473      !--------------------------------------- 
    462       IF( num_sal == 1 )   s_i_1d(:,:) = bulk_sal 
     474      IF( nn_icesal == 1 )   s_i_1d(:,:) = rn_icesal 
    463475 
    464476      !------------------------------------------------------ 
    … …  
    466478      !------------------------------------------------------ 
    467479 
    468       IF(  num_sal == 2  ) THEN 
     480      IF(  nn_icesal == 2  ) THEN 
    469481         ! 
    470482         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero 
    471             z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) ) 
     483            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 
     484            z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) ) 
    472485         END DO 
    473486 
    474487         ! Weighting factor between zs_zero and zs_inf 
    475488         !--------------------------------------------- 
    476          dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 ) 
    477          dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 ) 
    478          dummy_fac2 = 1._wp / REAL(nlay_i,wp) 
    479  
    480 !CDIR NOVERRCHK 
     489         zfac0 = 1._wp / ( zsi0 - zsi1 ) 
     490         zfac1 = zsi1 / ( zsi1 - zsi0 ) 
    481491         DO jk = 1, nlay_i 
    482 !CDIR NOVERRCHK 
    483492            DO ji = kideb, kiut 
    484493               ii =  MOD( npb(ji) - 1 , jpi ) + 1 
    485494               ij =     ( npb(ji) - 1 ) / jpi + 1 
    486                ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise 
    487                zswi0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_1d(ji) ) )  
    488                ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    489                zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) )  
    490                ! if 2.sm_i GE sss_m then zswibal = 1 
     495               ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise 
     496               zswi0  = MAX( 0._wp , SIGN( 1._wp  , zsi0 - sm_i_1d(ji) ) )  
     497               ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws  
     498               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) )  
     499               ! if 2.sm_i GE sss_m then rswitch = 1 
    491500               ! this is to force a constant salinity profile in the Baltic Sea 
    492                zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 
     501               rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 
    493502               ! 
    494                zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zswibal ) 
     503               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 )  ) * ( 1._wp - rswitch ) 
    495504               ! 
    496                zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2 
     505               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i 
    497506               ! weighting the profile 
    498507               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 
    499             END DO ! ji 
    500          END DO ! jk 
    501  
    502       ENDIF ! num_sal 
     508               ! bounding salinity 
     509               s_i_1d(ji,jk) = MIN( rn_simax, MAX( s_i_1d(ji,jk), rn_simin ) ) 
     510            END DO  
     511         END DO  
     512 
     513      ENDIF  
    503514 
    504515      !------------------------------------------------------- 
    … …  
    506517      !------------------------------------------------------- 
    507518 
    508       IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
     519      IF( nn_icesal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    509520         ! 
    510521         sm_i_1d(:) = 2.30_wp 
    511522         ! 
    512 !CDIR NOVERRCHK 
    513523         DO jk = 1, nlay_i 
    514             zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp) 
    515             zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) ) 
     524            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
     525            zsal =  1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) ) 
    516526            DO ji = kideb, kiut 
    517527               s_i_1d(ji,jk) = zsal 
    … …  
    524534      ! 
    525535   END SUBROUTINE lim_var_salprof1d 
     536 
     537   SUBROUTINE lim_var_zapsmall 
     538      !!------------------------------------------------------------------- 
     539      !!                   ***  ROUTINE lim_var_zapsmall *** 
     540      !! 
     541      !! ** Purpose :   Remove too small sea ice areas and correct fluxes 
     542      !! 
     543      !! history : LIM3.5 - 01-2014 (C. Rousset) original code 
     544      !!------------------------------------------------------------------- 
     545      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices 
     546      REAL(wp) ::   zsal, zvi, zvs, zei, zes 
     547      !!------------------------------------------------------------------- 
     548      at_i (:,:) = 0._wp 
     549      DO jl = 1, jpl 
     550         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     551      END DO 
     552 
     553      DO jl = 1, jpl 
     554 
     555         !----------------------------------------------------------------- 
     556         ! Zap ice energy and use ocean heat to melt ice 
     557         !----------------------------------------------------------------- 
     558         DO jk = 1, nlay_i 
     559            DO jj = 1 , jpj 
     560               DO ji = 1 , jpi 
     561                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 
     562                  rswitch          = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch 
     563                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch 
     564                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  & 
     565                     &                                       / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch 
     566                  zei              = e_i(ji,jj,jk,jl) 
     567                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch 
     568                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * rswitch + rt0 * ( 1._wp - rswitch ) 
     569                  ! update exchanges with ocean 
     570                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * r1_rdtice ! W.m-2 <0 
     571               END DO 
     572            END DO 
     573         END DO 
     574 
     575         DO jj = 1 , jpj 
     576            DO ji = 1 , jpi 
     577               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 
     578               rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch 
     579               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch 
     580               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  & 
     581                  &                              / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch 
     582               zsal = smv_i(ji,jj,  jl) 
     583               zvi  = v_i  (ji,jj,  jl) 
     584               zvs  = v_s  (ji,jj,  jl) 
     585               zes  = e_s  (ji,jj,1,jl) 
     586               !----------------------------------------------------------------- 
     587               ! Zap snow energy  
     588               !----------------------------------------------------------------- 
     589               t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * rswitch + rt0 * ( 1._wp - rswitch ) 
     590               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * rswitch 
     591 
     592               !----------------------------------------------------------------- 
     593               ! zap ice and snow volume, add water and salt to ocean 
     594               !----------------------------------------------------------------- 
     595               ato_i(ji,jj)    = a_i  (ji,jj,jl) * ( 1._wp - rswitch ) + ato_i(ji,jj) 
     596               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * rswitch 
     597               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * rswitch 
     598               v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * rswitch 
     599               t_su (ji,jj,jl) = t_su (ji,jj,jl) * rswitch + t_bo(ji,jj) * ( 1._wp - rswitch ) 
     600               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch 
     601               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch 
     602 
     603               ! update exchanges with ocean 
     604               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     605               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice 
     606               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice 
     607               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0 
     608            END DO 
     609         END DO 
     610      END DO  
     611 
     612      ! to be sure that at_i is the sum of a_i(jl) 
     613      at_i (:,:) = 0._wp 
     614      DO jl = 1, jpl 
     615         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     616      END DO 
     617 
     618      ! open water = 1 if at_i=0 
     619      DO jj = 1, jpj 
     620         DO ji = 1, jpi 
     621            rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 
     622            ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj) 
     623         END DO 
     624      END DO 
     625 
     626      ! 
     627   END SUBROUTINE lim_var_zapsmall 
     628 
     629   SUBROUTINE lim_var_itd( zhti, zhts, zai, zht_i, zht_s, za_i ) 
     630      !!------------------------------------------------------------------ 
     631      !!                ***  ROUTINE lim_var_itd   *** 
     632      !! 
     633      !! ** Purpose :  converting 1-cat ice to multiple ice categories 
     634      !! 
     635      !!                  ice thickness distribution follows a gaussian law 
     636      !!               around the concentration of the most likely ice thickness 
     637      !!                           (similar as limistate.F90) 
     638      !! 
     639      !! ** Method:   Iterative procedure 
     640      !!                 
     641      !!               1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian 
     642      !! 
     643      !!               2) Check whether the distribution conserves area and volume, positivity and 
     644      !!                  category boundaries 
     645      !!               
     646      !!               3) If not (input ice is too thin), the last category is empty and 
     647      !!                  the number of categories is reduced (jpl-1) 
     648      !! 
     649      !!               4) Iterate until ok (SUM(itest(:) = 4) 
     650      !! 
     651      !! ** Arguments : zhti: 1-cat ice thickness 
     652      !!                zhts: 1-cat snow depth 
     653      !!                zai : 1-cat ice concentration 
     654      !! 
     655      !! ** Output    : jpl-cat  
     656      !! 
     657      !!  (Example of application: BDY forcings when input are cell averaged)   
     658      !! 
     659      !!------------------------------------------------------------------- 
     660      !! History : LIM3.5 - 2012    (M. Vancoppenolle)  Original code 
     661      !!                    2014    (C. Rousset)        Rewriting 
     662      !!------------------------------------------------------------------- 
     663      !! Local variables 
     664      INTEGER  :: ji, jk, jl             ! dummy loop indices 
     665      INTEGER  :: ijpij, i_fill, jl0   
     666      REAL(wp) :: zarg, zV, zconv, zdh 
     667      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zai    ! input ice/snow variables 
     668      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zht_i, zht_s, za_i ! output ice/snow variables 
     669      INTEGER , POINTER, DIMENSION(:)         ::   itest 
     670  
     671      CALL wrk_alloc( 4, itest ) 
     672      !-------------------------------------------------------------------- 
     673      ! initialisation of variables 
     674      !-------------------------------------------------------------------- 
     675      ijpij = SIZE(zhti,1) 
     676      zht_i(1:ijpij,1:jpl) = 0._wp 
     677      zht_s(1:ijpij,1:jpl) = 0._wp 
     678      za_i (1:ijpij,1:jpl) = 0._wp 
     679 
     680      ! ---------------------------------------- 
     681      ! distribution over the jpl ice categories 
     682      ! ---------------------------------------- 
     683      DO ji = 1, ijpij 
     684          
     685         IF( zhti(ji) > 0._wp ) THEN 
     686 
     687         ! initialisation of tests 
     688         itest(:)  = 0 
     689          
     690         i_fill = jpl + 1                                             !==================================== 
     691         DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories   
     692            ! iteration                                               !==================================== 
     693            i_fill = i_fill - 1 
     694             
     695            ! initialisation of ice variables for each try 
     696            zht_i(ji,1:jpl) = 0._wp 
     697            za_i (ji,1:jpl) = 0._wp 
     698             
     699            ! *** case very thin ice: fill only category 1 
     700            IF ( i_fill == 1 ) THEN 
     701               zht_i(ji,1) = zhti(ji) 
     702               za_i (ji,1) = zai (ji) 
     703 
     704            ! *** case ice is thicker: fill categories >1 
     705            ELSE 
     706 
     707               ! Fill ice thicknesses except the last one (i_fill) by hmean  
     708               DO jl = 1, i_fill - 1 
     709                  zht_i(ji,jl) = hi_mean(jl) 
     710               END DO 
     711                
     712               ! find which category (jl0) the input ice thickness falls into 
     713               jl0 = i_fill 
     714               DO jl = 1, i_fill 
     715                  IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 
     716                     jl0 = jl 
     717           CYCLE 
     718                  ENDIF 
     719               END DO 
     720                
     721               ! Concentrations in the (i_fill-1) categories  
     722               za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl)) 
     723               DO jl = 1, i_fill - 1 
     724                  IF ( jl == jl0 ) CYCLE 
     725                  zarg        = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 
     726                  za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2) 
     727               END DO 
     728                
     729               ! Concentration in the last (i_fill) category 
     730               za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) ) 
     731                
     732               ! Ice thickness in the last (i_fill) category 
     733               zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) ) 
     734               zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / za_i(ji,i_fill)  
     735                
     736            ENDIF ! case ice is thick or thin 
     737             
     738            !--------------------- 
     739            ! Compatibility tests 
     740            !---------------------  
     741            ! Test 1: area conservation 
     742            zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) ) 
     743            IF ( zconv < epsi06 ) itest(1) = 1 
     744             
     745            ! Test 2: volume conservation 
     746            zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) ) 
     747            IF ( zconv < epsi06 ) itest(2) = 1 
     748             
     749            ! Test 3: thickness of the last category is in-bounds ? 
     750            IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 
     751             
     752            ! Test 4: positivity of ice concentrations 
     753            itest(4) = 1 
     754            DO jl = 1, i_fill 
     755               IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 
     756            END DO             
     757                                                           !============================ 
     758         END DO                                            ! end iteration on categories 
     759                                                           !============================ 
     760         ENDIF ! if zhti > 0 
     761      END DO ! i loop 
     762 
     763      ! ------------------------------------------------ 
     764      ! Adding Snow in each category where za_i is not 0 
     765      ! ------------------------------------------------  
     766      DO jl = 1, jpl 
     767         DO ji = 1, ijpij 
     768            IF( za_i(ji,jl) > 0._wp ) THEN 
     769               zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) ) 
     770               ! In case snow load is in excess that would lead to transformation from snow to ice 
     771               ! Then, transfer the snow excess into the ice (different from limthd_dh) 
     772               zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 )  
     773               ! recompute ht_i, ht_s avoiding out of bounds values 
     774               zht_i(ji,jl) = MIN( hi_max(jl), zht_i(ji,jl) + zdh ) 
     775               zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic * r1_rhosn ) 
     776            ENDIF 
     777         ENDDO 
     778      ENDDO 
     779 
     780      CALL wrk_dealloc( 4, itest ) 
     781      ! 
     782    END SUBROUTINE lim_var_itd 
     783 
    526784 
    527785#else 
    … …  
    542800   SUBROUTINE lim_var_salprof1d    ! Emtpy routines 
    543801   END SUBROUTINE lim_var_salprof1d 
     802   SUBROUTINE lim_var_zapsmall 
     803   END SUBROUTINE lim_var_zapsmall 
     804   SUBROUTINE lim_var_itd 
     805   END SUBROUTINE lim_var_itd 
    544806#endif 
    545807 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r4990 r5682  
    2424   USE lib_mpp         ! MPP library 
    2525   USE wrk_nemo        ! work arrays 
    26    USE par_ice 
    2726   USE iom 
    2827   USE timing          ! Timing 
    … …  
    6160      REAL(wp) ::  z1_365 
    6261      REAL(wp) ::  ztmp 
    63       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei 
     62      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei, zt_i, zt_s 
    6463      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace 
    6564      !!------------------------------------------------------------------- 
    … …  
    6766      IF( nn_timing == 1 )  CALL timing_start('limwri') 
    6867 
    69       CALL wrk_alloc( jpi, jpj, jpl, zoi, zei ) 
     68      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
    7069      CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi ) 
    7170 
    … …  
    7372      ! Mean category values 
    7473      !----------------------------- 
     74      z1_365 = 1._wp / 365._wp 
    7575 
    7676      CALL lim_var_icetm      ! mean sea ice temperature 
    … …  
    107107         DO jj = 2 , jpjm1 
    108108            DO ji = 2 , jpim1 
    109                z2da(ji,jj)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 
    110                z2db(ji,jj)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 
     109               z2da(ji,jj)  = (  u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 
     110               z2db(ji,jj)  = (  v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 
    111111           END DO 
    112112         END DO 
    113113         CALL lbc_lnk( z2da, 'T', -1. ) 
    114114         CALL lbc_lnk( z2db, 'T', -1. ) 
    115          CALL iom_put( "uice_ipa"     , z2da                )       ! ice velocity u component 
    116          CALL iom_put( "vice_ipa"     , z2db                )       ! ice velocity v component 
     115         CALL iom_put( "uice_ipa"     , z2da             )       ! ice velocity u component 
     116         CALL iom_put( "vice_ipa"     , z2db             )       ! ice velocity v component 
    117117         DO jj = 1, jpj                                  
    118118            DO ji = 1, jpi 
    … …  
    120120            END DO 
    121121         END DO 
    122          CALL iom_put( "icevel"       , z2d                 )       ! ice velocity module 
     122         CALL iom_put( "icevel"       , z2d              )       ! ice velocity module 
    123123      ENDIF 
    124124      ! 
    … …  
    128128            DO jj = 1, jpj 
    129129               DO ji = 1, jpi 
    130                   z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * oa_i(ji,jj,jl) 
     130                  rswitch    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
     131                  z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 ) 
    131132               END DO 
    132133            END DO 
    133134         END DO 
    134          z1_365 = 1._wp / 365._wp 
    135          CALL iom_put( "miceage"     , z2d * z1_365         )        ! mean ice age 
     135         CALL iom_put( "miceage"     , z2d * z1_365      )        ! mean ice age 
    136136      ENDIF 
    137137 
    … …  
    139139         DO jj = 1, jpj 
    140140            DO ji = 1, jpi 
    141                z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zswi(ji,jj) 
    142             END DO 
    143          END DO 
    144          CALL iom_put( "micet"       , z2d                  )        ! mean ice temperature 
     141               z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj) 
     142            END DO 
     143         END DO 
     144         CALL iom_put( "micet"       , z2d               )        ! mean ice temperature 
    145145      ENDIF 
    146146      ! 
    … …  
    150150            DO jj = 1, jpj 
    151151               DO ji = 1, jpi 
    152                   z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 ) 
     152                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 ) 
    153153               END DO 
    154154            END DO 
    155155         END DO 
    156          CALL iom_put( "icest"       , z2d                 )        ! ice surface temperature 
     156         CALL iom_put( "icest"       , z2d              )        ! ice surface temperature 
    157157      ENDIF 
    158158 
    … …  
    164164            END DO 
    165165         END DO 
    166          CALL iom_put( "icecolf"     , z2d                 )        ! frazil ice collection thickness 
     166         CALL iom_put( "icecolf"     , z2d              )        ! frazil ice collection thickness 
    167167      ENDIF 
    168168 
    … …  
    176176      CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point 
    177177      CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point 
    178       CALL iom_put( "snowpre"     , sprecip             )        ! snow precipitation  
     178      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation  
    179179      CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity 
    180180 
    … …  
    186186      CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport 
    187187      CALL iom_put( "snwtrp"      , diag_trp_vs * rday  )        ! snw volume transport 
     188      CALL iom_put( "saltrp"      , diag_trp_smv * rday * rhoic ) ! salt content transport 
    188189      CALL iom_put( "deitrp"      , diag_trp_ei         )        ! advected ice enthalpy (W/m2) 
    189190      CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2) 
    … …  
    200201 
    201202      ztmp = rday / rhoic 
    202       CALL iom_put( "vfxres"     , wfx_res * ztmp  )             ! daily prod./melting due to limupdate  
    203       CALL iom_put( "vfxopw"     , wfx_opw * ztmp  )             ! daily lateral thermodynamic ice production 
    204       CALL iom_put( "vfxsni"     , wfx_sni * ztmp  )             ! daily snowice ice production 
    205       CALL iom_put( "vfxbog"     , wfx_bog * ztmp  )             ! daily bottom thermodynamic ice production 
    206       CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp  )             ! daily dynamic ice production (rid/raft) 
    207       CALL iom_put( "vfxsum"     , wfx_sum * ztmp  )             ! surface melt  
    208       CALL iom_put( "vfxbom"     , wfx_bom * ztmp  )             ! bottom melt  
    209       CALL iom_put( "vfxice"     , wfx_ice * ztmp  )             ! total ice growth/melt  
    210       CALL iom_put( "vfxsnw"     , wfx_snw * ztmp  )             ! total snw growth/melt  
    211       CALL iom_put( "vfxsub"     , wfx_sub * ztmp  )             ! sublimation (snow)  
    212       CALL iom_put( "vfxspr"     , wfx_spr * ztmp  )             ! precip (snow)  
    213  
    214       CALL iom_put ('hfxthd', hfx_thd(:,:) )   !   
    215       CALL iom_put ('hfxdyn', hfx_dyn(:,:) )   !   
    216       CALL iom_put ('hfxres', hfx_res(:,:) )   !   
    217       CALL iom_put ('hfxout', hfx_out(:,:) )   !   
    218       CALL iom_put ('hfxin' , hfx_in(:,:) )   !   
    219       CALL iom_put ('hfxsnw', hfx_snw(:,:) )   !   
    220       CALL iom_put ('hfxsub', hfx_sub(:,:) )   !   
    221       CALL iom_put ('hfxerr', hfx_err(:,:) )   !   
    222       CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) )   !   
    223        
    224       CALL iom_put ('hfxsum', hfx_sum(:,:) )   !   
    225       CALL iom_put ('hfxbom', hfx_bom(:,:) )   !   
    226       CALL iom_put ('hfxbog', hfx_bog(:,:) )   !   
    227       CALL iom_put ('hfxdif', hfx_dif(:,:) )   !   
    228       CALL iom_put ('hfxopw', hfx_opw(:,:) )   !   
    229       CALL iom_put ('hfxtur', fhtur(:,:) * at_i(:,:) )   ! turbulent heat flux at ice base  
    230       CALL iom_put ('hfxdhc', diag_heat_dhc(:,:) )          ! Heat content variation in snow and ice  
    231       CALL iom_put ('hfxspr', hfx_spr(:,:) )          ! Heat content of snow precip  
     203      CALL iom_put( "vfxres"     , wfx_res * ztmp       )        ! daily prod./melting due to limupdate  
     204      CALL iom_put( "vfxopw"     , wfx_opw * ztmp       )        ! daily lateral thermodynamic ice production 
     205      CALL iom_put( "vfxsni"     , wfx_sni * ztmp       )        ! daily snowice ice production 
     206      CALL iom_put( "vfxbog"     , wfx_bog * ztmp       )        ! daily bottom thermodynamic ice production 
     207      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp       )        ! daily dynamic ice production (rid/raft) 
     208      CALL iom_put( "vfxsum"     , wfx_sum * ztmp       )        ! surface melt  
     209      CALL iom_put( "vfxbom"     , wfx_bom * ztmp       )        ! bottom melt  
     210      CALL iom_put( "vfxice"     , wfx_ice * ztmp       )        ! total ice growth/melt  
     211      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp       )        ! total snw growth/melt  
     212      CALL iom_put( "vfxsub"     , wfx_sub * ztmp       )        ! sublimation (snow)  
     213      CALL iom_put( "vfxspr"     , wfx_spr * ztmp       )        ! precip (snow) 
     214       
     215      CALL iom_put( "afxtot"     , afx_tot * rday       )        ! concentration tendency (total) 
     216      CALL iom_put( "afxdyn"     , afx_dyn * rday       )        ! concentration tendency (dynamics) 
     217      CALL iom_put( "afxthd"     , afx_thd * rday       )        ! concentration tendency (thermo) 
     218 
     219      CALL iom_put ('hfxthd'     , hfx_thd(:,:)         )   !   
     220      CALL iom_put ('hfxdyn'     , hfx_dyn(:,:)         )   !   
     221      CALL iom_put ('hfxres'     , hfx_res(:,:)         )   !   
     222      CALL iom_put ('hfxout'     , hfx_out(:,:)         )   !   
     223      CALL iom_put ('hfxin'      , hfx_in(:,:)          )   !   
     224      CALL iom_put ('hfxsnw'     , hfx_snw(:,:)         )   !   
     225      CALL iom_put ('hfxsub'     , hfx_sub(:,:)         )   !   
     226      CALL iom_put ('hfxerr'     , hfx_err(:,:)         )   !   
     227      CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:)     )   !   
     228       
     229      CALL iom_put ('hfxsum'     , hfx_sum(:,:)         )   !   
     230      CALL iom_put ('hfxbom'     , hfx_bom(:,:)         )   !   
     231      CALL iom_put ('hfxbog'     , hfx_bog(:,:)         )   !   
     232      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   !   
     233      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !   
     234      CALL iom_put ('hfxtur'     , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base  
     235      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice  
     236      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip  
    232237       
    233238      !-------------------------------- 
    … …  
    239244      CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories 
    240245 
     246      ! ice temperature 
     247      IF ( iom_use( "icetemp_cat" ) ) THEN  
     248         zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i 
     249         CALL iom_put( "icetemp_cat"   , zt_i - rt0  ) 
     250      ENDIF 
     251       
     252      ! snow temperature 
     253      IF ( iom_use( "snwtemp_cat" ) ) THEN  
     254         zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s 
     255         CALL iom_put( "snwtemp_cat"   , zt_s - rt0  ) 
     256      ENDIF 
     257 
    241258      ! Compute ice age 
    242259      IF ( iom_use( "iceage_cat" ) ) THEN  
    … …  
    244261            DO jj = 1, jpj 
    245262               DO ji = 1, jpi 
    246                   rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    247                   zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * rswitch 
     263                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
     264                  rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) ) 
     265                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch 
    248266               END DO 
    249267            END DO 
    250268         END DO 
    251          CALL iom_put( "iceage_cat"     , zoi        )        ! ice age for categories 
     269         CALL iom_put( "iceage_cat"   , zoi * z1_365 )        ! ice age for categories 
    252270      ENDIF 
    253271 
    … …  
    260278                  DO ji = 1, jpi 
    261279                     rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    262                      zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 
    263                         ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * & 
    264                         rswitch / nlay_i 
     280                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 * & 
     281                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 
     282                        rswitch * r1_nlay_i 
    265283                  END DO 
    266284               END DO 
    267285            END DO 
    268286         END DO 
    269          CALL iom_put( "brinevol_cat"     , zei         )        ! brine volume for categories 
     287         CALL iom_put( "brinevol_cat"     , zei      )        ! brine volume for categories 
    270288      ENDIF 
    271289 
    … …  
    274292      !     not yet implemented 
    275293       
    276       CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei ) 
     294      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
    277295      CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db ) 
    278296 
    … …  
    348366      CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )     
    349367      CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) ) 
    350       CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) ) 
     368      CALL histwrite( kid, "iicetemp", kt, tm_i - rt0    , jpi*jpj, (/1/) ) 
    351369      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) ) 
    352370      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) ) 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90

    r4688 r5682  
    9292         zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    9393         zindb  = zindh * zinda 
    94          ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
     94         ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) )  
    9595         zcmo(ji,jj,1)  = ht_s (ji,jj,1) 
    9696         zcmo(ji,jj,2)  = ht_i (ji,jj,1) 
    … …  
    9999         zcmo(ji,jj,5)  = sist  (ji,jj) 
    100100         zcmo(ji,jj,6)  = fhtur  (ji,jj) 
    101          zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    102             + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     101         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   & 
     102            + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) & 
    103103            / ztmu  
    104104 
    105          zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    106             + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     105         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   & 
     106            + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) & 
    107107            / ztmu 
    108108         zcmo(ji,jj,9)  = sst_m(ji,jj) 
    … …  
    135135               zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    136136               zindb  = zindh * zinda 
    137                ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
     137               ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) ) 
    138138               rcmoy(ji,jj,1)  = ht_s (ji,jj,1) 
    139139               rcmoy(ji,jj,2)  = ht_i (ji,jj,1) 
    … …  
    142142               rcmoy(ji,jj,5)  = sist  (ji,jj) 
    143143               rcmoy(ji,jj,6)  = fhtur  (ji,jj) 
    144                rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    145                   + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     144               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   & 
     145                  + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) & 
    146146                  / ztmu 
    147147 
    148                rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    149                   + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     148               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   & 
     149                  + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) & 
    150150                  / ztmu 
    151151               rcmoy(ji,jj,9)  = sst_m(ji,jj) 

  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r4990 r5682  
    66   !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module 
    77   !!---------------------------------------------------------------------- 
    8    USE par_ice        ! LIM-3 parameters 
    98   USE in_out_manager ! I/O manager 
    109   USE lib_mpp        ! MPP library 
     10   USE ice, ONLY :   nlay_i, nlay_s 
    1111 
    1212   IMPLICIT NONE 
    … …  
    1919   !!--------------------------- 
    2020   !                               !!! ** ice-thermo namelist (namicethd) ** 
    21    REAL(wp), PUBLIC ::   hmelt       !: maximum melting at the bottom; active only for one category 
    22    REAL(wp), PUBLIC ::   hiclim      !: minimum ice thickness 
    23    REAL(wp), PUBLIC ::   hnzst       !: thick. of the surf. layer in temp. comp. 
    24    REAL(wp), PUBLIC ::   parsub      !: switch for snow sublimation or not 
    25    REAL(wp), PUBLIC ::   maxfrazb    !: maximum portion of frazil ice collecting at the ice bottom 
    26    REAL(wp), PUBLIC ::   vfrazb      !: threshold drift speed for collection of bottom frazil ice 
    27    REAL(wp), PUBLIC ::   Cfrazb      !: squeezing coefficient for collection of bottom frazil ice 
    28    REAL(wp), PUBLIC ::   hiccrit     !: ice th. for lateral accretion in the NH (SH) (m) 
     21   REAL(wp), PUBLIC ::   rn_himin    !: minimum ice thickness 
     22   REAL(wp), PUBLIC ::   rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 
     23   REAL(wp), PUBLIC ::   rn_vfrazb   !: threshold drift speed for collection of bottom frazil ice 
     24   REAL(wp), PUBLIC ::   rn_Cfrazb   !: squeezing coefficient for collection of bottom frazil ice 
     25   REAL(wp), PUBLIC ::   rn_hnewice  !: thickness for new ice formation (m) 
    2926 
    30    INTEGER , PUBLIC ::   fraz_swi    !: use of frazil ice collection in function of wind (1) or not (0) 
     27   LOGICAL , PUBLIC ::   ln_frazil   !: use of frazil ice collection as function of wind (T) or not (F) 
    3128 
    3229   !!----------------------------- 
    … …  
    3734   !: are the variables corresponding to 2d vectors 
    3835 
    39    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: number of points where computations has to be done 
    40    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion) 
     36   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: address vector for 1d vertical thermo computations 
     37   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nplm   !: address vector for mono-category lateral melting 
     38   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: address vector for new ice formation 
    4139 
    4240   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      
    … …  
    5654   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d 
    5755   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d 
    5857 
    5958   ! heat flux associated with ice-atmosphere mass exchange 
    … …  
    9089   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld 
    9190   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice 
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice 
    93    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqla_ice_1d   !: <==> the 2D  dqla_ice 
    94    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice 
    9593   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics 
    9694   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
    … …  
    140138      !!---------------------------------------------------------------------! 
    141139 
    142       ALLOCATE( npb      (jpij) , npac     (jpij),                          & 
    143          !                                                                  ! 
    144          &      qlead_1d (jpij) , ftr_ice_1d  (jpij) ,     & 
    145          &      qsr_ice_1d (jpij) ,     & 
    146          &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     & 
    147          &      t_bo_1d   (jpij) ,                                          & 
    148          &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,     &  
    149          &      hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 
    150          &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 
    151          &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 
    152          &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij),       STAT=ierr(1) ) 
     140      ALLOCATE( npb      (jpij) , nplm      (jpij) , npac       (jpij) ,   & 
     141         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   & 
     142         &      fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij)  ,   & 
     143         &      t_bo_1d   (jpij) ,                                         & 
     144         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    &  
     145         &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,                      & 
     146         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      & 
     147         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   & 
     148         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(1) ) 
    153149      ! 
    154       ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d     (jpij) ,     & 
    155          &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,     & 
    156          &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , & 
    157          &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) ,  wfx_res_1d (jpij) ,  & 
    158          &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     & 
    159          &      tatm_ice_1d(jpij) ,      &    
    160          &      i0         (jpij) ,     &   
    161          &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,   & 
    162          &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , & 
    163          &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &      
     150      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d    (jpij) ,                     & 
     151         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,                     & 
     152         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) ,  & 
     153         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  & 
     154         &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         & 
     155         &      qprec_ice_1d(jpij), i0         (jpij) ,                                         &   
     156         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  & 
     157         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) ,                     & 
     158         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,                     &      
    164159         &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) ) 
    165160      ! 
    166       ALLOCATE( t_su_1d    (jpij) , a_i_1d    (jpij) , ht_i_1d   (jpij) ,    &    
    167          &      ht_s_1d    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
     161      ALLOCATE( t_su_1d   (jpij) , a_i_1d   (jpij) , ht_i_1d  (jpij) ,    &    
     162         &      ht_s_1d   (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
    168163         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &     
    169          &      dh_snowice(jpij) , sm_i_1d   (jpij) , s_i_new  (jpij) ,    & 
    170          &      t_s_1d(jpij,nlay_s),                                       & 
    171          &      t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1)                ,     &             
    172          &      q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1)                ,     & 
     164         &      dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    & 
     165         &      t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) ,  &             
     166         &      q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) ,                        & 
    173167         &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 
    174168      ! 
Note: See TracChangeset for help on using the changeset viewer.