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 5832 for branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

Ignore:
Timestamp:
2015-10-26T10:08:06+01:00 (9 years ago)
Author:
timgraham
Message:

Upgraded to trunk revision r5518 (NEMO 3.6 stable)

Location:
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3
Files:
3 deleted
27 edited
1 copied

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90

    r4161 r5832  
    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/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4333 r5832  
    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   !!====================================================================== 
    … …  
    105104   !! ** Global variables                                                 | 
    106105   !!-------------|-------------|---------------------------------|-------| 
    107    !! a_i         | a_i_b       |    Ice concentration            |       | 
     106   !! a_i         | a_i_1d      |    Ice concentration            |       | 
    108107   !! v_i         |      -      |    Ice volume per unit area     | m     | 
    109108   !! v_s         |      -      |    Snow volume per unit area    | m     | 
    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|  
    113    !!      -      ! q_i_b       !    Ice enthalpy per unit vol.   | J/m3  |  
    114    !! e_s         !      -      !    Snow enthalpy                | 10^9 J|  
    115    !!      -      ! q_s_b       !    Snow enthalpy per unit vol.  | J/m3  |  
     111   !! e_i         !      -      !    Ice enthalpy                 | J/m2  |  
     112   !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  |  
     113   !! e_s         !      -      !    Snow enthalpy                | J/m2  |  
     114   !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  |  
    116115   !!                                                                     | 
    117116   !!-------------|-------------|---------------------------------|-------| 
    … …  
    120119   !!-------------|-------------|---------------------------------|-------| 
    121120   !!                                                                     | 
    122    !! ht_i        | ht_i_b      |    Ice thickness                | m     | 
    123    !! ht_s        ! ht_s_b      |    Snow depth                   | m     | 
    124    !! sm_i        ! sm_i_b      |    Sea ice bulk salinity        ! ppt   | 
    125    !! s_i         ! s_i_b       |    Sea ice salinity profile     ! ppt   | 
     121   !! ht_i        | ht_i_1d     |    Ice thickness                | m     | 
     122   !! ht_s        ! ht_s_1d     |    Snow depth                   | m     | 
     123   !! sm_i        ! sm_i_1d     |    Sea ice bulk salinity        ! ppt   | 
     124   !! s_i         ! s_i_1d      |    Sea ice salinity profile     ! ppt   | 
    126125   !! o_i         !      -      |    Sea ice Age                  ! days  | 
    127    !! t_i         ! t_i_b       |    Sea ice temperature          ! K     | 
    128    !! t_s         ! t_s_b       |    Snow temperature             ! K     | 
    129    !! t_su        ! t_su_b      |    Sea ice surface temperature  ! K     | 
     126   !! t_i         ! t_i_1d      |    Sea ice temperature          ! K     | 
     127   !! t_s         ! t_s_1d      |    Snow temperature             ! K     | 
     128   !! t_su        ! t_su_1d     |    Sea ice surface temperature  ! K     | 
    130129   !!                                                                     | 
    131130   !! notes: the ice model only sees a bulk (i.e., vertically averaged)   | 
    … …  
    142141   !! ***         Category-summed state variables (diagnostic)        *** | 
    143142   !! ******************************************************************* | 
    144    !! at_i        | at_i_b      |    Total ice concentration      |       | 
     143   !! at_i        | at_i_1d     |    Total ice concentration      |       | 
    145144   !! vt_i        |      -      |    Total ice vol. per unit area | m     | 
    146145   !! vt_s        |      -      |    Total snow vol. per unit ar. | m     | 
    … …  
    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 ::   nbiter           !: number of sub-time steps for relaxation 
    169    INTEGER , PUBLIC ::   nbitdr           !: maximum number of iterations for relaxation 
    170    INTEGER , PUBLIC ::   nevp             !: number of iterations for subcycling 
    171    INTEGER , PUBLIC ::   nlay_i = 5            !: number of layers in the ice 
    172  
    173    !                                     !!** ice-dynamic namelist (namicedyn) ** 
    174    REAL(wp), PUBLIC ::   epsd             !: tolerance parameter for dynamic 
    175    REAL(wp), PUBLIC ::   alpha            !: coefficient for semi-implicit coriolis 
    176    REAL(wp), PUBLIC ::   dm               !: diffusion constant for dynamics 
    177    REAL(wp), PUBLIC ::   om               !: relaxation constant 
    178    REAL(wp), PUBLIC ::   resl             !: maximum value for the residual of relaxation 
    179    REAL(wp), PUBLIC ::   cw               !: drag coefficient for oceanic stress 
    180    REAL(wp), PUBLIC ::   angvg            !: turning angle for oceanic stress 
    181    REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79 
    182    REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength 
    183    REAL(wp), PUBLIC ::   etamn            !: minimun value for viscosity : has to be 0 
    184    REAL(wp), PUBLIC ::   creepl           !: creep limit : has to be under 1.0e-9 
    185    REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve 
    186    REAL(wp), PUBLIC ::   ahi0             !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    187    REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s) !SB 
    188    REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses !SB 
    189    REAL(wp), PUBLIC ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
    190    REAL(wp), PUBLIC ::   hminrhg = 0.001_wp    !: clem : 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)  
    191183 
    192184   !                                     !!** ice-salinity namelist (namicesal) ** 
    193    REAL(wp), PUBLIC ::   s_i_max          !: maximum ice salinity [PSU] 
    194    REAL(wp), PUBLIC ::   s_i_min          !: minimum ice salinity [PSU] 
    195    REAL(wp), PUBLIC ::   s_i_0            !: 1st sal. value for the computation of sal .prof. [PSU] 
    196    REAL(wp), PUBLIC ::   s_i_1            !: 2nd sal. value for the computation of sal .prof. [PSU] 
    197    REAL(wp), PUBLIC ::   sal_G            !: restoring salinity for gravity drainage [PSU] 
    198    REAL(wp), PUBLIC ::   sal_F            !: restoring salinity for flushing [PSU] 
    199    REAL(wp), PUBLIC ::   time_G           !: restoring time constant for gravity drainage (= 20 days) [s] 
    200    REAL(wp), PUBLIC ::   time_F           !: restoring time constant for gravity drainage (= 10 days) [s] 
    201    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 
    202192 
    203193   !                                     !!** ice-salinity namelist (namicesal) ** 
    204    INTEGER , PUBLIC ::   num_sal          !: salinity configuration used in the model 
     194   INTEGER , PUBLIC ::   nn_icesal           !: salinity configuration used in the model 
    205195   !                                         ! 1 - constant salinity in both space and time 
    206196   !                                         ! 2 - prognostic salinity (s(z,t)) 
    207197   !                                         ! 3 - salinity profile, constant in time 
    208    INTEGER , PUBLIC ::   sal_prof    = 1           !: salinity profile or not  
    209    INTEGER , PUBLIC ::   thcon_i_swi          !: thermal conductivity: =1 Untersteiner (1964) ; =2 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) 
    210201 
    211202   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    212    REAL(wp), PUBLIC ::   Cs               !: fraction of shearing energy contributing to ridging             
    213    REAL(wp), PUBLIC ::   Cf               !: ratio of ridging work to PE loss 
    214    REAL(wp), PUBLIC ::   fsnowrdg         !: fractional snow loss to the ocean during ridging 
    215    REAL(wp), PUBLIC ::   fsnowrft         !: fractional snow loss to the ocean during ridging 
    216    REAL(wp), PUBLIC ::   Gstar            !: fractional area of young ice contributing to ridging 
    217    REAL(wp), PUBLIC ::   astar            !: equivalent of G* for an exponential participation function 
    218    REAL(wp), PUBLIC ::   Hstar            !: thickness that determines the maximal thickness of ridged ice 
    219    REAL(wp), PUBLIC ::   hparmeter        !: threshold thickness (m) for rafting / ridging  
    220    REAL(wp), PUBLIC ::   Craft            !: coefficient for smoothness of the hyperbolic tangent in rafting 
    221    REAL(wp), PUBLIC ::   ridge_por        !: initial porosity of ridges (0.3 regular value) 
    222    REAL(wp), PUBLIC ::   sal_max_ridge    !: maximum ridged ice salinity (ppt) 
    223    REAL(wp), PUBLIC ::   betas            !: coef. for partitioning of snowfall between leads and sea ice 
    224    REAL(wp), PUBLIC ::   kappa_i          !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
    225    REAL(wp), PUBLIC ::   nconv_i_thd      !: maximal number of iterations for heat diffusion 
    226    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 
    227216 
    228217   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    229    INTEGER , PUBLIC ::   ridge_scheme_swi !: scheme used for ice ridging 
    230    INTEGER , PUBLIC ::   raftswi          !: rafting of ice or not                         
    231    INTEGER , PUBLIC ::   partfun_swi      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
    232    INTEGER , PUBLIC ::   transfun_swi     !: transfer function: =0 Hibler 1980, =1 Lipscomb et al. 2007 
    233    INTEGER , PUBLIC ::   brinstren_swi    !: use brine volume to diminish ice strength 
    234  
    235    REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( ecc * ecc ) 
    236    REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cw 
    237    REAL(wp), PUBLIC ::   sangvg, cangvg   !: sin and cos of the turning angle for ocean stress 
    238    REAL(wp), PUBLIC ::   pstarh           !: pstar / 2.0 
     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   ! 
     226   !                                     !!** switch for presence of ice or not  
     227   REAL(wp), PUBLIC ::   rswitch 
     228   ! 
     229   !                                     !!** define some parameters  
     230   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number  
     231   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number  
     232   REAL(wp), PUBLIC, PARAMETER ::   epsi20   = 1.e-20_wp  !: small number  
    239233 
    240234   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce   !: surface ocean velocity used in ice dynamics 
    … …  
    249243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i        !: Shear of the velocity field [s-1] 
    250244   ! 
    251    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   firic       !: IR flux over the ice (diag only) 
    252    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcsic       !: Sensible heat flux over the ice (diag only) 
    253    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fleic       !: Latent heat flux over the ice (diag only) 
    254    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlatic      !: latent flux 
    255    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvosif     !: Variation of volume at surface (diag only) 
    256    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvobif     !: Variation of ice volume at the bottom ice (diag only) 
    257    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdvolif     !: Total variation of ice volume (diag only) 
    258    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvonif     !: Lateral Variation of ice volume (diag only) 
    259245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist        !: Average Sea-Ice Surface Temperature [Kelvin] 
    260246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   icethi      !: total ice thickness (for all categories) (diag only) 
    261247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    262    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicifp      !: Ice production/melting==>!obsolete... can be removed 
    263248   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction 
    264249   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld       !: Leads fraction at previous time   
    265250   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif      !: Old ice thickness 
    266    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif        !: Heat flux at the ice base 
    267    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_snw     !: Variation of snow mass over 1 time step     [Kg/m2] 
    268    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_snw     !: Heat content associated with rdm_snw        [J/m2] 
    269    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_ice     !: Variation of ice mass over 1 time step      [Kg/m2] 
    270    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_ice     !: Heat content associated with rdm_ice        [J/m2] 
    271    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif       !: heat balance of the lead (or of the open ocean) 
    272    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif       !: Energy needed to bring the ocean to freezing  
    273    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdtcn       !: net downward heat flux from the ice to the ocean 
    274    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qdtcn       !: energy from the ice to the ocean 
    275    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric      !: transmitted solar radiation under ice 
    276    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fscmbq      !: associated with lead chipotage with solar flux 
    277    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif     !: related to max heat contained in brine pockets (?) 
    278    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbbq       !: Also linked with the solar flux below the ice (?) 
    279    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qfvbq       !: store energy in case of total lateral ablation (?) 
    280    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dmgwi       !: Variation of the mass of snow ice 
    281    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_thd     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
     252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur       !: net downward heat flux from the ice to the ocean 
     253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
     254 
     255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange over 1 time step [kg/m2] 
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice over 1 time step [kg/m2] 
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow sublimation over 1 time step [kg/m2] 
     258 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange over 1 time step [kg/m2] 
     260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice [kg/m2] 
     261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice [kg/m2] 
     262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice [kg/m2] 
     263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg/m2] 
     264   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice [kg/m2] 
     265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice [kg/m2] 
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2] 
     267 
     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 
     272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     275   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     276   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_opw     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    282277   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bri     !: salt flux due to brine rejection                      [PSU/m2/s] 
    283    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_mec     !: salt flux due to porous ridged ice formation          [PSU/m2/s] 
     278   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_dyn     !: salt flux due to porous ridged ice formation          [PSU/m2/s] 
    284279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: residual salt flux due to correction of ice thickness [PSU/m2/s] 
    285    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhbri       !: heat flux due to brine rejection 
    286    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_mec   !: heat flux associated with porous ridged ice formation [???] 
    287    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_res   !: residual heat flux due to correction of ice thickness 
    288    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmec       !: mass flux due to snow loss during compression         [Kg/m2/s] 
    289    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhmec       !: heat flux due to snow loss during compression 
    290  
    291    ! temporary arrays for dummy version of the code 
    292    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D, q_s 
     280 
     281   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth  
     282   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt  
     283   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt  
     284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation 
     285   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice  
     286   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt  
     287   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 
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping  
     290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations  
     291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  
     292 
     293   ! heat flux associated with ice-atmosphere mass exchange 
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation  
     295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  
     296 
     297   ! heat flux associated with ice-ocean mass exchange 
     298   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  
     299   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  
     300   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness 
     301 
     302   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice 
    293303 
    294304   !!-------------------------------------------------------------------------- 
    … …  
    321331   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i          !: mean sea ice salinity averaged over all categories [PSU] 
    322332 
    323    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   at_i_typ     !: total area   contained in each ice type [m^2] 
    324    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   vt_i_typ     !: total volume contained in each ice type [m^3] 
    325  
    326333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s        !: Snow temperatures [K] 
    327334   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s        !: Snow ...       
    328  
    329    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e_i_cat    !: ! go to trash 
    330335       
    331336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K] 
    332    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] 
    333338   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i        !: ice salinities          [PSU] 
    334339 
    … …  
    348353   !! * Old values of global variables 
    349354   !!-------------------------------------------------------------------------- 
    350    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_v_s, old_v_i               !: snow and ice volumes 
    351    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_a_i, old_smv_i, old_oa_i   !: ??? 
    352    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_s                        !: snow heat content 
    353    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_i                        !: ice temperatures 
    354    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   old_u_ice, old_v_ice           !: ice velocity (gv6 and gv7) 
    355        
    356  
    357    !!-------------------------------------------------------------------------- 
    358    !! * Increment of global variables 
    359    !!-------------------------------------------------------------------------- 
     355   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b               !: snow and ice volumes 
     356   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, smv_i_b, oa_i_b     !: 
     357   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content 
     358   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
     359   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
     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 
    360388   ! thd refers to changes induced by thermodynamics 
    361389   ! trp   ''         ''     ''       advection (transport of ice) 
    362    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_a_i_thd  , d_a_i_trp                 !: icefractions                   
    363    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_s_thd  , d_v_s_trp                 !: snow volume 
    364    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_i_thd  , d_v_i_trp                 !: ice  volume 
    365    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_smv_i_thd, d_smv_i_trp               !:      
    366    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_fl  , d_sm_i_gd                 !: 
    367    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_se  , d_sm_i_si  , d_sm_i_la    !: 
    368    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp , s_i_newice   !: 
    369  
    370    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !: 
    371    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_i_thd  , d_e_i_trp     !: 
    372    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   d_u_ice_dyn, d_v_ice_dyn   !: ice velocity  
    373        
    374    !!-------------------------------------------------------------------------- 
    375    !! * Ice thickness distribution variables 
    376    !!-------------------------------------------------------------------------- 
    377    ! REMOVE 
    378    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_types      !: Vector connecting types and categories 
    379    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ice_cat_bounds !: Matrix containing the integer upper and  
    380    !                                                                       !  lower boundaries of ice thickness categories 
    381    ! REMOVE 
    382    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_ncat_types !: nb of thickness categories in each ice type 
    383    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    384    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
    385    ! REMOVE 
    386    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hi_max_typ     !: Boundary of ice thickness categories in thickness space 
    387  
    388    !!-------------------------------------------------------------------------- 
    389    !! * Ice Run 
    390    !!-------------------------------------------------------------------------- 
    391    !                                                  !!: ** Namelist namicerun read in iceini ** 
    392    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
    393    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
    394    LOGICAL               , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
    395    LOGICAL               , PUBLIC ::   ln_nicep        !: flag for sea-ice points output (T) or not (F) 
    396    REAL(wp)              , PUBLIC ::   cai             !: atmospheric drag over sea ice 
    397    REAL(wp)              , PUBLIC ::   cao             !: atmospheric drag over ocean 
    398    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 
    399397   ! 
    400    !!-------------------------------------------------------------------------- 
    401    !! * Ice diagnostics 
    402    !!-------------------------------------------------------------------------- 
    403    !! Check if everything down here is necessary 
    404    LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
    405    LOGICAL , PUBLIC                                      ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
    406    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   v_newice   !: volume of ice formed in the leads 
    407    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd  !: thermodynamic growth rates  
    408    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   izero, fstroc, fhbricat 
    409    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sni_gr   ! snow ice growth  
    410    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_lat_gr   ! lateral ice growth  
    411    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_gr   ! bottom ice growth  
    412    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_dyn_gr   ! dynamical ice growth  
    413    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_me   ! vertical bottom melt  
    414    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sur_me   ! vertical surface melt 
    415    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_res_pr   ! production (growth+melt) due to limupdate 
    416    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   ! transport of ice volume 
    417    INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    418  
     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]  
     402   ! 
    419403   !!---------------------------------------------------------------------- 
    420404   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
    … …  
    430414      INTEGER :: ice_alloc 
    431415      ! 
    432       INTEGER :: ierr(20), ii 
     416      INTEGER :: ierr(17), ii 
    433417      !!----------------------------------------------------------------- 
    434418 
    … …  
    447431 
    448432      ii = ii + 1 
    449       ALLOCATE( firic    (jpi,jpj) , fcsic  (jpi,jpj) , fleic  (jpi,jpj) , qlatic   (jpi,jpj) ,     & 
    450          &      rdvosif  (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif(jpi,jpj) , rdvonif  (jpi,jpj) ,     & 
    451          &      sist     (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) , hicifp   (jpi,jpj) ,     & 
    452          &      frld     (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) , fbif     (jpi,jpj) ,     & 
    453          &      rdm_snw  (jpi,jpj) , rdq_snw(jpi,jpj) , rdm_ice(jpi,jpj) , rdq_ice  (jpi,jpj) ,     & 
    454          &                                              qldif  (jpi,jpj) , qcmif    (jpi,jpj) ,     & 
    455          &      fdtcn    (jpi,jpj) , qdtcn  (jpi,jpj) , fstric (jpi,jpj) , fscmbq   (jpi,jpj) ,     & 
    456          &      ffltbif  (jpi,jpj) , fsbbq  (jpi,jpj) , qfvbq  (jpi,jpj) , dmgwi    (jpi,jpj) ,     & 
    457          &      sfx_res  (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_mec(jpi,jpj) , fheat_mec(jpi,jpj) ,     & 
    458          &      fhbri    (jpi,jpj) , fmmec  (jpi,jpj) , sfx_thd(jpi,jpj) , fhmec    (jpi,jpj) ,     & 
    459          &      fheat_res(jpi,jpj)                                                            , STAT=ierr(ii) ) 
    460  
    461       ii = ii + 1 
    462       ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , fstbif(jpi,jpj) ,     & 
    463          &      fsup2D     (jpi,jpj) , focea2D    (jpi,jpj) , q_s   (jpi,jpj) , STAT=ierr(ii) ) 
     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) ,                        & 
     436         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(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) ,    & 
     446         &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) ) 
    464447 
    465448      ! * Ice global state variables 
    … …  
    475458         &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) ) 
    476459      ii = ii + 1 
    477       ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , at_i_typ(jpi,jpj,jpm) ,                            & 
    478          &      e_s(jpi,jpj,nlay_s,jpl) , vt_i_typ(jpi,jpj,jpm) , e_i_cat(jpi,jpj,jpl) , STAT=ierr(ii) ) 
    479       ii = ii + 1 
    480       ALLOCATE( t_i(jpi,jpj,jkmax,jpl) , e_i(jpi,jpj,jkmax,jpl) , s_i(jpi,jpj,jkmax,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) ) 
    481463 
    482464      ! * Moments for advection 
    … …  
    494476         &      STAT=ierr(ii) ) 
    495477      ii = ii + 1 
    496       ALLOCATE( sxe (jpi,jpj,jkmax,jpl) , sye (jpi,jpj,jkmax,jpl) , sxxe(jpi,jpj,jkmax,jpl) ,     & 
    497          &      syye(jpi,jpj,jkmax,jpl) , sxye(jpi,jpj,jkmax,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) ) 
    498480 
    499481      ! * Old values of global variables 
    500482      ii = ii + 1 
    501       ALLOCATE( old_v_s  (jpi,jpj,jpl) , old_v_i  (jpi,jpj,jpl) , old_e_s(jpi,jpj,nlay_s,jpl) ,     & 
    502          &      old_a_i  (jpi,jpj,jpl) , old_smv_i(jpi,jpj,jpl) , old_e_i(jpi,jpj,jkmax ,jpl) ,     & 
    503          &      old_oa_i (jpi,jpj,jpl)                                                        ,     & 
    504          &      old_u_ice(jpi,jpj)     , old_v_ice(jpi,jpj)                                   , STAT=ierr(ii) ) 
    505  
    506       ! * Increment of global variables 
    507       ii = ii + 1 
    508       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) ,   & 
    509          &      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) ,   &      
    510          &      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) ,   & 
    511          &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) , s_i_newice (jpi,jpj,jpl) ,   & 
    512          &     STAT=ierr(ii) ) 
    513       ii = ii + 1 
    514       ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,jkmax,jpl) , d_u_ice_dyn(jpi,jpj) ,     & 
    515          &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,jkmax,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 
     483      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     & 
     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) ) 
    516486       
    517487      ! * Ice thickness distribution variables 
    518488      ii = ii + 1 
    519       ALLOCATE( ice_types(jpl) , ice_cat_bounds(jpm,2) , ice_ncat_types  (jpm) ,     & 
    520          &      hi_max (0:jpl) , hi_mean(jpl)          , hi_max_typ(0:jpl,jpm) , STAT=ierr(ii) ) 
     489      ALLOCATE( hi_max(0:jpl), hi_mean(jpl),  STAT=ierr(ii) ) 
    521490 
    522491      ! * Ice diagnostics 
    523492      ii = ii + 1 
    524       ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , diag_sni_gr(jpi,jpj) , diag_lat_gr(jpi,jpj) ,     & 
    525          &      izero    (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) ,     & 
    526          &      fstroc   (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) ,     & 
    527          &      fhbricat (jpi,jpj,jpl) , diag_res_pr(jpi,jpj) , diag_trp_vi(jpi,jpj) , v_newice(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) ) 
    528496 
    529497      ice_alloc = MAXVAL( ierr(:) ) 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r4161 r5832  
    3030   PUBLIC   lim_adv_x   ! called by lim_trp 
    3131   PUBLIC   lim_adv_y   ! called by lim_trp 
    32  
    33    REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values 
    34    REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    35    REAL(wp)  ::   rone   = 1._wp       !    -       - 
    3632 
    3733   !! * Substitutions 
    … …  
    6763      !!  
    6864      INTEGER  ::   ji, jj                               ! dummy loop indices 
    69       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! local scalars 
     65      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars 
    7066      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      - 
    7167      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      - 
    … …  
    8480      DO jj = 1, jpj 
    8581         DO ji = 1, jpi 
    86             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     82            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    8783            zs1max  = 1.5 * zslpmax 
    8884            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 
    8985            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    9086               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    91             zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -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 
    9288 
    9389            ps0 (ji,jj) = zslpmax   
    94             psx (ji,jj) = zs1new      * zin0 
    95             psxx(ji,jj) = zs2new      * zin0 
    96             psy (ji,jj) = psy (ji,jj) * zin0 
    97             psyy(ji,jj) = psyy(ji,jj) * zin0 
    98             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 
    9995         END DO 
    10096      END DO 
    10197 
    10298      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
    103       psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
     99      psm (:,:)  = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
    104100 
    105101      !  Calculate fluxes and moments between boxes i<-->i+1               
    106102      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0  
    107103         DO ji = 1, jpi 
    108             zbet(ji,jj)  =  MAX( rzero, SIGN( rone, put(ji,jj) ) ) 
    109             zalf         =  MAX( rzero, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
     104            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
     105            zalf         =  MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
    110106            zalfq        =  zalf * zalf 
    111107            zalf1        =  1.0 - zalf 
    … …  
    133129      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0. 
    134130         DO ji = 1, fs_jpim1 
    135             zalf          = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
     131            zalf          = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
    136132            zalg  (ji,jj) = zalf 
    137133            zalfq         = zalf * zalf 
    … …  
    211207 
    212208      !-- Lateral boundary conditions 
    213       CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. ) 
    214       CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes 
    215       CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. ) 
    216       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. ) 
    217213 
    218214      IF(ln_ctl) THEN 
    … …  
    252248      !! 
    253249      INTEGER  ::   ji, jj                               ! dummy loop indices 
    254       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars 
     250      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars 
    255251      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    256252      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
    … …  
    269265      DO jj = 1, jpj 
    270266         DO ji = 1, jpi 
    271             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     267            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    272268            zs1max  = 1.5 * zslpmax 
    273269            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 
    274270            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    275271               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    276             zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -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 
    277273            ! 
    278274            ps0 (ji,jj) = zslpmax   
    279             psx (ji,jj) = psx (ji,jj) * zin0 
    280             psxx(ji,jj) = psxx(ji,jj) * zin0 
    281             psy (ji,jj) = zs1new * zin0 
    282             psyy(ji,jj) = zs2new * zin0 
    283             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 
    284280         END DO 
    285281      END DO 
    286282 
    287283      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    288       psm(:,:)  = MAX(  pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
     284      psm(:,:)  = MAX(  pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
    289285 
    290286      !  Calculate fluxes and moments between boxes j<-->j+1               
    291287      DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0    
    292288         DO ji = 1, jpi 
    293             zbet(ji,jj)  =  MAX( rzero, SIGN( rone, pvt(ji,jj) ) ) 
    294             zalf         =  MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
     289            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
     290            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
    295291            zalfq        =  zalf * zalf 
    296292            zalf1        =  1.0 - zalf 
    … …  
    318314      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    319315         DO ji = 1, jpi 
    320             zalf          = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
     316            zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
    321317            zalg  (ji,jj) = zalf 
    322318            zalfq         = zalf * zalf 
    … …  
    397393 
    398394      !-- Lateral boundary conditions 
    399       CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. ) 
    400       CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes 
    401       CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. ) 
    402       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. ) 
    403399 
    404400      IF(ln_ctl) THEN 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r4161 r5832  
    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 
     9   !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm 
     10   !!             -   ! 2015-03  (C. Rousset) add lim_cons_final 
    911   !!---------------------------------------------------------------------- 
    1012#if defined key_lim3 
    … …  
    1416   !!    lim_cons     :   checks whether energy, mass and salt are conserved  
    1517   !!---------------------------------------------------------------------- 
    16    USE par_ice        ! LIM-3 parameter 
     18   USE phycst         ! physical constants 
    1719   USE ice            ! LIM-3 variables 
    1820   USE dom_ice        ! LIM-3 domain 
    … …  
    2123   USE lib_mpp        ! MPP library 
    2224   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     25   USE sbc_oce , ONLY : sfx  ! Surface boundary condition: ocean fields 
    2326 
    2427   IMPLICIT NONE 
    … …  
    2831   PUBLIC   lim_column_sum_energy 
    2932   PUBLIC   lim_cons_check 
     33   PUBLIC   lim_cons_hsm 
     34   PUBLIC   lim_cons_final 
    3035 
    3136   !!---------------------------------------------------------------------- 
    … …  
    7075      !! ** Method  : Arithmetics 
    7176      !!--------------------------------------------------------------------- 
    72       INTEGER                               , INTENT(in   ) ::   ksum   !: number of categories 
    73       INTEGER                               , INTENT(in   ) ::   klay   !: number of vertical layers 
    74       REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl), INTENT(in   ) ::   pin   !: input field 
    75       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 
    7681      ! 
    7782      INTEGER ::   jk, jl   ! dummy loop indices 
    … …  
    151156   END SUBROUTINE lim_cons_check 
    152157 
     158 
     159   SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
     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 
     175      REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     176      REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft 
     177      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 
     181 
     182      IF( icount == 0 ) THEN 
     183 
     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 ) 
     206 
     207      ELSEIF( icount == 1 ) THEN 
     208 
     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 
     223  
     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 
     249         IF(lwp) THEN 
     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 
     256            ENDIF 
     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 
     262         ENDIF 
     263 
     264      ENDIF 
     265 
     266   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 
     306 
    153307#else 
    154308   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    • Property svn:keywords set to Id
    r4346 r5832  
    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 
    1918   USE sbc_oce         ! surface boundary condition: ocean fields 
     19   USE sbc_ice         ! Surface boundary condition: sea-ice fields 
    2020   USE daymod          ! model calendar 
    2121   USE phycst          ! physical constant 
    … …  
    3131 
    3232   PUBLIC   lim_diahsb        ! routine called by ice_step.F90 
    33    !!PUBLIC   lim_diahsb_init   ! routine called by ice_init.F90 
    34    !!PUBLIC   lim_diahsb_rst   ! routine called by ice_init.F90 
    35  
    36    REAL(dp) ::   frc_sal, frc_vol   ! global forcing trends 
    37    REAL(dp) ::   bg_grme            ! global ice growth+melt trends 
    38    REAL(wp) ::   epsi06 = 1.e-6_wp  ! small number 
    39    REAL(wp) ::   epsi03 = 1.e-3_wp  ! small number 
    40  
     33 
     34   real(wp) ::   frc_sal, frc_vol   ! global forcing trends 
     35   real(wp) ::   bg_grme            ! global ice growth+melt trends 
    4136 
    4237   !! * Substitutions 
    … …  
    4540   !!---------------------------------------------------------------------- 
    4641   !! NEMO/OPA 3.4 , NEMO Consortium (2012) 
    47    !! $Id: limdiahsb.F90 3294 2012-10-18 16:44:18Z rblod $ 
     42   !! $Id$ 
    4843   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4944   !!---------------------------------------------------------------------- 
    … …  
    5954      !!--------------------------------------------------------------------------- 
    6055      !! 
    61       REAL(dp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
    62       REAL(dp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_thd, zbg_sfx_res, zbg_sfx_mec  
    63       REAL(dp)   ::   zbg_emp, zbg_emp_bog, zbg_emp_lag, zbg_emp_sig, zbg_emp_dyg, zbg_emp_bom, zbg_emp_sum, zbg_emp_res  
    64       REAL(dp)   ::   z_frc_vol, z_frc_sal, z_bg_grme  
    65       REAL(dp)   ::   z1_area                     !    -     - 
    66       REAL(dp)   ::   zinda, zindb 
     56      real(wp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
     57      real(wp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni,   & 
     58      &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn  
     59      real(wp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 
     60      real(wp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub   
     61      real(wp)   ::   zbg_hfx_dhc, zbg_hfx_spr 
     62      real(wp)   ::   zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in    
     63      real(wp)   ::   zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 
     64      real(wp)   ::   z_frc_vol, z_frc_sal, z_bg_grme  
     65      real(wp)   ::   z1_area                     !    -     - 
     66      REAL(wp)   ::   ztmp 
    6767      !!--------------------------------------------------------------------------- 
    6868      IF( nn_timing == 1 )   CALL timing_start('lim_diahsb') 
    … …  
    7171 
    7272      ! 1/area 
    73       z1_area = 1.d0 / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
    74  
    75       zinda = MAX( 0.d0 , SIGN( 1.d0 , 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 ) ) 
    7676      ! ----------------------- ! 
    7777      ! 1 -  Content variations ! 
    7878      ! ----------------------- ! 
    79       zbg_ivo = glob_sum( vt_i(:,:) * area(:,:) * tms(:,:) ) ! volume ice  
    80       zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow 
    81       zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area 
    82       zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )       ! mean salt content 
    83       zbg_tem = glob_sum( ( tm_i(:,:) - rtt ) * vt_i(:,:) * area(:,:) * tms(:,:) )  ! mean temp content 
    84  
    85       !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 
    86       !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
    87  
    88       zbg_ihc = glob_sum( et_i(:,:) * 1.e-11 ) ! ice heat content  [10^9*1.e-11 J] 
    89       zbg_shc = glob_sum( et_s(:,:) * 1.e-11 ) ! snow heat content [10^9*1.e-11 J] 
    90  
    91       zbg_emp     = zinda * glob_sum(         emp(:,:) * area(:,:) * tms(:,:) ) * z1_area         * r1_rau0 * rday 
    92       zbg_emp_bog = zinda * glob_sum( diag_bot_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    93       zbg_emp_lag = zinda * glob_sum( diag_lat_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    94       zbg_emp_sig = zinda * glob_sum( diag_sni_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    95       zbg_emp_dyg = zinda * glob_sum( diag_dyn_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    96       zbg_emp_bom = zinda * glob_sum( diag_bot_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    97       zbg_emp_sum = zinda * glob_sum( diag_sur_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    98       zbg_emp_res = zinda * glob_sum( diag_res_pr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    99  
    100       zbg_sfx     = zinda * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    101       zbg_sfx_bri = zinda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    102       zbg_sfx_thd = zinda * glob_sum( sfx_thd(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    103       zbg_sfx_res = zinda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    104       zbg_sfx_mec = zinda * glob_sum( sfx_mec(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    105        
     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 
     87 
     88      ! Volume 
     89      ztmp = rswitch * z1_area * r1_rau0 * rday 
     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) ) 
     101 
     102      ! Salt 
     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) ) 
     113 
     114      ! Heat budget 
     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] 
     132     
    106133      ! --------------------------------------------- ! 
    107134      ! 2 - Trends due to forcing and ice growth/melt ! 
    108135      ! --------------------------------------------- ! 
    109       z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 
    110       z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes 
    111       z_bg_grme = glob_sum( ( diag_bot_gr(:,:) + diag_lat_gr(:,:) + diag_sni_gr(:,:) + diag_dyn_gr(:,:) + & 
    112                           &    diag_bot_me(:,:) + diag_sur_me(:,:) + diag_res_pr(:,:) ) * area(:,:) * tms(:,:) ) ! volume 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 
     138      z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
     139                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 
     140                          &     wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 
    113141      ! 
    114142      frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
    … …  
    123151      ! 3 - Diagnostics writing ! 
    124152      ! ----------------------- ! 
    125       zindb = MAX( 0.d0 , SIGN( 1.d0 , zbg_ivo - epsi06 ) ) 
    126       ! 
     153      rswitch = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 
     154      ! 
     155      IF( iom_use('ibgvoltot') )   & 
    127156      CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9        )   ! ice volume (km3 equivalent liquid)          
     157      IF( iom_use('sbgvoltot') )   & 
    128158      CALL iom_put( 'sbgvoltot' , zbg_svo * rhosn * r1_rau0 * 1.e-9        )   ! snw volume (km3 equivalent liquid)        
     159      IF( iom_use('ibgarea') )   & 
    129160      CALL iom_put( 'ibgarea'   , zbg_are * 1.e-6                          )   ! ice area   (km2) 
    130       CALL iom_put( 'ibgsaline' , zindb * zbg_sal / MAX( zbg_ivo, epsi06 ) )   ! ice saline (psu) 
    131       CALL iom_put( 'ibgtemper' , zindb * zbg_tem / MAX( zbg_ivo, epsi06 ) )   ! ice temper (C) 
     161      IF( iom_use('ibgsaline') )   & 
     162      CALL iom_put( 'ibgsaline' , rswitch * zbg_sal / MAX( zbg_ivo, epsi06 ) )   ! ice saline (psu) 
     163      IF( iom_use('ibgtemper') )   & 
     164      CALL iom_put( 'ibgtemper' , rswitch * zbg_tem / MAX( zbg_ivo, epsi06 ) )   ! ice temper (C) 
    132165      CALL iom_put( 'ibgheatco' , zbg_ihc                                  )   ! ice heat content (1.e20 J)         
    133166      CALL iom_put( 'sbgheatco' , zbg_shc                                  )   ! snw heat content (1.e20 J) 
     167      IF( iom_use('ibgsaltco') )   & 
    134168      CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9        )   ! ice salt content (psu*km3 equivalent liquid)         
    135169 
    136       CALL iom_put( 'ibgemp'    , zbg_emp                                  )   ! volume flux emp (m/day liquid) 
    137       CALL iom_put( 'ibgempbog' , zbg_emp_bog                              )   ! volume flux bottom growth     -(m/day equivalent liquid) 
    138       CALL iom_put( 'ibgemplag' , zbg_emp_lag                              )   ! volume flux open water growth - 
    139       CALL iom_put( 'ibgempsig' , zbg_emp_sig                              )   ! volume flux snow ice growth   - 
    140       CALL iom_put( 'ibgempdyg' , zbg_emp_dyg                              )   ! volume flux dynamic growth    - 
    141       CALL iom_put( 'ibgempbom' , zbg_emp_bom                              )   ! volume flux bottom melt       - 
    142       CALL iom_put( 'ibgempsum' , zbg_emp_sum                              )   ! volume flux surface melt      - 
    143       CALL iom_put( 'ibgempres' , zbg_emp_res                              )   ! volume flux resultant         - 
     170      CALL iom_put( 'ibgvfx'    , zbg_vfx                                  )   ! volume flux emp (m/day liquid) 
     171      CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog                              )   ! volume flux bottom growth     -(m/day equivalent liquid) 
     172      CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw                              )   ! volume flux open water growth - 
     173      CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni                              )   ! volume flux snow ice growth   - 
     174      CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn                              )   ! volume flux dynamic growth    - 
     175      CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom                              )   ! volume flux bottom melt       - 
     176      CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum                              )   ! volume flux surface melt      - 
     177      CALL iom_put( 'ibgvfxres' , zbg_vfx_res                              )   ! volume flux resultant         - 
     178      CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr                              )   ! volume flux from snow precip         - 
     179      CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw                              )   ! volume flux from snow melt         - 
     180      CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub                              )   ! volume flux from sublimation         - 
    144181           
    145182      CALL iom_put( 'ibgsfx'    , zbg_sfx                                  )   ! salt flux         -(psu*m/day equivalent liquid)        
    146183      CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri                              )   ! salt flux brines  -       
    147       CALL iom_put( 'ibgsfxthd' , zbg_sfx_thd                              )   ! salt flux thermo  -     
    148       CALL iom_put( 'ibgsfxmec' , zbg_sfx_mec                              )   ! salt flux dynamic -     
     184      CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn                              )   ! salt flux dynamic -     
    149185      CALL iom_put( 'ibgsfxres' , zbg_sfx_res                              )   ! salt flux result  -     
     186      CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog                              )   ! salt flux bottom growth    
     187      CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw                              )   ! salt flux open water growth - 
     188      CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni                              )   ! salt flux snow ice growth   - 
     189      CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom                              )   ! salt flux bottom melt       - 
     190      CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum                              )   ! salt flux surface melt      - 
     191 
     192      CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc                              )   ! Heat content variation in snow and ice [W] 
     193      CALL iom_put( 'ibghfxspr' , zbg_hfx_spr                              )   ! Heat content of snow precip [W] 
     194 
     195      CALL iom_put( 'ibghfxres' , zbg_hfx_res                              )   !  
     196      CALL iom_put( 'ibghfxsub' , zbg_hfx_sub                              )   !  
     197      CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn                              )   !  
     198      CALL iom_put( 'ibghfxthd' , zbg_hfx_thd                              )   !  
     199      CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw                              )   !  
     200      CALL iom_put( 'ibghfxsum' , zbg_hfx_sum                              )   !  
     201      CALL iom_put( 'ibghfxbom' , zbg_hfx_bom                              )   !  
     202      CALL iom_put( 'ibghfxbog' , zbg_hfx_bog                              )   !  
     203      CALL iom_put( 'ibghfxdif' , zbg_hfx_dif                              )   !  
     204      CALL iom_put( 'ibghfxopw' , zbg_hfx_opw                              )   !  
     205      CALL iom_put( 'ibghfxout' , zbg_hfx_out                              )   !  
     206      CALL iom_put( 'ibghfxin'  , zbg_hfx_in                               )   !  
    150207 
    151208      CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9                          )   ! vol - forcing     (km3 equivalent liquid)  
    152209      CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9                          )   ! sal - forcing     (psu*km3 equivalent liquid)    
    153       CALL iom_put( 'ibggrme'   , bg_grme * rhoic * r1_rau0 * 1.e-9        )   ! vol growth + melt (km3 equivalent liquid)          
     210      IF( iom_use('ibgvolgrm') )   & 
     211      CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9                )   ! vol growth + melt (km3 equivalent liquid)          
     212 
    154213      ! 
    155214      IF( lrst_ice )   CALL lim_diahsb_rst( numit, 'WRITE' ) 
    … …  
    186245         WRITE(numout,*) '~~~~~~~~~~~~' 
    187246      ENDIF 
    188  
    189       ! ---------------------------------- ! 
    190       ! 2 - initial conservation variables ! 
    191       ! ---------------------------------- ! 
    192       !frc_vol = 0.d0                                           ! volume       trend due to forcing 
    193       !frc_sal = 0.d0                                           ! salt content   -    -   -    -          
    194       !bg_grme = 0.d0                                           ! ice growth + melt volume trend 
    195247      ! 
    196248      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files 
    … …  
    226278           IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' 
    227279           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    228            frc_vol  = 0.d0                                            
    229            frc_sal  = 0.d0                                                   
    230            bg_grme  = 0.d0                                         
    231        ENDIF    
     280           frc_vol  = 0._wp                                           
     281           frc_sal  = 0._wp                                                  
     282           bg_grme  = 0._wp                                        
     283       ENDIF 
    232284 
    233285     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4624 r5832  
    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 
    … …  
    3029   USE lib_fortran      ! glob_sum 
    3130   USE timing          ! Timing 
     31   USE limcons        ! conservation tests 
     32   USE limvar 
    3233 
    3334   IMPLICIT NONE 
    … …  
    6364      INTEGER  ::   i_j1, i_jpj       ! Starting/ending j-indices for rheology 
    6465      REAL(wp) ::   zcoef             ! local scalar 
    65       REAL(wp), POINTER, DIMENSION(:)   ::   zind           ! i-averaged indicator of sea-ice 
     66      REAL(wp), POINTER, DIMENSION(:)   ::   zswitch        ! i-averaged indicator of sea-ice 
    6667      REAL(wp), POINTER, DIMENSION(:)   ::   zmsk           ! i-averaged of tmask 
    6768      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io   ! ice-ocean velocity 
    68       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    69       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     69      ! 
     70      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7071     !!--------------------------------------------------------------------- 
    7172 
    … …  
    7374 
    7475      CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 
    75       CALL wrk_alloc( jpj, zind, zmsk ) 
    76  
    77       ! ------------------------------- 
    78       !- check conservation (C Rousset) 
    79       IF (ln_limdiahsb) THEN 
    80          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    81          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    82          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    83          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    84       ENDIF 
    85       !- check conservation (C Rousset) 
    86       ! ------------------------------- 
     76      CALL wrk_alloc( jpj, zswitch, zmsk ) 
     77 
     78      CALL lim_var_agg(1)             ! aggregate ice categories 
    8779 
    8880      IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    … …  
    9082      IF( ln_limdyn ) THEN 
    9183         ! 
    92          old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 
    93          old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
     84         ! conservation test 
     85         IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     86 
     87         u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 
     88         v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 
    9489 
    9590         ! Rheology (ice dynamics) 
    … …  
    107102            ! 
    108103            DO jj = 1, jpj 
    109                zind(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line 
    110                zmsk(jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line 
     104               zswitch(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line 
     105               zmsk   (jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line 
    111106            END DO 
    112107 
    … …  
    117112               i_j1  = njeq 
    118113               i_jpj = jpj 
    119                DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
     114               DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
    120115                  i_j1 = i_j1 + 1 
    121116               END DO 
    … …  
    127122               i_j1  =  1 
    128123               i_jpj = njeq 
    129                DO WHILE ( i_jpj >= 1 .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
     124               DO WHILE ( i_jpj >= 1 .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
    130125                  i_jpj = i_jpj - 1 
    131126               END DO 
    … …  
    139134               !                                 ! latitude strip 
    140135               i_j1  = 1 
    141                DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
     136               DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
    142137                  i_j1 = i_j1 + 1 
    143138               END DO 
    … …  
    145140 
    146141               i_jpj  = jpj 
    147                DO WHILE ( i_jpj >= 1  .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
     142               DO WHILE ( i_jpj >= 1  .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
    148143                  i_jpj = i_jpj - 1 
    149144               END DO 
    … …  
    164159         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    165160         ! frictional velocity at T-point 
    166          zcoef = 0.5_wp * cw 
     161         zcoef = 0.5_wp * rn_cio 
    167162         DO jj = 2, jpjm1  
    168163            DO ji = fs_2, fs_jpim1   ! vector opt. 
    169164               ust2s(ji,jj) = zcoef * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    170                   &                    + 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) 
    171166            END DO 
    172167         END DO 
    173168         ! 
     169         ! conservation test 
     170         IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     171         ! 
    174172      ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
    175173         ! 
    176          zcoef = SQRT( 0.5_wp ) / rau0 
     174         zcoef = SQRT( 0.5_wp ) * r1_rau0 
    177175         DO jj = 2, jpjm1 
    178176            DO ji = fs_2, fs_jpim1   ! vector opt. 
    179177               ust2s(ji,jj) = zcoef * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    180                   &                        + 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) 
    181179            END DO 
    182180         END DO 
    … …  
    193191         CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :') 
    194192         CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :') 
    195          CALL prt_ctl(tab2d_1=area      , clinfo1=' lim_dyn  : cell area :') 
     193         CALL prt_ctl(tab2d_1=e12t      , clinfo1=' lim_dyn  : cell area :') 
    196194         CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :') 
    197195         CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :') 
    … …  
    224222      ENDIF 
    225223      ! 
    226       ! ------------------------------- 
    227       !- check conservation (C Rousset) 
    228       IF (ln_limdiahsb) THEN 
    229          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    230          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    231   
    232          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
    233          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
    234  
    235          zchk_vmin = glob_min(v_i) 
    236          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    237          zchk_amin = glob_min(a_i) 
    238  
    239          IF(lwp) THEN 
    240             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limdyn) = ',(zchk_v_i * rday) 
    241             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limdyn) = ',(zchk_smv * rday) 
    242             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limdyn) = ',(zchk_vmin * 1.e-3) 
    243             !IF ( zchk_amax >  amax+1.e-10   ) WRITE(numout,*) 'violation a_i>amax            (limdyn) = ',zchk_amax 
    244             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limdyn) = ',zchk_amin 
    245          ENDIF 
    246       ENDIF 
    247       !- check conservation (C Rousset) 
    248       ! ------------------------------- 
    249  
    250224      CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 
    251       CALL wrk_dealloc( jpj, zind, zmsk ) 
     225      CALL wrk_dealloc( jpj, zswitch, zmsk ) 
    252226      ! 
    253227      IF( nn_timing == 1 )  CALL timing_stop('limdyn') 
    … …  
    269243      !!------------------------------------------------------------------- 
    270244      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    271       NAMELIST/namicedyn/ epsd, alpha,    & 
    272          &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   & 
    273          &                c_rhg, etamn, creepl, ecc, ahi0, & 
    274          &                nevp, telast, 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 
    275249      !!------------------------------------------------------------------- 
    276250 
    … …  
    288262         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics ' 
    289263         WRITE(numout,*) '~~~~~~~~~~~~' 
    290          WRITE(numout,*) '   tolerance parameter                              epsd   = ', epsd 
    291          WRITE(numout,*) '   coefficient for semi-implicit coriolis           alpha  = ', alpha 
    292          WRITE(numout,*) '   diffusion constant for dynamics                  dm     = ', dm 
    293          WRITE(numout,*) '   number of sub-time steps for relaxation          nbiter = ', nbiter 
    294          WRITE(numout,*) '   maximum number of iterations for relaxation      nbitdr = ', nbitdr 
    295          WRITE(numout,*) '   relaxation constant                              om     = ', om 
    296          WRITE(numout,*) '   maximum value for the residual of relaxation     resl   = ', resl 
    297          WRITE(numout,*) '   drag coefficient for oceanic stress              cw     = ', cw 
    298          WRITE(numout,*) '   turning angle for oceanic stress                 angvg  = ', angvg 
    299          WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar 
    300          WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg 
    301          WRITE(numout,*) '   minimun value for viscosity                      etamn  = ', etamn 
    302          WRITE(numout,*) '   creep limit                                      creepl = ', creepl 
    303          WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc 
    304          WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
    305          WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp 
    306          WRITE(numout,*) '   timescale for elastic waves                      telast = ', telast 
    307          WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp 
    308          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 
    309276      ENDIF 
    310277      ! 
    311       IF( angvg /= 0._wp ) THEN 
    312          CALL ctl_warn( 'lim_dyn_init: turning angle for oceanic stress not properly coded for EVP ',   & 
    313             &           '(see limsbc module). We force  angvg = 0._wp'  ) 
    314          angvg = 0._wp 
    315       ENDIF 
    316        
    317       usecc2 = 1._wp / ( ecc * ecc ) 
    318       rhoco  = rau0  * cw 
    319       angvg  = angvg * rad 
    320       sangvg = SIN( angvg ) 
    321       cangvg = COS( angvg ) 
    322       pstarh = pstar * 0.5_wp 
    323  
    324       !  Diffusion coefficients. 
    325       ahiu(:,:) = ahi0 * umask(:,:,1) 
    326       ahiv(:,:) = ahi0 * vmask(:,:,1) 
    327       ! 
     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 
    328324   END SUBROUTINE lim_dyn_init 
    329325 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r4333 r5832  
    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 
    8386      zdiv0(:, 1 ) = 0._wp 
    8487      zdiv0(:,jpj) = 0._wp 
    85       IF( .NOT.lk_vopt_loop ) THEN 
    86          zflu (jpi,:) = 0._wp    
    87          zflv (jpi,:) = 0._wp 
    88          zdiv0(1,  :) = 0._wp 
    89          zdiv0(jpi,:) = 0._wp 
    90       ENDIF 
     88      zflu (jpi,:) = 0._wp    
     89      zflv (jpi,:) = 0._wp 
     90      zdiv0(1,  :) = 0._wp 
     91      zdiv0(jpi,:) = 0._wp 
    9192 
    9293      zconv = 1._wp           !==  horizontal diffusion using a Crant-Nicholson scheme  ==! 
    9394      iter  = 0 
    9495      ! 
    95       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 
    9697         ! 
    9798         iter = iter + 1                                 ! incrementation of the sub-time step number 
    … …  
    99100         DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    100101            DO ji = 1 , fs_jpim1   ! vector opt. 
    101                zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
    102                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) ) 
    103104            END DO 
    104105         END DO 
    … …  
    106107         DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    107108            DO ji = fs_2 , fs_jpim1   ! vector opt.  
    108                zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   & 
    109                   &            + 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) 
    110110            END DO 
    111111         END DO 
    … …  
    117117               zrlxint = (   ztab0(ji,jj)    & 
    118118                  &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * 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) + 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) ) 
    122122            END DO 
    123123         END DO 
    124124         CALL lbc_lnk( zrlx, 'T', 1. )                   ! lateral boundary condition 
    125125         ! 
    126          zconv = 0._wp                                   ! convergence test 
    127          DO jj = 2, jpjm1 
    128             DO ji = fs_2, fs_jpim1 
    129                zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  ) 
    130             END DO 
    131          END DO 
    132          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 
    133135         ! 
    134136         ptab(:,:) = zrlx(:,:) 
    … …  
    140142      DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    141143         DO ji = 1 , fs_jpim1   ! vector opt. 
    142             zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
    143             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) ) 
    144146         END DO 
    145147      END DO 
    … …  
    147149      DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    148150         DO ji = fs_2 , fs_jpim1   ! vector opt.  
    149             zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   & 
    150                  &            + 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) 
    151152            ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 
    152153         END DO 
    … …  
    166167   END SUBROUTINE lim_hdf 
    167168 
     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 
    168206#else 
    169207   !!---------------------------------------------------------------------- 
    170208   !!   Default option          Dummy module           NO LIM sea-ice model 
    171209   !!---------------------------------------------------------------------- 
    172 CONTAINS 
    173    SUBROUTINE lim_hdf         ! Empty routine 
    174    END SUBROUTINE lim_hdf 
    175210#endif 
    176211 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4624 r5832  
    66   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code 
    77   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
    8    !!             -   ! 2012    (C. Rousset) add par_oce (for jp_sal)...bug? 
     8   !!             -   ! 2014    (C. Rousset) add N/S initializations 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_lim3 
    … …  
    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 
    2726   USE in_out_manager   ! I/O manager 
    28    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    2927   USE lib_mpp          ! MPP library 
    3028   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    3634   PUBLIC   lim_istate      ! routine called by lim_init.F90 
    3735 
    38    !! * Module variables 
    3936   !                          !!** init namelist (namiceini) ** 
    40    REAL(wp) ::   ttest   ! threshold water temperature for initial sea ice 
    41    REAL(wp) ::   hninn   ! initial snow thickness in the north 
    42    REAL(wp) ::   hnins   ! initial snow thickness in the south 
    43    REAL(wp) ::   hginn   ! initial ice thickness in the north 
    44    REAL(wp) ::   hgins   ! initial ice thickness in the south 
    45    REAL(wp) ::   aginn   ! initial leads area in the north 
    46    REAL(wp) ::   agins   ! initial leads area in the south 
    47    REAL(wp) ::   sinn    ! initial salinity  
    48    REAL(wp) ::   sins   
    49  
     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 
    5050   !!---------------------------------------------------------------------- 
    5151   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
    … …  
    5353   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5454   !!---------------------------------------------------------------------- 
    55  
    5655CONTAINS 
    5756 
    … …  
    7776      !! 
    7877      !! ** Notes   : o_i, t_su, t_s, t_i, s_i must be filled everywhere, even 
    79       !!              where there is no ice (clem: I do not know why but it is mandatory)  
     78      !!              where there is no ice (clem: I do not know why, is it mandatory?)  
    8079      !! 
    8180      !! History : 
    … …  
    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 
    92       REAL(wp), POINTER, DIMENSION(:)     :: zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini 
    93       REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, za_i_ini, zv_i_ini 
    94       REAL(wp), POINTER, DIMENSION(:,:)   :: zidto    ! ice indicator 
     91      REAL(wp), POINTER, DIMENSION(:)     :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini 
     92      REAL(wp), POINTER, DIMENSION(:,:)   :: zh_i_ini, za_i_ini, zv_i_ini 
     93      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator 
    9594      INTEGER,  POINTER, DIMENSION(:,:)   :: zhemis   ! hemispheric index 
    9695      !-------------------------------------------------------------------- 
    9796 
    98       CALL wrk_alloc( jpi, jpj, zidto ) 
     97      CALL wrk_alloc( jpi, jpj, zswitch ) 
    9998      CALL wrk_alloc( jpi, jpj, zhemis ) 
    100       CALL wrk_alloc( jpl,   2, zht_i_ini,  za_i_ini,  zv_i_ini ) 
    101       CALL wrk_alloc(   2,      zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 
    102  
    103       epsi20   = 1.0e-20 
     99      CALL wrk_alloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     100      CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
     101 
    104102      IF(lwp) WRITE(numout,*) 
    105103      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
    … …  
    112110      CALL lim_istate_init     !  reading the initials parameters of the ice 
    113111 
    114 !!gm  in lim2  the initialisation if only done if required in the namelist : 
    115 !!gm      IF( .NOT. ln_limini ) THEN 
    116 !!gm  this should be added in lim3 namelist... 
     112      ! surface temperature 
     113      DO jl = 1, jpl ! loop over categories 
     114         t_su  (:,:,jl) = rt0 * tmask(:,:,1) 
     115         tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 
     116      END DO 
     117 
     118      ! basal temperature (considered at freezing point) 
     119      t_bo(:,:) = ( eos_fzp( sss_m(:,:) ) + rt0 ) * tmask(:,:,1)  
     120 
     121      IF( ln_iceini ) THEN 
    117122 
    118123      !-------------------------------------------------------------------- 
    119124      ! 2) Basal temperature, ice mask and hemispheric index 
    120125      !-------------------------------------------------------------------- 
    121  
    122       ! Basal temperature is set to the freezing point of seawater in Celsius 
    123       t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    124126 
    125127      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    126128         DO ji = 1, jpi 
    127             IF( tsn(ji,jj,1,jp_tem)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0._wp      ! no ice 
    128             ELSE                                                     ;   zidto(ji,jj) = 1._wp      !    ice 
     129            IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
     130               zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice 
     131            ELSE                                                                                    
     132               zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice 
    129133            ENDIF 
    130134         END DO 
    131135      END DO 
    132136 
    133       t_bo(:,:) = t_bo(:,:) + rt0                          ! conversion to Kelvin 
    134137 
    135138      ! Hemispheric index 
    136       ! MV 2011 new initialization 
    137139      DO jj = 1, jpj 
    138140         DO ji = 1, jpi 
    … …  
    144146         END DO 
    145147      END DO 
    146       ! END MV 2011 new initialization 
    147148 
    148149      !-------------------------------------------------------------------- 
    … …  
    153154      ! 3.1) Hemisphere-dependent arrays 
    154155      !----------------------------- 
    155       ! assign initial thickness, concentration, snow depth and salinity to 
    156       ! an hemisphere-dependent array 
    157       zhm_i_ini(1) = hginn ; zhm_i_ini(2) = hgins  ! ice thickness 
    158       zat_i_ini(1) = aginn ; zat_i_ini(2) = agins  ! ice concentration 
    159       zvt_i_ini(:) = zhm_i_ini(:) * zat_i_ini(:)   ! ice volume 
    160       zhm_s_ini(1) = hninn ; zhm_s_ini(2) = hnins  ! snow depth 
    161       zsm_i_ini(1) = sinn  ; zsm_i_ini(2) = sins   ! bulk ice salinity 
     156      ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
     157      zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s  ! ice thickness 
     158      zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s  ! snow depth 
     159      zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s  ! ice concentration 
     160      zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s  ! bulk ice salinity 
     161      ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s  ! temperature (ice and snow) 
     162 
     163      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume 
    162164 
    163165      !--------------------------------------------------------------------- 
    … …  
    183185            ! *** 1 category to fill 
    184186            IF ( i_fill .EQ. 1 ) THEN 
    185                zht_i_ini(1,i_hemis)       = zhm_i_ini(i_hemis) 
    186                za_i_ini(1,i_hemis)        = zat_i_ini(i_hemis) 
    187                zht_i_ini(2:jpl,i_hemis)   = 0._wp 
    188                za_i_ini(2:jpl,i_hemis)    = 0._wp 
     187               zh_i_ini(1,i_hemis)       = zht_i_ini(i_hemis) 
     188               za_i_ini(1,i_hemis)       = zat_i_ini(i_hemis) 
     189               zh_i_ini(2:jpl,i_hemis)   = 0._wp 
     190               za_i_ini(2:jpl,i_hemis)   = 0._wp 
    189191            ELSE 
    190192 
    191             ! *** >1 categores to fill 
    192             !--- Ice thicknesses in the i_fill - 1 first categories 
     193               ! *** >1 categores to fill 
     194               !--- Ice thicknesses in the i_fill - 1 first categories 
    193195               DO jl = 1, i_fill - 1 
    194                   zht_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
    195                END DO 
    196  
    197             !--- jl0: most likely index where cc will be maximum 
     196                  zh_i_ini(jl,i_hemis) = hi_mean(jl) 
     197               END DO 
     198                
     199               !--- jl0: most likely index where cc will be maximum 
    198200               DO jl = 1, jpl 
    199                   IF ( ( zhm_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
    200                        ( zhm_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
     201                  IF ( ( zht_i_ini(i_hemis) > hi_max(jl-1) ) .AND. & 
     202                     & ( zht_i_ini(i_hemis) <= hi_max(jl)   ) ) THEN 
    201203                     jl0 = jl 
    202204                  ENDIF 
    203205               END DO 
    204206               jl0 = MIN(jl0, i_fill) 
    205  
    206             !--- Concentrations 
     207                
     208               !--- Concentrations 
    207209               za_i_ini(jl0,i_hemis)      = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 
    208210               DO jl = 1, i_fill - 1 
    209211                  IF ( jl .NE. jl0 ) THEN 
    210                      zsigma               = 0.5 * zhm_i_ini(i_hemis) 
    211                      zarg                 = ( zht_i_ini(jl,i_hemis) - zhm_i_ini(i_hemis) ) / zsigma 
     212                     zsigma               = 0.5 * zht_i_ini(i_hemis) 
     213                     zarg                 = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma 
    212214                     za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 
    213215                  ENDIF 
    214                END DO  
    215  
     216               END DO 
     217                
    216218               zA = 0. ! sum of the areas in the jpl categories  
    217219               DO jl = 1, i_fill - 1 
    … …  
    221223               IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    222224          
    223             !--- Ice thickness in the last category 
     225               !--- Ice thickness in the last category 
    224226               zV = 0. ! sum of the volumes of the N-1 categories 
    225227               DO jl = 1, i_fill - 1 
    226                   zV = zV + za_i_ini(jl,i_hemis)*zht_i_ini(jl,i_hemis) 
    227                END DO 
    228                zht_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
    229                IF ( i_fill .LT. jpl ) zht_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    230  
    231             !--- volumes 
    232                zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zht_i_ini(:,i_hemis) 
     228                  zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis) 
     229               END DO 
     230               zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
     231               IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
     232 
     233               !--- volumes 
     234               zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis) 
    233235               IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    234236 
    … …  
    262264 
    263265            ! Test 3: thickness of the last category is in-bounds ? 
    264             IF ( zht_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
     266            IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN 
    265267               ztest_3 = 1 
    266268            ELSE 
    267269               ! this write is useful 
    268                IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zht_i_ini(i_fill,i_hemis) = ', & 
    269                zht_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
     270               IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 
     271               zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
    270272               ztest_3 = 0 
    271273            ENDIF 
    … …  
    288290 
    289291      IF(lwp) THEN  
    290          WRITE(numout,*), ' ztests : ', ztests 
     292         WRITE(numout,*) ' ztests : ', ztests 
    291293         IF ( ztests .NE. 4 ) THEN 
    292294            WRITE(numout,*) 
    293             WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
    294             WRITE(numout,*), ' !!!! RED ALERT                  !!! ' 
    295             WRITE(numout,*), ' !!!! BIIIIP BIIIP BIIIIP BIIIIP !!!' 
    296             WRITE(numout,*), ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    297             WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
     295            WRITE(numout,*) ' !!!! ALERT                  !!! ' 
     296            WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    298297            WRITE(numout,*) 
    299             WRITE(numout,*), ' *** ztests is not equal to 4 ' 
    300             WRITE(numout,*), ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    301             WRITE(numout,*), ' zat_i_ini : ', zat_i_ini(i_hemis) 
    302             WRITE(numout,*), ' zhm_i_ini : ', zhm_i_ini(i_hemis) 
     298            WRITE(numout,*) ' *** ztests is not equal to 4 ' 
     299            WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
     300            WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(i_hemis) 
     301            WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(i_hemis) 
    303302         ENDIF ! ztests .NE. 4 
    304303      ENDIF 
    … …  
    314313         DO jj = 1, jpj 
    315314            DO ji = 1, jpi 
    316                a_i(ji,jj,jl)   = zidto(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
    317                ht_i(ji,jj,jl)  = zidto(ji,jj) * zht_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
    318                ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zhm_s_ini( zhemis(ji,jj) ) / zhm_i_ini( zhemis(ji,jj) ) )  ! snow depth 
    319                sm_i(ji,jj,jl)  = zidto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min ! salinity 
    320                o_i(ji,jj,jl)   = zidto(ji,jj) * 1._wp + ( 1._wp - zidto(ji,jj) ) ! age 
    321                t_su(ji,jj,jl)  = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * 270.0 ! surf temp 
     315               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
     316               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))   ! ice thickness 
     317               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth 
     318               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj))    ! salinity 
     319               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                        ! age (1 day) 
     320               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 
    322321 
    323322               ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
    … …  
    327326               ! recompute ht_i, ht_s avoiding out of bounds values 
    328327               ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh ) 
    329                ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic / rhosn ) 
     328               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn ) 
    330329 
    331330               ! ice volume, salt content, age content 
    … …  
    334333               smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 
    335334               oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content 
    336             END DO ! ji 
    337          END DO ! jj 
    338       END DO ! jl 
     335            END DO 
     336         END DO 
     337      END DO 
    339338 
    340339      ! Snow temperature and heat content 
    … …  
    343342            DO jj = 1, jpj 
    344343               DO ji = 1, jpi 
    345                    t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * rtt 
     344                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 
    346345                   ! Snow energy of melting 
    347                    e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    348                    ! Change dimensions 
    349                    e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    350                    ! Multiply by volume, so that heat content in 10^9 Joules 
    351                    e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
    352                END DO ! ji 
    353             END DO ! jj 
    354          END DO ! jl 
    355       END DO ! jk 
     346                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
     347 
     348                   ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 
     349                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
     350               END DO 
     351            END DO 
     352         END DO 
     353      END DO 
    356354 
    357355      ! Ice salinity, temperature and heat content 
    … …  
    360358            DO jj = 1, jpj 
    361359               DO ji = 1, jpi 
    362                    t_i(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1._wp - zidto(ji,jj) ) * rtt  
    363                    s_i(ji,jj,jk,jl) = zidto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min 
    364                    ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
     360                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0  
     361                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin 
     362                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 
    365363 
    366364                   ! heat content per unit volume 
    367                    e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    368                       +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
    369                       -   rcp     * ( ztmelts - rtt ) ) 
    370  
    371                    ! Correct dimensions to avoid big values 
    372                    e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    373  
    374                    ! Mutliply by ice volume, and divide by number of layers  
    375                    ! to get heat content in 10^9 J 
    376                    e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 
    377                END DO ! ji 
    378             END DO ! jj 
    379          END DO ! jl 
    380       END DO ! jk 
    381  
     365                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     366                      +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
     367                      -   rcp     * ( ztmelts - rt0 ) ) 
     368 
     369                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
     370                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
     371               END DO 
     372            END DO 
     373         END DO 
     374      END DO 
     375 
     376      tn_ice (:,:,:) = t_su (:,:,:) 
     377 
     378      ELSE  
     379         ! if ln_iceini=false 
     380         a_i  (:,:,:) = 0._wp 
     381         v_i  (:,:,:) = 0._wp 
     382         v_s  (:,:,:) = 0._wp 
     383         smv_i(:,:,:) = 0._wp 
     384         oa_i (:,:,:) = 0._wp 
     385         ht_i (:,:,:) = 0._wp 
     386         ht_s (:,:,:) = 0._wp 
     387         sm_i (:,:,:) = 0._wp 
     388         o_i  (:,:,:) = 0._wp 
     389 
     390         e_i(:,:,:,:) = 0._wp 
     391         e_s(:,:,:,:) = 0._wp 
     392 
     393         DO jl = 1, jpl 
     394            DO jk = 1, nlay_i 
     395               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 
     396            END DO 
     397            DO jk = 1, nlay_s 
     398               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 
     399            END DO 
     400         END DO 
     401       
     402      ENDIF ! ln_iceini 
     403       
     404      at_i (:,:) = 0.0_wp 
     405      DO jl = 1, jpl 
     406         at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
     407      END DO 
     408      ! 
    382409      !-------------------------------------------------------------------- 
    383410      ! 4) Global ice variables for output diagnostics                    |  
    384411      !-------------------------------------------------------------------- 
    385       fsbbq (:,:)     = 0._wp 
    386412      u_ice (:,:)     = 0._wp 
    387413      v_ice (:,:)     = 0._wp 
    … …  
    390416      stress12_i(:,:) = 0._wp 
    391417 
    392 # if defined key_coupled 
    393       albege(:,:)   = 0.8 * tms(:,:) 
    394 # endif 
    395  
    396418      !-------------------------------------------------------------------- 
    397419      ! 5) Moments for advection 
    … …  
    428450      sxyage (:,:,:)  = 0._wp 
    429451 
    430       !-------------------------------------------------------------------- 
    431       ! 6) Lateral boundary conditions                                    |  
    432       !-------------------------------------------------------------------- 
    433  
    434       DO jl = 1, jpl 
    435  
    436          CALL lbc_lnk( a_i(:,:,jl)  , 'T', 1. ) 
    437          CALL lbc_lnk( v_i(:,:,jl)  , 'T', 1. ) 
    438          CALL lbc_lnk( v_s(:,:,jl)  , 'T', 1. ) 
    439          CALL lbc_lnk( smv_i(:,:,jl), 'T', 1. ) 
    440          CALL lbc_lnk( oa_i(:,:,jl) , 'T', 1. ) 
    441  
    442          CALL lbc_lnk( ht_i(:,:,jl) , 'T', 1. ) 
    443          CALL lbc_lnk( ht_s(:,:,jl) , 'T', 1. ) 
    444          CALL lbc_lnk( sm_i(:,:,jl) , 'T', 1. ) 
    445          CALL lbc_lnk( o_i(:,:,jl)  , 'T', 1. ) 
    446          CALL lbc_lnk( t_su(:,:,jl) , 'T', 1. ) 
    447          DO jk = 1, nlay_s 
    448             CALL lbc_lnk(t_s(:,:,jk,jl), 'T', 1. ) 
    449             CALL lbc_lnk(e_s(:,:,jk,jl), 'T', 1. ) 
    450          END DO 
    451          DO jk = 1, nlay_i 
    452             CALL lbc_lnk(t_i(:,:,jk,jl), 'T', 1. ) 
    453             CALL lbc_lnk(e_i(:,:,jk,jl), 'T', 1. ) 
    454          END DO 
    455          ! 
    456          a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl) 
    457       END DO 
    458        
    459       at_i (:,:) = 0.0_wp 
    460       DO jl = 1, jpl 
    461          at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
    462       END DO 
    463  
    464       CALL lbc_lnk( at_i , 'T', 1. ) 
    465       at_i(:,:) = tms(:,:) * at_i(:,:)                       ! put 0 over land 
    466       ! 
    467       CALL lbc_lnk( fsbbq  , 'T', 1. ) 
    468       ! 
    469       !-------------------------------------------------------------------- 
    470       ! 6) ????                                                           |  
    471       !-------------------------------------------------------------------- 
    472       tn_ice (:,:,:) = t_su (:,:,:) 
    473  
    474       CALL wrk_dealloc( jpi, jpj, zidto ) 
     452 
     453      CALL wrk_dealloc( jpi, jpj, zswitch ) 
    475454      CALL wrk_dealloc( jpi, jpj, zhemis ) 
    476       CALL wrk_dealloc( jpl,   2, zht_i_ini,  za_i_ini,  zv_i_ini ) 
    477       CALL wrk_dealloc(   2,      zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 
     455      CALL wrk_dealloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     456      CALL wrk_dealloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    478457 
    479458   END SUBROUTINE lim_istate 
    … …  
    495474      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    496475      !!----------------------------------------------------------------------------- 
    497       NAMELIST/namiceini/ ttest, hninn, hnins, hginn, hgins, aginn, agins, sinn, sins 
    498       ! 
     476      NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s,  & 
     477         &                                      rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s 
    499478      INTEGER :: ios                 ! Local integer output status for namelist read 
    500479      !!----------------------------------------------------------------------------- 
    … …  
    516495         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    517496         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    518          WRITE(numout,*) '   threshold water temp. for initial sea-ice    ttest      = ', ttest 
    519          WRITE(numout,*) '   initial snow thickness in the north          hninn      = ', hninn 
    520          WRITE(numout,*) '   initial snow thickness in the south          hnins      = ', hnins  
    521          WRITE(numout,*) '   initial ice thickness  in the north          hginn      = ', hginn 
    522          WRITE(numout,*) '   initial ice thickness  in the south          hgins      = ', hgins 
    523          WRITE(numout,*) '   initial ice concentr.  in the north          aginn      = ', aginn 
    524          WRITE(numout,*) '   initial ice concentr.  in the north          agins      = ', agins 
    525          WRITE(numout,*) '   initial  ice salinity  in the north          sinn       = ', sinn 
    526          WRITE(numout,*) '   initial  ice salinity  in the south          sins       = ', sins 
     497         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini 
     498         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst 
     499         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n 
     500         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s  
     501         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n 
     502         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s 
     503         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n 
     504         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s 
     505         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n 
     506         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s 
     507         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n 
     508         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s 
    527509      ENDIF 
    528510 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4624 r5832  
    55   !!====================================================================== 
    66   !! History :  LIM  ! 2006-02  (M. Vancoppenolle) Original code  
    7    !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_mec 
     7   !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_dyn 
    88   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
    99   !!---------------------------------------------------------------------- 
    … …  
    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 limcons          ! LIM 
    25    USE in_out_manager   ! I/O manager 
    2622   USE lbclnk           ! lateral boundary condition - MPP exchanges 
    2723   USE lib_mpp          ! MPP library 
    2824   USE wrk_nemo         ! work arrays 
    2925   USE prtctl           ! Print control 
    30   ! Check budget (Rousset) 
     26 
     27   USE in_out_manager   ! I/O manager 
    3128   USE iom              ! I/O manager 
    32    USE lib_fortran     ! glob_sum 
     29   USE lib_fortran      ! glob_sum 
    3330   USE limdiahsb 
    34    USE timing          ! Timing 
     31   USE timing           ! Timing 
     32   USE limcons          ! conservation tests 
    3533 
    3634   IMPLICIT NONE 
    … …  
    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 
    44  
    45    REAL(wp) ::   epsi20 = 1.e-20_wp   ! constant values 
    46    REAL(wp) ::   epsi10 = 1.e-10_wp   ! constant values 
    47    REAL(wp) ::   epsi06 = 1.e-06_wp   ! constant values 
     40   PUBLIC   lim_itd_me_alloc        ! called by sbc_lim_init  
    4841 
    4942   !----------------------------------------------------------------------- 
    … …  
    129122      !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged 
    130123      !!--------------------------------------------------------------------! 
    131       INTEGER ::   ji, jj, jk, jl   ! dummy loop index 
    132       INTEGER ::   niter, nitermax = 20   ! local integer  
    133       LOGICAL  ::   asum_error            ! flag for asum .ne. 1 
     124      INTEGER  ::   ji, jj, jk, jl        ! dummy loop index 
     125      INTEGER  ::   niter                 ! local integer  
    134126      INTEGER  ::   iterate_ridging       ! if true, repeat the ridging 
    135       REAL(wp) ::   w1, tmpfac            ! local scalar 
     127      REAL(wp) ::   za, zfac              ! local scalar 
    136128      CHARACTER (len = 15) ::   fieldid 
    137       REAL(wp), POINTER, DIMENSION(:,:) ::   closing_net     ! net rate at which area is removed    (1/s) 
    138                                                              ! (ridging ice area - area of new ridges) / dt 
    139       REAL(wp), POINTER, DIMENSION(:,:) ::   divu_adv        ! divu as implied by transport scheme  (1/s) 
    140       REAL(wp), POINTER, DIMENSION(:,:) ::   opning          ! rate of opening due to divergence/shear 
    141       REAL(wp), POINTER, DIMENSION(:,:) ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
    142       REAL(wp), POINTER, DIMENSION(:,:) ::   msnow_mlt       ! mass of snow added to ocean (kg m-2) 
    143       REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    144       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
    145       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    146       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    147       ! mass and salt flux (clem) 
    148       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
     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     
     139      ! 
     140      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    149141      !!----------------------------------------------------------------------------- 
    150142      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    151143 
    152       CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    153  
    154       CALL wrk_alloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    155  
    156       IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only) 
     144      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    157145 
    158146      IF(ln_ctl) THEN 
    … …  
    162150 
    163151      IF( ln_limdyn ) THEN          !   Start ridging and rafting   ! 
    164       ! ------------------------------- 
    165       !- check conservation (C Rousset) 
    166       IF (ln_limdiahsb) THEN 
    167          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    168          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    169          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    170          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    171       ENDIF 
    172       !- check conservation (C Rousset) 
    173       ! ------------------------------- 
    174  
    175       ! mass and salt flux init (clem) 
    176       zviold(:,:,:) = v_i(:,:,:) 
    177       zvsold(:,:,:) = v_s(:,:,:) 
    178       zsmvold(:,:,:) = smv_i(:,:,:) 
     152 
     153      ! conservation test 
     154      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     155 
     156      CALL lim_var_zapsmall 
     157      CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
    179158 
    180159      !-----------------------------------------------------------------------------! 
    181160      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 
    182161      !-----------------------------------------------------------------------------! 
    183       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 
    184163      ! 
    185164      CALL lim_itd_me_ridgeprep                                    ! prepare ridging 
    … …  
    215194            !  (thick, newly ridged ice). 
    216195 
    217             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 ) 
    218197 
    219198            ! 2.2 divu_adv 
    … …  
    259238               ! Reduce the closing rate if more than 100% of the open water  
    260239               ! would be removed.  Reduce the opening rate proportionately. 
    261                IF ( ato_i(ji,jj) .GT. epsi10 .AND. athorn(ji,jj,0) .GT. 0.0 ) THEN 
    262                   w1 = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
    263                   IF ( w1 .GT. ato_i(ji,jj)) THEN 
    264                      tmpfac = ato_i(ji,jj) / w1 
    265                      closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 
    266                      opning(ji,jj) = opning(ji,jj) * tmpfac 
    267                   ENDIF !w1 
    268                ENDIF !at0i and athorn 
    269  
    270             END DO ! ji 
    271          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 
    272249 
    273250         ! correction to closing rate / opening if excessive ice removal 
    … …  
    275252         ! Reduce the closing rate if more than 100% of any ice category  
    276253         ! would be removed.  Reduce the opening rate proportionately. 
    277  
    278254         DO jl = 1, jpl 
    279255            DO jj = 1, jpj 
    280256               DO ji = 1, jpi 
    281                   IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN 
    282                      w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
    283                      IF ( w1  >  a_i(ji,jj,jl) ) THEN 
    284                         tmpfac = a_i(ji,jj,jl) / w1 
    285                         closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 
    286                         opning       (ji,jj) = opning       (ji,jj) * tmpfac 
    287                      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 
    288262                  ENDIF 
    289                END DO !ji 
    290             END DO ! jj 
    291          END DO !jl 
     263               END DO 
     264            END DO 
     265         END DO 
    292266 
    293267         ! 3.3 Redistribute area, volume, and energy. 
    … …  
    298272         ! 3.4 Compute total area of ice plus open water after ridging. 
    299273         !-----------------------------------------------------------------------------! 
    300  
    301          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 
    302279 
    303280         ! 3.5 Do we keep on iterating ??? 
    … …  
    310287         DO jj = 1, jpj 
    311288            DO ji = 1, jpi 
    312                IF (ABS(asum(ji,jj) - kamax ) .LT. epsi10) THEN 
     289               IF (ABS(asum(ji,jj) - kamax ) < epsi10) THEN 
    313290                  closing_net(ji,jj) = 0._wp 
    314291                  opning     (ji,jj) = 0._wp 
    … …  
    346323      ! Convert ridging rate diagnostics to correct units. 
    347324      ! Update fresh water and heat fluxes due to snow melt. 
    348  
    349       asum_error = .false.  
    350  
    351325      DO jj = 1, jpj 
    352326         DO ji = 1, jpi 
    353  
    354             IF(ABS(asum(ji,jj) - kamax) > epsi10 ) asum_error = .true. 
    355327 
    356328            dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice 
    … …  
    362334            ! 5) Heat, salt and freshwater fluxes 
    363335            !-----------------------------------------------------------------------------! 
    364             fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
    365             fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean 
     336            wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
     337            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean (<0, W.m-2) 
    366338 
    367339         END DO 
    … …  
    369341 
    370342      ! Check if there is a ridging error 
    371       DO jj = 1, jpj 
    372          DO ji = 1, jpi 
    373             IF( ABS( asum(ji,jj) - kamax)  >  epsi10 ) THEN   ! there is a bug 
    374                WRITE(numout,*) ' ' 
    375                WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj) 
    376                WRITE(numout,*) ' limitd_me ' 
    377                WRITE(numout,*) ' POINT : ', ji, jj 
    378                WRITE(numout,*) ' jpl, a_i, athorn ' 
    379                WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0) 
    380                DO jl = 1, jpl 
    381                   WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl) 
    382                END DO 
    383             ENDIF  ! asum 
    384  
    385          END DO !ji 
    386       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 
    387360 
    388361      ! Conservation check 
    … …  
    393366      ENDIF 
    394367 
     368      CALL lim_var_agg( 1 )  
     369 
    395370      !-----------------------------------------------------------------------------! 
    396       ! 6) Updating state variables and trend terms (done in limupdate) 
     371      ! control prints 
    397372      !-----------------------------------------------------------------------------! 
    398       CALL lim_var_glo2eqv 
    399       CALL lim_itd_me_zapsmall 
    400  
    401       !-------------------------------- 
    402       ! Update mass/salt fluxes (clem) 
    403       !-------------------------------- 
    404       DO jl = 1, jpl 
    405          DO jj = 1, jpj  
    406             DO ji = 1, jpi 
    407                diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 
    408                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    409                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    410                sfx_mec(ji,jj) = sfx_mec(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic * r1_rdtice  
    411             END DO 
    412          END DO 
    413       END DO 
    414  
    415       IF(ln_ctl) THEN     ! Control print 
     373      IF(ln_ctl) THEN  
     374         CALL lim_var_glo2eqv 
     375 
    416376         CALL prt_ctl_info(' ') 
    417377         CALL prt_ctl_info(' - Cell values : ') 
    418378         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    419          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 :') 
    420380         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :') 
    421381         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :') 
    … …  
    445405      ENDIF 
    446406 
    447       ! ------------------------------- 
    448       !- check conservation (C Rousset) 
    449       IF (ln_limdiahsb) THEN 
    450          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    451          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    452   
    453          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    454          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    455  
    456          zchk_vmin = glob_min(v_i) 
    457          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    458          zchk_amin = glob_min(a_i) 
    459         
    460          IF(lwp) THEN 
    461             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_me) = ',(zchk_v_i * rday) 
    462             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_me) = ',(zchk_smv * rday) 
    463             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_me) = ',(zchk_vmin * 1.e-3) 
    464             IF ( zchk_amax >  kamax+epsi10  ) WRITE(numout,*) 'violation a_i>amax            (limitd_me) = ',zchk_amax 
    465             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limitd_me) = ',zchk_amin 
    466          ENDIF 
    467       ENDIF 
    468       !- check conservation (C Rousset) 
    469       ! ------------------------------- 
     407      ! conservation test 
     408      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    470409 
    471410      ENDIF  ! ln_limdyn=.true. 
    472411      ! 
    473412      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    474       ! 
    475       CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    476413      ! 
    477414      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
    … …  
    494431      !!---------------------------------------------------------------------- 
    495432      INTEGER, INTENT(in) ::   kstrngth    ! = 1 for Rothrock formulation, 0 for Hibler (1979) 
    496  
    497       INTEGER ::   ji,jj, jl   ! dummy loop indices 
    498       INTEGER ::   ksmooth     ! smoothing the resistance to deformation 
    499       INTEGER ::   numts_rm    ! number of time steps for the P smoothing 
    500       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 
    501437      REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here 
    502438      !!---------------------------------------------------------------------- 
    … …  
    524460                  ! 
    525461                  IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN 
    526                      hi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     462                     zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    527463                     !---------------------------- 
    528464                     ! PE loss from deforming ice 
    529465                     !---------------------------- 
    530                      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 
    531467 
    532468                     !-------------------------- 
    533469                     ! PE gain from rafting ice 
    534470                     !-------------------------- 
    535                      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 
    536472 
    537473                     !---------------------------- 
    538474                     ! PE gain from ridging ice 
    539475                     !---------------------------- 
    540                      strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl)/krdg(ji,jj,jl)     & 
    541                         * z1_3 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) / ( hrmax(ji,jj,jl)-hrmin(ji,jj,jl) )    
    542 !!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...                     
    543                   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 
    544480                  ! 
    545                END DO ! ji 
    546             END DO !jj 
    547          END DO !jl 
    548  
    549          zzc = Cf * Cp     ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and Cf accounts for frictional dissipation 
    550          strength(:,:) = zzc * strength(:,:) / aksum(:,:) 
    551  
     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 
    552487         ksmooth = 1 
    553488 
    … …  
    557492      ELSE                      ! kstrngth ne 1:  Hibler (1979) form 
    558493         ! 
    559          strength(:,:) = Pstar * vt_i(:,:) * EXP( - C_rhg * ( 1._wp - at_i(:,:) )  ) 
     494         strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  ) 
    560495         ! 
    561496         ksmooth = 1 
    … …  
    569504      ! CAN BE REMOVED 
    570505      ! 
    571       IF ( brinstren_swi == 1 ) THEN 
     506      IF( ln_icestr_bvf ) THEN 
    572507 
    573508         DO jj = 1, jpj 
    574509            DO ji = 1, jpi 
    575                IF ( bv_i(ji,jj) .GT. 0.0 ) THEN 
    576                   zdummy = MIN ( bv_i(ji,jj), 0.10 ) * MIN( bv_i(ji,jj), 0.10 ) 
    577                ELSE 
    578                   zdummy = 0.0 
    579                ENDIF 
    580510               strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv_i(ji,jj),0.0))) 
    581             END DO              ! j 
    582          END DO                 ! i 
     511            END DO 
     512         END DO 
    583513 
    584514      ENDIF 
    … …  
    596526         CALL lbc_lnk( strength, 'T', 1. ) 
    597527 
    598          DO jj = 2, jpj - 1 
    599             DO ji = 2, jpi - 1 
    600                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN ! ice is 
    601                   ! present 
    602                   zworka(ji,jj) = 4.0 * strength(ji,jj)              & 
    603                      &          + strength(ji-1,jj) * tms(ji-1,jj) &   
    604                      &          + strength(ji+1,jj) * tms(ji+1,jj) &   
    605                      &          + strength(ji,jj-1) * tms(ji,jj-1) &   
    606                      &          + strength(ji,jj+1) * tms(ji,jj+1)     
    607  
    608                   zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1) 
    609                   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) ) 
    610535               ELSE 
    611536                  zworka(ji,jj) = 0._wp 
    … …  
    614539         END DO 
    615540 
    616          DO jj = 2, jpj - 1 
    617             DO ji = 2, jpi - 1 
     541         DO jj = 2, jpjm1 
     542            DO ji = 2, jpim1 
    618543               strength(ji,jj) = zworka(ji,jj) 
    619544            END DO 
    … …  
    621546         CALL lbc_lnk( strength, 'T', 1. ) 
    622547 
    623       ENDIF ! ksmooth 
     548      ENDIF 
    624549 
    625550      !-------------------- 
    … …  
    638563         DO jj = 1, jpj - 1 
    639564            DO ji = 1, jpi - 1 
    640                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  
    641566                  numts_rm = 1 ! number of time steps for the running mean 
    642                   IF ( strp1(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1 
    643                   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 
    644569                  zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm 
    645570                  strp2(ji,jj) = strp1(ji,jj) 
    … …  
    670595      !!---------------------------------------------------------------------! 
    671596      INTEGER ::   ji,jj, jl    ! dummy loop indices 
    672       INTEGER ::   krdg_index   !  
    673       REAL(wp) ::   Gstari, astari, hi, hrmean, zdummy   ! local scalar 
     597      REAL(wp) ::   Gstari, astari, zhi, hrmean, zdummy   ! local scalar 
    674598      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here 
    675599      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n 
    … …  
    679603      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
    680604 
    681       Gstari     = 1.0/Gstar     
    682       astari     = 1.0/astar     
     605      Gstari     = 1.0/rn_gstar     
     606      astari     = 1.0/rn_astar     
    683607      aksum(:,:)    = 0.0 
    684608      athorn(:,:,:) = 0.0 
    … …  
    691615 
    692616      !     ! Zero out categories with very small areas 
    693       CALL lim_itd_me_zapsmall 
     617      CALL lim_var_zapsmall 
    694618 
    695619      !------------------------------------------------------------------------------! 
    … …  
    698622 
    699623      ! Compute total area of ice plus open water. 
    700       CALL lim_itd_me_asumr 
    701       ! This is in general not equal to one  
    702       ! 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 
    703629 
    704630      ! Compute cumulative thickness distribution function 
    … …  
    708634 
    709635      Gsum(:,:,-1) = 0._wp 
    710  
    711       DO jj = 1, jpj 
    712          DO ji = 1, jpi 
    713             IF( ato_i(ji,jj) > epsi10 ) THEN   ;   Gsum(ji,jj,0) = ato_i(ji,jj) 
    714             ELSE                               ;   Gsum(ji,jj,0) = 0._wp 
    715             ENDIF 
    716          END DO 
    717       END DO 
     636      Gsum(:,:,0 ) = ato_i(:,:) 
    718637 
    719638      ! for each value of h, you have to add ice concentration then 
    720639      DO jl = 1, jpl 
    721          DO jj = 1, jpj  
    722             DO ji = 1, jpi 
    723                IF( a_i(ji,jj,jl) .GT. epsi10 ) THEN   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 
    724                ELSE                                   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 
    725                ENDIF 
    726             END DO 
    727          END DO 
     640         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 
    728641      END DO 
    729642 
    … …  
    746659      !----------------------------------------------------------------- 
    747660 
    748       krdg_index = 1 
    749  
    750       IF( krdg_index == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    751          DO jl = 0, ice_cat_bounds(1,2)       ! only undeformed ice participates 
     661      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
     662         DO jl = 0, jpl     
    752663            DO jj = 1, jpj  
    753664               DO ji = 1, jpi 
    754                   IF( Gsum(ji,jj,jl) < Gstar) THEN 
    755                      athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * & 
    756                         (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari) 
    757                   ELSEIF (Gsum(ji,jj,jl-1) < Gstar) THEN 
    758                      athorn(ji,jj,jl) = Gstari * (Gstar-Gsum(ji,jj,jl-1)) *  & 
    759                         (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 ) 
    760671                  ELSE 
    761672                     athorn(ji,jj,jl) = 0.0 
    762673                  ENDIF 
    763                END DO ! ji 
    764             END DO ! jj 
    765          END DO ! jl  
     674               END DO 
     675            END DO 
     676         END DO 
    766677 
    767678      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007) 
    768679         !                         
    769680         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array 
    770  
    771681         DO jl = -1, jpl 
    772682            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 
    773          END DO !jl 
    774          DO jl = 0, ice_cat_bounds(1,2) 
     683         END DO 
     684         DO jl = 0, jpl 
    775685             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 
    776686         END DO 
    777687         ! 
    778       ENDIF ! krdg_index 
    779  
    780       IF( raftswi == 1 ) THEN      ! Ridging and rafting ice participation functions 
     688      ENDIF 
     689 
     690      IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions 
    781691         ! 
    782692         DO jl = 1, jpl 
    783693            DO jj = 1, jpj  
    784694               DO ji = 1, jpi 
    785                   IF ( athorn(ji,jj,jl) .GT. 0._wp ) THEN 
     695                  IF ( athorn(ji,jj,jl) > 0._wp ) THEN 
    786696!!gm  TANH( -X ) = - TANH( X )  so can be computed only 1 time.... 
    787                      aridge(ji,jj,jl) = ( TANH (  Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 
    788                      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) 
    789699                     IF ( araft(ji,jj,jl) < epsi06 )   araft(ji,jj,jl)  = 0._wp 
    790700                     aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 ) 
    791                   ENDIF ! athorn 
    792                END DO ! ji 
    793             END DO ! jj 
    794          END DO ! jl 
    795  
    796       ELSE  ! raftswi = 0 
     701                  ENDIF 
     702               END DO 
     703            END DO 
     704         END DO 
     705 
     706      ELSE 
    797707         ! 
    798708         DO jl = 1, jpl 
    … …  
    802712      ENDIF 
    803713 
    804       IF ( raftswi == 1 ) THEN 
    805  
    806          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 
    807717            DO jl = 1, jpl 
    808718               DO jj = 1, jpj 
    809719                  DO ji = 1, jpi 
    810                      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 
    811721                        WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 
    812722                        WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl 
    … …  
    854764            DO ji = 1, jpi 
    855765 
    856                IF (a_i(ji,jj,jl) .GT. epsi10 .AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN 
    857                   hi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    858                   hrmean          = MAX(SQRT(Hstar*hi), hi*krdgmin) 
    859                   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)) 
    860770                  hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl) 
    861                   hraft(ji,jj,jl) = kraft*hi 
    862                   krdg(ji,jj,jl)  = hrmean / hi 
     771                  hraft(ji,jj,jl) = kraft*zhi 
     772                  krdg(ji,jj,jl)  = hrmean / zhi 
    863773               ELSE 
    864774                  hraft(ji,jj,jl) = 0.0 
    … …  
    868778               ENDIF 
    869779 
    870             END DO ! ji 
    871          END DO ! jj 
    872       END DO ! jl 
     780            END DO 
     781         END DO 
     782      END DO 
    873783 
    874784      ! Normalization factor : aksum, ensures mass conservation 
    … …  
    902812      LOGICAL, PARAMETER ::   l_conservation_check = .true.  ! if true, check conservation (useful for debugging) 
    903813      ! 
    904       LOGICAL ::   neg_ato_i      ! flag for ato_i(i,j) < -puny 
    905       LOGICAL ::   large_afrac    ! flag for afrac > 1 
    906       LOGICAL ::   large_afrft    ! flag for afrac > 1 
    907814      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices 
    908815      INTEGER ::   ij                ! horizontal index, combines i and j loops 
    909816      INTEGER ::   icells            ! number of cells with aicen > puny 
    910       REAL(wp) ::   zindb, zsrdg2   ! local scalar 
    911       REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration 
     817      REAL(wp) ::   hL, hR, farea, ztmelts    ! left and right limits of integration 
    912818 
    913819      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices 
    … …  
    917823 
    918824      REAL(wp), POINTER, DIMENSION(:,:,:) ::   aicen_init, vicen_init   ! ice  area    & volume before ridging 
    919       REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnon_init, esnon_init   ! snow volume  & energy before ridging 
     825      REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnwn_init, esnwn_init   ! snow volume  & energy before ridging 
    920826      REAL(wp), POINTER, DIMENSION(:,:,:) ::   smv_i_init, oa_i_init    ! ice salinity & age    before ridging 
    921827 
    … …  
    925831      REAL(wp), POINTER, DIMENSION(:,:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges 
    926832      REAL(wp), POINTER, DIMENSION(:,:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice 
    927       REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! areal age content of ridged & rifging ice 
    928833      REAL(wp), POINTER, DIMENSION(:,:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2 
    929834 
    … …  
    934839      REAL(wp), POINTER, DIMENSION(:,:) ::   srdg2   ! sal*volume of new ridges 
    935840      REAL(wp), POINTER, DIMENSION(:,:) ::   smsw    ! sal*volume of water trapped into ridges 
     841      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! ice age of ice ridged 
    936842 
    937843      REAL(wp), POINTER, DIMENSION(:,:) ::   afrft            ! fraction of category area rafted 
    … …  
    939845      REAL(wp), POINTER, DIMENSION(:,:) ::   virft , vsrft    ! ice & snow volume of rafting ice 
    940846      REAL(wp), POINTER, DIMENSION(:,:) ::   esrft , smrft    ! snow energy & salinity of rafting ice 
    941       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 
    942848 
    943849      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eirft      ! ice energy of rafting ice 
    … …  
    947853      !!---------------------------------------------------------------------- 
    948854 
    949       CALL wrk_alloc( (jpi+1)*(jpj+1),      indxi, indxj ) 
    950       CALL wrk_alloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final ) 
    951       CALL wrk_alloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 
    952       CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    953       CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    954       CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 
    955       CALL wrk_alloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    956       CALL wrk_alloc( jpi, jpj, jkmax, 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 ) 
    957863 
    958864      ! Conservation check 
    … …  
    962868         CALL lim_column_sum        (jpl,    v_i,       vice_init ) 
    963869         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_init ) 
    964          DO ji = mi0(jiindx), mi1(jiindx) 
    965             DO jj = mj0(jjindx), mj1(jjindx) 
     870         DO ji = mi0(iiceprt), mi1(iiceprt) 
     871            DO jj = mj0(jiceprt), mj1(jiceprt) 
    966872               WRITE(numout,*) ' vice_init  : ', vice_init(ji,jj) 
    967873               WRITE(numout,*) ' eice_init  : ', eice_init(ji,jj) 
    … …  
    973879      ! 1) Compute change in open water area due to closing and opening. 
    974880      !------------------------------------------------------------------------------- 
    975  
    976       neg_ato_i = .false. 
    977  
    978881      DO jj = 1, jpj 
    979882         DO ji = 1, jpi 
    980883            ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice        & 
    981884               &                        + opning(ji,jj)                          * rdt_ice 
    982             IF( ato_i(ji,jj) < -epsi10 ) THEN 
    983                neg_ato_i = .TRUE. 
    984             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 
    985888               ato_i(ji,jj) = 0._wp 
    986889            ENDIF 
    987          END DO !jj 
    988       END DO !ji 
    989  
    990       ! if negative open water area alert it 
    991       IF( neg_ato_i ) THEN       ! there is a bug 
    992          DO jj = 1, jpj  
    993             DO ji = 1, jpi 
    994                IF( ato_i(ji,jj) < -epsi10 ) THEN  
    995                   WRITE(numout,*) ''   
    996                   WRITE(numout,*) 'Ridging error: ato_i < 0' 
    997                   WRITE(numout,*) 'ato_i : ', ato_i(ji,jj) 
    998                ENDIF               ! ato_i < -epsi10 
    999             END DO 
    1000          END DO 
    1001       ENDIF 
     890         END DO 
     891      END DO 
    1002892 
    1003893      !----------------------------------------------------------------- 
    1004894      ! 2) Save initial state variables 
    1005895      !----------------------------------------------------------------- 
    1006  
    1007       DO jl = 1, jpl 
    1008          aicen_init(:,:,jl) = a_i(:,:,jl) 
    1009          vicen_init(:,:,jl) = v_i(:,:,jl) 
    1010          vsnon_init(:,:,jl) = v_s(:,:,jl) 
    1011          ! 
    1012          smv_i_init(:,:,jl) = smv_i(:,:,jl) 
    1013          oa_i_init (:,:,jl) = oa_i (:,:,jl) 
    1014       END DO !jl 
    1015  
    1016       esnon_init(:,:,:) = e_s(:,:,1,:) 
    1017  
    1018       DO jl = 1, jpl   
    1019          DO jk = 1, nlay_i 
    1020             eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl) 
    1021          END DO 
    1022       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 (:,:,:) 
    1023903 
    1024904      ! 
    … …  
    1043923                  indxi(icells) = ji 
    1044924                  indxj(icells) = jj 
    1045                ENDIF ! test on a_icen_init  
    1046             END DO ! ji 
    1047          END DO ! jj 
    1048  
    1049          large_afrac = .false. 
    1050          large_afrft = .false. 
    1051  
    1052 !CDIR NODEP 
     925               ENDIF 
     926            END DO 
     927         END DO 
     928 
    1053929         DO ij = 1, icells 
    1054930            ji = indxi(ij) 
    … …  
    1064940            arft2(ji,jj) = arft1(ji,jj) / kraft 
    1065941 
    1066             oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    1067             oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    1068             oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1) 
    1069             oirft2(ji,jj)= oirft1(ji,jj) / kraft 
    1070  
    1071942            !--------------------------------------------------------------- 
    1072943            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1  
    … …  
    1076947            afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 
    1077948 
    1078             IF (afrac(ji,jj) > kamax + epsi10) THEN  !riging 
    1079                large_afrac = .true. 
    1080             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 
    1081952               afrac(ji,jj) = kamax 
    1082953            ENDIF 
    1083             IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting 
    1084                large_afrft = .true. 
    1085             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 
    1086958               afrft(ji,jj) = kamax 
    1087959            ENDIF 
    … …  
    1091963            !     / rafting category n1. 
    1092964            !-------------------------------------------------------------------------- 
    1093             vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
    1094             vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 
    1095             vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por 
    1096  
    1097             vsrdg(ji,jj) = vsnon_init(ji,jj,jl1) * afrac(ji,jj) 
    1098             esrdg(ji,jj) = esnon_init(ji,jj,jl1) * afrac(ji,jj) 
    1099             srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
    1100             srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
     965            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 
     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)  
    1101974 
    1102975            ! rafting volumes, heat contents ... 
    1103             virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
    1104             vsrft(ji,jj) = vsnon_init(ji,jj,jl1) * afrft(ji,jj) 
    1105             esrft(ji,jj) = esnon_init(ji,jj,jl1) * afrft(ji,jj) 
    1106             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  
    1107982 
    1108983            ! substract everything 
    1109             a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1(ji,jj)  - arft1(ji,jj) 
    1110             v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1(ji,jj)  - virft(ji,jj) 
    1111             v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg(ji,jj)  - vsrft(ji,jj) 
    1112             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) 
    1113989            oa_i(ji,jj,jl1)  = oa_i(ji,jj,jl1)  - oirdg1(ji,jj) - oirft1(ji,jj) 
    1114             smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj)  - smrft(ji,jj) 
    1115990 
    1116991            !----------------------------------------------------------------- 
    1117992            ! 3.5) Compute properties of new ridges 
    1118993            !----------------------------------------------------------------- 
    1119             !------------- 
     994            !--------- 
    1120995            ! Salinity 
    1121             !------------- 
    1122             smsw(ji,jj)  = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0       ! salt content of seawater frozen in voids 
    1123  
    1124             zsrdg2       = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
    1125  
    1126             srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
     996            !--------- 
     997            smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014 
     998            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
     999 
     1000            !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
    11271001             
    1128             !                                                             ! excess of salt is flushed into the ocean 
    1129             !sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 
    1130  
    1131             !rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic    ! gurvan: increase in ice volume du to seawater frozen in voids              
     1002            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
     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              
    11321004 
    11331005            !------------------------------------             
    … …  
    11551027            !           ij looping 1-icells 
    11561028 
    1157             msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg)   &   ! rafting included 
    1158                &                                + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 
    1159  
    1160             esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
    1161                &                                + 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)           
    11621035 
    11631036            !----------------------------------------------------------------- 
    … …  
    11721045            dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) 
    11731046 
    1174          END DO                 ! ij 
     1047         END DO 
    11751048 
    11761049         !-------------------------------------------------------------------- 
    … …  
    11791052         !-------------------------------------------------------------------- 
    11801053         DO jk = 1, nlay_i 
    1181 !CDIR NODEP 
    11821054            DO ij = 1, icells 
    11831055               ji = indxi(ij) 
    11841056               jj = indxj(ij) 
    11851057               ! heat content of ridged ice 
    1186                erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )  
     1058               erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj)  
    11871059               eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 
    11881060               e_i  (ji,jj,jk,jl1)  = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) 
    1189                ! sea water heat content 
    1190                ztmelts          = - tmut * sss_m(ji,jj) + rtt 
    1191                ! heat content per unit volume 
    1192                zdummy0          = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 
    1193  
    1194                ! corrected sea water salinity 
    1195                zindb  = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - epsi20 ) ) 
    1196                zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), epsi20 ) 
    1197  
    1198                ztmelts          = - tmut * zdummy + rtt 
    1199                ersw(ji,jj,jk)   = - rcp * ( ztmelts - rtt ) * vsw(ji,jj) 
    1200  
    1201                ! heat flux 
    1202                fheat_mec(ji,jj) = fheat_mec(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) * r1_rdtice 
    1203  
    1204                ! Correct dimensions to avoid big values 
    1205                ersw(ji,jj,jk)   = ersw(ji,jj,jk) * 1.e-09 
    1206  
    1207                ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    1208                ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / REAL( nlay_i ) 
    1209  
     1061                
     1062                
     1063               ! enthalpy of the trapped seawater (J/m2, >0) 
     1064               ! clem: if sst>0, then ersw <0 (is that possible?) 
     1065               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * sst_m(ji,jj) * r1_nlay_i 
     1066 
     1067               ! heat flux to the ocean 
     1068               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux  
     1069 
     1070               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 
    12101071               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
    1211             END DO ! ij 
    1212          END DO !jk 
     1072 
     1073            END DO 
     1074         END DO 
    12131075 
    12141076 
    12151077         IF( con_i ) THEN 
    12161078            DO jk = 1, nlay_i 
    1217 !CDIR NODEP 
    12181079               DO ij = 1, icells 
    12191080                  ji = indxi(ij) 
    12201081                  jj = indxj(ij) 
    12211082                  eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk) 
    1222                END DO ! ij 
    1223             END DO !jk 
    1224          ENDIF 
    1225  
    1226          IF( large_afrac ) THEN   ! there is a bug 
    1227 !CDIR NODEP 
    1228             DO ij = 1, icells 
    1229                ji = indxi(ij) 
    1230                jj = indxj(ij) 
    1231                IF( afrac(ji,jj) > kamax + epsi10 ) THEN  
    1232                   WRITE(numout,*) '' 
    1233                   WRITE(numout,*) ' ardg > a_i' 
    1234                   WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 
    1235                ENDIF 
    1236             END DO 
    1237          ENDIF 
    1238          IF( large_afrft ) THEN  ! there is a bug 
    1239 !CDIR NODEP 
    1240             DO ij = 1, icells 
    1241                ji = indxi(ij) 
    1242                jj = indxj(ij) 
    1243                IF( afrft(ji,jj) > kamax + epsi10 ) THEN  
    1244                   WRITE(numout,*) '' 
    1245                   WRITE(numout,*) ' arft > a_i' 
    1246                   WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 
    1247                ENDIF 
     1083               END DO 
    12481084            END DO 
    12491085         ENDIF 
    … …  
    12531089         !------------------------------------------------------------------------------- 
    12541090         !        jl1 looping 1-jpl 
    1255          DO jl2  = ice_cat_bounds(1,1), ice_cat_bounds(1,2)  
     1091         DO jl2  = 1, jpl  
    12561092            ! over categories to which ridged ice is transferred 
    1257 !CDIR NODEP 
    12581093            DO ij = 1, icells 
    12591094               ji = indxi(ij) 
    … …  
    12641099               ! Transfer area, volume, and energy accordingly. 
    12651100 
    1266                IF( hrmin(ji,jj,jl1) >= hi_max(jl2)  .OR.        & 
    1267                    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 
    12681102                  hL = 0._wp 
    12691103                  hR = 0._wp 
    … …  
    12791113               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ardg2 (ji,jj) * farea 
    12801114               v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj) 
    1281                v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 
    1282                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 
    12831117               smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + srdg2 (ji,jj) * fvol(ji,jj) 
    12841118               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea 
    12851119 
    1286             END DO ! ij 
     1120            END DO 
    12871121 
    12881122            ! Transfer ice energy to category jl2 by ridging 
    12891123            DO jk = 1, nlay_i 
    1290 !CDIR NODEP 
    12911124               DO ij = 1, icells 
    12921125                  ji = indxi(ij) 
    12931126                  jj = indxj(ij) 
    1294                   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) 
    12951128               END DO 
    12961129            END DO 
    … …  
    12981131         END DO                 ! jl2 (new ridges)             
    12991132 
    1300          DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2)  
    1301  
    1302 !CDIR NODEP 
     1133         DO jl2 = 1, jpl  
     1134 
    13031135            DO ij = 1, icells 
    13041136               ji = indxi(ij) 
    … …  
    13071139               ! thickness category jl2, transfer area, volume, and energy accordingly. 
    13081140               ! 
    1309                IF( hraft(ji,jj,jl1) <= hi_max(jl2)  .AND.        & 
    1310                    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 
    13111142                  a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + arft2 (ji,jj) 
    13121143                  v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + virft (ji,jj) 
    1313                   v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * fsnowrft 
    1314                   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 
    13151146                  smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)     
    1316                   oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)     
    1317                ENDIF ! hraft 
     1147                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj) 
     1148               ENDIF 
    13181149               ! 
    1319             END DO ! ij 
     1150            END DO 
    13201151 
    13211152            ! Transfer rafted ice energy to category jl2  
    13221153            DO jk = 1, nlay_i 
    1323 !CDIR NODEP 
    13241154               DO ij = 1, icells 
    13251155                  ji = indxi(ij) 
    13261156                  jj = indxj(ij) 
    1327                   IF(  hraft(ji,jj,jl1)  <=  hi_max(jl2)   .AND.        & 
    1328                        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 
    13291158                     e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk) 
    13301159                  ENDIF 
    1331                END DO           ! ij 
    1332             END DO !jk 
    1333  
    1334          END DO ! jl2 
     1160               END DO 
     1161            END DO 
     1162 
     1163         END DO 
    13351164 
    13361165      END DO ! jl1 (deforming categories) 
    … …  
    13461175         CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid)  
    13471176 
    1348          DO ji = mi0(jiindx), mi1(jiindx) 
    1349             DO jj = mj0(jjindx), mj1(jjindx) 
     1177         DO ji = mi0(iiceprt), mi1(iiceprt) 
     1178            DO jj = mj0(jiceprt), mj1(jiceprt) 
    13501179               WRITE(numout,*) ' vice_init  : ', vice_init (ji,jj) 
    13511180               WRITE(numout,*) ' vice_final : ', vice_final(ji,jj) 
    … …  
    13561185      ENDIF 
    13571186      ! 
    1358       CALL wrk_dealloc( (jpi+1)*(jpj+1),      indxi, indxj ) 
    1359       CALL wrk_dealloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final ) 
    1360       CALL wrk_dealloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 
    1361       CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    1362       CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    1363       CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 
    1364       CALL wrk_dealloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    1365       CALL wrk_dealloc( jpi, jpj, jkmax, 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 ) 
    13661195      ! 
    13671196   END SUBROUTINE lim_itd_me_ridgeshift 
    1368  
    1369  
    1370    SUBROUTINE lim_itd_me_asumr 
    1371       !!----------------------------------------------------------------------------- 
    1372       !!                ***  ROUTINE lim_itd_me_asumr *** 
    1373       !! 
    1374       !! ** Purpose :   finds total fractional area 
    1375       !! 
    1376       !! ** Method  :   Find the total area of ice plus open water in each grid cell. 
    1377       !!              This is similar to the aggregate_area subroutine except that the 
    1378       !!              total area can be greater than 1, so the open water area is  
    1379       !!              included in the sum instead of being computed as a residual.  
    1380       !!----------------------------------------------------------------------------- 
    1381       INTEGER ::   jl   ! dummy loop index 
    1382       !!----------------------------------------------------------------------------- 
    1383       ! 
    1384       asum(:,:) = ato_i(:,:)                    ! open water 
    1385       DO jl = 1, jpl                            ! ice categories 
    1386          asum(:,:) = asum(:,:) + a_i(:,:,jl) 
    1387       END DO 
    1388       ! 
    1389    END SUBROUTINE lim_itd_me_asumr 
    1390  
    13911197 
    13921198   SUBROUTINE lim_itd_me_init 
    … …  
    14041210      !!------------------------------------------------------------------- 
    14051211      INTEGER :: ios                 ! Local integer output status for namelist read 
    1406       NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,&  
    1407          Gstar, astar,                                & 
    1408          Hstar, raftswi, hparmeter, Craft, ridge_por, & 
    1409          sal_max_ridge,  partfun_swi, transfun_swi,   & 
    1410          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 
    14111215      !!------------------------------------------------------------------- 
    14121216      ! 
    … …  
    14241228         WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution ' 
    14251229         WRITE(numout,*)' ~~~~~~~~~~~~~~~' 
    1426          WRITE(numout,*)'   Switch choosing the ice redistribution scheme           ridge_scheme_swi', ridge_scheme_swi  
    1427          WRITE(numout,*)'   Fraction of shear energy contributing to ridging        Cs              ', Cs  
    1428          WRITE(numout,*)'   Ratio of ridging work to PotEner change in ridging      Cf              ', Cf  
    1429          WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrdg        ', fsnowrdg  
    1430          WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrft        ', fsnowrft  
    1431          WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  Gstar           ', Gstar 
    1432          WRITE(numout,*)'   Equivalent to G* for an exponential part function       astar           ', astar 
    1433          WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     Hstar           ', Hstar 
    1434          WRITE(numout,*)'   Rafting of ice sheets or not                            raftswi         ', raftswi 
    1435          WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       hparmeter       ', hparmeter 
    1436          WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  Craft           ', Craft   
    1437          WRITE(numout,*)'   Initial porosity of ridges                              ridge_por       ', ridge_por 
    1438          WRITE(numout,*)'   Maximum salinity of ridging ice                         sal_max_ridge   ', sal_max_ridge 
    1439          WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    partfun_swi     ', partfun_swi 
    1440          WRITE(numout,*)'   Switch for tran. function (0) linear (1) exponential    transfun_swi    ', transfun_swi 
    1441          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 
    14421241      ENDIF 
    14431242      ! 
    14441243   END SUBROUTINE lim_itd_me_init 
    1445  
    1446  
    1447    SUBROUTINE lim_itd_me_zapsmall 
    1448       !!------------------------------------------------------------------- 
    1449       !!                   ***  ROUTINE lim_itd_me_zapsmall *** 
    1450       !! 
    1451       !! ** Purpose :   Remove too small sea ice areas and correct salt fluxes 
    1452       !! 
    1453       !! history : 
    1454       !! author: William H. Lipscomb, LANL 
    1455       !! Nov 2003:  Modified by Julie Schramm to conserve volume and energy 
    1456       !! Sept 2004: Modified by William Lipscomb; replaced normalize_state with 
    1457       !!            additions to local freshwater, salt, and heat fluxes 
    1458       !!  9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code 
    1459       !!------------------------------------------------------------------- 
    1460       INTEGER ::   ji, jj, jl, jk   ! dummy loop indices 
    1461       INTEGER ::   icells           ! number of cells with ice to zap 
    1462  
    1463       REAL(wp), POINTER, DIMENSION(:,:) ::   zmask   ! 2D workspace 
    1464       REAL(wp)                          ::   zmask_glo 
    1465 !!gm      REAL(wp) ::   xtmp      ! temporary variable 
    1466       !!------------------------------------------------------------------- 
    1467  
    1468       CALL wrk_alloc( jpi, jpj, zmask ) 
    1469  
    1470       DO jl = 1, jpl 
    1471  
    1472          !----------------------------------------------------------------- 
    1473          ! Count categories to be zapped. 
    1474          ! Abort model in case of negative area. 
    1475          !----------------------------------------------------------------- 
    1476          icells = 0 
    1477          zmask(:,:)  = 0._wp 
    1478          DO jj = 1, jpj 
    1479             DO ji = 1, jpi 
    1480                IF(  ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) <  0._wp   ) .OR.   & 
    1481                   & ( a_i(ji,jj,jl) >  0._wp   .AND. a_i(ji,jj,jl) <= epsi10  ) .OR.   & 
    1482                   & ( v_i(ji,jj,jl) == 0._wp   .AND. a_i(ji,jj,jl) >  0._wp   ) .OR.   & 
    1483                   & ( v_i(ji,jj,jl) >  0._wp   .AND. v_i(ji,jj,jl) <= epsi10  ) )   zmask(ji,jj) = 1._wp 
    1484             END DO 
    1485          END DO 
    1486          !zmask_glo = glob_sum(zmask) 
    1487          !IF( ln_nicep .AND. lwp ) WRITE(numout,*) zmask_glo, ' cells of ice zapped in the ocean ' 
    1488  
    1489          !----------------------------------------------------------------- 
    1490          ! Zap ice energy and use ocean heat to melt ice 
    1491          !----------------------------------------------------------------- 
    1492  
    1493          DO jk = 1, nlay_i 
    1494             DO jj = 1 , jpj 
    1495                DO ji = 1 , jpi 
    1496 !!gm                  xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) * r1_rdtice 
    1497 !!gm                  xtmp = xtmp * unit_fac 
    1498                   ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
    1499                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 
    1500                END DO 
    1501             END DO 
    1502          END DO 
    1503  
    1504          DO jj = 1 , jpj 
    1505             DO ji = 1 , jpi 
    1506  
    1507                !----------------------------------------------------------------- 
    1508                ! Zap snow energy and use ocean heat to melt snow 
    1509                !----------------------------------------------------------------- 
    1510                !           xtmp = esnon(i,j,n) / dt ! < 0 
    1511                !           fhnet(i,j)      = fhnet(i,j)      + xtmp 
    1512                !           fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp 
    1513                ! xtmp is greater than 0 
    1514                ! fluxes are positive to the ocean 
    1515                ! here the flux has to be negative for the ocean 
    1516 !!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice 
    1517                !           fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
    1518  
    1519 !!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice !RB   ??????? 
    1520  
    1521                t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
    1522  
    1523                !----------------------------------------------------------------- 
    1524                ! zap ice and snow volume, add water and salt to ocean 
    1525                !----------------------------------------------------------------- 
    1526  
    1527                !           xtmp = (rhoi*vicen(i,j,n) + rhos*vsnon(i,j,n)) / dt 
    1528                !           sfx_res(ji,jj)  = sfx_res(ji,jj) + ( sss_m(ji,jj)                  )   & 
    1529                !                                            * rhosn * v_s(ji,jj,jl) * r1_rdtice 
    1530                !           sfx_res(ji,jj)  = sfx_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) )   &  
    1531                !                                            * rhoic * v_i(ji,jj,jl) * r1_rdtice 
    1532                !           sfx (i,j)      = sfx (i,j)      + xtmp 
    1533  
    1534                ato_i(ji,jj)    = a_i  (ji,jj,jl) *       zmask(ji,jj)   + ato_i(ji,jj) 
    1535                a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1536                v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1537                v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1538                t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj) 
    1539                oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1540                smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1541                ! 
    1542             END DO 
    1543          END DO 
    1544          ! 
    1545       END DO                 ! jl  
    1546       ! 
    1547       CALL wrk_dealloc( jpi, jpj, zmask ) 
    1548       ! 
    1549    END SUBROUTINE lim_itd_me_zapsmall 
    15501244 
    15511245#else 
    … …  
    15581252   SUBROUTINE lim_itd_me_icestrength 
    15591253   END SUBROUTINE lim_itd_me_icestrength 
    1560    SUBROUTINE lim_itd_me_sort 
    1561    END SUBROUTINE lim_itd_me_sort 
    15621254   SUBROUTINE lim_itd_me_init 
    15631255   END SUBROUTINE lim_itd_me_init 
    1564    SUBROUTINE lim_itd_me_zapsmall 
    1565    END SUBROUTINE lim_itd_me_zapsmall 
    15661256#endif 
    15671257   !!====================================================================== 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r4333 r5832  
    66   !! History :   -   !          (W. H. Lipscomb and E.C. Hunke) CICE (c) original code 
    77   !!            3.0  ! 2005-12  (M. Vancoppenolle) adaptation to LIM-3 
    8    !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age and types 
     8   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age 
    99   !!             -   ! 2007-04  (M. Vancoppenolle) Mass conservation checked 
    1010   !!---------------------------------------------------------------------- 
    … …  
    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 
     32   USE limcons          ! conservation tests 
    3733 
    3834   IMPLICIT NONE 
    3935   PRIVATE 
    4036 
    41    PUBLIC   lim_itd_th         ! called by ice_stp 
    4237   PUBLIC   lim_itd_th_rem 
    4338   PUBLIC   lim_itd_th_reb 
    44    PUBLIC   lim_itd_fitline 
    45    PUBLIC   lim_itd_shiftice 
    46  
    47    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    48    REAL(wp) ::   epsi06 = 1.e-6_wp   ! 
    4939 
    5040   !!---------------------------------------------------------------------- 
    … …  
    5545CONTAINS 
    5646 
    57    SUBROUTINE lim_itd_th( kt ) 
    58       !!------------------------------------------------------------------ 
    59       !!                ***  ROUTINE lim_itd_th *** 
    60       !! 
    61       !! ** Purpose :   computes the thermodynamics of ice thickness distribution 
    62       !! 
    63       !! ** Method  : 
    64       !!------------------------------------------------------------------ 
    65       INTEGER, INTENT(in) ::   kt   ! time step index 
    66       ! 
    67       INTEGER ::   jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index          
    68       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    69       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    70       !!------------------------------------------------------------------ 
    71       IF( nn_timing == 1 )  CALL timing_start('limitd_th') 
    72  
    73       ! ------------------------------- 
    74       !- check conservation (C Rousset) 
    75       IF (ln_limdiahsb) THEN 
    76          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    77          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    78          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    79          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    80        ENDIF 
    81       !- check conservation (C Rousset) 
    82       ! ------------------------------- 
    83  
    84       IF( kt == nit000 .AND. lwp ) THEN 
    85          WRITE(numout,*) 
    86          WRITE(numout,*) 'lim_itd_th  : Thermodynamics of the ice thickness distribution' 
    87          WRITE(numout,*) '~~~~~~~~~~~' 
    88       ENDIF 
    89  
    90       !------------------------------------------------------------------------------| 
    91       !  1) Transport of ice between thickness categories.                           | 
    92       !------------------------------------------------------------------------------| 
    93       ! Given thermodynamic growth rates, transport ice between 
    94       ! thickness categories. 
    95       DO jm = 1, jpm 
    96          jbnd1 = ice_cat_bounds(jm,1) 
    97          jbnd2 = ice_cat_bounds(jm,2) 
    98          IF( ice_ncat_types(jm) > 1 )   CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt ) 
    99       END DO 
    100       ! 
    101       CALL lim_var_glo2eqv    ! only for info 
    102       CALL lim_var_agg(1) 
    103  
    104       !------------------------------------------------------------------------------| 
    105       !  3) Add frazil ice growing in leads. 
    106       !------------------------------------------------------------------------------| 
    107  
    108       CALL lim_thd_lac 
    109       CALL lim_var_glo2eqv    ! only for info 
    110  
    111      IF(ln_ctl) THEN   ! Control print 
    112          CALL prt_ctl_info(' ') 
    113          CALL prt_ctl_info(' - Cell values : ') 
    114          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    115          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_th  : cell area :') 
    116          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :') 
    117          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :') 
    118          CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :') 
    119          DO jl = 1, jpl 
    120             CALL prt_ctl_info(' ') 
    121             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    122             CALL prt_ctl_info('   ~~~~~~~~~~') 
    123             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ') 
    124             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ') 
    125             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ') 
    126             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ') 
    127             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ') 
    128             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ') 
    129             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ') 
    130             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ') 
    131             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ') 
    132             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ') 
    133             DO ja = 1, nlay_i 
    134                CALL prt_ctl_info(' ') 
    135                CALL prt_ctl_info(' - Layer : ', ivar1=ja) 
    136                CALL prt_ctl_info('   ~~~~~~~') 
    137                CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : t_i      : ') 
    138                CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : e_i      : ') 
    139             END DO 
    140          END DO 
    141       ENDIF 
    142       ! 
    143       ! ------------------------------- 
    144       !- check conservation (C Rousset) 
    145       IF( ln_limdiahsb ) THEN 
    146          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    147          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    148   
    149          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    150          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    151  
    152          zchk_vmin = glob_min(v_i) 
    153          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    154          zchk_amin = glob_min(a_i) 
    155  
    156          IF(lwp) THEN 
    157             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_th) = ',(zchk_v_i * rday) 
    158             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_th) = ',(zchk_smv * rday) 
    159             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_th) = ',(zchk_vmin * 1.e-3) 
    160             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limitd_th) = ',zchk_amax 
    161             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limitd_th) = ',zchk_amin 
    162          ENDIF 
    163        ENDIF 
    164       !- check conservation (C Rousset) 
    165       ! ------------------------------- 
    166       ! 
    167      IF( nn_timing == 1 )  CALL timing_stop('limitd_th') 
    168    END SUBROUTINE lim_itd_th 
    169    ! 
    170  
    171    SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp, kt ) 
     47   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt ) 
    17248      !!------------------------------------------------------------------ 
    17349      !!                ***  ROUTINE lim_itd_th_rem *** 
    … …  
    18258      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point 
    18359      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied 
    184       INTEGER , INTENT (in) ::   ntyp    ! Number of the type used 
    18560      INTEGER , INTENT (in) ::   kt      ! Ocean time step  
    18661      ! 
    … …  
    19065      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars 
    19166      REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      - 
    192       REAL(wp) ::   zx3,             zareamin, zindb   !   -      - 
     67      REAL(wp) ::   zx3         
    19368      CHARACTER (len = 15) :: fieldid 
    19469 
    … …  
    20075      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hL          ! left boundary for the ITD for each thickness 
    20176      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hR          ! left boundary for the ITD for each thickness 
    202       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_o     ! old ice thickness 
     77      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_b     ! old ice thickness 
    20378      REAL(wp), POINTER, DIMENSION(:,:,:) ::   dummy_es 
    20479      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice          ! local increment of ice area and volume 
    … …  
    21691      !!------------------------------------------------------------------ 
    21792 
    218       CALL wrk_alloc( jpi,jpj, zremap_flag )    ! integer 
    219       CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer 
    220       CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es ) 
     93      CALL wrk_alloc( jpi,jpj, zremap_flag ) 
     94      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) 
     95      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    22196      CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    22297      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    22398      CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    224       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer  
     99      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    225100      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 ) 
    226  
    227       zareamin = epsi10   !minimum area in thickness categories tolerated by the conceptors of the model 
    228101 
    229102      !!---------------------------------------------------------------------------------------------- 
    … …  
    247120         WRITE(numout,*) ' klbnd :       ', klbnd 
    248121         WRITE(numout,*) ' kubnd :       ', kubnd 
    249          WRITE(numout,*) ' ntyp  :       ', ntyp  
    250122      ENDIF 
    251123 
    … …  
    254126         DO jj = 1, jpj 
    255127            DO ji = 1, jpi 
    256                zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes 
    257                ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb 
    258                zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 
    259                zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb 
    260                IF( a_i(ji,jj,jl) > epsi06 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
     128               rswitch           = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) )     !0 if no ice and 1 if yes 
     129               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch 
     130               rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) ) 
     131               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 
     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?  
    261133            END DO 
    262134         END DO 
    … …  
    277149      DO jj = 1, jpj 
    278150         DO ji = 1, jpi 
    279             IF ( at_i(ji,jj) .gt. zareamin ) THEN 
     151            IF ( at_i(ji,jj) > epsi10 ) THEN 
    280152               nbrem         = nbrem + 1 
    281153               nind_i(nbrem) = ji 
    … …  
    285157               zremap_flag(ji,jj) = 0 
    286158            ENDIF 
    287          END DO !ji 
    288       END DO !jj 
     159         END DO 
     160      END DO 
    289161 
    290162      !----------------------------------------------------------------------------------------------- 
    … …  
    292164      !----------------------------------------------------------------------------------------------- 
    293165      !- 4.1 Compute category boundaries 
    294       ! Tricky trick see limitd_me.F90 
    295       ! will be soon removed, CT 
    296       ! hi_max(kubnd) = 99. 
    297166      zhbnew(:,:,:) = 0._wp 
    298167 
    … …  
    302171            ij = nind_j(ji) 
    303172            ! 
    304             IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. &  
    305                ( zht_i_o(ii,ij,jl+1) .GT. epsi10 ) ) THEN 
     173            zhbnew(ii,ij,jl) = hi_max(jl) 
     174            IF    ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 
    306175               !interpolate between adjacent category growth rates 
    307                zslope = ( zdhice(ii,ij,jl+1)     - zdhice(ii,ij,jl) ) / & 
    308                   ( zht_i_o   (ii,ij,jl+1) - zht_i_o   (ii,ij,jl) ) 
    309                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + & 
    310                   zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 
    311             ELSEIF (zht_i_o(ii,ij,jl).gt.epsi10) THEN 
     176               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) ) 
     177               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) ) 
     178            ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN 
    312179               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 
    313             ELSEIF (zht_i_o(ii,ij,jl+1).gt.epsi10) THEN 
     180            ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN 
    314181               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 
    315             ELSE 
    316                zhbnew(ii,ij,jl) = hi_max(jl) 
    317182            ENDIF 
    318183         END DO 
    … …  
    320185         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
    321186         DO ji = 1, nbrem 
    322             ! jl, ji 
    323187            ii = nind_i(ji) 
    324188            ij = nind_j(ji) 
    325             ! jl, ji 
    326             IF ( ( a_i(ii,ij,jl) .GT.epsi10) .AND. &  
    327                ( ht_i(ii,ij,jl).GE. zhbnew(ii,ij,jl) ) & 
    328               ) 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 
    329193               zremap_flag(ii,ij) = 0 
    330             ELSEIF ( ( a_i(ii,ij,jl+1) .GT. epsi10 ) .AND. & 
    331                ( ht_i(ii,ij,jl+1).LE. zhbnew(ii,ij,jl) ) & 
    332                ) THEN 
     194            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN 
    333195               zremap_flag(ii,ij) = 0 
    334196            ENDIF 
    335197 
    336198            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max   
    337             ! jl, ji 
    338             IF (zhbnew(ii,ij,jl).gt.hi_max(jl+1)) THEN 
    339                zremap_flag(ii,ij) = 0 
    340             ENDIF 
    341             ! jl, ji 
    342             IF (zhbnew(ii,ij,jl).lt.hi_max(jl-1)) THEN 
    343                zremap_flag(ii,ij) = 0 
    344             ENDIF 
    345             ! jl, ji 
    346          END DO !ji 
    347          ! ji 
    348       END DO !jl 
     199            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     200            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 
     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 
    349208 
    350209      !----------------------------------------------------------------------------------------------- 
    … …  
    354213      DO jj = 1, jpj 
    355214         DO ji = 1, jpi 
    356             IF ( zremap_flag(ji,jj) == 1 ) THEN 
     215            IF( zremap_flag(ji,jj) == 1 ) THEN 
    357216               nbrem         = nbrem + 1 
    358217               nind_i(nbrem) = ji 
    359218               nind_j(nbrem) = jj 
    360219            ENDIF 
    361          END DO !ji 
    362       END DO !jj 
     220         END DO  
     221      END DO  
    363222 
    364223      !----------------------------------------------------------------------------------------------- 
    … …  
    367226      DO jj = 1, jpj 
    368227         DO ji = 1, jpi 
    369             zhb0(ji,jj) = hi_max_typ(0,ntyp) ! 0eme 
    370             zhb1(ji,jj) = hi_max_typ(1,ntyp) ! 1er 
    371  
    372             zhbnew(ji,jj,klbnd-1) = 0._wp 
     228            zhb0(ji,jj) = hi_max(0) 
     229            zhb1(ji,jj) = hi_max(1) 
    373230 
    374231            IF( a_i(ji,jj,kubnd) > epsi10 ) THEN 
    375                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) ) 
    376233            ELSE 
    377                zhbnew(ji,jj,kubnd) = hi_max(kubnd)   
    378                !!? clem bug: since hi_max(jpl)=99, this limit is very high  
    379                !!? but I think it is erased in fitline subroutine  
    380             ENDIF 
    381  
    382             IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) )   zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
    383  
    384          END DO !jj 
    385       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 
    386248 
    387249      !----------------------------------------------------------------------------------------------- 
    … …  
    389251      !----------------------------------------------------------------------------------------------- 
    390252      !- 7.1 g(h) for category 1 at start of time step 
    391       CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_o(:,:,klbnd),         & 
    392          &                  g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   & 
     253      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   & 
    393254         &                  hR(:,:,klbnd), zremap_flag ) 
    394255 
    … …  
    398259         ij = nind_j(ji)  
    399260 
    400          !ji 
    401          IF (a_i(ii,ij,klbnd) .gt. epsi10) THEN 
     261         IF( a_i(ii,ij,klbnd) > epsi10 ) THEN 
     262 
    402263            zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category 
    403             ! ji, a_i > epsi10 
    404             IF (zdh0 .lt. 0.0) THEN !remove area from category 1 
    405                ! ji, a_i > epsi10; zdh0 < 0 
    406                zdh0 = MIN(-zdh0,hi_max(klbnd)) 
    407  
     264 
     265            IF( zdh0 < 0.0 ) THEN      !remove area from category 1 
     266               zdh0 = MIN( -zdh0, hi_max(klbnd) ) 
    408267               !Integrate g(1) from 0 to dh0 to estimate area melted 
    409                zetamax = MIN(zdh0,hR(ii,ij,klbnd)) - hL(ii,ij,klbnd) 
    410                IF (zetamax.gt.0.0) THEN 
    411                   zx1  = zetamax 
    412                   zx2  = 0.5 * zetamax*zetamax  
    413                   zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed 
    414                   ! Constrain new thickness <= ht_i 
    415                   zdamax = a_i(ii,ij,klbnd) * &  
    416                      (1.0 - ht_i(ii,ij,klbnd)/zht_i_o(ii,ij,klbnd)) ! zdamax > 0 
    417                   !ice area lost due to melting of thin ice 
    418                   zda0   = MIN(zda0, zdamax) 
    419  
     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) 
    420277                  ! Remove area, conserving volume 
    421                   ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) &  
    422                      * 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 ) 
    423279                  a_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) - zda0 
    424                   v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd)*ht_i(ii,ij,klbnd) ! clem-useless ? 
    425                ENDIF     ! zetamax > 0 
    426                ! ji, a_i > epsi10 
    427  
    428             ELSE ! if ice accretion 
    429                ! ji, a_i > epsi10; zdh0 > 0 
    430                IF ( ntyp .EQ. 1 ) zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
    431                ! zhbnew was 0, and is shifted to the right to account for thin ice 
    432                ! growth in openwater (F0 = f1) 
    433                IF ( ntyp .NE. 1 ) zhbnew(ii,ij,0) = 0  
    434                ! in other types there is 
    435                ! no open water growth (F0 = 0) 
    436             ENDIF ! zdh0  
    437  
    438             ! a_i > epsi10 
    439          ENDIF ! a_i > epsi10 
    440  
    441       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 
    442291 
    443292      !- 7.3 g(h) for each thickness category   
    444293      DO jl = klbnd, kubnd 
    445          CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 
    446             g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl),     & 
    447             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 ) 
    448296      END DO 
    449297 
    … …  
    465313            ij = nind_j(ji) 
    466314 
    467             IF (zhbnew(ii,ij,jl) .gt. hi_max(jl)) THEN ! transfer from jl to jl+1 
    468  
     315            IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1 
    469316               ! left and right integration limits in eta space 
    470                zvetamin(ji) = MAX(hi_max(jl), hL(ii,ij,jl)) - hL(ii,ij,jl) 
    471                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) 
    472319               zdonor(ii,ij,jl) = jl 
    473320 
    474             ELSE  ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    475  
     321            ELSE                                    ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    476322               ! left and right integration limits in eta space 
    477323               zvetamin(ji) = 0.0 
    478                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) 
    479325               zdonor(ii,ij,jl) = jl + 1 
    480326 
    481             ENDIF  ! zhbnew(jl) > hi_max(jl) 
    482  
    483             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 
    484330            zetamin = zvetamin(ji) 
    485331 
    486332            zx1  = zetamax - zetamin 
    487             zwk1 = zetamin*zetamin 
    488             zwk2 = zetamax*zetamax 
    489             zx2  = 0.5 * (zwk2 - zwk1) 
     333            zwk1 = zetamin * zetamin 
     334            zwk2 = zetamax * zetamax 
     335            zx2  = 0.5 * ( zwk2 - zwk1 ) 
    490336            zwk1 = zwk1 * zetamin 
    491337            zwk2 = zwk2 * zetamax 
    492             zx3  = 1.0/3.0 * (zwk2 - zwk1) 
     338            zx3  = 1.0 / 3.0 * ( zwk2 - zwk1 ) 
    493339            nd   = zdonor(ii,ij,jl) 
    494340            zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 
    495             zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + & 
    496                zdaice(ii,ij,jl)*hL(ii,ij,nd) 
    497  
    498          END DO ! ji 
    499       END DO ! jl klbnd -> kubnd - 1 
     341            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 
     342 
     343         END DO 
     344      END DO 
    500345 
    501346      !!---------------------------------------------------------------------------------------------- 
    … …  
    511356         ii = nind_i(ji) 
    512357         ij = nind_j(ji) 
    513          IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim ) ) THEN 
    514             a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim  
    515             ht_i(ii,ij,1) = hiclim 
    516             v_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless 
     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 
    517361         ENDIF 
    518       END DO !ji 
     362      END DO 
    519363 
    520364      !!---------------------------------------------------------------------------------------------- 
    … …  
    540384      ENDIF 
    541385 
    542       CALL wrk_dealloc( jpi,jpj, zremap_flag )    ! integer 
    543       CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer 
    544       CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es ) 
     386      CALL wrk_dealloc( jpi,jpj, zremap_flag ) 
     387      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) 
     388      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    545389      CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    546390      CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    547391      CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    548       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer  
     392      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    549393      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 ) 
    550394 
    … …  
    552396 
    553397 
    554    SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice,   & 
    555       &                        g0, g1, hL, hR, zremap_flag ) 
     398   SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag ) 
    556399      !!------------------------------------------------------------------ 
    557400      !!                ***  ROUTINE lim_itd_fitline *** 
    … …  
    572415      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) ::   zremap_flag  ! 
    573416      ! 
    574       INTEGER ::   ji,jj           ! horizontal indices 
     417      INTEGER  ::   ji,jj        ! horizontal indices 
    575418      REAL(wp) ::   zh13         ! HbL + 1/3 * (HbR - HbL) 
    576419      REAL(wp) ::   zh23         ! HbL + 2/3 * (HbR - HbL) 
    … …  
    579422      !!------------------------------------------------------------------ 
    580423      ! 
    581       ! 
    582424      DO jj = 1, jpj 
    583425         DO ji = 1, jpi 
    584426            ! 
    585427            IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10   & 
    586                &                        .AND. hice(ji,jj)        > 0._wp     ) THEN 
     428               &                        .AND. hice(ji,jj)        > 0._wp ) THEN 
    587429 
    588430               ! Initialize hL and hR 
    589  
    590431               hL(ji,jj) = HbL(ji,jj) 
    591432               hR(ji,jj) = HbR(ji,jj) 
    592433 
    593434               ! Change hL or hR if hice falls outside central third of range 
    594  
    595                zh13 = 1.0/3.0 * (2.0*hL(ji,jj) + hR(ji,jj)) 
    596                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) ) 
    597437 
    598438               IF    ( hice(ji,jj) < zh13 ) THEN   ;   hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj) 
    … …  
    601441 
    602442               ! Compute coefficients of g(eta) = g0 + g1*eta 
    603  
    604443               zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj)) 
    605444               zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr 
    606445               zwk2 = ( hice(ji,jj) - hL(ji,jj) ) * zdhr 
    607                g0(ji,jj) = zwk1 * ( 2._wp/3._wp - zwk2 ) 
    608                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 ) 
    609448               ! 
    610             ELSE                   ! remap_flag = .false. or a_i < epsi10  
     449            ELSE  ! remap_flag = .false. or a_i < epsi10  
    611450               hL(ji,jj) = 0._wp 
    612451               hR(ji,jj) = 0._wp 
    613452               g0(ji,jj) = 0._wp 
    614453               g1(ji,jj) = 0._wp 
    615             ENDIF                  ! a_i > epsi10 
     454            ENDIF 
    616455            ! 
    617456         END DO 
    … …  
    637476 
    638477      INTEGER ::   ji, jj, jl, jl2, jl1, jk   ! dummy loop indices 
    639       INTEGER ::   ii, ij          ! indices when changing from 2D-1D is done 
     478      INTEGER ::   ii, ij                     ! indices when changing from 2D-1D is done 
    640479 
    641480      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn 
    … …  
    647486      REAL(wp) ::   zdo_aice           ! ice age times volume transferred 
    648487      REAL(wp) ::   zdaTsf             ! aicen*Tsfcn transferred 
    649       REAL(wp) ::   zindsn             ! snow or not 
    650       REAL(wp) ::   zindb              ! ice or not 
    651488 
    652489      INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions 
    653490 
    654       INTEGER ::   nbrem             ! number of cells with ice to transfer 
    655  
    656       LOGICAL ::   zdaice_negative         ! true if daice < -puny 
    657       LOGICAL ::   zdvice_negative         ! true if dvice < -puny 
    658       LOGICAL ::   zdaice_greater_aicen    ! true if daice > aicen 
    659       LOGICAL ::   zdvice_greater_vicen    ! true if dvice > vicen 
     491      INTEGER  ::   nbrem             ! number of cells with ice to transfer 
    660492      !!------------------------------------------------------------------ 
    661493 
    662494      CALL wrk_alloc( jpi,jpj,jpl, zaTsfn ) 
    663495      CALL wrk_alloc( jpi,jpj, zworka ) 
    664       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
     496      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    665497 
    666498      !---------------------------------------------------------------------------------------------- 
    … …  
    669501 
    670502      DO jl = klbnd, kubnd 
    671          zaTsfn(:,:,jl) = a_i(:,:,jl)*t_su(:,:,jl) 
    672       END DO 
    673  
    674       !---------------------------------------------------------------------------------------------- 
    675       ! 2) Check for daice or dvice out of range, allowing for roundoff error 
    676       !---------------------------------------------------------------------------------------------- 
    677       ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl 
    678       ! has a small area, with h(n) very close to a boundary.  Then 
    679       ! the coefficients of g(h) are large, and the computed daice and 
    680       ! dvice can be in error. If this happens, it is best to transfer 
    681       ! either the entire category or nothing at all, depending on which 
    682       ! side of the boundary hice(n) lies. 
    683       !----------------------------------------------------------------- 
    684       DO jl = klbnd, kubnd-1 
    685  
    686          zdaice_negative = .false. 
    687          zdvice_negative = .false. 
    688          zdaice_greater_aicen = .false. 
    689          zdvice_greater_vicen = .false. 
    690  
    691          DO jj = 1, jpj 
    692             DO ji = 1, jpi 
    693  
    694                IF (zdonor(ji,jj,jl) .GT. 0) THEN 
    695                   jl1 = zdonor(ji,jj,jl) 
    696  
    697                   IF (zdaice(ji,jj,jl) .LT. 0.0) THEN 
    698                      IF (zdaice(ji,jj,jl) .GT. -epsi10) THEN 
    699                         IF ( ( jl1.EQ.jl   .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) )           & 
    700                            .OR.                                      & 
    701                            ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) )           &   
    702                            ) THEN                                                              
    703                            zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category 
    704                            zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
    705                         ELSE 
    706                            zdaice(ji,jj,jl) = 0.0 ! shift no ice 
    707                            zdvice(ji,jj,jl) = 0.0 
    708                         ENDIF 
    709                      ELSE 
    710                         zdaice_negative = .true. 
    711                      ENDIF 
    712                   ENDIF 
    713  
    714                   IF (zdvice(ji,jj,jl) .LT. 0.0) THEN 
    715                      IF (zdvice(ji,jj,jl) .GT. -epsi10 ) THEN 
    716                         IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) )     & 
    717                            .OR.                                     & 
    718                            ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) & 
    719                            ) THEN 
    720                            zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category 
    721                            zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    722                         ELSE 
    723                            zdaice(ji,jj,jl) = 0.0    ! shift no ice 
    724                            zdvice(ji,jj,jl) = 0.0 
    725                         ENDIF 
    726                      ELSE 
    727                         zdvice_negative = .true. 
    728                      ENDIF 
    729                   ENDIF 
    730  
    731                   ! If daice is close to aicen, set daice = aicen. 
    732                   IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - epsi10 ) THEN 
    733                      IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+epsi10) THEN 
    734                         zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    735                         zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    736                      ELSE 
    737                         zdaice_greater_aicen = .true. 
    738                      ENDIF 
    739                   ENDIF 
    740  
    741                   IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)-epsi10) THEN 
    742                      IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+epsi10) THEN 
    743                         zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    744                         zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    745                      ELSE 
    746                         zdvice_greater_vicen = .true. 
    747                      ENDIF 
    748                   ENDIF 
    749  
    750                ENDIF               ! donor > 0 
    751             END DO                   ! i 
    752          END DO                 ! j 
    753  
    754       END DO !jl 
     503         zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl) 
     504      END DO 
    755505 
    756506      !------------------------------------------------------------------------------- 
    757       ! 3) Transfer volume and energy between categories 
     507      ! 2) Transfer volume and energy between categories 
    758508      !------------------------------------------------------------------------------- 
    759509 
    … …  
    762512         DO jj = 1, jpj 
    763513            DO ji = 1, jpi 
    764                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 
    765515                  nbrem = nbrem + 1 
    766516                  nind_i(nbrem) = ji 
    767517                  nind_j(nbrem) = jj 
    768                ENDIF ! tmask 
     518               ENDIF 
    769519            END DO 
    770520         END DO 
    … …  
    775525 
    776526            jl1 = zdonor(ii,ij,jl) 
    777             zindb             = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) ) 
    778             zworka(ii,ij)   = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * zindb 
     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 
    779529            IF( jl1 == jl) THEN   ;   jl2 = jl1+1 
    780             ELSE                    ;   jl2 = jl  
     530            ELSE                  ;   jl2 = jl  
    781531            ENDIF 
    782532 
    … …  
    784534            ! Ice areas 
    785535            !-------------- 
    786  
    787536            a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl) 
    788537            a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl) 
    … …  
    791540            ! Ice volumes 
    792541            !-------------- 
    793  
    794542            v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl)  
    795543            v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl) 
    … …  
    798546            ! Snow volumes 
    799547            !-------------- 
    800  
    801             zdvsnow          = v_s(ii,ij,jl1) * zworka(ii,ij) 
     548            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij) 
    802549            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 
    803550            v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow  
    … …  
    806553            ! Snow heat content   
    807554            !-------------------- 
    808  
    809             zdesnow              = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
     555            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
    810556            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow 
    811557            e_s(ii,ij,1,jl2)   = e_s(ii,ij,1,jl2) + zdesnow 
    … …  
    814560            ! Ice age  
    815561            !-------------- 
    816  
    817             zdo_aice             = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
     562            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
    818563            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice 
    819564            oa_i(ii,ij,jl2)    = oa_i(ii,ij,jl2) + zdo_aice 
    … …  
    822567            ! Ice salinity 
    823568            !-------------- 
    824  
    825             zdsm_vice            = smv_i(ii,ij,jl1) * zworka(ii,ij) 
     569            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij) 
    826570            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice 
    827571            smv_i(ii,ij,jl2)   = smv_i(ii,ij,jl2) + zdsm_vice 
    … …  
    830574            ! Surface temperature 
    831575            !--------------------- 
    832  
    833             zdaTsf               = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
     576            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
    834577            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf 
    835578            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf  
    836579 
    837          END DO                 ! ji 
     580         END DO 
    838581 
    839582         !------------------ 
    … …  
    842585 
    843586         DO jk = 1, nlay_i 
    844 !CDIR NODEP 
    845587            DO ji = 1, nbrem 
    846588               ii = nind_i(ji) 
    … …  
    848590 
    849591               jl1 = zdonor(ii,ij,jl) 
    850                IF (jl1 .EQ. jl) THEN 
     592               IF (jl1 == jl) THEN 
    851593                  jl2 = jl+1 
    852594               ELSE             ! n1 = n+1 
    … …  
    857599               e_i(ii,ij,jk,jl1) =  e_i(ii,ij,jk,jl1) - zdeice 
    858600               e_i(ii,ij,jk,jl2) =  e_i(ii,ij,jk,jl2) + zdeice  
    859             END DO              ! ji 
    860          END DO                 ! jk 
     601            END DO 
     602         END DO 
    861603 
    862604      END DO                   ! boundaries, 1 to ncat-1 
    … …  
    872614                  ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl)  
    873615                  t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl)  
    874                   zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes 
    875616               ELSE 
    876617                  ht_i(ji,jj,jl)  = 0._wp 
    877                   t_su(ji,jj,jl)  = rtt 
     618                  t_su(ji,jj,jl)  = rt0 
    878619               ENDIF 
    879             END DO                 ! ji 
    880          END DO                 ! jj 
    881       END DO                    ! jl 
     620            END DO 
     621         END DO 
     622      END DO 
    882623      ! 
    883624      CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn ) 
    884625      CALL wrk_dealloc( jpi,jpj, zworka ) 
    885       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
     626      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    886627      ! 
    887628   END SUBROUTINE lim_itd_shiftice 
    888629    
    889630 
    890    SUBROUTINE lim_itd_th_reb( klbnd, kubnd, ntyp ) 
     631   SUBROUTINE lim_itd_th_reb( klbnd, kubnd ) 
    891632      !!------------------------------------------------------------------ 
    892633      !!                ***  ROUTINE lim_itd_th_reb *** 
    … …  
    898639      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point 
    899640      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied 
    900       INTEGER , INTENT (in) ::   ntyp    ! number of the ice type involved in the rebinning process 
    901641      ! 
    902642      INTEGER ::   ji,jj, jl   ! dummy loop indices 
    … …  
    927667         DO jj = 1, jpj 
    928668            DO ji = 1, jpi  
    929                IF( a_i(ji,jj,jl) > epsi10 ) THEN  
    930                   ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    931                ELSE 
    932                   ht_i(ji,jj,jl) = 0._wp 
    933                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 
    934671            END DO 
    935672         END DO 
    … …  
    937674 
    938675      !------------------------------------------------------------------------------ 
    939       ! 2) Make sure thickness of cat klbnd is at least hi_max_typ(klbnd) 
    940       !------------------------------------------------------------------------------ 
    941       DO jj = 1, jpj  
    942          DO ji = 1, jpi  
    943             IF( a_i(ji,jj,klbnd) > epsi10 ) THEN 
    944                IF( ht_i(ji,jj,klbnd) <= hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN 
    945                   a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max_typ(0,ntyp)  
    946                   ht_i(ji,jj,klbnd) = hi_max_typ(0,ntyp) 
    947                ENDIF 
    948             ENDIF 
    949          END DO 
    950       END DO 
    951  
    952       !------------------------------------------------------------------------------ 
    953       ! 3) If a category thickness is not in bounds, shift the 
     676      ! 2) If a category thickness is not in bounds, shift the 
    954677      ! entire area, volume, and energy to the neighboring category 
    955678      !------------------------------------------------------------------------------ 
    … …  
    980703                  zdonor(ji,jj,jl)  = jl  
    981704                  ! begin TECLIM change 
    982                   !zdaice(ji,jj,jl)  = a_i(ji,jj,jl) 
    983                   !zdvice(ji,jj,jl)  = v_i(ji,jj,jl) 
    984705                  !zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * 0.5_wp 
    985706                  !zdvice(ji,jj,jl)  = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1)) * 0.5_wp 
    986707                  ! end TECLIM change  
    987708                  ! clem: how much of a_i you send in cat sup is somewhat arbitrary 
    988                   zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi10 ) / ht_i(ji,jj,jl)   
    989                   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 ) 
    990711               ENDIF 
    991             END DO                 ! ji 
    992          END DO                 ! jj 
     712            END DO 
     713         END DO 
    993714         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
    994715 
    … …  
    1001722         ENDIF 
    1002723         ! 
    1003       END DO                    ! jl 
     724      END DO 
    1004725 
    1005726      !---------------------------- 
    … …  
    1014735         zshiftflag = 0 
    1015736 
    1016 !clem-change 
    1017 !         DO jj = 1, jpj 
    1018 !            DO ji = 1, jpi 
    1019 !               IF( a_i(ji,jj,jl+1) >  epsi10 .AND.   & 
    1020 !                  ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    1021 !                  ! 
    1022 !                  zshiftflag = 1 
    1023 !                  zdonor(ji,jj,jl) = jl + 1 
    1024 !                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1)  
    1025 !                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
    1026 !               ENDIF 
    1027 !            END DO                 ! ji 
    1028 !         END DO                 ! jj 
    1029 ! 
    1030 !         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
    1031 !          
    1032 !         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories 
    1033 !            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    1034 !            ! Reset shift parameters 
    1035 !            zdonor(:,:,jl) = 0 
    1036 !            zdaice(:,:,jl) = 0._wp 
    1037 !            zdvice(:,:,jl) = 0._wp 
    1038 !         ENDIF 
    1039 !clem-change 
    1040  
    1041          ! clem-change begin: why not doing that? 
    1042737         DO jj = 1, jpj 
    1043738            DO ji = 1, jpi 
    1044                IF( a_i(ji,jj,jl+1) >  epsi10 .AND.   & 
    1045                   ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    1046                   ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
    1047                   a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
     739               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     740                  ! 
     741                  zshiftflag = 1 
     742                  zdonor(ji,jj,jl) = jl + 1 
     743                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1)  
     744                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
    1048745               ENDIF 
    1049             END DO                 ! ji 
    1050          END DO                 ! jj 
    1051          ! clem-change end 
    1052  
    1053       END DO                    ! jl 
     746            END DO 
     747         END DO 
     748 
     749         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
     750          
     751         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories 
     752            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
     753            ! Reset shift parameters 
     754            zdonor(:,:,jl) = 0 
     755            zdaice(:,:,jl) = 0._wp 
     756            zdvice(:,:,jl) = 0._wp 
     757         ENDIF 
     758 
     759      END DO 
    1054760 
    1055761      !------------------------------------------------------------------------------ 
    1056       ! 4) Conservation check 
     762      ! 3) Conservation check 
    1057763      !------------------------------------------------------------------------------ 
    1058764 
    … …  
    1067773      ENDIF 
    1068774      ! 
    1069       CALL wrk_dealloc( jpi,jpj,jpl, zdonor )   ! interger 
     775      CALL wrk_dealloc( jpi,jpj,jpl, zdonor ) 
    1070776      CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice ) 
    1071777      CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final ) 
    … …  
    1078784   !!---------------------------------------------------------------------- 
    1079785CONTAINS 
    1080    SUBROUTINE lim_itd_th           ! Empty routines 
    1081    END SUBROUTINE lim_itd_th 
    1082    SUBROUTINE lim_itd_th_ini 
    1083    END SUBROUTINE lim_itd_th_ini 
    1084786   SUBROUTINE lim_itd_th_rem 
    1085787   END SUBROUTINE lim_itd_th_rem 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90

    r4161 r5832  
    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/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r4346 r5832  
    5050   PUBLIC   lim_rhg        ! routine called by lim_dyn (or lim_dyn_2) 
    5151 
    52    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   rzero   = 0._wp   ! constant values 
    54    REAL(wp) ::   rone    = 1._wp   ! constant values 
    55        
    5652   !! * Substitutions 
    5753#  include "vectopt_loop_substitute.h90" 
    … …  
    106102      !!                 and charge ellipse. 
    107103      !!                 The user should make sure that the parameters 
    108       !!                 nevp, telast and creepl maintain stress state 
     104      !!                 nn_nevp, elastic time scale and rn_creepl maintain stress state 
    109105      !!                 on the charge ellipse for plastic flow 
    110106      !!                 e.g. in the Canadian Archipelago 
    … …  
    112108      !! References : Hunke and Dukowicz, JPO97 
    113109      !!              Bouillon et al., Ocean Modelling 2009 
    114       !!              Vancoppenolle et al., Ocean Modelling 2008 
    115110      !!------------------------------------------------------------------- 
    116111      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation 
    … …  
    121116      CHARACTER (len=50) ::   charout 
    122117      REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         ! 
    123       REAL(wp) ::   za, zstms, zsang, zmask   ! local scalars 
    124  
    125       REAL(wp) ::   dtevp              ! time step for subcycling 
    126       REAL(wp) ::   dtotel, ecc2, ecci ! square of yield ellipse eccenticity 
    127       REAL(wp) ::   z0, zr, zcca, zccb ! temporary scalars 
    128       REAL(wp) ::   zu_ice2, zv_ice1   ! 
    129       REAL(wp) ::   zddc, zdtc, zzdst   ! delta on corners and on centre 
    130       REAL(wp) ::   zdsshx, zdsshy     ! term for the gradient of ocean surface 
    131       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 
    132129 
    133130      REAL(wp) ::   zresm         ! Maximal error on ice velocity 
    134       REAL(wp) ::   zindb         ! ice (1) or not (0)       
    135       REAL(wp) ::   zdummy        ! dummy argument 
    136131      REAL(wp) ::   zintb, zintn  ! dummy argument 
    137132 
    … …  
    142137      REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points 
    143138      REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays 
    144       REAL(wp), POINTER, DIMENSION(:,:) ::   zc1              ! ice mass 
    145       REAL(wp), POINTER, DIMENSION(:,:) ::   zusw             ! temporary weight for ice strength computation 
    146       REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                            
    147       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 
    148141      REAL(wp), POINTER, DIMENSION(:,:) ::   u_ice2, v_ice1   ! ice u/v component on V/U point 
    149142      REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses 
     143      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask            ! mask ocean grid points 
    150144       
    151       REAL(wp), POINTER, DIMENSION(:,:) ::   zdd   , zdt      ! Divergence and tension at centre of grid cells 
     145      REAL(wp), POINTER, DIMENSION(:,:) ::   zdt              ! tension at centre of grid cells 
    152146      REAL(wp), POINTER, DIMENSION(:,:) ::   zds              ! Shear on northeast corner of grid cells 
    153       REAL(wp), POINTER, DIMENSION(:,:) ::   zdst             ! Shear on centre of grid cells 
    154       REAL(wp), POINTER, DIMENSION(:,:) ::   deltat, deltac   ! Delta at centre and corners of grid cells 
    155147      REAL(wp), POINTER, DIMENSION(:,:) ::   zs1   , zs2      ! Diagonal stress tensor components zs1 and zs2  
    156148      REAL(wp), POINTER, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12 
    … …  
    159151                                                              !   ocean surface (ssh_m) if ice is not embedded 
    160152                                                              !   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 
    161156      !!------------------------------------------------------------------- 
    162157 
    163158      CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 
    164       CALL wrk_alloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                ) 
    165       CALL wrk_alloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  ) 
    166       CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
     159      CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               ) 
     160      CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
     161      CALL wrk_alloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
    167162 
    168163#if  defined key_lim2 && ! defined key_lim2_vp 
    169164# if defined key_agrif 
    170      USE ice_2, vt_s => hsnm 
    171      USE ice_2, vt_i => hicm 
     165      USE ice_2, vt_s => hsnm 
     166      USE ice_2, vt_i => hicm 
    172167# else 
    173      vt_s => hsnm 
    174      vt_i => hicm 
     168      vt_s => hsnm 
     169      vt_i => hicm 
    175170# endif 
    176      at_i(:,:) = 1. - frld(:,:) 
     171      at_i(:,:) = 1. - frld(:,:) 
    177172#endif 
    178173#if defined key_agrif && defined key_lim2  
    179     CALL agrif_rhg_lim2_load      ! First interpolation of coarse values 
    180 #endif 
    181       ! 
    182       !------------------------------------------------------------------------------! 
    183       ! 1) Ice-Snow mass (zc1), ice strength (zpresh)                                ! 
     174      CALL agrif_rhg_lim2_load      ! First interpolation of coarse values 
     175#endif 
     176      ! 
     177      !------------------------------------------------------------------------------! 
     178      ! 1) Ice strength (zpresh)                                ! 
    184179      !------------------------------------------------------------------------------! 
    185180      ! 
    186181      ! Put every vector to 0 
    187       zpresh (:,:) = 0._wp   ;   zc1   (:,:) = 0._wp 
     182      delta_i(:,:) = 0._wp   ; 
     183      zpresh (:,:) = 0._wp   ;   
    188184      zpreshc(:,:) = 0._wp 
    189185      u_ice2 (:,:) = 0._wp   ;   v_ice1(:,:) = 0._wp 
    190       zdd    (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp 
     186      divu_i (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp 
     187      shear_i(:,:) = 0._wp 
    191188 
    192189#if defined key_lim3 
    193       CALL lim_itd_me_icestrength( ridge_scheme_swi )      ! LIM-3: Ice strength on T-points 
    194 #endif 
    195  
    196 !CDIR NOVERRCHK 
     190      CALL lim_itd_me_icestrength( nn_icestr )      ! LIM-3: Ice strength on T-points 
     191#endif 
     192 
    197193      DO jj = k_j1 , k_jpj       ! Ice mass and temp variables 
    198 !CDIR NOVERRCHK 
    199194         DO ji = 1 , jpi 
    200             zc1(ji,jj)    = tms(ji,jj) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) ) 
    201195#if defined key_lim3 
    202             zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj) 
     196            zpresh(ji,jj) = tmask(ji,jj,1) *  strength(ji,jj) 
    203197#endif 
    204198#if defined key_lim2 
    205             zpresh(ji,jj) = tms(ji,jj) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) ) 
    206 #endif 
    207             ! tmi = 1 where there is ice or on land 
    208             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) 
    209203         END DO 
    210204      END DO 
    … …  
    212206      ! Ice strength on grid cell corners (zpreshc) 
    213207      ! needed for calculation of shear stress  
    214 !CDIR NOVERRCHK 
    215208      DO jj = k_j1+1, k_jpj-1 
    216 !CDIR NOVERRCHK 
    217209         DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1) 
    218             zstms          =  tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
    219                &              tms(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
    220                &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + & 
    221                &              tms(ji,jj)     * wght(ji+1,jj+1,1,1) 
    222             zusw(ji,jj)    = 1.0 / MAX( zstms, epsd ) 
    223             zpreshc(ji,jj) = (  zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
    224                &                zpresh(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
    225                &                zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &  
    226                &                zpresh(ji,jj)     * wght(ji+1,jj+1,1,1)   & 
    227                &             ) * zusw(ji,jj) 
     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 ) 
    228215         END DO 
    229216      END DO 
    230  
    231217      CALL lbc_lnk( zpreshc(:,:), 'F', 1. ) 
    232218      ! 
    … …  
    243229      !  zcorl2: Coriolis parameter on V-points                             
    244230      !  (ztagnx,ztagny): wind stress on U/V points                        
    245       !  u_oce1: ocean u component on u points                            
    246231      !  v_oce1: ocean v component on u points                           
    247232      !  u_oce2: ocean u component on v points                          
    248       !  v_oce2: ocean v component on v points                         
    249233 
    250234      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
    251           !                                             
    252           ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
    253           !                                               = (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} 
    254238         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp      
    255           ! 
    256           ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
    257           !                                               = (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}) 
    258242         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    259           ! 
     243         ! 
    260244         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0 
    261           ! 
     245         ! 
    262246      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
    263247         zpice(:,:) = ssh_m(:,:) 
    … …  
    267251         DO ji = fs_2, fs_jpim1 
    268252 
    269             zt11 = tms(ji  ,jj) * e1t(ji  ,jj) 
    270             zt12 = tms(ji+1,jj) * e1t(ji+1,jj) 
    271             zt21 = tms(ji,jj  ) * e2t(ji,jj  ) 
    272             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) 
    273261 
    274262            ! Leads area. 
    275             zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd ) 
    276             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 ) 
    277265 
    278266            ! Mass, coriolis coeff. and currents 
    279             zmass1(ji,jj) = ( zt12*zc1(ji,jj) + zt11*zc1(ji+1,jj) ) / (zt11+zt12+epsd) 
    280             zmass2(ji,jj) = ( zt22*zc1(ji,jj) + zt21*zc1(ji,jj+1) ) / (zt21+zt22+epsd) 
    281             zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) )   & 
    282                &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd ) 
    283             zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1)*fcor(ji,jj) + e2t(ji,jj)*fcor(ji,jj+1) )   & 
    284                &                          / ( 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 ) 
    285273            ! 
    286             u_oce1(ji,jj)  = u_oce(ji,jj) 
    287             v_oce2(ji,jj)  = v_oce(ji,jj) 
    288  
    289274            ! Ocean has no slip boundary condition 
    290             v_oce1(ji,jj)  = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)    & 
    291                &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) & 
    292                &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)   
    293  
    294             u_oce2(ji,jj)  = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)     & 
    295                &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) & 
    296                &                / (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) 
    297282 
    298283            ! Wind stress at U,V-point 
    … …  
    306291            ! include it later 
    307292 
    308             zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 
    309             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) 
    310295 
    311296            za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx 
    … …  
    321306      ! 
    322307      ! Time step for subcycling 
    323       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 
    324312      dtotel = dtevp / ( 2._wp * telast ) 
    325  
     313#endif 
     314      z1_dtotel = 1._wp / ( 1._wp + dtotel ) 
     315      z1_dtevp  = 1._wp / dtevp 
    326316      !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter) 
    327       ecc2 = ecc * ecc 
     317      ecc2 = rn_ecc * rn_ecc 
    328318      ecci = 1. / ecc2 
    329319 
    … …  
    334324 
    335325      !                                               !----------------------! 
    336       DO jter = 1 , nevp                              !    loop over jter    ! 
     326      DO jter = 1 , nn_nevp                           !    loop over jter    ! 
    337327         !                                            !----------------------!         
    338328         DO jj = k_j1, k_jpj-1 
    … …  
    342332 
    343333         DO jj = k_j1+1, k_jpj-1 
    344             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 
    345335 
    346336               !   
    347337               !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002) 
    348                !- zdd(:,:), zdt(:,:): divergence and tension at centre of grid cells 
     338               !- divu_i(:,:), zdt(:,:): divergence and tension at centre of grid cells 
    349339               !- zds(:,:): shear on northeast corner of grid cells 
    350340               ! 
    … …  
    355345               !                      bugs (Martin, for Miguel). 
    356346               ! 
    357                !- ALSO: arrays zdd, zdt, zds and delta could  
     347               !- ALSO: arrays zdt, zds and delta could  
    358348               !  be removed in the future to minimise memory demand. 
    359349               ! 
    … …  
    363353               ! 
    364354               ! 
    365                zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    366                   &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
    367                   &          +e1v(ji,jj)*v_ice(ji,jj)                      & 
    368                   &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
    369                   &          )                                             & 
    370                   &         / area(ji,jj) 
    371  
    372                zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
    373                   &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                & 
    374                   &           )*e2t(ji,jj)*e2t(ji,jj)                      & 
    375                   &          -( v_ice(ji,jj)/e1v(ji,jj)                    & 
    376                   &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                & 
    377                   &           )*e1t(ji,jj)*e1t(ji,jj)                      & 
    378                   &         )                                              & 
    379                   &        / 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) 
    380362 
    381363               ! 
    382                zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1)                & 
    383                   &            -u_ice(ji,jj)/e1u(ji,jj)                    & 
    384                   &           )*e1f(ji,jj)*e1f(ji,jj)                      & 
    385                   &          +( v_ice(ji+1,jj)/e2v(ji+1,jj)                & 
    386                   &            -v_ice(ji,jj)/e2v(ji,jj)                    & 
    387                   &           )*e2f(ji,jj)*e2f(ji,jj)                      & 
    388                   &         )                                              & 
    389                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 
    390                   &        * tmi(ji,jj) * tmi(ji,jj+1)                     & 
    391                   &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
    392  
    393  
    394                v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    395                   &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    396                   &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)  
    397  
    398                u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
    399                   &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
    400                   &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    401  
    402             END DO 
    403          END DO 
    404          CALL lbc_lnk( v_ice1, 'U', -1. )   ;   CALL lbc_lnk( u_ice2, 'V', -1. )      ! lateral boundary cond. 
    405  
    406 !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          
    407382         DO jj = k_j1+1, k_jpj-1 
    408 !CDIR NOVERRCHK 
    409383            DO ji = fs_2, fs_jpim1 
    410384 
    411385               !- Calculate Delta at centre of grid cells 
    412                zzdst      = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          & 
    413                   &          - e2u(ji-1, jj) * v_ice1(ji-1,jj)          & 
    414                   &          + e1v(ji, jj  ) * u_ice2(ji,jj  )          & 
    415                   &          - e1v(ji, jj-1) * u_ice2(ji,jj-1)          & 
    416                   &          )                                          & 
    417                   &         / area(ji,jj) 
    418  
    419                delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zzdst*zzdst ) * usecc2 )   
    420                ! MV rewriting 
    421                ! deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 + (zdt(ji,jj)**2 + zzdst**2)*usecc2), creepl ) 
    422                !!gm faster to replace the line above with simply: 
    423                !!                deltat(ji,jj) = MAX( delta, creepl ) 
    424                !!gm end   
    425                deltat(ji,jj) = delta + creepl 
    426                ! END MV 
    427                !-Calculate stress tensor components zs1 and zs2  
    428                !-at centre of grid cells (see section 3.5 of CICE user's guide). 
    429                !zs1(ji,jj) = ( zs1(ji,jj) - dtotel*( ( 1._wp - alphaevp) * zs1(ji,jj) +   & 
    430                !   &          ( delta / deltat(ji,jj) - zdd(ji,jj) / deltat(ji,jj) ) * zpresh(ji,jj) ) )  &        
    431                !   &          / ( 1._wp + alphaevp * dtotel ) 
    432  
    433                !zs2(ji,jj) = ( zs2(ji,jj) - dtotel * ( ( 1._wp - alphaevp ) * ecc2 * zs2(ji,jj) -   & 
    434                !              zdt(ji,jj) / deltat(ji,jj) * zpresh(ji,jj) ) )   & 
    435                !   &          / ( 1._wp + alphaevp * ecc2 * dtotel ) 
    436  
    437                ! new formulation from S. Bouillon to help stabilizing the code (no need of alphaevp) 
    438                zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( zdd(ji,jj) / deltat(ji,jj) - delta / deltat(ji,jj) )  & 
    439                   &         * zpresh(ji,jj) ) ) / ( 1._wp + dtotel ) 
    440                zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / deltat(ji,jj) * zpresh(ji,jj) ) )  & 
    441                   &         / ( 1._wp + dtotel ) 
    442  
    443             END DO 
    444          END DO 
    445  
    446          CALL lbc_lnk( zs1(:,:), 'T', 1. ) 
    447          CALL lbc_lnk( zs2(:,:), 'T', 1. ) 
    448  
    449 !CDIR NOVERRCHK 
    450          DO jj = k_j1+1, k_jpj-1 
    451 !CDIR NOVERRCHK 
    452             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 
    453393               !- Calculate Delta on corners 
    454                zddc  =      ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
    455                   &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
    456                   &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
    457                   &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
    458                   &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
    459                   &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
    460                   &         )                                               & 
    461                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
    462  
    463                zdtc  =      (-( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
    464                   &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
    465                   &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
    466                   &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
    467                   &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
    468                   &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
    469                   &         )                                               & 
    470                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
    471  
    472                deltac(ji,jj) = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl 
    473  
    474                !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide). 
    475                !zs12(ji,jj) = ( zs12(ji,jj) - dtotel * ( (1.0-alphaevp) * ecc2 * zs12(ji,jj) - zds(ji,jj) /  & 
    476                !   &          ( 2._wp * deltac(ji,jj) ) * zpreshc(ji,jj) ) )  & 
    477                !   &          / ( 1._wp + alphaevp * ecc2 * dtotel )  
    478  
    479                ! new formulation from S. Bouillon to help stabilizing the code (no need of alphaevp) 
    480                zs12(ji,jj) = ( zs12(ji,jj) + dtotel *  & 
    481                   &          ( ecci * zds(ji,jj) / ( 2._wp * deltac(ji,jj) ) * zpreshc(ji,jj) ) )  & 
    482                   &          / ( 1.0 + dtotel )  
    483  
    484             END DO ! ji 
    485          END DO ! jj 
    486  
    487          CALL lbc_lnk( zs12(:,:), 'F', 1. ) 
    488  
     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  
    489418         ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 
    490419         DO jj = k_j1+1, k_jpj-1 
    491420            DO ji = fs_2, fs_jpim1 
    492421               !- contribution of zs1, zs2 and zs12 to zf1 
    493                zf1(ji,jj) = 0.5*( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj) & 
    494                   &              +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj) & 
    495                   &              +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj) & 
    496                   &             ) / ( 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) 
    497426               ! contribution of zs1, zs2 and zs12 to zf2 
    498                zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) & 
    499                   &              -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) & 
    500                   &              + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 -    & 
    501                   zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) & 
    502                   &             ) / ( 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) 
    503431            END DO 
    504432         END DO 
    … …  
    510438         IF (MOD(jter,2).eq.0) THEN  
    511439 
    512 !CDIR NOVERRCHK 
    513440            DO jj = k_j1+1, k_jpj-1 
    514 !CDIR NOVERRCHK 
    515441               DO ji = fs_2, fs_jpim1 
    516                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
    517                   zsang        = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 
    518                   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 
    519444 
    520445                  ! SB modif because ocean has no slip boundary condition 
    521                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)         & 
    522                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
    523                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    524                   za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
    525                      (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj)) 
    526                   zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    527                      za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj)) 
    528                   zcca         = z0+za*cangvg 
    529                   zccb         = zcorl1(ji,jj)+za*zsang 
    530                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    531  
     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 
     453                  zccb         = zcorl1(ji,jj) 
     454                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
    532455               END DO 
    533456            END DO 
    … …  
    535458            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    536459#if defined key_agrif && defined key_lim2 
    537             CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     460            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
    538461#endif 
    539462#if defined key_bdy 
    540          ! clem: change u_ice and v_ice at the boundary for each iteration 
    541463         CALL bdy_ice_lim_dyn( 'U' ) 
    542464#endif          
    543465 
    544 !CDIR NOVERRCHK 
    545466            DO jj = k_j1+1, k_jpj-1 
    546 !CDIR NOVERRCHK 
    547467               DO ji = fs_2, fs_jpim1 
    548468 
    549                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
    550                   zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    551                   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 
    552471                  ! SB modif because ocean has no slip boundary condition 
    553                   zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)     & 
    554                      &                 + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
    555                      &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    556                   za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &  
    557                      (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    558                   zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    559                      za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj)) 
    560                   zcca         = z0+za*cangvg 
    561                   zccb         = zcorl2(ji,jj)+za*zsang 
    562                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    563  
     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 
     479                  zccb         = zcorl2(ji,jj) 
     480                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    564481               END DO 
    565482            END DO 
    … …  
    567484            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    568485#if defined key_agrif && defined key_lim2 
    569             CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
     486            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    570487#endif 
    571488#if defined key_bdy 
    572          ! clem: change u_ice and v_ice at the boundary for each iteration 
    573489         CALL bdy_ice_lim_dyn( 'V' ) 
    574490#endif          
    575491 
    576492         ELSE  
    577 !CDIR NOVERRCHK 
    578493            DO jj = k_j1+1, k_jpj-1 
    579 !CDIR NOVERRCHK 
    580494               DO ji = fs_2, fs_jpim1 
    581                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
    582                   zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    583                   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 
    584497                  ! SB modif because ocean has no slip boundary condition 
    585                   zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)      & 
    586                      &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
    587                      &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)    
    588  
    589                   za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 
    590                      (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    591                   zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    592                      za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj)) 
    593                   zcca         = z0+za*cangvg 
    594                   zccb         = zcorl2(ji,jj)+za*zsang 
    595                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    596  
     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 
     506                  zccb         = zcorl2(ji,jj) 
     507                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    597508               END DO 
    598509            END DO 
    … …  
    600511            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    601512#if defined key_agrif && defined key_lim2 
    602             CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
     513            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    603514#endif 
    604515#if defined key_bdy 
    605          ! clem: change u_ice and v_ice at the boundary for each iteration 
    606516         CALL bdy_ice_lim_dyn( 'V' ) 
    607517#endif          
    608518 
    609 !CDIR NOVERRCHK 
    610519            DO jj = k_j1+1, k_jpj-1 
    611 !CDIR NOVERRCHK 
    612520               DO ji = fs_2, fs_jpim1 
    613                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
    614                   zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    615                   z0           = zmass1(ji,jj)/dtevp 
    616                   ! SB modif because ocean has no slip boundary condition 
    617                   ! GG Bug 
    618                   !                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)      & 
    619                   !                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj))   & 
    620                   !                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    621                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      & 
    622                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
    623                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    624  
    625                   za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
    626                      (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj)) 
    627                   zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    628                      za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj)) 
    629                   zcca         = z0+za*cangvg 
    630                   zccb         = zcorl1(ji,jj)+za*zsang 
    631                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    632                END DO ! ji 
    633             END DO ! jj 
     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 
     531                  zccb         = zcorl1(ji,jj) 
     532                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
     533               END DO 
     534            END DO 
    634535 
    635536            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    636537#if defined key_agrif && defined key_lim2 
    637             CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     538            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
    638539#endif 
    639540#if defined key_bdy 
    640          ! clem: change u_ice and v_ice at the boundary for each iteration 
    641541         CALL bdy_ice_lim_dyn( 'U' ) 
    642542#endif          
    … …  
    647547            !---  Convergence test. 
    648548            DO jj = k_j1+1 , k_jpj-1 
    649                zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) ,           & 
    650                   ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    651             END DO 
    652             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 ) ) 
    653552            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain 
    654553         ENDIF 
    … …  
    661560      ! 4) Prevent ice velocities when the ice is thin 
    662561      !------------------------------------------------------------------------------! 
    663       !clem : add hminrhg in the namelist 
    664       ! 
    665       ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 
    666       ! ocean velocity,  
    667       ! This prevents high velocity when ice is thin 
    668 !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 
    669564      DO jj = k_j1+1, k_jpj-1 
    670 !CDIR NOVERRCHK 
    671565         DO ji = fs_2, fs_jpim1 
    672             zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - epsi10 ) )  
    673             !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , epsi10 ) 
    674             zdummy = vt_i(ji,jj) 
    675             IF ( zdummy .LE. hminrhg ) THEN 
     566            IF ( vt_i(ji,jj) <= zvmin ) THEN 
    676567               u_ice(ji,jj) = u_oce(ji,jj) 
    677568               v_ice(ji,jj) = v_oce(ji,jj) 
    678             ENDIF ! zdummy 
     569            ENDIF 
    679570         END DO 
    680571      END DO 
    681572 
    682       CALL lbc_lnk( u_ice(:,:), 'U', -1. )  
    683       CALL lbc_lnk( v_ice(:,:), 'V', -1. )  
     573      CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. ) 
     574 
    684575#if defined key_agrif && defined key_lim2 
    685       CALL agrif_rhg_lim2( nevp , nevp, 'U' ) 
    686       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' ) 
    687578#endif 
    688579#if defined key_bdy 
    689       ! clem: change u_ice and v_ice at the boundary 
    690580      CALL bdy_ice_lim_dyn( 'U' ) 
    691581      CALL bdy_ice_lim_dyn( 'V' ) 
    … …  
    694584      DO jj = k_j1+1, k_jpj-1  
    695585         DO ji = fs_2, fs_jpim1 
    696             zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - epsi10 ) )  
    697             !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , epsi10 ) 
    698             zdummy = vt_i(ji,jj) 
    699             IF ( zdummy .LE. hminrhg ) THEN 
    700                v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    701                   &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    702                   &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    703  
    704                u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
    705                   &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
    706                   &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    707             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  
    708595         END DO 
    709596      END DO 
    710597 
    711       CALL lbc_lnk( u_ice2(:,:), 'V', -1. )  
    712       CALL lbc_lnk( v_ice1(:,:), 'U', -1. ) 
     598      CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. ) 
    713599 
    714600      ! Recompute delta, shear and div, inputs for mechanical redistribution  
    715 !CDIR NOVERRCHK 
    716601      DO jj = k_j1+1, k_jpj-1 
    717 !CDIR NOVERRCHK 
    718          DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi 
    719             !- zdd(:,:), zdt(:,:): divergence and tension at centre  
     602         DO ji = fs_2, jpim1   !RB bug no vect opt due to zmask 
     603            !- divu_i(:,:), zdt(:,:): divergence and tension at centre  
    720604            !- zds(:,:): shear on northeast corner of grid cells 
    721             zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - epsi10 ) )  
    722             !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , epsi10 ) 
    723             zdummy = vt_i(ji,jj) 
    724             IF ( zdummy .LE. hminrhg ) THEN 
    725  
    726                zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    727                   &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
    728                   &          +e1v(ji,jj)*v_ice(ji,jj)                      & 
    729                   &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
    730                   &         )                                              & 
    731                   &         / area(ji,jj) 
    732  
    733                zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
    734                   &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                & 
    735                   &           )*e2t(ji,jj)*e2t(ji,jj)                      & 
    736                   &          -( v_ice(ji,jj)/e1v(ji,jj)                    & 
    737                   &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                & 
    738                   &           )*e1t(ji,jj)*e1t(ji,jj)                      & 
    739                   &         )                                              & 
    740                   &        / 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) 
    741614               ! 
    742615               ! SB modif because ocean has no slip boundary condition  
    743                zds(ji,jj) = ( ( u_ice(ji,jj+1) / e1u(ji,jj+1)              & 
    744                   &           - u_ice(ji,jj)   / e1u(ji,jj) )              & 
    745                   &           * e1f(ji,jj) * e1f(ji,jj)                    & 
    746                   &          + ( v_ice(ji+1,jj) / e2v(ji+1,jj)             & 
    747                   &            - v_ice(ji,jj)  / e2v(ji,jj) )              & 
    748                   &           * e2f(ji,jj) * e2f(ji,jj) )                  & 
    749                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 
    750                   &        * tmi(ji,jj) * tmi(ji,jj+1)                     & 
    751                   &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
    752  
    753                zdst(ji,jj) = (  e2u( ji  , jj   ) * v_ice1(ji  ,jj  )    & 
    754                   &           - e2u( ji-1, jj   ) * v_ice1(ji-1,jj  )    & 
    755                   &           + e1v( ji  , jj   ) * u_ice2(ji  ,jj  )    & 
    756                   &           - e1v( ji  , jj-1 ) * u_ice2(ji  ,jj-1)  ) / area(ji,jj) 
    757  
    758 !              deltat(ji,jj) = SQRT(    zdd(ji,jj)*zdd(ji,jj)   &  
    759 !                  &                 + ( zdt(ji,jj)*zdt(ji,jj) + zdst(ji,jj)*zdst(ji,jj) ) * usecc2 &  
    760 !                  &                          ) + creepl 
    761                ! MV rewriting 
    762                delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst(ji,jj)*zdst(ji,jj) ) * usecc2 )   
    763                deltat(ji,jj) = delta + creepl 
    764                ! END MV 
     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 
    765626             
    766             ENDIF ! zdummy 
    767  
    768          END DO !jj 
    769       END DO !ji 
     627            ENDIF 
     628         END DO 
     629      END DO 
    770630      ! 
    771631      !------------------------------------------------------------------------------! 
    772632      ! 5) Store stress tensor and its invariants 
    773633      !------------------------------------------------------------------------------! 
    774       ! 
    775634      ! * Invariants of the stress tensor are required for limitd_me 
    776635      !   (accelerates convergence and improves stability) 
    777636      DO jj = k_j1+1, k_jpj-1 
    778637         DO ji = fs_2, fs_jpim1 
    779             divu_i (ji,jj) = zdd   (ji,jj) 
    780             delta_i(ji,jj) = deltat(ji,jj) 
    781             ! begin TECLIM change  
    782             zdst(ji,jj)= (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &    
    783                &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         &    
    784                &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           &    
    785                &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) / area(ji,jj)  
    786             shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst(ji,jj) * zdst(ji,jj) ) 
    787             ! end TECLIM change 
     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)  
     640            shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 
    788641         END DO 
    789642      END DO 
    790643 
    791644      ! Lateral boundary condition 
    792       CALL lbc_lnk( divu_i (:,:), 'T', 1. ) 
    793       CALL lbc_lnk( delta_i(:,:), 'T', 1. ) 
    794       ! CALL lbc_lnk( shear_i(:,:), 'F', 1. ) 
    795       CALL lbc_lnk( shear_i(:,:), 'T', 1. ) 
     645      CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1.,  shear_i(:,:), 'T', 1. ) 
    796646 
    797647      ! * Store the stress tensor for the next time step 
    … …  
    824674            DO jj = k_j1+1, k_jpj-1 
    825675               DO ji = 2, jpim1 
    826                   IF (zpresh(ji,jj) .GT. 1.0) THEN 
     676                  IF (zpresh(ji,jj) > 1.0) THEN 
    827677                     sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )  
    828678                     sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 
    … …  
    838688      ! 
    839689      CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 
    840       CALL wrk_dealloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                ) 
    841       CALL wrk_dealloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  ) 
    842       CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
     690      CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               ) 
     691      CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
     692      CALL wrk_dealloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
    843693 
    844694   END SUBROUTINE lim_rhg 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r4205 r5832  
    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 
    … …  
    162170      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'        , u_ice      ) 
    163171      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'        , v_ice      ) 
    164       CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'        , fsbbq      ) 
    165172      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'    , stress1_i  ) 
    166173      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  ) 
    167174      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i'   , stress12_i ) 
    168       CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )   !clem modif 
    169       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 ) 
    170177 
    171178      DO jl = 1, jpl  
    … …  
    307314      !! ** purpose  :   read of sea-ice variable restart in a netcdf file 
    308315      !!---------------------------------------------------------------------- 
    309       INTEGER :: ji, jj, jk, jl, indx 
     316      INTEGER :: ji, jj, jk, jl 
    310317      REAL(wp) ::   zfice, ziter 
    311       REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb   ! local scalars used for the salinity profile 
    312       REAL(wp), POINTER, DIMENSION(:)  ::   zs_zero  
    313318      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d 
    314319      CHARACTER(len=15) ::   znam 
    … …  
    318323      !!---------------------------------------------------------------------- 
    319324 
    320       CALL wrk_alloc( nlay_i, zs_zero ) 
    321325      CALL wrk_alloc( jpi, jpj, z2d ) 
    322326 
    … …  
    330334        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    331335        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90 
    332         INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
     336        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
    333337        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    334338      ENDIF 
    335339 
    336       CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib ) 
     340      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib ) 
    337341 
    338342      CALL iom_get( numrir, 'nn_fsbc', zfice ) 
    … …  
    393397      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      ) 
    394398      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      ) 
    395       CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      ) 
    396399      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  ) 
    397400      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  ) 
    398401      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i ) 
    399       CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )   !clem modif 
    400       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 ) 
    401404 
    402405      DO jl = 1, jpl  
    … …  
    522525      END DO 
    523526      ! 
     527      ! clem: I do not understand why the following IF is needed 
     528      !       I suspect something inconsistent in the main code with option nn_icesal=1 
     529      IF( nn_icesal == 1 ) THEN 
     530         DO jl = 1, jpl  
     531            sm_i(:,:,jl) = rn_icesal 
     532            DO jk = 1, nlay_i  
     533               s_i(:,:,jk,jl) = rn_icesal 
     534            END DO 
     535         END DO 
     536      ENDIF 
     537      ! 
    524538      !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 
    525539      ! 
    526       CALL wrk_dealloc( nlay_i, zs_zero ) 
    527540      CALL wrk_dealloc( jpi, jpj, z2d ) 
    528541      ! 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4614 r5832  
    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 domvvl           ! ocean vertical scale factors 
    30    USE dom_ice,    ONLY : tms 
    3128   USE ice              ! LIM sea-ice variables 
    3229   USE sbc_ice          ! Surface boundary condition: sea-ice fields 
    3330   USE sbc_oce          ! Surface boundary condition: ocean fields 
    3431   USE sbccpl 
    35    USE cpl_oasis3, ONLY : lk_cpl 
    36    USE oce       , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     32   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    3733   USE albedo           ! albedo parameters 
    3834   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
    … …  
    4238   USE prtctl           ! Print control 
    4339   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    44    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 
     41   USE iom 
     42   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 
    52  
    53    REAL(wp)  ::   rzero  = 0._wp     
    54    REAL(wp)  ::   rone   = 1._wp 
    5552 
    5653   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2] 
    … …  
    9794      !!              - fr_i    : ice fraction 
    9895      !!              - tn_ice  : sea-ice surface temperature 
    99       !!              - alb_ice : sea-ice alberdo (lk_cpl=T) 
     96      !!              - alb_ice : sea-ice albedo (only useful in coupled mode) 
    10097      !! 
    10198      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
    10299      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
     100      !!              These refs are now obsolete since everything has been revised 
     101      !!              The ref should be Rousset et al., 2015 
    103102      !!--------------------------------------------------------------------- 
    104       INTEGER, INTENT(in) ::   kt    ! number of iteration 
    105       ! 
    106       INTEGER  ::   ji, jj, jl           ! dummy loop indices 
    107       INTEGER  ::   ierr, ifvt, i1mfr, idfr           ! local integer 
    108       INTEGER  ::   iflt, ial , iadv , ifral, ifrdv   !   -      - 
    109       REAL(wp) ::   zinda, zemp, zemp_snow, zfmm      ! local scalars 
    110       REAL(wp) ::   zemp_snw                          !   -      - 
    111       REAL(wp) ::   zfcm1 , zfcm2                     !   -      - 
    112       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
    113       REAL(wp) ::   zzfcm1, zfscmbq ! clem: for light penetration 
     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 
     107      ! 
     108      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
    114109      !!--------------------------------------------------------------------- 
    115        
    116       IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 
    117  
    118       !------------------------------------------! 
    119       !      heat flux at the ocean surface      ! 
    120       !------------------------------------------! 
     110 
     111      ! make calls for heat fluxes before it is modified 
     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(:,:) )   
     122 
    121123      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    122       ! changed to old_frld and old ht_i 
    123  
    124124      DO jj = 1, jpj 
    125125         DO ji = 1, jpi 
    126             zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    127             ifvt    = zinda  *  MAX( rzero , SIGN( rone, - phicif(ji,jj) ) )  !subscripts are bad here 
    128             i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - at_i(ji,jj) ) ) 
    129             idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 
    130             iflt    = zinda  * (1 - i1mfr) * (1 - ifvt ) 
    131             ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr 
    132             iadv    = ( 1  - i1mfr ) * zinda 
    133             ifral   = ( 1  - i1mfr * ( 1 - ial ) )    
    134             ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv  
    135  
    136             ! switch --- 1.0 ---------------- 0.0 -------------------- 
    137             ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    138             ! zinda   | if pfrld = 1       | if pfrld < 1            | 
    139             !  -> ifvt| if pfrld old_ht_i 
    140             ! i1mfr   | if frld = 1        | if frld  < 1            | 
    141             ! idfr    | if frld <= pfrld    | if frld > pfrld        | 
    142             ! iflt    |  
    143             ! ial     | 
    144             ! iadv    | 
    145             ! ifral 
    146             ! ifrdv 
    147  
    148             !   computation the solar flux at ocean surface 
    149             IF (lk_cpl) THEN ! be carfeful: not been tested yet 
    150                ! original line 
    151                !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 
    152                ! new line to include solar penetration (not tested) 
    153                zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
    154                DO jl = 1, jpl 
    155                   zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 
    156                END DO 
    157             ELSE 
    158                zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
    159                     &    ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
    160             ENDIF 
    161             ! fstric     Solar flux transmitted trough the ice 
    162             ! qsr        Net short wave heat flux on free ocean 
    163             ! new line 
    164             fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
    165  
    166             ! solar flux and fscmbq with light penetration (clem) 
    167             zzfcm1  = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 
    168             zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 
    169  
    170             !  computation the non solar heat flux at ocean surface 
    171             zfcm2 = - zzfcm1                                                                    & ! 
    172                &    + iflt    * zfscmbq                                                         & ! total ablation: heat given to the ocean 
    173                &    + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   & 
    174                &    + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice   & 
    175                &    + fhmec(ji,jj)                                                              & ! snow melt when ridging 
    176                &    + fheat_mec(ji,jj)                                                          & ! ridge formation 
    177                &    + fheat_res(ji,jj)                                                            ! residual heat flux 
    178             ! qcmif   Energy needed to bring the ocean surface layer until its freezing (ok) 
    179             ! qldif   heat balance of the lead (or of the open ocean) 
    180             ! qfvbq   latent heat uptake/release after accretion/ablation 
    181             ! qdtcn   Energy from the turbulent oceanic heat flux heat flux coming in the lead 
    182  
    183             IF( num_sal == 2 )   zfcm2 = zfcm2 + fhbri(ji,jj)    ! add contribution due to brine drainage  
    184  
    185             ! bottom radiative component is sent to the computation of the oceanic heat flux 
    186             fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj)      
    187  
    188             ! used to compute the oceanic heat flux at the next time step 
    189             qsr(ji,jj) = zfcm1                                       ! solar heat flux  
    190             qns(ji,jj) = zfcm2 - fdtcn(ji,jj)                        ! non solar heat flux 
    191             !                           ! fdtcn : turbulent oceanic heat flux 
    192          END DO 
    193       END DO 
    194  
    195       !------------------------------------------! 
    196       !      mass flux at the ocean surface      ! 
    197       !------------------------------------------! 
    198  
    199 !!gm   optimisation: this loop have to be merged with the previous one 
    200       DO jj = 1, jpj 
    201          DO ji = 1, jpi 
     126 
     127            !------------------------------------------! 
     128            !      heat flux at the ocean surface      ! 
     129            !------------------------------------------! 
     130            ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
     131            !--------------------------------------------------- 
     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 
     136 
     137            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
     138            !--------------------------------------------------- 
     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) 
     145 
     146            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
     147            !--------------------------------------------------- 
     148            qsr(ji,jj) = zqsr                                       
     149            qns(ji,jj) = hfx_out(ji,jj) - zqsr               
     150 
     151            !------------------------------------------! 
     152            !      mass flux at the ocean surface      ! 
     153            !------------------------------------------! 
    202154            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 
    203155            !  -------------------------------------------------------------------------------------  
    … …  
    208160            !                     Even if i see Ice melting as a FW and SALT flux 
    209161            !         
    210  
    211             !  computing freshwater exchanges at the ice/ocean interface 
    212             IF (lk_cpl) THEN  
    213                zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
    214                   &   - rdm_snw(ji,jj) / rdt_ice 
    215             ELSE 
    216                zemp =   emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
    217                   &   - tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
    218                   &   + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
    219                   &   - fmmec(ji,jj)                                         ! snow falling when ridging 
    220             ENDIF 
    221  
    222             ! mass flux at the ocean/ice interface (sea ice fraction) 
    223             zemp_snw = rdm_snw(ji,jj) * r1_rdtice                         ! snow melting = pure water that enters the ocean 
    224             zfmm     = rdm_ice(ji,jj) * r1_rdtice                         ! Freezing minus melting   
    225  
    226             fmmflx(ji,jj) = zfmm                                     ! F/M mass flux save at least for biogeochemical model 
    227  
    228             emp(ji,jj) = zemp + zemp_snw + zfmm  ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     162            ! mass flux from ice/ocean 
     163            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
     164                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     165 
     166            ! mass flux at the ocean/ice interface 
     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) 
    229169             
    230             !  correcting brine salt fluxes   (zinda = 1  if pfrld=1 , =0 otherwise) 
    231             zinda        = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    232             sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj) 
    233170         END DO 
    234171      END DO 
    … …  
    237174      !      salt flux at the ocean surface      ! 
    238175      !------------------------------------------! 
    239  
    240       IF( num_sal == 2 ) THEN      ! variable ice salinity: brine drainage included in the salt flux 
    241          sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 
    242       ELSE                         ! constant ice salinity: 
    243          sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 
    244       ENDIF 
    245       !-----------------------------------------------! 
    246       !   mass of snow and ice per unit area          ! 
    247       !-----------------------------------------------! 
    248       IF( nn_ice_embd /= 0 ) THEN                               ! embedded sea-ice (mass required) 
    249          snwice_mass_b(:,:) = snwice_mass(:,:)                  ! save mass from the previous ice time step 
    250          !                                                      ! new mass per unit area 
    251          snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
    252          !                                                      ! time evolution of snow+ice mass 
     176      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
     177         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 
     178 
     179      !-------------------------------------------------------------! 
     180      !   mass of snow and ice per unit area for embedded sea-ice   ! 
     181      !-------------------------------------------------------------! 
     182      IF( nn_ice_embd /= 0 ) THEN 
     183         ! save mass from the previous ice time step 
     184         snwice_mass_b(:,:) = snwice_mass(:,:)                   
     185         ! new mass per unit area 
     186         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
     187         ! time evolution of snow+ice mass 
    253188         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
    254189      ENDIF 
    … …  
    260195      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                       
    261196 
    262       !------------------------------------------------! 
    263       !    Computation of snow/ice and ocean albedo    ! 
    264       !------------------------------------------------! 
    265       IF( lk_cpl ) THEN          ! coupled case 
    266          CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo 
    267          ! 
    268          alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys) 
    269       ENDIF 
     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 - ' ) 
    270210 
    271211      IF(ln_ctl) THEN 
    … …  
    275215         CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    276216      ENDIF 
    277       ! 
    278       IF( lk_cpl )   CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 
    279       !  
     217 
    280218   END SUBROUTINE lim_sbc_flx 
    281219 
    … …  
    315253      ! 
    316254      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    317 !CDIR NOVERRCHK 
    318255         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point) 
    319 !CDIR NOVERRCHK 
    320256            DO ji = fs_2, fs_jpim1 
    321257               !                                               ! 2*(U_ice-U_oce) at T-point 
    … …  
    367303      !! ** input   : Namelist namicedia 
    368304      !!------------------------------------------------------------------- 
    369       REAL(wp) :: zsum, zarea 
    370       ! 
    371305      INTEGER  ::   ji, jj, jk                       ! dummy loop indices 
    372306      REAL(wp) ::   zcoefu, zcoefv, zcoeff          ! local scalar 
    … …  
    388322         END WHERE 
    389323      ENDIF 
    390       ! clem modif 
    391       IF( .NOT. ln_rstart ) THEN 
    392          iatte(:,:) = 1._wp 
    393          oatte(:,:) = 1._wp 
    394       ENDIF 
    395       ! 
    396       ! clem: snwice_mass in the restart file now 
     324      ! 
    397325      IF( .NOT. ln_rstart ) THEN 
    398326         !                                      ! embedded sea ice 
    399327         IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    400             snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
     328            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
    401329            snwice_mass_b(:,:) = snwice_mass(:,:) 
    402330         ELSE 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4624 r5832  
    88   !!            3.0  ! 2005-11 (M. Vancoppenolle)  LIM-3 : Multi-layer thermodynamics + salinity variations 
    99   !!             -   ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif 
    10    !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw 
     10   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw 
    1111   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 
    1212   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
    … …  
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain variables 
    24    USE oce     , ONLY :  iatte, oatte 
    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 
    … …  
    4342   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4443   USE timing         ! Timing 
     44   USE limcons        ! conservation tests 
     45   USE limctl 
    4546 
    4647   IMPLICIT NONE 
    4748   PRIVATE 
    4849 
    49    PUBLIC   lim_thd        ! called by limstp module 
    50    PUBLIC   lim_thd_init   ! called by iceini module 
    51  
    52    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   zzero  = 0._wp      ! 
    54    REAL(wp) ::   zone   = 1._wp      ! 
     50   PUBLIC   lim_thd         ! called by limstp module 
     51   PUBLIC   lim_thd_init    ! called by sbc_lim_init 
    5552 
    5653   !! * Substitutions 
    … …  
    6865      !!                ***  ROUTINE lim_thd  ***        
    6966      !!   
    70       !! ** Purpose : This routine manages the ice thermodynamic. 
     67      !! ** Purpose : This routine manages ice thermodynamics 
    7168      !!          
    7269      !! ** Action : - Initialisation of some variables 
    … …  
    7471      !!               at the ice base, snow acc.,heat budget of the leads) 
    7572      !!             - selection of the icy points and put them in an array 
    76       !!             - call lim_vert_ther for vert ice thermodynamic 
    77       !!             - back to the geographic grid 
    78       !!             - selection of points for lateral accretion 
    79       !!             - call lim_lat_acc  for the ice accretion 
     73      !!             - call lim_thd_dif  for vertical heat diffusion 
     74      !!             - call lim_thd_dh   for vertical ice growth and melt 
     75      !!             - call lim_thd_ent  for enthalpy remapping 
     76      !!             - call lim_thd_sal  for ice desalination 
     77      !!             - call lim_thd_temp to  retrieve temperature from ice enthalpy 
    8078      !!             - back to the geographic grid 
    8179      !!      
    82       !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
     80      !! ** References :  
    8381      !!--------------------------------------------------------------------- 
    84       INTEGER, INTENT(in) ::   kt    ! number of iteration 
     82      INTEGER, INTENT(in) :: kt    ! number of iteration 
    8583      !! 
    86       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    87       INTEGER  ::   nbpb             ! nb of icy pts for thermo. cal. 
    88       REAL(wp) ::   zfric_umin = 5e-03_wp    ! lower bound for the friction velocity 
    89       REAL(wp) ::   zfric_umax = 2e-02_wp    ! upper bound for the friction velocity 
    90       REAL(wp) ::   zinda, zindb, zthsnice, zfric_u     ! local scalar 
    91       REAL(wp) ::   zfntlat, zpareff, zareamin, zcoef   !    -         - 
    92       REAL(wp), POINTER, DIMENSION(:,:) ::   zqlbsbq   ! link with lead energy budget qldif 
    93       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    94       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     84      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
     85      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations 
     86      INTEGER  :: ii, ij           ! temporary dummy loop index 
     87      REAL(wp) :: zfric_u, zqld, zqfr 
     88      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     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      !!------------------------------------------------------------------- 
     93 
    9694      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    9795 
    98       CALL wrk_alloc( jpi, jpj, zqlbsbq ) 
    99     
    100       ! ------------------------------- 
    101       !- check conservation (C Rousset) 
    102       IF (ln_limdiahsb) THEN 
    103          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    104          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    105          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    106          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    107       ENDIF 
    108       !- check conservation (C Rousset) 
    109       ! ------------------------------- 
    110  
    111       !------------------------------------------------------------------------------! 
    112       ! 1) Initialization of diagnostic variables                                    ! 
    113       !------------------------------------------------------------------------------! 
     96      ! conservation test 
     97      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     98 
     99      CALL lim_var_glo2eqv 
     100      !------------------------------------------------------------------------! 
     101      ! 1) Initialization of some variables                                    ! 
     102      !------------------------------------------------------------------------! 
     103      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice 
    114104 
    115105      !-------------------- 
    116106      ! 1.2) Heat content     
    117107      !-------------------- 
    118       ! 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 
    119109      DO jl = 1, jpl 
    120110         DO jk = 1, nlay_i 
    121111            DO jj = 1, jpj 
    122112               DO ji = 1, jpi 
     113                  !0 if no ice and 1 if yes 
     114                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  ) 
    123115                  !Energy of melting q(S,T) [J.m-3] 
    124                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 
    125                   !0 if no ice and 1 if yes 
    126                   zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  ) 
    127                   !convert units ! very important that this line is here 
    128                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb  
     116                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i ) 
    129117               END DO 
    130118            END DO 
    … …  
    133121            DO jj = 1, jpj 
    134122               DO ji = 1, jpi 
     123                  !0 if no ice and 1 if yes 
     124                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 )  ) 
    135125                  !Energy of melting q(S,T) [J.m-3] 
    136                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 
    137                   !0 if no ice and 1 if yes 
    138                   zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  ) 
    139                   !convert units ! very important that this line is here 
    140                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb  
     126                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s ) 
    141127               END DO 
    142128            END DO 
    … …  
    144130      END DO 
    145131 
    146       !----------------------------------- 
    147       ! 1.4) Compute global heat content 
    148       !----------------------------------- 
    149       qt_i_in  (:,:) = 0.e0 
    150       qt_s_in  (:,:) = 0.e0 
    151       qt_i_fin (:,:) = 0.e0 
    152       qt_s_fin (:,:) = 0.e0 
    153       sum_fluxq(:,:) = 0.e0 
    154       fatm     (:,:) = 0.e0 
    155  
    156132      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    157133      !-----------------------------------------------------------------------------! 
    158  
    159 !CDIR NOVERRCHK 
    160134      DO jj = 1, jpj 
    161 !CDIR NOVERRCHK 
    162135         DO ji = 1, jpi 
    163             zinda          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) + epsi10 ) ) ) 
     136            rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
    164137            ! 
    165138            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
    … …  
    168141            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
    169142            !           !  temperature and turbulent mixing (McPhee, 1992) 
    170             ! friction velocity 
    171             zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )  
    172  
    173             ! here the drag will depend on ice thickness and type (0.006) 
    174             fdtcn(ji,jj)  = zinda * rau0 * rcp * 0.006  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) )  
    175             ! also category dependent 
    176             !           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead  
    177             qdtcn(ji,jj)  = zinda * fdtcn(ji,jj) * ( 1.0 - at_i(ji,jj) ) * rdt_ice 
    178             !                        
    179             !           !-- Lead heat budget, qldif (part 1, next one is in limthd_dh)  
    180             !           !   caution: exponent betas used as more snow can fallinto leads 
    181             qldif(ji,jj) =  tms(ji,jj) * rdt_ice  * (                             & 
    182                &   pfrld(ji,jj)        * (  qsr(ji,jj) * oatte(ji,jj)             &   ! solar heat + clem modif 
    183                &                            + qns(ji,jj)                          &   ! non solar heat 
    184                &                            + fdtcn(ji,jj)                        &   ! turbulent ice-ocean heat 
    185                &                            + fsbbq(ji,jj) * ( 1.0 - zinda )  )   &   ! residual heat from previous step 
    186                & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus                    )   ! latent heat of sprecip melting 
    187143            ! 
    188             ! Positive heat budget is used for bottom ablation 
    189             zfntlat        = 1.0 - MAX( zzero , SIGN( zone ,  - qldif(ji,jj) ) ) 
    190             != 1 if positive heat budget 
    191             zpareff        = 1.0 - zinda * zfntlat 
    192             != 0 if ice and positive heat budget and 1 if one of those two is false 
    193             zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / ( rdt_ice * MAX( at_i(ji,jj), epsi10 ) ) 
     144            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
     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 
     158 
     159            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 
     160            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
     161 
     162            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting  
     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 
     165               qlead(ji,jj) = 0._wp 
     166            ELSE 
     167               fhld (ji,jj) = 0._wp 
     168            ENDIF 
    194169            ! 
    195             ! Heat budget of the lead, energy transferred from ice to ocean 
    196             qldif  (ji,jj) = zpareff * qldif(ji,jj) 
    197             qdtcn  (ji,jj) = zpareff * qdtcn(ji,jj) 
    198             ! 
    199             ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx) 
    200             qcmif  (ji,jj) =  rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
    201             ! 
    202             ! oceanic heat flux (limthd_dh) 
    203             fbif   (ji,jj) = zinda * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) + fdtcn(ji,jj) ) 
    204             ! 
     170            ! ----------------------------------------- 
     171            ! Net heat flux on top of ice-ocean [W.m-2] 
     172            ! ----------------------------------------- 
     173            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
     174 
     175            ! ----------------------------------------------------------------------------- 
     176            ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
     177            ! ----------------------------------------------------------------------------- 
     178            !     First  step here              :  non solar + precip - qlead - qturb 
     179            !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
     180            !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     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) 
    205186         END DO 
    206187      END DO 
    … …  
    217198         ENDIF 
    218199 
    219          zareamin = epsi10 
    220200         nbpb = 0 
    221201         DO jj = 1, jpj 
    222202            DO ji = 1, jpi 
    223                IF ( a_i(ji,jj,jl) .gt. zareamin ) THEN      
     203               IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
    224204                  nbpb      = nbpb  + 1 
    225205                  npb(nbpb) = (jj - 1) * jpi + ji 
    … …  
    230210         ! debug point to follow 
    231211         jiindex_1d = 0 
    232          IF( ln_nicep ) THEN 
    233             DO ji = mi0(jiindx), mi1(jiindx) 
    234                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) 
    235215                  jiindex_1d = (jj - 1) * jpi + ji 
     216                  WRITE(numout,*) ' lim_thd : Category no : ', jl  
    236217               END DO 
    237218            END DO 
    … …  
    246227         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing. 
    247228 
    248             !------------------------- 
    249             ! 4.1 Move to 1D arrays 
    250             !------------------------- 
    251  
    252             CALL tab_2d_1d( nbpb, at_i_b     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
    253             CALL tab_2d_1d( nbpb, a_i_b      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
    254             CALL tab_2d_1d( nbpb, ht_i_b     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    255             CALL tab_2d_1d( nbpb, ht_s_b     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    256  
    257             CALL tab_2d_1d( nbpb, t_su_b     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    258             CALL tab_2d_1d( nbpb, sm_i_b     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    259             DO jk = 1, nlay_s 
    260                CALL tab_2d_1d( nbpb, t_s_b(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    261                CALL tab_2d_1d( nbpb, q_s_b(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    262             END DO 
    263             DO jk = 1, nlay_i 
    264                CALL tab_2d_1d( nbpb, t_i_b(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    265                CALL tab_2d_1d( nbpb, q_i_b(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    266                CALL tab_2d_1d( nbpb, s_i_b(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    267             END DO 
    268  
    269             CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:)   , jpi, jpj, npb(1:nbpb) ) 
    270             CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    271             CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
    272             CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) ) 
    273             CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    274 #if ! defined key_coupled 
    275             CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    276             CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    277 #endif 
    278             CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    279             CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
    280             CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) )  
    281             CALL tab_2d_1d( nbpb, fbif_1d    (1:nbpb), fbif            , jpi, jpj, npb(1:nbpb) ) 
    282             CALL tab_2d_1d( nbpb, qldif_1d   (1:nbpb), qldif           , jpi, jpj, npb(1:nbpb) ) 
    283             CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice         , jpi, jpj, npb(1:nbpb) ) 
    284             CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw         , jpi, jpj, npb(1:nbpb) ) 
    285             CALL tab_2d_1d( nbpb, dmgwi_1d   (1:nbpb), dmgwi           , jpi, jpj, npb(1:nbpb) ) 
    286             CALL tab_2d_1d( nbpb, qlbbq_1d   (1:nbpb), zqlbsbq         , jpi, jpj, npb(1:nbpb) ) 
    287  
    288             CALL tab_2d_1d( nbpb, sfx_thd_1d (1:nbpb), sfx_thd         , jpi, jpj, npb(1:nbpb) ) 
    289             CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    290             CALL tab_2d_1d( nbpb, fhbri_1d   (1:nbpb), fhbri           , jpi, jpj, npb(1:nbpb) ) 
    291             CALL tab_2d_1d( nbpb, fstbif_1d  (1:nbpb), fstric          , jpi, jpj, npb(1:nbpb) ) 
    292             CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq           , jpi, jpj, npb(1:nbpb) ) 
    293  
    294             CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) ) ! clem modif 
    295             CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) ) ! clem modif 
    296             !-------------------------------- 
    297             ! 4.3) Thermodynamic processes 
    298             !-------------------------------- 
    299  
    300             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_enmelt( 1, nbpb )   ! computes sea ice energy of melting 
    301             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_glohec( qt_i_in, qt_s_in, q_i_layer_in, 1, nbpb, jl ) 
    302  
    303             !                                 !---------------------------------! 
    304             CALL lim_thd_dif( 1, nbpb, jl )   ! Ice/Snow Temperature profile    ! 
    305             !                                 !---------------------------------! 
    306  
    307             CALL lim_thd_enmelt( 1, nbpb )    ! computes sea ice energy of melting compulsory for limthd_dh 
    308  
    309             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_glohec ( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl )  
    310             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_con_dif( 1 , nbpb , jl ) 
    311  
    312             !                                 !---------------------------------! 
    313             CALL lim_thd_dh( 1, nbpb, jl )    ! Ice/Snow thickness              !  
    314             !                                 !---------------------------------! 
    315  
    316             !                                 !---------------------------------! 
    317             CALL lim_thd_ent( 1, nbpb, jl )   ! Ice/Snow enthalpy remapping     ! 
    318             !                                 !---------------------------------! 
    319  
    320             !                                 !---------------------------------! 
    321             CALL lim_thd_sal( 1, nbpb )       ! Ice salinity computation        ! 
    322             !                                 !---------------------------------! 
    323  
    324             !           CALL lim_thd_enmelt(1,nbpb)   ! computes sea ice energy of melting 
    325             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_glohec( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl )  
    326             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_con_dh ( 1 , nbpb , jl ) 
    327  
    328             !-------------------------------- 
    329             ! 4.4) Move 1D to 2D vectors 
    330             !-------------------------------- 
    331  
    332                CALL tab_1d_2d( nbpb, at_i          , npb, at_i_b    (1:nbpb)   , jpi, jpj ) 
    333                CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_b    (1:nbpb)   , jpi, jpj ) 
    334                CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_b    (1:nbpb)   , jpi, jpj ) 
    335                CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_b     (1:nbpb)   , jpi, jpj ) 
    336                CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_b    (1:nbpb)   , jpi, jpj ) 
    337                CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_b    (1:nbpb)   , jpi, jpj ) 
    338             DO jk = 1, nlay_s 
    339                CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b     (1:nbpb,jk), jpi, jpj) 
    340                CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b     (1:nbpb,jk), jpi, jpj) 
    341             END DO 
    342             DO jk = 1, nlay_i 
    343                CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b     (1:nbpb,jk), jpi, jpj) 
    344                CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b     (1:nbpb,jk), jpi, jpj) 
    345                CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b     (1:nbpb,jk), jpi, jpj) 
    346             END DO 
    347                CALL tab_1d_2d( nbpb, fstric        , npb, fstbif_1d (1:nbpb)   , jpi, jpj ) 
    348                CALL tab_1d_2d( nbpb, qldif         , npb, qldif_1d  (1:nbpb)   , jpi, jpj ) 
    349                CALL tab_1d_2d( nbpb, qfvbq         , npb, qfvbq_1d  (1:nbpb)   , jpi, jpj ) 
    350                CALL tab_1d_2d( nbpb, rdm_ice       , npb, rdm_ice_1d(1:nbpb)   , jpi, jpj ) 
    351                CALL tab_1d_2d( nbpb, rdm_snw       , npb, rdm_snw_1d(1:nbpb)   , jpi, jpj ) 
    352                CALL tab_1d_2d( nbpb, dmgwi         , npb, dmgwi_1d  (1:nbpb)   , jpi, jpj ) 
    353                CALL tab_1d_2d( nbpb, rdvosif       , npb, dvsbq_1d  (1:nbpb)   , jpi, jpj ) 
    354                CALL tab_1d_2d( nbpb, rdvobif       , npb, dvbbq_1d  (1:nbpb)   , jpi, jpj ) 
    355                CALL tab_1d_2d( nbpb, fdvolif       , npb, dvlbq_1d  (1:nbpb)   , jpi, jpj ) 
    356                CALL tab_1d_2d( nbpb, rdvonif       , npb, dvnbq_1d  (1:nbpb)   , jpi, jpj )  
    357                CALL tab_1d_2d( nbpb, sfx_thd       , npb, sfx_thd_1d(1:nbpb)   , jpi, jpj ) 
    358             ! 
    359             IF( num_sal == 2 ) THEN 
    360                CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
    361                CALL tab_1d_2d( nbpb, fhbri         , npb, fhbri_1d  (1:nbpb)   , jpi, jpj ) 
    362             ENDIF 
    363             ! 
    364             !+++++       temporary stuff for a dummy version 
    365             CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj ) 
    366             CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj ) 
    367             CALL tab_1d_2d( nbpb, fsup2D     , npb, fsup     (1:nbpb)      , jpi, jpj ) 
    368             CALL tab_1d_2d( nbpb, focea2D    , npb, focea    (1:nbpb)      , jpi, jpj ) 
    369             CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj ) 
    370             CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj ) 
    371             CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 
    372             !+++++ 
     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 ) 
     238 
     239            !---------------------------------! 
     240            ! --- Ice/Snow thickness ---      ! 
     241            !---------------------------------! 
     242            CALL lim_thd_dh( 1, nbpb )     
     243 
     244            ! --- Ice enthalpy remapping --- ! 
     245            CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  
     246                                             
     247            !---------------------------------! 
     248            ! --- Ice salinity ---            ! 
     249            !---------------------------------! 
     250            CALL lim_thd_sal( 1, nbpb )     
     251 
     252            !---------------------------------! 
     253            ! --- temperature update ---      ! 
     254            !---------------------------------! 
     255            CALL lim_thd_temp( 1, nbpb ) 
     256 
     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 
    373269            ! 
    374270            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
    375271         ENDIF 
    376272         ! 
    377       END DO 
     273      END DO !jl 
    378274 
    379275      !------------------------------------------------------------------------------! 
    … …  
    382278 
    383279      !------------------------ 
    384       ! 5.1) Ice heat content               
     280      ! Ice heat content               
    385281      !------------------------ 
    386       ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    387       zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 
     282      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    388283      DO jl = 1, jpl 
    389284         DO jk = 1, nlay_i 
    390             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef 
     285            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 
    391286         END DO 
    392287      END DO 
    393288 
    394289      !------------------------ 
    395       ! 5.2) Snow heat content               
     290      ! Snow heat content               
    396291      !------------------------ 
    397       ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    398       zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 
     292      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    399293      DO jl = 1, jpl 
    400294         DO jk = 1, nlay_s 
    401             e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef 
     295            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 
    402296         END DO 
    403297      END DO 
    404  
     298  
    405299      !---------------------------------- 
    406       ! 5.3) Change thickness to volume 
     300      ! Change thickness to volume 
    407301      !---------------------------------- 
    408       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 
    409317 
    410318      !-------------------------------------------- 
    411       ! 5.4) Diagnostic thermodynamic growth rates 
     319      ! Diagnostic thermodynamic growth rates 
    412320      !-------------------------------------------- 
    413 !clem@useless      d_v_i_thd(:,:,:) = v_i      (:,:,:) - old_v_i(:,:,:)    ! ice volumes  
    414 !clem@mv-to-itd    dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    415  
    416       IF( con_i .AND. jiindex_1d > 0 )   fbif(:,:) = fbif(:,:) + zqlbsbq(:,:) 
     321      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print 
    417322 
    418323      IF(ln_ctl) THEN            ! Control print 
    … …  
    420325         CALL prt_ctl_info(' - Cell values : ') 
    421326         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    422          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_thd  : cell area :') 
     327         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd  : cell area :') 
    423328         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :') 
    424329         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :') 
    … …  
    448353      ENDIF 
    449354      ! 
    450       ! ------------------------------- 
    451       !- check conservation (C Rousset) 
    452       IF (ln_limdiahsb) THEN 
    453          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    454          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     355      ! 
     356      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 
     411      ! 
     412      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
     413 
     414   END SUBROUTINE lim_thd  
     415 
    455416  
    456          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    457          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    458  
    459          zchk_vmin = glob_min(v_i) 
    460          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    461          zchk_amin = glob_min(a_i) 
    462         
    463          IF(lwp) THEN 
    464             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limthd) = ',(zchk_v_i * rday) 
    465             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limthd) = ',(zchk_smv * rday) 
    466             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limthd) = ',(zchk_vmin * 1.e-3) 
    467             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limthd) = ',zchk_amax 
    468             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limthd) = ',zchk_amin 
    469          ENDIF 
    470       ENDIF 
    471       !- check conservation (C Rousset) 
    472       ! ------------------------------- 
    473       ! 
    474       CALL wrk_dealloc( jpi, jpj, zqlbsbq ) 
    475       ! 
    476       IF( nn_timing == 1 )  CALL timing_stop('limthd') 
    477    END SUBROUTINE lim_thd 
    478  
    479  
    480    SUBROUTINE lim_thd_glohec( eti, ets, etilayer, kideb, kiut, jl ) 
     417   SUBROUTINE lim_thd_temp( kideb, kiut ) 
    481418      !!----------------------------------------------------------------------- 
    482       !!                   ***  ROUTINE lim_thd_glohec ***  
     419      !!                   ***  ROUTINE lim_thd_temp ***  
    483420      !!                  
    484       !! ** Purpose :  Compute total heat content for each category 
    485       !!               Works with 1d vectors only 
    486       !!----------------------------------------------------------------------- 
    487       INTEGER , INTENT(in   )                         ::   kideb, kiut   ! bounds for the spatial loop 
    488       INTEGER , INTENT(in   )                         ::   jl            ! category number 
    489       REAL(wp), INTENT(  out), DIMENSION (jpij,jpl  ) ::   eti, ets      ! vertically-summed heat content for ice & snow 
    490       REAL(wp), INTENT(  out), DIMENSION (jpij,jkmax) ::   etilayer      ! heat content for ice layers 
    491       !! 
    492       INTEGER  ::   ji,jk   ! loop indices 
    493       !!----------------------------------------------------------------------- 
    494       eti(:,:) = 0._wp 
    495       ets(:,:) = 0._wp 
    496       ! 
    497       DO jk = 1, nlay_i                ! total q over all layers, ice [J.m-2] 
    498          DO ji = kideb, kiut 
    499             etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 
    500             eti     (ji,jl) = eti(ji,jl) + etilayer(ji,jk)  
    501          END DO 
    502       END DO 
    503       DO ji = kideb, kiut              ! total q over all layers, snow [J.m-2] 
    504          ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / REAL( nlay_s ) 
    505       END DO 
    506       ! 
    507       WRITE(numout,*) ' lim_thd_glohec ' 
    508       WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) * r1_rdtice 
    509       WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) * r1_rdtice 
    510       WRITE(numout,*) ' qt_in   : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) * r1_rdtice 
    511       ! 
    512    END SUBROUTINE lim_thd_glohec 
    513  
    514  
    515    SUBROUTINE lim_thd_con_dif( kideb, kiut, jl ) 
    516       !!----------------------------------------------------------------------- 
    517       !!                   ***  ROUTINE lim_thd_con_dif ***  
    518       !!                  
    519       !! ** Purpose :   Test energy conservation after heat diffusion 
    520       !!------------------------------------------------------------------- 
    521       INTEGER , INTENT(in   ) ::   kideb, kiut   ! bounds for the spatial loop 
    522       INTEGER , INTENT(in   ) ::   jl            ! category number 
    523  
    524       INTEGER  ::   ji, jk         ! loop indices 
    525       INTEGER  ::   ii, ij 
    526       INTEGER  ::   numce          ! number of points for which conservation is violated 
    527       REAL(wp) ::   meance         ! mean conservation error 
    528       REAL(wp) ::   max_cons_err, max_surf_err 
    529       !!--------------------------------------------------------------------- 
    530  
    531       max_cons_err =  1.0_wp          ! maximum tolerated conservation error 
    532       max_surf_err =  0.001_wp        ! maximum tolerated surface error 
    533  
    534       !-------------------------- 
    535       ! Increment of energy 
    536       !-------------------------- 
    537       ! global 
    538       DO ji = kideb, kiut 
    539          dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 
    540       END DO 
    541       ! layer by layer 
    542       dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) 
    543  
    544       !---------------------------------------- 
    545       ! Atmospheric heat flux, ice heat budget 
    546       !---------------------------------------- 
    547       DO ji = kideb, kiut 
    548          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    549          ij =    ( npb(ji) - 1 ) / jpi + 1 
    550          fatm     (ji,jl) = qnsr_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) 
    551          sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(ii,ij,jl) 
    552       END DO 
    553  
    554       !-------------------- 
    555       ! Conservation error 
    556       !-------------------- 
    557       DO ji = kideb, kiut 
    558          cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    559       END DO 
    560  
    561       numce  = 0 
    562       meance = 0._wp 
    563       DO ji = kideb, kiut 
    564          IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 
    565             numce = numce + 1 
    566             meance = meance + cons_error(ji,jl) 
    567          ENDIF 
    568       END DO 
    569       IF( numce > 0 )   meance = meance / numce 
    570  
    571       WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 
    572       WRITE(numout,*) ' After lim_thd_dif, category : ', jl 
    573       WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 
    574       WRITE(numout,*) ' Number of points where there is a cons err gt than c.e. : ', numce, numit 
    575  
    576       !------------------------------------------------------- 
    577       ! Surface error due to imbalance between Fatm and Fcsu 
    578       !------------------------------------------------------- 
    579       numce  = 0 
    580       meance = 0._wp 
    581  
    582       DO ji = kideb, kiut 
    583          surf_error(ji,jl) = ABS ( fatm(ji,jl) - fc_su(ji) ) 
    584          IF( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) THEN 
    585             numce = numce + 1  
    586             meance = meance + surf_error(ji,jl) 
    587          ENDIF 
    588       ENDDO 
    589       IF( numce > 0 )   meance = meance / numce 
    590  
    591       WRITE(numout,*) ' Maximum tolerated surface error : ', max_surf_err 
    592       WRITE(numout,*) ' After lim_thd_dif, category : ', jl 
    593       WRITE(numout,*) ' Mean surface error on big error points ', meance, numit 
    594       WRITE(numout,*) ' Number of points where there is a surf err gt than surf_err : ', numce, numit 
    595  
    596       WRITE(numout,*) ' fc_su      : ', fc_su(jiindex_1d) 
    597       WRITE(numout,*) ' fatm       : ', fatm(jiindex_1d,jl) 
    598       WRITE(numout,*) ' t_su       : ', t_su_b(jiindex_1d) 
    599  
    600       !--------------------------------------- 
    601       ! Write ice state in case of big errors 
    602       !--------------------------------------- 
    603       DO ji = kideb, kiut 
    604          IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. & 
    605             ( cons_error(ji,jl) .GT. max_cons_err  ) ) THEN 
    606             ii                 = MOD( npb(ji) - 1, jpi ) + 1 
    607             ij                 = ( npb(ji) - 1 ) / jpi + 1 
    608             ! 
    609             WRITE(numout,*) ' alerte 1     ' 
    610             WRITE(numout,*) ' Untolerated conservation / surface error after ' 
    611             WRITE(numout,*) ' heat diffusion in the ice ' 
    612             WRITE(numout,*) ' Category   : ', jl 
    613             WRITE(numout,*) ' ii , ij  : ', ii, ij 
    614             WRITE(numout,*) ' lat, lon   : ', gphit(ii,ij), glamt(ii,ij) 
    615             WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    616             WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 
    617             WRITE(numout,*) ' dq_i       : ', - dq_i(ji,jl) * r1_rdtice 
    618             WRITE(numout,*) ' Fdt        : ', sum_fluxq(ji,jl) 
    619             WRITE(numout,*) 
    620             !        WRITE(numout,*) ' qt_i_in   : ', qt_i_in(ji,jl) 
    621             !        WRITE(numout,*) ' qt_s_in   : ', qt_s_in(ji,jl) 
    622             !        WRITE(numout,*) ' qt_i_fin  : ', qt_i_fin(ji,jl) 
    623             !        WRITE(numout,*) ' qt_s_fin  : ', qt_s_fin(ji,jl) 
    624             !        WRITE(numout,*) ' qt        : ', qt_i_fin(ji,jl) + qt_s_fin(ji,jl) 
    625             WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
    626             WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
    627             WRITE(numout,*) ' t_su       : ', t_su_b(ji) 
    628             WRITE(numout,*) ' t_s        : ', t_s_b(ji,1) 
    629             WRITE(numout,*) ' t_i        : ', t_i_b(ji,1:nlay_i) 
    630             WRITE(numout,*) ' t_bo       : ', t_bo_b(ji) 
    631             WRITE(numout,*) ' q_i        : ', q_i_b(ji,1:nlay_i) 
    632             WRITE(numout,*) ' s_i        : ', s_i_b(ji,1:nlay_i) 
    633             WRITE(numout,*) ' tmelts     : ', rtt - tmut*s_i_b(ji,1:nlay_i) 
    634             WRITE(numout,*) 
    635             WRITE(numout,*) ' Fluxes ' 
    636             WRITE(numout,*) ' ~~~~~~ ' 
    637             WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
    638             WRITE(numout,*) ' fc_su      : ', fc_su    (ji) 
    639             WRITE(numout,*) ' fstr_inice : ', qsr_ice_1d(ji)*i0(ji) 
    640             WRITE(numout,*) ' fc_bo      : ', - fc_bo_i  (ji) 
    641             WRITE(numout,*) ' foc        : ', fbif_1d(ji) 
    642             WRITE(numout,*) ' fstroc     : ', fstroc   (ii,ij,jl) 
    643             WRITE(numout,*) ' i0         : ', i0(ji) 
    644             WRITE(numout,*) ' qsr_ice    : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
    645             WRITE(numout,*) ' qns_ice    : ', qnsr_ice_1d(ji) 
    646             WRITE(numout,*) ' Conduction fluxes : ' 
    647             WRITE(numout,*) ' fc_s      : ', fc_s(ji,0:nlay_s) 
    648             WRITE(numout,*) ' fc_i      : ', fc_i(ji,0:nlay_i) 
    649             WRITE(numout,*) 
    650             WRITE(numout,*) ' Layer by layer ... ' 
    651             WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 
    652             WRITE(numout,*) ' dfc_snow  : ', fc_s(ji,1) - fc_s(ji,0) 
    653             DO jk = 1, nlay_i 
    654                WRITE(numout,*) ' layer  : ', jk 
    655                WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) * r1_rdtice   
    656                WRITE(numout,*) ' radab  : ', radab(ji,jk) 
    657                WRITE(numout,*) ' dfc_i  : ', fc_i(ji,jk) - fc_i(ji,jk-1) 
    658                WRITE(numout,*) ' tot f  : ', fc_i(ji,jk) - fc_i(ji,jk-1) - radab(ji,jk) 
    659             END DO 
    660  
    661          ENDIF 
    662          ! 
    663       END DO 
    664       ! 
    665    END SUBROUTINE lim_thd_con_dif 
    666  
    667  
    668    SUBROUTINE lim_thd_con_dh( kideb, kiut, jl ) 
    669       !!----------------------------------------------------------------------- 
    670       !!                   ***  ROUTINE lim_thd_con_dh  ***  
    671       !!                  
    672       !! ** Purpose :   Test energy conservation after enthalpy redistr. 
    673       !!----------------------------------------------------------------------- 
    674       INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
    675       INTEGER, INTENT(in) ::   jl            ! category number 
    676       ! 
    677       INTEGER  ::   ji                ! loop indices 
    678       INTEGER  ::   ii, ij, numce         ! local integers 
    679       REAL(wp) ::   meance, max_cons_err    !local scalar 
    680       !!--------------------------------------------------------------------- 
    681  
    682       max_cons_err = 1._wp 
    683  
    684       !-------------------------- 
    685       ! Increment of energy 
    686       !-------------------------- 
    687       DO ji = kideb, kiut 
    688          dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl)   ! global 
    689       END DO 
    690       dq_i_layer(:,:)    = q_i_layer_fin(:,:) - q_i_layer_in(:,:)                            ! layer by layer 
    691  
    692       !---------------------------------------- 
    693       ! Atmospheric heat flux, ice heat budget 
    694       !---------------------------------------- 
    695       DO ji = kideb, kiut 
    696          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    697          ij =    ( npb(ji) - 1 ) / jpi + 1 
    698  
    699          fatm      (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji)                       ! total heat flux 
    700          sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(ii,ij,jl)  
    701          cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    702       END DO 
    703  
    704       !-------------------- 
    705       ! Conservation error 
    706       !-------------------- 
    707       DO ji = kideb, kiut 
    708          cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    709       END DO 
    710  
    711       numce = 0 
    712       meance = 0._wp 
    713       DO ji = kideb, kiut 
    714          IF( cons_error(ji,jl) .GT. max_cons_err ) THEN 
    715             numce = numce + 1 
    716             meance = meance + cons_error(ji,jl) 
    717          ENDIF 
    718       ENDDO 
    719       IF(numce > 0 ) meance = meance / numce 
    720  
    721       WRITE(numout,*) ' Error report - Category : ', jl 
    722       WRITE(numout,*) ' ~~~~~~~~~~~~ ' 
    723       WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 
    724       WRITE(numout,*) ' After lim_thd_ent, category : ', jl 
    725       WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 
    726       WRITE(numout,*) ' Number of points where there is a cons err gt than 0.1 W/m2 : ', numce, numit 
    727  
    728       !--------------------------------------- 
    729       ! Write ice state in case of big errors 
    730       !--------------------------------------- 
    731       DO ji = kideb, kiut 
    732          IF ( cons_error(ji,jl) .GT. max_cons_err  ) THEN 
    733             ii = MOD( npb(ji) - 1, jpi ) + 1 
    734             ij =    ( npb(ji) - 1 ) / jpi + 1 
    735             ! 
    736             WRITE(numout,*) ' alerte 1 - category : ', jl 
    737             WRITE(numout,*) ' Untolerated conservation error after limthd_ent ' 
    738             WRITE(numout,*) ' ii , ij  : ', ii, ij 
    739             WRITE(numout,*) ' lat, lon   : ', gphit(ii,ij), glamt(ii,ij) 
    740             WRITE(numout,*) ' * ' 
    741             WRITE(numout,*) ' Ftotal     : ', sum_fluxq(ji,jl) 
    742             WRITE(numout,*) ' dq_t       : ', - dq_i(ji,jl) * r1_rdtice 
    743             WRITE(numout,*) ' dq_i       : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) * r1_rdtice 
    744             WRITE(numout,*) ' dq_s       : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 
    745             WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    746             WRITE(numout,*) ' * ' 
    747             WRITE(numout,*) ' Fluxes        --- : ' 
    748             WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
    749             WRITE(numout,*) ' foce       : ', fbif_1d(ji) 
    750             WRITE(numout,*) ' fres       : ', ftotal_fin(ji) 
    751             WRITE(numout,*) ' fhbri      : ', fhbricat(ii,ij,jl) 
    752             WRITE(numout,*) ' * ' 
    753             WRITE(numout,*) ' Heat contents --- : ' 
    754             WRITE(numout,*) ' qt_s_in    : ', qt_s_in(ji,jl) * r1_rdtice 
    755             WRITE(numout,*) ' qt_i_in    : ', qt_i_in(ji,jl) * r1_rdtice 
    756             WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) * r1_rdtice 
    757             WRITE(numout,*) ' qt_s_fin   : ', qt_s_fin(ji,jl) * r1_rdtice 
    758             WRITE(numout,*) ' qt_i_fin   : ', qt_i_fin(ji,jl) * r1_rdtice 
    759             WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) * r1_rdtice 
    760             WRITE(numout,*) ' * ' 
    761             WRITE(numout,*) ' Ice variables --- : ' 
    762             WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
    763             WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
    764             WRITE(numout,*) ' dh_s_tot  : ', dh_s_tot(ji) 
    765             WRITE(numout,*) ' dh_snowice: ', dh_snowice(ji) 
    766             WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji) 
    767             WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    768          ENDIF 
    769          ! 
    770       END DO 
    771       ! 
    772    END SUBROUTINE lim_thd_con_dh 
    773  
    774  
    775    SUBROUTINE lim_thd_enmelt( kideb, kiut ) 
    776       !!----------------------------------------------------------------------- 
    777       !!                   ***  ROUTINE lim_thd_enmelt ***  
    778       !!                  
    779       !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) 
     421      !! ** Purpose :   Computes sea ice temperature (Kelvin) from enthalpy 
    780422      !! 
    781423      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
    … …  
    784426      !! 
    785427      INTEGER  ::   ji, jk   ! dummy loop indices 
    786       REAL(wp) ::   ztmelts  ! local scalar  
     428      REAL(wp) ::   ztmelts, zaaa, zbbb, zccc, zdiscrim  ! local scalar  
    787429      !!------------------------------------------------------------------- 
    788       ! 
    789       DO jk = 1, nlay_i             ! Sea ice energy of melting 
     430      ! Recover ice temperature 
     431      DO jk = 1, nlay_i 
    790432         DO ji = kideb, kiut 
    791             ztmelts      =  - tmut  * s_i_b(ji,jk) + rtt  
    792             q_i_b(ji,jk) =    rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) )                                 & 
    793                &                      + lfus * ( 1.0 - (ztmelts-rtt) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) )   & 
    794                &                      - rcp  * ( ztmelts-rtt  )  )  
    795          END DO 
     433            ztmelts       =  -tmut * s_i_1d(ji,jk) + rt0 
     434            ! Conversion q(S,T) -> T (second order equation) 
     435            zaaa          =  cpic 
     436            zbbb          =  ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus 
     437            zccc          =  lfus * ( ztmelts - rt0 ) 
     438            zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 
     439            t_i_1d(ji,jk) =  rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 
     440             
     441            ! mask temperature 
     442            rswitch       =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )  
     443            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0 
     444         END DO  
     445      END DO  
     446 
     447   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 
    796478      END DO 
    797       DO jk = 1, nlay_s             ! Snow energy of melting 
    798          DO ji = kideb, kiut 
    799             q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 
    800          END DO 
    801       END DO 
    802       ! 
    803    END SUBROUTINE lim_thd_enmelt 
     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 
    804616 
    805617 
    … …  
    817629      !!------------------------------------------------------------------- 
    818630      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    819       NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   & 
    820          &                hicmin, hiclim,                                        & 
    821          &                sbeta  , parlat, hakspl, hibspl, exld,                 & 
    822          &                hakdif, hnzst  , thth  , parsub, alphs, betas,         &  
    823          &                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 
    824634      !!------------------------------------------------------------------- 
    825635      ! 
    … …  
    839649      IF(lwm) WRITE ( numoni, namicethd ) 
    840650      ! 
     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 
     656      ! 
    841657      IF(lwp) THEN                          ! control print 
    842658         WRITE(numout,*) 
    843659         WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation ' 
    844          WRITE(numout,*)'      maximum melting at the bottom                           hmelt        = ', hmelt 
    845          WRITE(numout,*)'      ice thick. for lateral accretion in NH (SH)             hiccrit(1/2) = ', hiccrit 
    846          WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       fraz_swi     = ', fraz_swi 
    847          WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   maxfrazb     = ', maxfrazb 
    848          WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  vfrazb       = ', vfrazb 
    849          WRITE(numout,*)'      Squeezing coefficient for collection of frazil          Cfrazb       = ', Cfrazb 
    850          WRITE(numout,*)'      ice thick. corr. to max. energy stored in brine pocket  hicmin       = ', hicmin   
    851          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  
    852666         WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice ' 
    853          WRITE(numout,*)'      Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)   sbeta        = ', sbeta 
    854          WRITE(numout,*)'      percentage of energy used for lateral ablation          parlat       = ', parlat 
    855          WRITE(numout,*)'      slope of distr. for Hakkinen-Mellor lateral melting     hakspl       = ', hakspl   
    856          WRITE(numout,*)'      slope of distribution for Hibler lateral melting        hibspl       = ', hibspl 
    857          WRITE(numout,*)'      exponent for leads-closure rate                         exld         = ', exld 
    858          WRITE(numout,*)'      coefficient for diffusions of ice and snow              hakdif       = ', hakdif 
    859          WRITE(numout,*)'      threshold thick. for comp. of eq. thermal conductivity  zhth         = ', thth  
    860          WRITE(numout,*)'      thickness of the surf. layer in temp. computation       hnzst        = ', hnzst 
    861          WRITE(numout,*)'      switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub   
    862          WRITE(numout,*)'      coefficient for snow density when snow ice formation    alphs        = ', alphs 
    863          WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          betas        = ', betas 
    864          WRITE(numout,*)'      extinction radiation parameter in sea ice (1.0)         kappa_i      = ', kappa_i 
    865          WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nconv_i_thd  = ', nconv_i_thd 
    866          WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd 
    867          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 
     672         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 
    868675      ENDIF 
    869       ! 
    870       rcdsn = hakdif * rcdsn  
    871       rcdic = hakdif * rcdic 
    872676      ! 
    873677   END SUBROUTINE lim_thd_init 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r4333 r5832  
    66   !! History :  LIM  ! 2003-05 (M. Vancoppenolle) Original code in 1D 
    77   !!                 ! 2005-06 (M. Vancoppenolle) 3D version  
    8    !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw & rdm_ice 
     8   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw & wfx_ice 
    99   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
    1010   !!            3.5  ! 2012-10 (G. Madec & co) salt flux + bug fixes  
    … …  
    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 
    … …  
    2625   USE wrk_nemo       ! work arrays 
    2726   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    28  
     27    
    2928   IMPLICIT NONE 
    3029   PRIVATE 
    3130 
    32    PUBLIC   lim_thd_dh   ! called by lim_thd 
    33  
    34    REAL(wp) ::   epsi20 = 1.e-20   ! constant values 
    35    REAL(wp) ::   epsi10 = 1.e-10   ! 
    36    REAL(wp) ::   epsi13 = 1.e-13   ! 
    37    REAL(wp) ::   zzero  = 0._wp    ! 
    38    REAL(wp) ::   zone   = 1._wp    ! 
     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 
    3937 
    4038   !!---------------------------------------------------------------------- 
    … …  
    4543CONTAINS 
    4644 
    47    SUBROUTINE lim_thd_dh( kideb, kiut, jl ) 
     45   SUBROUTINE lim_thd_dh( kideb, kiut ) 
    4846      !!------------------------------------------------------------------ 
    4947      !!                ***  ROUTINE lim_thd_dh  *** 
    … …  
    7068      !!------------------------------------------------------------------ 
    7169      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    72       INTEGER , INTENT(in) ::   jl            ! Thickness cateogry number 
    7370      !!  
    7471      INTEGER  ::   ji , jk        ! dummy loop indices 
    7572      INTEGER  ::   ii, ij         ! 2D corresponding indices to ji 
    76       INTEGER  ::   isnow          ! switch for presence (1) or absence (0) of snow 
    77       INTEGER  ::   isnowic        ! snow ice formation not 
    78       INTEGER  ::   i_ice_switch   ! ice thickness above a certain treshold or not 
    7973      INTEGER  ::   iter 
    8074 
    81       REAL(wp) ::   zzfmass_i, zihgnew                     ! local scalar 
    82       REAL(wp) ::   zzfmass_s, zhsnew, ztmelts             ! local scalar 
    83       REAL(wp) ::   zhn, zdhcf, zdhbf, zhni, zhnfi, zihg   ! 
    84       REAL(wp) ::   zdhnm, zhnnew, zhisn, zihic, zzc       ! 
     75      REAL(wp) ::   ztmelts             ! local scalar 
     76      REAL(wp) ::   zfdum        
    8577      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment 
    86       REAL(wp) ::   zcoeff       ! dummy argument for snowfall partitioning over ice and leads 
    87       REAL(wp) ::   zsm_snowice  ! snow-ice salinity 
     78      REAL(wp) ::   zs_snic      ! snow-ice salinity 
    8879      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity 
    8980      REAL(wp) ::   zswi12       ! switch for computation of bottom salinity 
    9081      REAL(wp) ::   zswi2        ! switch for computation of bottom salinity 
    9182      REAL(wp) ::   zgrr         ! bottom growth rate 
    92       REAL(wp) ::   ztform       ! bottom formation temperature 
    93       ! 
    94       REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness 
    95       REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness 
    96       REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! melting point 
    97       REAL(wp), POINTER, DIMENSION(:) ::   zhsold      ! old snow thickness 
    98       REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow 
    99       REAL(wp), POINTER, DIMENSION(:) ::   zqfont_su   ! incoming, remaining surface energy 
    100       REAL(wp), POINTER, DIMENSION(:) ::   zqfont_bo   ! incoming, bottom energy 
    101       REAL(wp), POINTER, DIMENSION(:) ::   z_f_surf    ! surface heat for ablation 
    102       REAL(wp), POINTER, DIMENSION(:) ::   zhgnew      ! new ice thickness 
    103       REAL(wp), POINTER, DIMENSION(:) ::   zfmass_i    !  
     83      REAL(wp) ::   zt_i_new     ! bottom formation temperature 
     84 
     85      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean 
     86      REAL(wp) ::   zEi          ! specific enthalpy of sea ice (J/kg) 
     87      REAL(wp) ::   zEw          ! specific enthalpy of exchanged water (J/kg) 
     88      REAL(wp) ::   zdE          ! specific enthalpy difference (J/kg) 
     89      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean 
     90      REAL(wp) ::   zsstK        ! SST in Kelvin 
     91 
     92      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3) 
     93      REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2) 
     94      REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2) 
     95      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2) 
     96      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2) 
    10497 
    10598      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt  
    … …  
    108101 
    109102      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah 
    110  
    111       ! Pathological cases 
    112       REAL(wp), POINTER, DIMENSION(:) ::   zfdt_init   ! total incoming heat for ice melt 
    113       REAL(wp), POINTER, DIMENSION(:) ::   zfdt_final  ! total remaing heat for ice melt 
    114       REAL(wp), POINTER, DIMENSION(:) ::   zqt_i       ! total ice heat content 
    115       REAL(wp), POINTER, DIMENSION(:) ::   zqt_s       ! total snow heat content 
    116       REAL(wp), POINTER, DIMENSION(:) ::   zqt_dummy   ! dummy heat content 
    117  
    118       REAL(wp), POINTER, DIMENSION(:,:) ::   zqt_i_lay   ! total ice heat content 
    119  
    120       ! mass and salt flux (clem) 
    121       REAL(wp) :: zdvres, zdvsur, zdvbot 
    122       REAL(wp), POINTER, DIMENSION(:) ::   zviold, zvsold   ! old ice volume... 
     103      REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness 
     104      INTEGER , POINTER, DIMENSION(:,:) ::   icount    ! number of layers vanished by melting  
     105 
     106      REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2) 
     107      REAL(wp), POINTER, DIMENSION(:) ::   zqh_s       ! total snow heat content (J.m-2) 
     108      REAL(wp), POINTER, DIMENSION(:) ::   zq_s        ! total snow enthalpy     (J.m-3) 
     109      REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing 
     110 
     111      REAL(wp) :: zswitch_sal 
    123112 
    124113      ! Heat conservation  
    125       INTEGER  ::   num_iter_max, numce_dh 
    126       REAL(wp) ::   meance_dh 
    127       REAL(wp) ::   zinda  
    128       REAL(wp), POINTER, DIMENSION(:) ::   zinnermelt 
    129       REAL(wp), POINTER, DIMENSION(:) ::   zfbase, zdq_i 
     114      INTEGER  ::   num_iter_max 
     115 
    130116      !!------------------------------------------------------------------ 
    131117 
    132       CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 
    133       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
    134       CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i ) 
    135       CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
    136  
    137       CALL wrk_alloc( jpij, zviold, zvsold ) ! clem 
    138        
    139       ftotal_fin(:) = 0._wp 
    140       zfdt_init (:) = 0._wp 
    141       zfdt_final(:) = 0._wp 
    142  
    143       dh_i_surf (:) = 0._wp 
    144       dh_i_bott (:) = 0._wp 
    145       dh_snowice(:) = 0._wp 
    146  
    147       DO ji = kideb, kiut 
    148          old_ht_i_b(ji) = ht_i_b(ji) 
    149          old_ht_s_b(ji) = ht_s_b(ji) 
    150          zviold(ji) = a_i_b(ji) * ht_i_b(ji) ! clem 
    151          zvsold(ji) = a_i_b(ji) * ht_s_b(ji) ! clem 
    152       END DO 
     118      ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 
     119      SELECT CASE( nn_icesal )                       ! varying salinity or not 
     120         CASE( 1, 3, 4 ) ;   zswitch_sal = 0       ! prescribed salinity profile 
     121         CASE( 2 )       ;   zswitch_sal = 1       ! varying salinity profile 
     122      END SELECT 
     123 
     124      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw ) 
     125      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     126      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 
     127      CALL wrk_alloc( jpij, nlay_i, icount ) 
     128        
     129      dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp 
     130      dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp    
     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 
     145 
     146      ! initialize layer thicknesses and enthalpies 
     147      h_i_old (:,0:nlay_i+1) = 0._wp 
     148      qh_i_old(:,0:nlay_i+1) = 0._wp 
     149      DO jk = 1, nlay_i 
     150         DO ji = kideb, kiut 
     151            h_i_old (ji,jk) = ht_i_1d(ji) * r1_nlay_i 
     152            qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk) 
     153         ENDDO 
     154      ENDDO 
    153155      ! 
    154156      !------------------------------------------------------------------------------! 
    155       !  1) Calculate available heat for surface ablation                            ! 
     157      !  1) Calculate available heat for surface and bottom ablation                 ! 
    156158      !------------------------------------------------------------------------------! 
    157159      ! 
    158160      DO ji = kideb, kiut 
    159          isnow         = INT(  1.0 - MAX(  0.0 , SIGN( 1.0 , - ht_s_b(ji) )  )  ) 
    160          ztfs     (ji) = isnow * rtt + ( 1.0 - isnow ) * rtt 
    161          z_f_surf (ji) = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
    162          z_f_surf (ji) = MAX(  zzero , z_f_surf(ji)  ) * MAX(  zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) )  ) 
    163          zfdt_init(ji) = ( z_f_surf(ji) + MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) ) * rdt_ice 
    164       END DO ! ji 
    165  
    166       zqfont_su  (:) = 0._wp 
    167       zqfont_bo  (:) = 0._wp 
    168       dsm_i_se_1d(:) = 0._wp      
    169       dsm_i_si_1d(:) = 0._wp    
     161         zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
     162         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
     163 
     164         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 
     165         zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 
     166      END DO 
     167 
    170168      ! 
    171169      !------------------------------------------------------------------------------! 
    172       !  2) Computing layer thicknesses and  snow and sea-ice enthalpies.            ! 
     170      ! If snow temperature is above freezing point, then snow melts  
     171      ! (should not happen but sometimes it does) 
    173172      !------------------------------------------------------------------------------! 
    174       ! 
    175       DO ji = kideb, kiut     ! Layer thickness 
    176          zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
    177          zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 
    178       END DO 
    179       ! 
    180       zqt_s(:) = 0._wp        ! Total enthalpy of the snow 
     173      DO ji = kideb, kiut 
     174         IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting 
     175            ! Contribution to heat flux to the ocean [W.m-2], < 0   
     176            hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice 
     177            ! Contribution to mass flux 
     178            wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice 
     179            ! updates 
     180            ht_s_1d(ji)   = 0._wp 
     181            q_s_1d (ji,1) = 0._wp 
     182            t_s_1d (ji,1) = rt0 
     183         END IF 
     184      END DO 
     185 
     186      !------------------------------------------------------------! 
     187      !  2) Computing layer thicknesses and enthalpies.            ! 
     188      !------------------------------------------------------------! 
     189      ! 
    181190      DO jk = 1, nlay_s 
    182191         DO ji = kideb, kiut 
    183             zqt_s(ji) =  zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s ) 
     192            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s 
    184193         END DO 
    185194      END DO 
    186195      ! 
    187       zqt_i(:) = 0._wp        ! Total enthalpy of the ice 
    188196      DO jk = 1, nlay_i 
    189197         DO ji = kideb, kiut 
    190             zzc = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 
    191             zqt_i(ji)        =  zqt_i(ji) + zzc 
    192             zqt_i_lay(ji,jk) =              zzc 
     198            zh_i(ji,jk) = ht_i_1d(ji) * r1_nlay_i 
     199            zqh_i(ji)   = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk) 
    193200         END DO 
    194201      END DO 
    … …  
    212219      ! Martin Vancoppenolle, December 2006 
    213220 
    214       ! Snow fall 
    215       DO ji = kideb, kiut 
    216          zcoeff = ( 1.0 - ( 1.0 - at_i_b(ji) )**betas ) / at_i_b(ji)  
    217          zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn 
    218       END DO 
    219       zdh_s_mel(:) =  0._wp 
    220  
    221       ! Melt of fallen snow 
    222       DO ji = kideb, kiut 
    223          ! tatm_ice is now in K 
    224          zqprec   (ji)   =  rhosn * ( cpic * ( rtt - tatm_ice_1d(ji) ) + lfus )   
    225          zqfont_su(ji)   =  z_f_surf(ji) * rdt_ice 
    226          zdeltah  (ji,1) =  MIN( 0.e0 , - zqfont_su(ji) / MAX( zqprec(ji) , epsi13 ) ) 
    227          zqfont_su(ji)   =  MAX( 0.e0 , - zdh_s_pre(ji) - zdeltah(ji,1)              ) * zqprec(ji) 
    228          zdeltah  (ji,1) =  MAX( - zdh_s_pre(ji) , zdeltah(ji,1) ) 
    229          zdh_s_mel(ji)   =  zdh_s_mel(ji) + zdeltah(ji,1) 
    230          ! heat conservation 
    231          qt_s_in(ji,jl)  =  qt_s_in(ji,jl) + zqprec(ji) * zdh_s_pre(ji) 
    232          zqt_s  (ji)     =  zqt_s  (ji)    + zqprec(ji) * zdh_s_pre(ji) 
    233          zqt_s  (ji)     =  MAX( zqt_s(ji) - zqfont_su(ji) , 0.e0 )  
    234       END DO 
    235  
    236  
    237       ! Snow melt due to surface heat imbalance 
     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 
     224      DO ji = kideb, kiut 
     225         !----------- 
     226         ! Snow fall 
     227         !----------- 
     228         ! thickness change 
     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)    
     232         IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 
     233         ! heat flux from snow precip (>0, W.m-2) 
     234         hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 
     235         ! mass flux, <0 
     236         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice 
     237 
     238         !--------------------- 
     239         ! Melt of falling snow 
     240         !--------------------- 
     241         ! thickness change 
     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  
     245         ! heat used to melt snow (W.m-2, >0) 
     246         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 
     247         ! snow melting only = water into the ocean (then without snow precip), >0 
     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 
    238259      DO jk = 1, nlay_s 
    239260         DO ji = kideb, kiut 
    240             zdeltah  (ji,jk) = - zqfont_su(ji) / q_s_b(ji,jk) 
    241             zqfont_su(ji)    =  MAX( 0.0 , - zh_s(ji) - zdeltah(ji,jk) ) * q_s_b(ji,jk)  
    242             zdeltah  (ji,jk) =  MAX( zdeltah(ji,jk) , - zh_s(ji) ) 
    243             zdh_s_mel(ji)    =  zdh_s_mel(ji) + zdeltah(ji,jk)        ! resulting melt of snow     
     261            ! thickness change 
     262            rswitch          = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )  
     263            rswitch          = rswitch * ( MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,jk) - epsi20 ) ) )  
     264            zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 ) 
     265            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - ht_s_1d(ji) ) ! bound melting 
     266            zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)     
     267            ! heat used to melt snow(W.m-2, >0) 
     268            hfx_snw_1d(ji)   = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_1d(ji) * q_s_1d(ji,jk) * r1_rdtice  
     269            ! snow melting only = water into the ocean (then without snow precip) 
     270            wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     271            ! updates available heat + thickness 
     272            zq_su (ji)  = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) ) 
     273            ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) ) 
    244274         END DO 
    245275      END DO 
    246276 
    247       ! Apply snow melt to snow depth 
    248       DO ji = kideb, kiut 
    249          dh_s_tot(ji)   =  zdh_s_mel(ji) + zdh_s_pre(ji) 
    250          ! Old and new snow depths 
    251          zhsold(ji)     =  ht_s_b(ji) 
    252          zhsnew         =  ht_s_b(ji) + dh_s_tot(ji) 
    253          ! If snow is still present zhn = 1, else zhn = 0 
    254          zhn            =  1.0 - MAX(  zzero , SIGN( zone , - zhsnew )  ) 
    255          ht_s_b(ji)     =  MAX( zzero , zhsnew ) 
    256          ! we recompute dh_s_tot (clem)  
    257          dh_s_tot (ji)  =  ht_s_b(ji) - zhsold(ji) 
    258          ! Volume and mass variations of snow 
    259          dvsbq_1d  (ji) =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_pre(ji) ) 
    260          dvsbq_1d  (ji) =  MIN( zzero, dvsbq_1d(ji) ) 
    261          !clem rdm_snw_1d(ji) =  rdm_snw_1d(ji) + rhosn * dvsbq_1d(ji) 
    262       END DO ! ji 
    263  
    264       !-------------------------- 
    265       ! 3.2 Surface ice ablation  
    266       !-------------------------- 
    267       DO ji = kideb, kiut  
    268          z_f_surf (ji) =  zqfont_su(ji) * r1_rdtice   ! heat conservation test 
    269          zdq_i    (ji) =  0._wp 
    270       END DO ! ji 
    271  
    272       DO jk = 1, nlay_i 
    273          DO ji = kideb, kiut  
    274             !                                                    ! melt of layer jk 
    275             zdeltah  (ji,jk) = - zqfont_su(ji) / q_i_b(ji,jk) 
    276             !                                                    ! recompute heat available 
    277             zqfont_su(ji   ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk)  
    278             !                                                    ! melt of layer jk cannot be higher than its thickness 
    279             zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_i(ji) ) 
    280             !                                                    ! update surface melt 
    281             dh_i_surf(ji   ) = dh_i_surf(ji) + zdeltah(ji,jk)  
    282             !                                                    ! for energy conservation 
    283             zdq_i    (ji   ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 
    284             ! 
    285             ! clem 
    286             sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji)    & 
    287                &                              * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic / rdt_ice 
    288          END DO 
    289       END DO 
    290  
    291       !                                          !------------------- 
    292       IF( con_i .AND. jiindex_1d > 0 ) THEN      ! Conservation test 
    293          !                                       !------------------- 
    294          numce_dh  = 0 
    295          meance_dh = 0._wp 
    296          DO ji = kideb, kiut 
    297             IF ( ( z_f_surf(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN 
    298                numce_dh  = numce_dh + 1 
    299                meance_dh = meance_dh + z_f_surf(ji) + zdq_i(ji) 
    300             ENDIF 
    301             IF( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN! 
    302                WRITE(numout,*) ' ALERTE heat loss for surface melt ' 
    303                WRITE(numout,*) ' ii, ij, jl :', ii, ij, jl 
    304                WRITE(numout,*) ' ht_i_b       : ', ht_i_b(ji) 
    305                WRITE(numout,*) ' z_f_surf     : ', z_f_surf(ji) 
    306                WRITE(numout,*) ' zdq_i        : ', zdq_i(ji) 
    307                WRITE(numout,*) ' ht_i_b       : ', ht_i_b(ji) 
    308                WRITE(numout,*) ' fc_bo_i      : ', fc_bo_i(ji) 
    309                WRITE(numout,*) ' fbif_1d      : ', fbif_1d(ji) 
    310                WRITE(numout,*) ' qlbbq_1d     : ', qlbbq_1d(ji) 
    311                WRITE(numout,*) ' s_i_new      : ', s_i_new(ji) 
    312                WRITE(numout,*) ' sss_m        : ', sss_m(ii,ij) 
    313             ENDIF 
    314          END DO 
    315          ! 
    316          IF( numce_dh > 0 )   meance_dh = meance_dh / numce_dh 
    317          WRITE(numout,*) ' Error report - Category : ', jl 
    318          WRITE(numout,*) ' ~~~~~~~~~~~~ ' 
    319          WRITE(numout,*) ' Number of points where there is sur. me. error : ', numce_dh 
    320          WRITE(numout,*) ' Mean basal growth error on error points : ', meance_dh 
    321          ! 
    322       ENDIF 
    323  
    324277      !---------------------- 
    325       ! 3.3 Snow sublimation 
     278      ! 3.2 Snow sublimation  
    326279      !---------------------- 
    327  
    328       DO ji = kideb, kiut 
    329          ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
    330 #if defined key_coupled 
    331          zdh_s_sub(ji)    =  0._wp      ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 
    332 #else 
    333          !                              ! forced  mode: snow thickness change due to sublimation 
    334          zdh_s_sub(ji)    =  - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice 
    335 #endif 
    336          dh_s_tot (ji)    =  dh_s_tot(ji) + zdh_s_sub(ji) 
    337          zdhcf            =  ht_s_b(ji) + zdh_s_sub(ji)  
    338          ht_s_b   (ji)    =  MAX( zzero , zdhcf ) 
    339          ! we recompute dh_s_tot  
    340          dh_s_tot (ji)    =  ht_s_b(ji) - zhsold(ji) 
    341          qt_s_in  (ji,jl) =  qt_s_in(ji,jl) + zdh_s_sub(ji)*q_s_b(ji,1) 
    342       END DO 
    343  
    344       zqt_dummy(:) = 0.e0 
     280      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
     281      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean) 
     282      ! clem comment: ice should also sublimate 
     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       
     302      ! --- Update snow diags --- ! 
     303      DO ji = kideb, kiut 
     304         dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
     305      END DO 
     306 
     307      !------------------------------------------- 
     308      ! 3.3 Update temperature, energy 
     309      !------------------------------------------- 
     310      ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 
     311      zq_s(:) = 0._wp  
    345312      DO jk = 1, nlay_s 
    346313         DO ji = kideb,kiut 
    347             q_s_b    (ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 
    348             zqt_dummy(ji)    =  zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s )            ! heat conservation 
     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 ) ) 
     318            zq_s(ji)     =  zq_s(ji) + q_s_1d(ji,jk) 
    349319         END DO 
    350320      END DO 
    351321 
    352       DO jk = 1, nlay_s 
     322      !-------------------------- 
     323      ! 3.4 Surface ice ablation  
     324      !-------------------------- 
     325      zdeltah(:,:) = 0._wp ! important 
     326      DO jk = 1, nlay_i 
    353327         DO ji = kideb, kiut 
    354             ! In case of disparition of the snow, we have to update the snow temperatures 
    355             zhisn  =  MAX(  zzero , SIGN( zone, - ht_s_b(ji) )  ) 
    356             t_s_b(ji,jk) = ( 1.0 - zhisn ) * t_s_b(ji,jk) + zhisn * rtt 
    357             q_s_b(ji,jk) = ( 1.0 - zhisn ) * q_s_b(ji,jk) 
     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 
     385            ! record which layers have disappeared (for bottom melting)  
     386            !    => icount=0 : no layer has vanished 
     387            !    => icount=5 : 5 layers have vanished 
     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) ) 
     391 
     392            ! update heat content (J.m-2) and layer thickness 
     393            qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 
     394            h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    358395         END DO 
     396      END DO 
     397      ! update ice thickness 
     398      DO ji = kideb, kiut 
     399         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) ) 
    359400      END DO 
    360401 
    … …  
    364405      !------------------------------------------------------------------------------! 
    365406      ! 
    366       ! Ice basal growth / melt is given by the ratio of heat budget over basal 
    367       ! ice heat content.  Basal heat budget is given by the difference between 
    368       ! the inner conductive flux  (fc_bo_i), from the open water heat flux  
    369       ! (qlbbqb) and the turbulent ocean flux (fbif).  
    370       ! fc_bo_i is positive downwards. fbif and qlbbq are positive to the ice  
    371  
    372       !----------------------------------------------------- 
    373       ! 4.1 Basal growth - (a) salinity not varying in time  
    374       !----------------------------------------------------- 
    375       IF(  num_sal /= 2  ) THEN   ! ice salinity constant in time 
     407      !------------------ 
     408      ! 4.1 Basal growth  
     409      !------------------ 
     410      ! Basal growth is driven by heat imbalance at the ice-ocean interface, 
     411      ! between the inner conductive flux  (fc_bo_i), from the open water heat flux  
     412      ! (fhld) and the turbulent ocean flux (fhtur).  
     413      ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice  
     414 
     415      ! If salinity varies in time, an iterative procedure is required, because 
     416      ! the involved quantities are inter-dependent. 
     417      ! Basal growth (dh_i_bott) depends upon new ice specific enthalpy (zEi), 
     418      ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bott) 
     419      ! -> need for an iterative procedure, which converges quickly 
     420 
     421      num_iter_max = 1 
     422      IF( nn_icesal == 2 ) num_iter_max = 5 
     423 
     424      ! Iterative procedure 
     425      DO iter = 1, num_iter_max 
    376426         DO ji = kideb, kiut 
    377             IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0._wp  ) THEN 
    378                s_i_new(ji)         =  sm_i_b(ji) 
    379                ! Melting point in K 
    380                ztmelts             =  - tmut * s_i_new(ji) + rtt  
    381                ! New ice heat content (Bitz and Lipscomb, 1999) 
    382                ztform              =  t_i_b(ji,nlay_i)  ! t_bo_b crashes in the 
    383                ! Baltic 
    384                q_i_b(ji,nlay_i+1)  = rhoic * (  cpic * ( ztmelts - ztform )                                & 
    385                   &                           + lfus * (  1.0 - ( ztmelts - rtt ) / ( ztform - rtt )  )    & 
    386                   &                           - rcp  * ( ztmelts - rtt )                                 ) 
    387                ! Basal growth rate = - F*dt / q 
    388                dh_i_bott(ji)       =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
    389                sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 
     427            IF(  zf_tt(ji) < 0._wp  ) THEN 
     428 
     429               ! New bottom ice salinity (Cox & Weeks, JGR88 ) 
     430               !--- zswi1  if dh/dt < 2.0e-8 
     431               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7  
     432               !--- zswi2  if dh/dt > 3.6e-7 
     433               zgrr               = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi10 ) ) 
     434               zswi2              = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) ) 
     435               zswi12             = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 
     436               zswi1              = 1. - zswi2 * zswi12 
     437               zfracs             = MIN ( zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   & 
     438                  &               + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  , 0.5 ) 
     439 
     440               ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     441 
     442               s_i_new(ji)        = zswitch_sal * zfracs * sss_m(ii,ij)  &  ! New ice salinity 
     443                                  + ( 1. - zswitch_sal ) * sm_i_1d(ji)  
     444               ! New ice growth 
     445               ztmelts            = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K) 
     446 
     447               zt_i_new           = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
     448                
     449               zEi                = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)       
     450                  &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   & 
     451                  &               + rcp  * ( ztmelts-rt0 )           
     452 
     453               zEw                = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0) 
     454 
     455               zdE                = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0) 
     456 
     457               dh_i_bott(ji)      = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) ) 
     458 
     459               q_i_1d(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0) 
     460                
    390461            ENDIF 
    391462         END DO 
    392       ENDIF 
    393  
    394       !------------------------------------------------- 
    395       ! 4.1 Basal growth - (b) salinity varying in time  
    396       !------------------------------------------------- 
    397       IF(  num_sal == 2  ) THEN 
    398          ! the growth rate (dh_i_bott) is function of the new ice heat content (q_i_b(nlay_i+1)).  
    399          ! q_i_b depends on the new ice salinity (snewice).  
    400          ! snewice depends on dh_i_bott ; it converges quickly, so, no problem 
    401          ! See Vancoppenolle et al., OM08 for more info on this 
    402  
    403          ! Initial value (tested 1D, can be anything between 1 and 20) 
    404          num_iter_max = 4 
    405          s_i_new(:)   = 4.0 
    406  
    407          ! Iterative procedure 
    408          DO iter = 1, num_iter_max 
    409             DO ji = kideb, kiut 
    410                IF(  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0.e0  ) THEN 
    411                   ii = MOD( npb(ji) - 1, jpi ) + 1 
    412                   ij = ( npb(ji) - 1 ) / jpi + 1 
    413                   ! Melting point in K 
    414                   ztmelts             =   - tmut * s_i_new(ji) + rtt  
    415                   ! New ice heat content (Bitz and Lipscomb, 1999) 
    416                   q_i_b(ji,nlay_i+1)  =  rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                             & 
    417                      &                            + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )   & 
    418                      &                            - rcp * ( ztmelts-rtt )                                     ) 
    419                   ! Bottom growth rate = - F*dt / q 
    420                   dh_i_bott(ji) =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 
    421                   ! New ice salinity ( Cox and Weeks, JGR, 1988 ) 
    422                   ! zswi2  (1) if dh_i_bott/rdt .GT. 3.6e-7 
    423                   ! zswi12 (1) if dh_i_bott/rdt .LT. 3.6e-7 and .GT. 2.0e-8 
    424                   ! zswi1  (1) if dh_i_bott/rdt .LT. 2.0e-8 
    425                   zgrr   = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi13 ) ) 
    426                   zswi2  = MAX( zzero , SIGN( zone , zgrr - 3.6e-7 ) )  
    427                   zswi12 = MAX( zzero , SIGN( zone , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 
    428                   zswi1  = 1. - zswi2 * zswi12  
    429                   zfracs = zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   & 
    430                      &                   + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  
    431                   zfracs = MIN( 0.5 , zfracs ) 
    432                   s_i_new(ji) = zfracs * sss_m(ii,ij) 
    433                ENDIF ! fc_bo_i 
    434             END DO ! ji 
    435          END DO ! iter 
    436  
    437          ! Final values 
    438          DO ji = kideb, kiut 
    439             IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .LT. 0.0  ) THEN 
    440                ! New ice salinity must not exceed 20 psu 
    441                s_i_new(ji) = MIN( s_i_new(ji), s_i_max ) 
    442                ! Metling point in K 
    443                ztmelts     =   - tmut * s_i_new(ji) + rtt  
    444                ! New ice heat content (Bitz and Lipscomb, 1999) 
    445                q_i_b(ji,nlay_i+1)  =  rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                              & 
    446                   &                            + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )    & 
    447                   &                            - rcp * ( ztmelts - rtt )                                    ) 
    448                ! Basal growth rate = - F*dt / q 
    449                dh_i_bott(ji)       =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 
    450                ! Salinity update 
    451                ! entrapment during bottom growth 
    452                sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 
    453             ENDIF ! heat budget 
    454          END DO 
    455       ENDIF 
     463      END DO 
     464 
     465      ! Contribution to Energy and Salt Fluxes 
     466      DO ji = kideb, kiut 
     467         IF(  zf_tt(ji) < 0._wp  ) THEN 
     468            ! New ice growth 
     469                                     
     470            zfmdt          = - rhoic * dh_i_bott(ji)             ! Mass flux x time step (kg/m2, < 0) 
     471 
     472            ztmelts        = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K) 
     473             
     474            zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
     475             
     476            zEi            = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)       
     477               &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   & 
     478               &               + rcp  * ( ztmelts-rt0 )           
     479             
     480            zEw            = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0) 
     481             
     482            zdE            = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0) 
     483             
     484            ! Contribution to heat flux to the ocean [W.m-2], >0   
     485            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
     486 
     487            ! Total heat flux used in this process [W.m-2], <0   
     488            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
     489             
     490            ! Contribution to salt flux, <0 
     491            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice 
     492 
     493            ! Contribution to mass flux, <0 
     494            wfx_bog_1d(ji) =  wfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * r1_rdtice 
     495 
     496            ! update heat content (J.m-2) and layer thickness 
     497            qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_1d(ji,nlay_i+1) 
     498            h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji) 
     499         ENDIF 
     500      END DO 
    456501 
    457502      !---------------- 
    458503      ! 4.2 Basal melt 
    459504      !---------------- 
    460       meance_dh = 0._wp 
    461       numce_dh  = 0 
    462       zinnermelt(:) = 0._wp 
    463  
    464       DO ji = kideb, kiut 
    465          ! heat convergence at the surface > 0 
    466          IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0._wp  ) THEN 
    467             s_i_new(ji)   =  s_i_b(ji,nlay_i) 
    468             zqfont_bo(ji) =  rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) 
    469             zfbase(ji)    =  zqfont_bo(ji) * r1_rdtice     ! heat conservation test 
    470             zdq_i(ji)     =  0._wp 
    471             dh_i_bott(ji) =  0._wp 
    472          ENDIF 
    473       END DO 
    474  
     505      zdeltah(:,:) = 0._wp ! important 
    475506      DO jk = nlay_i, 1, -1 
    476507         DO ji = kideb, kiut 
    477             IF(  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji)  >=  0._wp  ) THEN 
    478                ztmelts = - tmut * s_i_b(ji,jk) + rtt  
    479                IF( t_i_b(ji,jk) >= ztmelts ) THEN   !!gm : a comment is needed 
    480                   zdeltah   (ji,jk) = - zh_i(ji) 
    481                   dh_i_bott (ji   ) = dh_i_bott(ji) + zdeltah(ji,jk) 
    482                   zinnermelt(ji   ) = 1._wp 
    483                ELSE                                  ! normal ablation 
    484                   zdeltah  (ji,jk) = - zqfont_bo(ji) / q_i_b(ji,jk) 
    485                   zqfont_bo(ji   ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 
    486                   zdeltah  (ji,jk) = MAX(zdeltah(ji,jk), - zh_i(ji) ) 
    487                   dh_i_bott(ji   ) = dh_i_bott(ji) + zdeltah(ji,jk) 
    488                   zdq_i    (ji   ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 
     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) 
     511 
     512               IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting 
     513 
     514                  zEi               = - q_i_1d(ji,jk) * r1_rhoic    ! Specific enthalpy of melting ice (J/kg, <0) 
     515                  zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
     516                                                                    ! set up at 0 since no energy is needed to melt water...(it is already melted) 
     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 
     519 
     520                  dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk) 
     521 
     522                  zfmdt             = - zdeltah(ji,jk) * rhoic      ! Mass flux x time step > 0 
     523 
     524                  ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean)  
     525                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice 
     526 
     527                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     528                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
     529                                     
     530                  ! Contribution to mass flux 
     531                  wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     532 
     533                  ! update heat content (J.m-2) and layer thickness 
     534                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 
     535                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
     536 
     537               ELSE                               !!! Basal melting 
     538 
     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 
     548                   
     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 
     556 
     557                  ! Contribution to heat flux to the ocean [W.m-2], <0   
     558                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
     559 
     560                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     561                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoic *  a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
     562                   
     563                  ! Total heat flux used in this process [W.m-2], >0   
     564                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
     565                   
     566                  ! Contribution to mass flux 
     567                  wfx_bom_1d(ji)  =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     568 
     569                  ! update heat content (J.m-2) and layer thickness 
     570                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 
     571                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    489572               ENDIF 
    490                ! clem: contribution to salt flux 
    491                sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji)    & 
    492                     &                              * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice 
    493             ENDIF 
    494          END DO ! ji 
    495       END DO ! jk 
    496  
    497       !                                          !------------------- 
    498       IF( con_i .AND. jiindex_1d > 0 ) THEN      ! Conservation test 
    499       !                                          !------------------- 
    500          DO ji = kideb, kiut 
    501             IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0.e0  ) THEN 
    502                IF( ( zfbase(ji) + zdq_i(ji) ) >= 1.e-3 ) THEN 
    503                   numce_dh  = numce_dh + 1 
    504                   meance_dh = meance_dh + zfbase(ji) + zdq_i(ji) 
    505                ENDIF 
    506                IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN 
    507                   WRITE(numout,*) ' ALERTE heat loss for basal melt : ii, ij, jl :', ii, ij, jl 
    508                   WRITE(numout,*) ' ht_i_b    : ', ht_i_b(ji) 
    509                   WRITE(numout,*) ' zfbase    : ', zfbase(ji) 
    510                   WRITE(numout,*) ' zdq_i     : ', zdq_i(ji) 
    511                   WRITE(numout,*) ' ht_i_b    : ', ht_i_b(ji) 
    512                   WRITE(numout,*) ' fc_bo_i   : ', fc_bo_i(ji) 
    513                   WRITE(numout,*) ' fbif_1d   : ', fbif_1d(ji) 
    514                   WRITE(numout,*) ' qlbbq_1d  : ', qlbbq_1d(ji) 
    515                   WRITE(numout,*) ' s_i_new   : ', s_i_new(ji) 
    516                   WRITE(numout,*) ' sss_m     : ', sss_m(ii,ij) 
    517                   WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    518                   WRITE(numout,*) ' innermelt : ', INT( zinnermelt(ji) ) 
    519                ENDIF 
     573            
    520574            ENDIF 
    521575         END DO 
    522          IF( numce_dh > 0 )   meance_dh = meance_dh / numce_dh 
    523          WRITE(numout,*) ' Number of points where there is bas. me. error : ', numce_dh 
    524          WRITE(numout,*) ' Mean basal melt error on error points : ', meance_dh 
    525          WRITE(numout,*) ' Remaining bottom heat : ', zqfont_bo(jiindex_1d) 
    526          ! 
    527       ENDIF 
    528  
    529       ! 
    530       !------------------------------------------------------------------------------! 
    531       !  5) Pathological cases                                                       ! 
    532       !------------------------------------------------------------------------------! 
    533       ! 
    534       !---------------------------------------------- 
    535       ! 5.1 Excessive ablation in a 1-category model 
    536       !---------------------------------------------- 
    537  
    538       DO ji = kideb, kiut 
    539          !                     ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 
    540          IF( jpl == 1 ) THEN   ;   zdhbf = MAX( hmelt , dh_i_bott(ji) ) 
    541          ELSE                  ;   zdhbf =              dh_i_bott(ji)  
    542          ENDIF 
    543          zdvres        = zdhbf - dh_i_bott(ji) 
    544          dh_i_bott(ji) = zdhbf 
    545          sfx_thd_1d(ji)  = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice 
    546          !                     ! excessive energy is sent to lateral ablation 
    547          zinda = MAX( 0._wp, SIGN( 1._wp , 1.0 - at_i_b(ji) - epsi10 ) ) 
    548          fsup(ji) =  zinda * rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi10 ) * zdvres * r1_rdtice 
    549       END DO 
    550  
    551       !----------------------------------- 
    552       ! 5.2 More than available ice melts 
    553       !----------------------------------- 
    554       ! then heat applied minus heat content at previous time step should equal heat remaining  
    555       ! 
    556       DO ji = kideb, kiut 
    557          ! Adapt the remaining energy if too much ice melts 
    558          !-------------------------------------------------- 
    559          zdvres     = MAX( 0._wp, - ht_i_b(ji) - dh_i_surf(ji) - dh_i_bott(ji) ) 
    560          zdvsur     = MIN( 0._wp, dh_i_surf(ji) + zdvres ) - dh_i_surf(ji) ! fill the surface first 
    561          zdvbot     = MAX( 0._wp, zdvres - zdvsur ) ! then the bottom 
    562          dh_i_surf (ji) = dh_i_surf(ji) + zdvsur ! clem 
    563          dh_i_bott (ji) = dh_i_bott(ji) + zdvbot ! clem 
    564  
    565          ! new ice thickness (clem) 
    566          zhgnew(ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 
    567          zihgnew    = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice 
    568          zhgnew(ji) = zihgnew * zhgnew(ji)      ! ice thickness is put to 0 
    569   
    570          !                     !since ice volume is only used for outputs, we keep it global for all categories 
    571          dvbbq_1d (ji) = a_i_b(ji) * dh_i_bott(ji) 
    572  
    573         ! remaining heat 
    574          zfdt_final(ji) = ( 1.0 - zihgnew ) * ( zqfont_su(ji) +  zqfont_bo(ji) )  
    575  
    576          ! If snow remains, energy is used to melt snow 
    577          zhni =  ht_s_b(ji)      ! snow depth at previous time step 
    578          zihg =  MAX(  zzero , SIGN ( zone , - ht_s_b(ji) )  )   ! =0 if snow  
    579  
    580          ! energy of melting of remaining snow 
    581          zinda = MAX( 0._wp, SIGN( 1._wp , zhni - epsi10 ) ) 
    582          zqt_s(ji) =    ( 1. - zihg ) * zqt_s(ji) / MAX( zhni, epsi10 ) * zinda 
    583          zdhnm     =  - ( 1. - zihg ) * ( 1. - zihgnew ) * zfdt_final(ji) / MAX( zqt_s(ji) , epsi13 ) 
    584          zhnfi     =  zhni + zdhnm 
    585          zfdt_final(ji) =  MAX( zfdt_final(ji) + zqt_s(ji) * zdhnm , 0.0 ) 
    586          ht_s_b(ji)     =  MAX( zzero , zhnfi ) 
    587          zqt_s(ji)      =  zqt_s(ji) * ht_s_b(ji) 
    588          ! we recompute dh_s_tot (clem) 
    589          dh_s_tot (ji)  =  ht_s_b(ji) - zhsold(ji) 
    590  
    591          ! Mass variations of ice and snow 
    592          !--------------------------------- 
    593          !                                              ! mass variation of the jl category 
    594          zzfmass_s = - a_i_b(ji) * ( zhni       - ht_s_b(ji) ) * rhosn   ! snow 
    595          zzfmass_i =   a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic   ! ice   
    596          ! 
    597          zfmass_i(ji) = zzfmass_i                       ! ice variation saved to compute salt flux (see below) 
    598          ! 
    599          !                                              ! mass variation cumulated over category 
    600          !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + zzfmass_s                     ! snow  
    601          !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + zzfmass_i                     ! ice  
    602  
    603          ! Remaining heat to the ocean  
    604          !--------------------------------- 
    605          focea(ji)  = - zfdt_final(ji) * r1_rdtice         ! focea is in W.m-2 * dt 
    606  
    607          ! residual salt flux (clem) 
    608          !-------------------------- 
    609          ! surface 
    610          sfx_thd_1d(ji)    = sfx_thd_1d(ji) - sm_i_b(ji)  * a_i_b(ji) * zdvsur * rhoic * r1_rdtice 
    611          ! bottom 
    612          IF ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN ! melting 
    613             sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji)  * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 
    614          ELSE                                                          ! growth 
    615             sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 
    616          ENDIF 
    617          ! 
    618          ! diagnostic  
    619          ii = MOD( npb(ji) - 1, jpi ) + 1 
    620          ij = ( npb(ji) - 1 ) / jpi + 1 
    621          diag_bot_gr(ii,ij) = diag_bot_gr(ii,ij) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
    622          diag_sur_me(ii,ij) = diag_sur_me(ii,ij) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) * r1_rdtice 
    623          diag_bot_me(ii,ij) = diag_bot_me(ii,ij) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
    624       END DO 
    625  
    626       ftotal_fin (:) = zfdt_final(:)  * r1_rdtice 
    627  
    628       !--------------------------- 
    629       ! heat fluxes                     
    630       !--------------------------- 
    631       DO ji = kideb, kiut 
    632          zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )   ! =1 if ice 
    633          ! 
    634          ! Heat flux 
    635          ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 
    636          ! excessive total  ablation energy (focea) sent to the ocean 
    637          qfvbq_1d(ji)  = qfvbq_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) * rdt_ice 
    638  
    639          zihic   = 1.0 - MAX(  zzero , SIGN( zone , -ht_i_b(ji) )  )      ! equals 0 if ht_i = 0, 1 if ht_i gt 0 
    640          fscbq_1d(ji) =  a_i_b(ji) * fstbif_1d(ji) 
    641          qldif_1d(ji)  = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea   (ji) * a_i_b(ji) * rdt_ice   & 
    642             &                                    + ( 1.0 - zihic   ) * fscbq_1d(ji)             * rdt_ice 
    643       END DO  ! ji 
    644  
    645       !------------------------------------------- 
    646       ! Correct temperature, energy and thickness 
    647       !------------------------------------------- 
    648       DO ji = kideb, kiut 
    649          zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )  
    650          t_su_b(ji) =  zihgnew * t_su_b(ji) + ( 1.0 - zihgnew ) * rtt 
    651       END DO  ! ji 
    652  
    653       DO jk = 1, nlay_i 
    654          DO ji = kideb, kiut 
    655             zihgnew      =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )  
    656             t_i_b(ji,jk) =  zihgnew * t_i_b(ji,jk) + ( 1.0 - zihgnew ) * rtt 
    657             q_i_b(ji,jk) =  zihgnew * q_i_b(ji,jk) 
    658          END DO 
    659       END DO  ! ji 
    660  
    661       DO ji = kideb, kiut 
    662          ht_i_b(ji) = zhgnew(ji) 
    663       END DO  ! ji 
     576      END DO 
     577 
     578      !------------------------------------------- 
     579      ! Update temperature, energy 
     580      !------------------------------------------- 
     581      DO ji = kideb, kiut 
     582         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_bott(ji) ) 
     583      END DO   
     584 
     585      !------------------------------------------- 
     586      ! 5. What to do with remaining energy 
     587      !------------------------------------------- 
     588      ! If heat still available for melting and snow remains, then melt more snow 
     589      !------------------------------------------- 
     590      zdeltah(:,:) = 0._wp ! important 
     591      DO ji = kideb, kiut 
     592         zq_rema(ji)     = zq_su(ji) + zq_bo(ji)  
     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         !     
     606         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     607         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 
     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) 
     611      END DO 
     612       
    664613      ! 
    665614      !------------------------------------------------------------------------------| 
    … …  
    670619      DO ji = kideb, kiut 
    671620         ! 
    672          dh_snowice(ji) = MAX(  zzero , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic )  ) 
    673          zhgnew(ji)     = MAX(  zhgnew(ji) , zhgnew(ji) + dh_snowice(ji)  ) 
    674          zhnnew         = MIN(  ht_s_b(ji) , ht_s_b(ji) - dh_snowice(ji)  ) 
    675  
    676          !  Changes in ice volume and ice mass. 
    677          dvnbq_1d  (ji) =                a_i_b(ji) * ( zhgnew(ji)-ht_i_b(ji) ) 
    678          dmgwi_1d  (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn 
    679  
    680          !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic  
    681          !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + a_i_b(ji) * ( zhnnew     - ht_s_b(ji) ) * rhosn  
    682  
    683          !        Equivalent salt flux (1) Snow-ice formation component 
    684          !        ----------------------------------------------------- 
    685          ii = MOD( npb(ji) - 1, jpi ) + 1 
    686          ij =    ( npb(ji) - 1 ) / jpi + 1 
    687  
    688          IF( num_sal == 2 ) THEN   ;   zsm_snowice = sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic 
    689          ELSE                      ;   zsm_snowice = sm_i_b(ji)    
    690          ENDIF 
     621         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  ) 
     622 
     623         ht_i_1d(ji)    = ht_i_1d(ji) + dh_snowice(ji) 
     624         ht_s_1d(ji)    = ht_s_1d(ji) - dh_snowice(ji) 
     625 
     626         ! Salinity of snow ice 
     627         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     628         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
     629 
    691630         ! entrapment during snow ice formation 
    692          ! clem: new salinity difference stored (to be used in limthd_ent.F90) 
    693          IF (  num_sal == 2  ) THEN 
    694             i_ice_switch = MAX( 0._wp , SIGN( 1._wp , zhgnew(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 ) ) 
    695634            ! salinity dif due to snow-ice formation 
    696             dsm_i_si_1d(ji) = ( zsm_snowice - sm_i_b(ji) ) * dh_snowice(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch      
     635            dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch      
    697636            ! salinity dif due to bottom growth  
    698             IF (  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji)  < 0._wp ) THEN 
    699                dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_b(ji) ) * dh_i_bott(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch 
     637            IF (  zf_tt(ji)  < 0._wp ) THEN 
     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 
    700639            ENDIF 
    701640         ENDIF 
    702641 
    703          !  Actualize new snow and ice thickness. 
    704          ht_s_b(ji)  = zhnnew 
    705          ht_i_b(ji)  = zhgnew(ji) 
    706  
    707          ! Total ablation ! new lines added to debug 
    708          IF( ht_i_b(ji) <= 0._wp )   a_i_b(ji) = 0._wp 
    709  
    710          ! diagnostic ( snow ice growth ) 
    711          ii = MOD( npb(ji) - 1, jpi ) + 1 
    712          ij =    ( npb(ji) - 1 ) / jpi + 1 
    713          diag_sni_gr(ii,ij)  = diag_sni_gr(ii,ij) + dh_snowice(ji)*a_i_b(ji) * r1_rdtice 
    714          ! 
    715          ! salt flux 
    716          sfx_thd_1d(ji) = sfx_thd_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 
    717          !-------------------------------- 
    718          ! Update mass fluxes (clem) 
    719          !-------------------------------- 
    720          rdm_ice_1d(ji) = rdm_ice_1d(ji) + ( a_i_b(ji) * ht_i_b(ji) - zviold(ji) ) * rhoic  
    721          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ( a_i_b(ji) * ht_s_b(ji) - zvsold(ji) ) * rhosn  
    722  
    723       END DO !ji 
    724       ! 
    725       CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 
    726       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
    727       CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 
    728       CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
    729       ! 
    730       CALL wrk_dealloc( jpij, zviold, zvsold ) ! clem 
     642         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 
     643         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     644         zfmdt          = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp )    ! <0 
     645         zsstK          = sst_m(ii,ij) + rt0                                 
     646         zEw            = rcp * ( zsstK - rt0 ) 
     647         zQm            = zfmdt * zEw  
     648          
     649         ! Contribution to heat flux 
     650         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice  
     651 
     652         ! Contribution to salt flux 
     653         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice  
     654           
     655         ! Contribution to mass flux 
     656         ! All snow is thrown in the ocean, and seawater is taken to replace the volume 
     657         wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice 
     658         wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhosn * r1_rdtice 
     659 
     660         ! update heat content (J.m-2) and layer thickness 
     661         qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_1d(ji,1) + zfmdt * zEw 
     662         h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 
     663          
     664      END DO 
     665 
     666      ! 
     667      !------------------------------------------- 
     668      ! Update temperature, energy 
     669      !------------------------------------------- 
     670      DO ji = kideb, kiut 
     671         rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )  
     672         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0 
     673      END DO 
     674 
     675      DO jk = 1, nlay_s 
     676         DO ji = kideb,kiut 
     677            ! mask enthalpy 
     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) 
     680            ! recalculate t_s_1d from q_s_1d 
     681            t_s_1d(ji,jk) = rt0 + rswitch * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic ) 
     682         END DO 
     683      END DO 
     684 
     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 ) 
     689      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     690      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 
     691      CALL wrk_dealloc( jpij, nlay_i, icount ) 
     692      ! 
    731693      ! 
    732694   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 
    733713    
    734714#else 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r4333 r5832  
    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 
    … …  
    3130   PUBLIC   lim_thd_dif   ! called by lim_thd 
    3231 
    33    REAL(wp) ::   epsi10      =  1.e-10_wp    ! 
    3432   !!---------------------------------------------------------------------- 
    3533   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    … …  
    3937CONTAINS 
    4038 
    41    SUBROUTINE lim_thd_dif( kideb , kiut , jl ) 
     39   SUBROUTINE lim_thd_dif( kideb , kiut ) 
    4240      !!------------------------------------------------------------------ 
    4341      !!                ***  ROUTINE lim_thd_dif  *** 
    … …  
    7472      !! 
    7573      !! ** Inputs / Ouputs : (global commons) 
    76       !!           surface temperature : t_su_b 
    77       !!           ice/snow temperatures   : t_i_b, t_s_b 
    78       !!           ice salinities          : s_i_b 
     74      !!           surface temperature : t_su_1d 
     75      !!           ice/snow temperatures   : t_i_1d, t_s_1d 
     76      !!           ice salinities          : s_i_1d 
    7977      !!           number of layers in the ice/snow: nlay_i, nlay_s 
    8078      !!           profile of the ice/snow layers : z_i, z_s 
    81       !!           total ice/snow thickness : ht_i_b, ht_s_b 
     79      !!           total ice/snow thickness : ht_i_1d, ht_s_1d 
    8280      !! 
    8381      !! ** External :  
    … …  
    9189      !!           (04-2007) Energy conservation tested by M. Vancoppenolle 
    9290      !!------------------------------------------------------------------ 
    93       INTEGER , INTENT (in) ::   kideb   ! Start point on which the  the computation is applied 
    94       INTEGER , INTENT (in) ::   kiut    ! End point on which the  the computation is applied 
    95       INTEGER , INTENT (in) ::   jl      ! Category number 
     91      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    9692 
    9793      !! * Local variables 
    … …  
    9995      INTEGER ::   ii, ij      ! temporary dummy loop index 
    10096      INTEGER ::   numeq       ! current reference number of equation 
    101       INTEGER ::   layer       ! vertical dummy loop index  
     97      INTEGER ::   jk       ! vertical dummy loop index  
    10298      INTEGER ::   nconv       ! number of iterations in iterative procedure 
    10399      INTEGER ::   minnumeqmin, maxnumeqmax 
    104       INTEGER, DIMENSION(kiut) ::   numeqmin   ! reference number of top equation 
    105       INTEGER, DIMENSION(kiut) ::   numeqmax   ! reference number of bottom equation 
    106       INTEGER, DIMENSION(kiut) ::   isnow      ! switch for presence (1) or absence (0) of snow 
     100       
     101      INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation 
     102      INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation 
     103       
    107104      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
    108105      REAL(wp) ::   zg1       =  2._wp        ! 
    109106      REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat 
    110107      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13) 
    111       REAL(wp) ::   zraext_s  =  1.e+8_wp     ! extinction coefficient of radiation in the snow 
     108      REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow 
    112109      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
     110      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered as 0°C  
    113111      REAL(wp) ::   ztmelt_i    ! ice melting temperature 
    114112      REAL(wp) ::   zerritmax   ! current maximal error on temperature  
    115       REAL(wp), DIMENSION(kiut) ::   ztfs        ! ice melting point 
    116       REAL(wp), DIMENSION(kiut) ::   ztsuold     ! old surface temperature (before the iterative procedure ) 
    117       REAL(wp), DIMENSION(kiut) ::   ztsuoldit   ! surface temperature at previous iteration 
    118       REAL(wp), DIMENSION(kiut) ::   zh_i        ! ice layer thickness 
    119       REAL(wp), DIMENSION(kiut) ::   zh_s        ! snow layer thickness 
    120       REAL(wp), DIMENSION(kiut) ::   zfsw        ! solar radiation absorbed at the surface 
    121       REAL(wp), DIMENSION(kiut) ::   zf          ! surface flux function 
    122       REAL(wp), DIMENSION(kiut) ::   dzf         ! derivative of the surface flux function 
    123       REAL(wp), DIMENSION(kiut) ::   zerrit      ! current error on temperature 
    124       REAL(wp), DIMENSION(kiut) ::   zdifcase    ! case of the equation resolution (1->4) 
    125       REAL(wp), DIMENSION(kiut) ::   zftrice     ! solar radiation transmitted through the ice 
    126       REAL(wp), DIMENSION(kiut) ::   zihic, zhsu 
    127       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztcond_i    ! Ice thermal conductivity 
    128       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradtr_i    ! Radiation transmitted through the ice 
    129       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradab_i    ! Radiation absorbed in the ice 
    130       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zkappa_i    ! Kappa factor in the ice 
    131       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztiold      ! Old temperature in the ice 
    132       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zeta_i      ! Eta factor in the ice 
    133       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztitemp     ! Temporary temperature in the ice to check the convergence 
    134       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zspeche_i   ! Ice specific heat 
    135       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   z_i         ! Vertical cotes of the layers in the ice 
    136       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradtr_s    ! Radiation transmited through the snow 
    137       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradab_s    ! Radiation absorbed in the snow 
    138       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zkappa_s    ! Kappa factor in the snow 
    139       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zeta_s       ! Eta factor in the snow 
    140       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztstemp      ! Temporary temperature in the snow to check the convergence 
    141       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztsold       ! Temporary temperature in the snow 
    142       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   z_s          ! Vertical cotes of the layers in the snow 
    143       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindterm   ! Independent term 
    144       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindtbis   ! temporary independent term 
    145       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zdiagbis 
    146       REAL(wp), DIMENSION(kiut,jkmax+2,3) ::   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       
     150      ! diag errors on heat 
     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       
    147166      !!------------------------------------------------------------------      
    148167      !  
     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 ) 
     175 
     176      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 
     177 
     178      ! --- diag error on heat diffusion - PART 1 --- ! 
     179      zdq(:) = 0._wp ; zq_ini(:) = 0._wp       
     180      DO ji = kideb, kiut 
     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 )  
     183      END DO 
     184 
    149185      !------------------------------------------------------------------------------! 
    150186      ! 1) Initialization                                                            ! 
    151187      !------------------------------------------------------------------------------! 
    152       ! 
    153188      DO ji = kideb , kiut 
    154          ! is there snow or not 
    155          isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
    156          ! surface temperature of fusion 
    157 !!gm ???  ztfs(ji) = rtt !!!???? 
    158          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 
    159190         ! layer thickness 
    160          zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
    161          zh_s(ji) = ht_s_b(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 
    162193      END DO 
    163194 
    … …  
    169200      z_i(:,0) = 0._wp   ! vert. coord. of the up. lim. of the 1st ice layer 
    170201 
    171       DO layer = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
    172          DO ji = kideb , kiut 
    173             z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / REAL( nlay_s ) 
    174          END DO 
    175       END DO 
    176  
    177       DO layer = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
    178          DO ji = kideb , kiut 
    179             z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / REAL( nlay_i ) 
     202      DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
     203         DO ji = kideb , kiut 
     204            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) * r1_nlay_s 
     205         END DO 
     206      END DO 
     207 
     208      DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
     209         DO ji = kideb , kiut 
     210            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) * r1_nlay_i 
    180211         END DO 
    181212      END DO 
    182213      ! 
    183214      !------------------------------------------------------------------------------| 
    184       ! 2) Radiations                                                                | 
     215      ! 2) Radiation                                                       | 
    185216      !------------------------------------------------------------------------------| 
    186217      ! 
    … …  
    194225      ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface  
    195226      ! zftrice = io.qsr_ice       is below the surface  
    196       ! fstbif  = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
    197  
     227      ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
     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 
    198230      DO ji = kideb , kiut 
    199231         ! switches 
    200          isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) )  
     232         isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )  
    201233         ! hs > 0, isnow = 1 
    202          zhsu (ji) = hnzst  ! threshold for the computation of i0 
    203          zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_b(ji) / zhsu(ji) ) )      
    204  
    205          i0(ji)    = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
    206          !fr1_i0_1d = i0 for a thin ice surface 
    207          !fr1_i0_2d = i0 for a thick ice surface 
    208          !            a function of the cloud cover 
    209          ! 
    210          !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_b(ji)+10.0) 
    211          !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) ) 
    212237      END DO 
    213238 
    … …  
    217242      !------------------------------------------------------- 
    218243      DO ji = kideb , kiut 
    219          zfsw   (ji) =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface 
    220          zftrice(ji) =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer 
    221          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 
    222248      END DO 
    223249 
    … …  
    230256      END DO 
    231257 
    232       DO layer = 1, nlay_s          ! Radiation through snow 
     258      DO jk = 1, nlay_s          ! Radiation through snow 
    233259         DO ji = kideb, kiut 
    234260            !                             ! radiation transmitted below the layer-th snow layer 
    235             zradtr_s(ji,layer) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,layer) ) ) ) 
     261            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,jk) ) ) ) 
    236262            !                             ! radiation absorbed by the layer-th snow layer 
    237             zradab_s(ji,layer) = zradtr_s(ji,layer-1) - zradtr_s(ji,layer) 
     263            zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk) 
    238264         END DO 
    239265      END DO 
    240266 
    241267      DO ji = kideb, kiut           ! ice initialization 
    242          zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * REAL( isnow(ji) ) + zftrice(ji) * REAL( 1 - isnow(ji) ) 
    243       END DO 
    244  
    245       DO layer = 1, nlay_i          ! Radiation through ice 
     268         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) ) 
     269      END DO 
     270 
     271      DO jk = 1, nlay_i          ! Radiation through ice 
    246272         DO ji = kideb, kiut 
    247273            !                             ! radiation transmitted below the layer-th ice layer 
    248             zradtr_i(ji,layer) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,layer) ) ) ) 
     274            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) ) 
    249275            !                             ! radiation absorbed by the layer-th ice layer 
    250             zradab_i(ji,layer) = zradtr_i(ji,layer-1) - zradtr_i(ji,layer) 
     276            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) 
    251277         END DO 
    252278      END DO 
    253279 
    254280      DO ji = kideb, kiut           ! Radiation transmitted below the ice 
    255          fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 
    256       END DO 
    257  
    258       ! +++++ 
    259       ! just to check energy conservation 
    260       DO ji = kideb, kiut 
    261          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    262          ij =    ( npb(ji) - 1 ) / jpi + 1 
    263          fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 
    264       END DO 
    265       ! +++++ 
    266  
    267       DO layer = 1, nlay_i 
    268          DO ji = kideb, kiut 
    269             radab(ji,layer) = zradab_i(ji,layer) 
    270          END DO 
    271       END DO 
    272  
    273       ! 
     281         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i)  
     282      END DO 
     283 
    274284      !------------------------------------------------------------------------------| 
    275285      !  3) Iterative procedure begins                                               | 
    … …  
    277287      ! 
    278288      DO ji = kideb, kiut        ! Old surface temperature 
    279          ztsuold  (ji) =  t_su_b(ji)                              ! temperature at the beg of iter pr. 
    280          ztsuoldit(ji) =  t_su_b(ji)                              ! temperature at the previous iter 
    281          t_su_b   (ji) =  MIN( t_su_b(ji), ztfs(ji)-0.00001 )     ! necessary 
    282          zerrit   (ji) =  1000._wp                                ! initial value of error 
    283       END DO 
    284  
    285       DO layer = 1, nlay_s       ! Old snow temperature 
    286          DO ji = kideb , kiut 
    287             ztsold(ji,layer) =  t_s_b(ji,layer) 
    288          END DO 
    289       END DO 
    290  
    291       DO layer = 1, nlay_i       ! Old ice temperature 
    292          DO ji = kideb , kiut 
    293             ztiold(ji,layer) =  t_i_b(ji,layer) 
     289         ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr. 
     290         ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter 
     291         t_su_1d(ji) =  MIN( t_su_1d(ji), rt0 - ztsu_err )       ! necessary 
     292         zerrit (ji) =  1000._wp                                 ! initial value of error 
     293      END DO 
     294 
     295      DO jk = 1, nlay_s       ! Old snow temperature 
     296         DO ji = kideb , kiut 
     297            ztsb(ji,jk) =  t_s_1d(ji,jk) 
     298         END DO 
     299      END DO 
     300 
     301      DO jk = 1, nlay_i       ! Old ice temperature 
     302         DO ji = kideb , kiut 
     303            ztib(ji,jk) =  t_i_1d(ji,jk) 
    294304         END DO 
    295305      END DO 
    … …  
    298308      zerritmax =  1000._wp    ! maximal value of error on all points 
    299309 
    300       DO WHILE ( zerritmax > maxer_i_thd .AND. nconv < nconv_i_thd ) 
     310      DO WHILE ( zerritmax > rn_terr_dif .AND. nconv < nn_conv_dif ) 
    301311         ! 
    302312         nconv = nconv + 1 
    … …  
    306316         !------------------------------------------------------------------------------| 
    307317         ! 
    308          IF( thcon_i_swi == 0 ) THEN      ! Untersteiner (1964) formula 
    309             DO ji = kideb , kiut 
    310                ztcond_i(ji,0)        = rcdic + zbeta*s_i_b(ji,1) / MIN(-epsi10,t_i_b(ji,1)-rtt) 
    311                ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin) 
    312             END DO 
    313             DO layer = 1, nlay_i-1 
     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 ) 
     322            END DO 
     323            DO jk = 1, nlay_i-1 
    314324               DO ji = kideb , kiut 
    315                   ztcond_i(ji,layer) = rcdic + zbeta*( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) /  & 
    316                      MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt) 
    317                   ztcond_i(ji,layer) = MAX(ztcond_i(ji,layer),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 ) 
    318328               END DO 
    319329            END DO 
    320330         ENDIF 
    321331 
    322          IF( thcon_i_swi == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T 
    323             DO ji = kideb , kiut 
    324                ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_b(ji,1) / MIN( -epsi10, t_i_b(ji,1)-rtt )   & 
    325                   &                   - 0.011_wp * ( t_i_b(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 )   
    326336               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 
    327337            END DO 
    328             DO layer = 1, nlay_i-1 
     338            DO jk = 1, nlay_i-1 
    329339               DO ji = kideb , kiut 
    330                   ztcond_i(ji,layer) = rcdic + 0.090_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) )   & 
    331                      &                                  / MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt)   & 
    332                      &                       - 0.0055_wp* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt )   
    333                   ztcond_i(ji,layer) = MAX( ztcond_i(ji,layer), zkimin ) 
     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 )   
     344                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin ) 
    334345               END DO 
    335346            END DO 
    336347            DO ji = kideb , kiut 
    337                ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN(-epsi10,t_bo_b(ji)-rtt)   & 
    338                   &                        - 0.011_wp * ( t_bo_b(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 )   
    339350               ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin ) 
    340351            END DO 
    341352         ENDIF 
    342          ! 
    343          !------------------------------------------------------------------------------| 
    344          !  5) kappa factors                                                            | 
    345          !------------------------------------------------------------------------------| 
    346          ! 
     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 
    347400         DO ji = kideb, kiut 
    348  
    349             !-- Snow kappa factors 
    350             zkappa_s(ji,0)         = rcdsn / MAX(epsi10,zh_s(ji)) 
    351             zkappa_s(ji,nlay_s)    = rcdsn / MAX(epsi10,zh_s(ji)) 
    352          END DO 
    353  
    354          DO layer = 1, nlay_s-1 
    355             DO ji = kideb , kiut 
    356                zkappa_s(ji,layer)  = 2.0 * rcdsn / & 
    357                   MAX(epsi10,2.0*zh_s(ji)) 
    358             END DO 
    359          END DO 
    360  
    361          DO layer = 1, nlay_i-1 
    362             DO ji = kideb , kiut 
    363                !-- Ice kappa factors 
    364                zkappa_i(ji,layer)  = 2.0*ztcond_i(ji,layer)/ & 
    365                   MAX(epsi10,2.0*zh_i(ji))  
    366             END DO 
    367          END DO 
    368  
    369          DO ji = kideb , kiut 
    370             zkappa_i(ji,0)        = ztcond_i(ji,0)/MAX(epsi10,zh_i(ji)) 
    371             zkappa_i(ji,nlay_i)   = ztcond_i(ji,nlay_i) / MAX(epsi10,zh_i(ji)) 
    372             !-- Interface 
    373             zkappa_s(ji,nlay_s)   = 2.0*rcdsn*ztcond_i(ji,0)/MAX(epsi10, & 
    374                (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji))) 
    375             zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*REAL( isnow(ji) ) & 
    376                + zkappa_i(ji,0)*REAL( 1 - isnow(ji) ) 
    377          END DO 
    378          ! 
    379          !------------------------------------------------------------------------------| 
    380          ! 6) Sea ice specific heat, eta factors                                        | 
    381          !------------------------------------------------------------------------------| 
    382          ! 
    383          DO layer = 1, nlay_i 
    384             DO ji = kideb , kiut 
    385                ztitemp(ji,layer)   = t_i_b(ji,layer) 
    386                zspeche_i(ji,layer) = cpic + zgamma*s_i_b(ji,layer)/ & 
    387                   MAX((t_i_b(ji,layer)-rtt)*(ztiold(ji,layer)-rtt),epsi10) 
    388                zeta_i(ji,layer)    = rdt_ice / MAX(rhoic*zspeche_i(ji,layer)*zh_i(ji), & 
    389                   epsi10) 
    390             END DO 
    391          END DO 
    392  
    393          DO layer = 1, nlay_s 
    394             DO ji = kideb , kiut 
    395                ztstemp(ji,layer) = t_s_b(ji,layer) 
    396                zeta_s(ji,layer)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10) 
    397             END DO 
    398          END DO 
    399          ! 
    400          !------------------------------------------------------------------------------| 
    401          ! 7) surface flux computation                                                  | 
    402          !------------------------------------------------------------------------------| 
    403          ! 
    404          DO ji = kideb , kiut 
    405  
    406             ! update of the non solar flux according to the update in T_su 
    407             qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * &  
    408                ( t_su_b(ji) - ztsuoldit(ji) ) 
    409  
     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 
     404         END DO 
     405 
     406         DO jk = 1, nlay_s-1 
     407            DO ji = kideb , kiut 
     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 
     413         DO jk = 1, nlay_i-1 
     414            DO ji = kideb , kiut 
     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                                        | 
     432         !------------------------------------------------------------------------------| 
     433         ! 
     434         DO jk = 1, nlay_i 
     435            DO ji = kideb , kiut 
     436               ztitemp(ji,jk)   = t_i_1d(ji,jk) 
     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 ) 
     439            END DO 
     440         END DO 
     441 
     442         DO jk = 1, nlay_s 
     443            DO ji = kideb , kiut 
     444               ztstemp(ji,jk) = t_s_1d(ji,jk) 
     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  
     455            DO ji = kideb , kiut 
     456               ! update of the non solar flux according to the update in T_su 
     457               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) ) 
     458            END DO 
     459         ENDIF 
     460 
     461         ! Update incoming flux 
     462         DO ji = kideb , kiut 
    410463            ! update incoming flux 
    411             zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    412                + qnsr_ice_1d(ji)           ! non solar total flux  
    413             ! (LWup, LWdw, SH, LH) 
    414  
    415          END DO 
    416  
    417          ! 
    418          !------------------------------------------------------------------------------| 
    419          ! 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                                                  | 
    420471         !------------------------------------------------------------------------------| 
    421472         ! 
    … …  
    427478         !!ice interior terms (top equation has the same form as the others) 
    428479 
    429          DO numeq=1,jkmax+2 
     480         DO numeq=1,nlay_i+3 
    430481            DO ji = kideb , kiut 
    431482               ztrid(ji,numeq,1) = 0. 
    … …  
    440491         DO numeq = nlay_s + 2, nlay_s + nlay_i  
    441492            DO ji = kideb , kiut 
    442                layer              = numeq - nlay_s - 1 
    443                ztrid(ji,numeq,1)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer-1) 
    444                ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,layer)*(zkappa_i(ji,layer-1) + & 
    445                   zkappa_i(ji,layer)) 
    446                ztrid(ji,numeq,3)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer) 
    447                zindterm(ji,numeq) =  ztiold(ji,layer) + zeta_i(ji,layer)* & 
    448                   zradab_i(ji,layer) 
     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) 
    449498            END DO 
    450499         ENDDO 
    … …  
    454503            !!ice bottom term 
    455504            ztrid(ji,numeq,1)  =  - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)    
    456             ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i)*( zkappa_i(ji,nlay_i)*zg1 & 
    457                +  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) ) 
    458506            ztrid(ji,numeq,3)  =  0.0 
    459             zindterm(ji,numeq) =  ztiold(ji,nlay_i) + zeta_i(ji,nlay_i)* & 
    460                ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 & 
    461                *  t_bo_b(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) )  
    462509         ENDDO 
    463510 
    464511 
    465512         DO ji = kideb , kiut 
    466             IF ( ht_s_b(ji).gt.0.0 ) THEN 
     513            IF ( ht_s_1d(ji) > 0.0 ) THEN 
    467514               ! 
    468515               !------------------------------------------------------------------------------| 
    … …  
    472519               !!snow interior terms (bottom equation has the same form as the others) 
    473520               DO numeq = 3, nlay_s + 1 
    474                   layer =  numeq - 1 
    475                   ztrid(ji,numeq,1)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer-1) 
    476                   ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,layer)*( zkappa_s(ji,layer-1) + & 
    477                      zkappa_s(ji,layer) ) 
    478                   ztrid(ji,numeq,3)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer) 
    479                   zindterm(ji,numeq)  =  ztsold(ji,layer) + zeta_s(ji,layer)* & 
    480                      zradab_s(ji,layer) 
     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) ) 
     524                  ztrid(ji,numeq,3)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk) 
     525                  zindterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk) 
    481526               END DO 
    482527 
    … …  
    484529               IF ( nlay_i.eq.1 ) THEN 
    485530                  ztrid(ji,nlay_s+2,3)    =  0.0 
    486                   zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1)* & 
    487                      t_bo_b(ji)  
     531                  zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1) * t_bo_1d(ji)  
    488532               ENDIF 
    489533 
    490                IF ( t_su_b(ji) .LT. rtt ) THEN 
     534               IF ( t_su_1d(ji) < rt0 ) THEN 
    491535 
    492536                  !------------------------------------------------------------------------------| 
    … …  
    498542 
    499543                  !!surface equation 
    500                   ztrid(ji,1,1) = 0.0 
    501                   ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0) 
    502                   ztrid(ji,1,3) = zg1s*zkappa_s(ji,0) 
    503                   zindterm(ji,1) = dzf(ji)*t_su_b(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) 
    504548 
    505549                  !!first layer of snow equation 
    506                   ztrid(ji,2,1)  =  - zkappa_s(ji,0)*zg1s*zeta_s(ji,1) 
    507                   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 ) 
    508552                  ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1) 
    509                   zindterm(ji,2) =  ztsold(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) 
    510554 
    511555               ELSE  
    … …  
    521565                  !!first layer of snow equation 
    522566                  ztrid(ji,2,1)  =  0.0 
    523                   ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + & 
    524                      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 ) 
    525568                  ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1)  
    526                   zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) *            & 
    527                      ( zradab_s(ji,1) +                         & 
    528                      zkappa_s(ji,0) * zg1s * t_su_b(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) )  
    529571               ENDIF 
    530572            ELSE 
    … …  
    534576               !------------------------------------------------------------------------------| 
    535577               ! 
    536                IF (t_su_b(ji) .LT. rtt) THEN 
     578               IF ( t_su_1d(ji) < rt0 ) THEN 
    537579                  ! 
    538580                  !------------------------------------------------------------------------------| 
    … …  
    548590                  ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1     
    549591                  ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1 
    550                   zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_b(ji) - zf(ji) 
     592                  zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji) 
    551593 
    552594                  !!first layer of ice equation 
    553595                  ztrid(ji,numeqmin(ji)+1,1) =  - zkappa_i(ji,0) * zg1 * zeta_i(ji,1) 
    554                   ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) &  
    555                      + zkappa_i(ji,0) * zg1 ) 
    556                   ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1)*zkappa_i(ji,1)   
    557                   zindterm(ji,numeqmin(ji)+1)=  ztiold(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)   
    558599 
    559600                  !!case of only one layer in the ice (surface & ice equations are altered) 
    560601 
    561                   IF (nlay_i.eq.1) THEN 
     602                  IF ( nlay_i == 1 ) THEN 
    562603                     ztrid(ji,numeqmin(ji),1)    =  0.0 
    563                      ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0)*2.0 
    564                      ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0)*2.0 
    565                      ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0)*2.0*zeta_i(ji,1) 
    566                      ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 
    567                         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) ) 
    568608                     ztrid(ji,numeqmin(ji)+1,3)  =  0.0 
    569609 
    570                      zindterm(ji,numeqmin(ji)+1) =  ztiold(ji,1) + zeta_i(ji,1)* & 
    571                         ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(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) ) 
    572612                  ENDIF 
    573613 
    … …  
    585625                  !!first layer of ice equation 
    586626                  ztrid(ji,numeqmin(ji),1)      =  0.0 
    587                   ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,1) + zkappa_i(ji,0)* & 
    588                      zg1)   
     627                  ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )   
    589628                  ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1) 
    590                   zindterm(ji,numeqmin(ji))     =  ztiold(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + & 
    591                      zkappa_i(ji,0) * zg1 * t_su_b(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) )  
    592631 
    593632                  !!case of only one layer in the ice (surface & ice equations are altered) 
    594                   IF (nlay_i.eq.1) THEN 
     633                  IF ( nlay_i == 1 ) THEN 
    595634                     ztrid(ji,numeqmin(ji),1)  =  0.0 
    596                      ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 
    597                         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) ) 
    598636                     ztrid(ji,numeqmin(ji),3)  =  0.0 
    599                      zindterm(ji,numeqmin(ji)) =  ztiold(ji,1) + zeta_i(ji,1)* & 
    600                         (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji)) & 
    601                         + t_su_b(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 
    602639                  ENDIF 
    603640 
    … …  
    609646         ! 
    610647         !------------------------------------------------------------------------------| 
    611          ! 9) tridiagonal system solving                                                | 
     648         ! 10) tridiagonal system solving                                               | 
    612649         !------------------------------------------------------------------------------| 
    613650         ! 
    … …  
    618655 
    619656         maxnumeqmax = 0 
    620          minnumeqmin = jkmax+4 
     657         minnumeqmin = nlay_i+5 
    621658 
    622659         DO ji = kideb , kiut 
    … …  
    627664         END DO 
    628665 
    629          DO layer = minnumeqmin+1, maxnumeqmax 
    630             DO ji = kideb , kiut 
    631                numeq               =  min(max(numeqmin(ji)+1,layer),numeqmax(ji)) 
    632                zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* & 
    633                   ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1) 
    634                zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1)* & 
    635                   zindtbis(ji,numeq-1)/zdiagbis(ji,numeq-1) 
     666         DO jk = minnumeqmin+1, maxnumeqmax 
     667            DO ji = kideb , kiut 
     668               numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji)) 
     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) 
    636671            END DO 
    637672         END DO 
    … …  
    639674         DO ji = kideb , kiut 
    640675            ! ice temperatures 
    641             t_i_b(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji)) 
    642          END DO 
    643  
    644          DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1 
    645             DO ji = kideb , kiut 
    646                layer    =  numeq - nlay_s - 1 
    647                t_i_b(ji,layer)  =  (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* & 
    648                   t_i_b(ji,layer+1))/zdiagbis(ji,numeq) 
     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 
     680            DO ji = kideb , kiut 
     681               jk    =  numeq - nlay_s - 1 
     682               t_i_1d(ji,jk)  =  ( zindtbis(ji,numeq) - ztrid(ji,numeq,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,numeq) 
    649683            END DO 
    650684         END DO 
    … …  
    652686         DO ji = kideb , kiut 
    653687            ! snow temperatures       
    654             IF (ht_s_b(ji).GT.0._wp) & 
    655                t_s_b(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
    656                *  t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) & 
    657                *        MAX(0.0,SIGN(1.0,ht_s_b(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) ) )  
    658691 
    659692            ! surface temperature 
    660             isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) )  ) ) 
    661             ztsuoldit(ji) = t_su_b(ji) 
    662             IF( t_su_b(ji) < ztfs(ji) ) & 
    663                t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_b(ji,1)   & 
    664                &          + REAL( 1 - isnow(ji) )*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
     693            isnow(ji)   = 1._wp - MAX( 0._wp , SIGN( 1._wp , -ht_s_1d(ji) ) ) 
     694            ztsubit(ji) = t_su_1d(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))   
    665698         END DO 
    666699         ! 
    667700         !-------------------------------------------------------------------------- 
    668          !  10) Has the scheme converged ?, end of the iterative procedure         | 
     701         !  11) Has the scheme converged ?, end of the iterative procedure         | 
    669702         !-------------------------------------------------------------------------- 
    670703         ! 
    671704         ! check that nowhere it has started to melt 
    672          ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd 
    673          DO ji = kideb , kiut 
    674             t_su_b(ji) =  MAX(  MIN( t_su_b(ji) , ztfs(ji) ) , 190._wp  ) 
    675             zerrit(ji) =  ABS( t_su_b(ji) - ztsuoldit(ji) )      
    676          END DO 
    677  
    678          DO layer  =  1, nlay_s 
    679             DO ji = kideb , kiut 
    680                ii = MOD( npb(ji) - 1, jpi ) + 1 
    681                ij = ( npb(ji) - 1 ) / jpi + 1 
    682                t_s_b(ji,layer) = MAX(  MIN( t_s_b(ji,layer), rtt ), 190._wp  ) 
    683                zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer))) 
    684             END DO 
    685          END DO 
    686  
    687          DO layer  =  1, nlay_i 
    688             DO ji = kideb , kiut 
    689                ztmelt_i        = -tmut * s_i_b(ji,layer) + rtt  
    690                t_i_b(ji,layer) =  MAX(MIN(t_i_b(ji,layer),ztmelt_i), 190._wp) 
    691                zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_b(ji,layer) - ztitemp(ji,layer))) 
     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) )      
     709         END DO 
     710 
     711         DO jk  =  1, nlay_s 
     712            DO ji = kideb , kiut 
     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) ) ) 
     715            END DO 
     716         END DO 
     717 
     718         DO jk  =  1, nlay_i 
     719            DO ji = kideb , kiut 
     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) ) ) 
    692723            END DO 
    693724         END DO 
    … …  
    703734      END DO  ! End of the do while iterative procedure 
    704735 
    705       IF( ln_nicep .AND. lwp ) THEN 
     736      IF( ln_icectl .AND. lwp ) THEN 
    706737         WRITE(numout,*) ' zerritmax : ', zerritmax 
    707738         WRITE(numout,*) ' nconv     : ', nconv 
    … …  
    710741      ! 
    711742      !-------------------------------------------------------------------------! 
    712       !   11) Fluxes at the interfaces                                          ! 
     743      !   12) Fluxes at the interfaces                                          ! 
    713744      !-------------------------------------------------------------------------! 
    714745      DO ji = kideb, kiut 
    715 #if ! defined key_coupled 
    716          ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux)  
    717          qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 
    718 #endif 
    719746         !                                ! surface ice conduction flux 
    720          isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) ) ) 
    721          fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji))   & 
    722             &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_b(ji,1) - t_su_b(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)) 
    723750         !                                ! bottom ice conduction flux 
    724          fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    725       END DO 
    726  
    727       !-------------------------! 
    728       ! Heat conservation       ! 
    729       !-------------------------! 
    730       IF( con_i .AND. jiindex_1d > 0 ) THEN 
     751         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) ) 
     752      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 
    731759         DO ji = kideb, kiut 
    732             ! Upper snow value 
    733             fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) )  
    734             ! Bott. snow value 
    735             fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) )  
    736          END DO 
    737          DO ji = kideb, kiut         ! Upper ice layer 
    738             fc_i(ji,0) = - REAL( isnow(ji) ) * &  ! interface flux if there is snow 
    739                ( zkappa_i(ji,0)  * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 
    740                - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
    741                zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 
    742          END DO 
    743          DO layer = 1, nlay_i - 1         ! Internal ice layers 
    744             DO ji = kideb, kiut 
    745                fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - t_i_b(ji,layer) ) 
    746                ii = MOD( npb(ji) - 1, jpi ) + 1 
    747                ij = ( npb(ji) - 1 ) / jpi + 1 
    748             END DO 
    749          END DO 
    750          DO ji = kideb, kiut         ! Bottom ice layers 
    751             fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    752          END DO 
    753       ENDIF 
     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  
     778 
     779      !----------------------------------------- 
     780      ! Heat flux used to warm/cool ice in W.m-2 
     781      !----------------------------------------- 
     782      DO ji = kideb, kiut 
     783         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC 
     784            hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   & 
     785               &            ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 
     786         ELSE                          ! case T_su = 0degC 
     787            hfx_dif_1d(ji) = hfx_dif_1d(ji) +    & 
     788               &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 
     789         ENDIF 
     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    
    754793      ! 
     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 ) 
     801      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 
     802 
    755803   END SUBROUTINE lim_thd_dif 
     804 
     805   SUBROUTINE lim_thd_enmelt( kideb, kiut ) 
     806      !!----------------------------------------------------------------------- 
     807      !!                   ***  ROUTINE lim_thd_enmelt ***  
     808      !!                  
     809      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature 
     810      !! 
     811      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
     812      !!------------------------------------------------------------------- 
     813      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
     814      ! 
     815      INTEGER  ::   ji, jk   ! dummy loop indices 
     816      REAL(wp) ::   ztmelts  ! local scalar  
     817      !!------------------------------------------------------------------- 
     818      ! 
     819      DO jk = 1, nlay_i             ! Sea ice energy of melting 
     820         DO ji = kideb, kiut 
     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 )  )  
     827         END DO 
     828      END DO 
     829      DO jk = 1, nlay_s             ! Snow energy of melting 
     830         DO ji = kideb, kiut 
     831            q_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) 
     832         END DO 
     833      END DO 
     834      ! 
     835   END SUBROUTINE lim_thd_enmelt 
    756836 
    757837#else 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

    r4333 r5832  
    1010   !!                 ! 2006-11 (X. Fettweis) Vectorized  
    1111   !!            3.0  ! 2008-03 (M. Vancoppenolle) Energy conservation and clean code 
    12    !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     12   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
     13   !!             -   ! 2014-05 (C. Rousset) complete rewriting 
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_lim3 
    … …  
    2223   USE domain         ! 
    2324   USE phycst         ! physical constants 
     25   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2426   USE ice            ! LIM variables 
    25    USE par_ice        ! LIM parameters 
    2627   USE thd_ice        ! LIM thermodynamics 
    2728   USE limvar         ! LIM variables 
    … …  
    3435   PRIVATE 
    3536 
    36    PUBLIC   lim_thd_ent         ! called by lim_thd 
    37  
    38    REAL(wp) ::   epsi20 = 1.e-20_wp   ! constant values 
    39    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    40    REAL(wp) ::   zzero  = 0._wp      ! 
    41    REAL(wp) ::   zone   = 1._wp      ! 
     37   PUBLIC   lim_thd_ent         ! called by limthd and limthd_lac 
    4238 
    4339   !!---------------------------------------------------------------------- 
    … …  
    4844CONTAINS 
    4945  
    50    SUBROUTINE lim_thd_ent( kideb, kiut, jl ) 
     46   SUBROUTINE lim_thd_ent( kideb, kiut, qnew ) 
    5147      !!------------------------------------------------------------------- 
    5248      !!               ***   ROUTINE lim_thd_ent  *** 
    5349      !! 
    5450      !! ** Purpose : 
    55       !!           This routine computes new vertical grids  
    56       !!           in the ice and in the snow, and consistently redistributes  
    57       !!           temperatures in the snow / ice.  
     51      !!           This routine computes new vertical grids in the ice,  
     52      !!           and consistently redistributes temperatures.  
    5853      !!           Redistribution is made so as to ensure to energy conservation 
    5954      !! 
    … …  
    6156      !! ** Method  : linear conservative remapping 
    6257      !!            
    63       !! ** Steps : 1) Grid 
    64       !!            2) Switches 
    65       !!            3) Snow redistribution 
    66       !!            4) Ice enthalpy redistribution 
    67       !!            5) Ice salinity, recover temperature 
     58      !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses 
     59      !!            2) linear remapping on the new layers 
     60      !! 
     61      !! ------------ cum0(0)                        ------------- cum1(0) 
     62      !!                                    NEW      ------------- 
     63      !! ------------ cum0(1)               ==>      ------------- 
     64      !!     ...                                     ------------- 
     65      !! ------------                                ------------- 
     66      !! ------------ cum0(nlay_i+2)                 ------------- cum1(nlay_i) 
     67      !! 
    6868      !! 
    6969      !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 
    7070      !!------------------------------------------------------------------- 
    7171      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    72       INTEGER , INTENT(in) ::   jl            ! Thickness cateogry number 
    7372 
    74       INTEGER ::   ji,jk   !  dummy loop indices 
    75       INTEGER ::   ii, ij       ,   &  !  dummy indices 
    76          ntop0          ,   &  !  old layer top index 
    77          nbot1          ,   &  !  new layer bottom index 
    78          ntop1          ,   &  !  new layer top index 
    79          limsum         ,   &  !  temporary loop index 
    80          nlayi0,nlays0  ,   &  !  old number of layers 
    81          maxnbot0       ,   &  !  old layer bottom index 
    82          layer0, layer1        !  old/new layer indexes 
     73      REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew          ! new enthlapies (J.m-3, remapped) 
    8374 
    84  
    85       REAL(wp) :: & 
    86          ztmelts        ,   &  ! ice melting point 
    87          zqsnic         ,   &  ! enthalpy of snow ice layer 
    88          zhsnow         ,   &  ! temporary snow thickness variable 
    89          zswitch        ,   &  ! dummy switch argument 
    90          zfac1          ,   &  ! dummy factor 
    91          zfac2          ,   &  ! dummy factor 
    92          ztform         ,   &  !: bottom formation temperature 
    93          zaaa           ,   &  !: dummy factor 
    94          zbbb           ,   &  !: dummy factor 
    95          zccc           ,   &  !: dummy factor 
    96          zdiscrim              !: dummy factor 
    97  
    98       INTEGER, POINTER, DIMENSION(:) ::   snswi     !  snow switch 
    99       INTEGER, POINTER, DIMENSION(:) ::   nbot0     !  old layer bottom index 
    100       INTEGER, POINTER, DIMENSION(:) ::   icsuind   !  ice surface index 
    101       INTEGER, POINTER, DIMENSION(:) ::   icsuswi   !  ice surface switch 
    102       INTEGER, POINTER, DIMENSION(:) ::   icboind   !  ice bottom index 
    103       INTEGER, POINTER, DIMENSION(:) ::   icboswi   !  ice bottom switch 
    104       INTEGER, POINTER, DIMENSION(:) ::   snicind   !  snow ice index 
    105       INTEGER, POINTER, DIMENSION(:) ::   snicswi   !  snow ice switch 
    106       INTEGER, POINTER, DIMENSION(:) ::   snind     !  snow index 
     75      INTEGER  :: ji         !  dummy loop indices 
     76      INTEGER  :: jk0, jk1   !  old/new layer indices 
    10777      ! 
    108       REAL(wp), POINTER, DIMENSION(:) ::   zh_i   ! thickness of an ice layer 
    109       REAL(wp), POINTER, DIMENSION(:) ::   zh_s          ! thickness of a snow layer 
    110       REAL(wp), POINTER, DIMENSION(:) ::   zqsnow        ! enthalpy of the snow put in snow ice     
    111       REAL(wp), POINTER, DIMENSION(:) ::   zdeltah       ! temporary variable 
    112       REAL(wp), POINTER, DIMENSION(:) ::   zqti_in, zqts_in 
    113       REAL(wp), POINTER, DIMENSION(:) ::   zqti_fin, zqts_fin 
    114  
    115       REAL(wp), POINTER, DIMENSION(:,:) ::   zm0       !  old layer-system vertical cotes  
    116       REAL(wp), POINTER, DIMENSION(:,:) ::   qm0       !  old layer-system heat content  
    117       REAL(wp), POINTER, DIMENSION(:,:) ::   z_s       !  new snow system vertical cotes  
    118       REAL(wp), POINTER, DIMENSION(:,:) ::   z_i       !  new ice system vertical cotes  
    119       REAL(wp), POINTER, DIMENSION(:,:) ::   zthick0   !  old ice thickness  
    120       REAL(wp), POINTER, DIMENSION(:,:) ::   zhl0      ! old and new layer thicknesses  
    121       REAL(wp), POINTER, DIMENSION(:,:) ::   zrl01 
    122  
    123       REAL(wp) ::   zinda  
     78      REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces 
     79      REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces 
     80      REAL(wp), POINTER, DIMENSION(:)   :: zhnew               ! new layers thicknesses 
    12481      !!------------------------------------------------------------------- 
    12582 
    126       CALL wrk_alloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind )   ! integer 
    127       CALL wrk_alloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin )           ! real 
    128       CALL wrk_alloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 
    129       CALL wrk_alloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 
     83      CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 
     84      CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 
     85      CALL wrk_alloc( jpij, zhnew ) 
    13086 
    131       zthick0(:,:) = 0._wp 
    132       zm0    (:,:) = 0._wp 
    133       qm0    (:,:) = 0._wp 
    134       zrl01  (:,:) = 0._wp 
    135       zhl0   (:,:) = 0._wp 
    136       z_i    (:,:) = 0._wp 
    137       z_s    (:,:) = 0._wp 
    138  
    139       ! 
    140       !------------------------------------------------------------------------------| 
    141       !  1) Grid                                                                     | 
    142       !------------------------------------------------------------------------------| 
    143       nlays0 = nlay_s 
    144       nlayi0 = nlay_i 
    145  
    146       DO ji = kideb, kiut 
    147          zh_i(ji) = old_ht_i_b(ji) / REAL( nlay_i )  
    148          zh_s(ji) = old_ht_s_b(ji) / REAL( nlay_s ) 
    149       END DO 
    150  
    151       ! 
    152       !------------------------------------------------------------------------------| 
    153       !  2) Switches                                                                 | 
    154       !------------------------------------------------------------------------------| 
    155       ! 2.1 snind(ji), snswi(ji) 
    156       ! snow surface behaviour : computation of snind(ji)-snswi(ji) 
    157       ! snind(ji) : index which equals  
    158       !   0 if snow is accumulating 
    159       !   1 if 1st layer is melting 
    160       !   2 if 2nd layer is melting ... 
    161       DO ji = kideb, kiut 
    162          snind  (ji) = 0 
    163          zdeltah(ji) = 0._wp 
    164       ENDDO !ji 
    165  
    166       DO jk = 1, nlays0 
     87      !-------------------------------------------------------------------------- 
     88      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces 
     89      !-------------------------------------------------------------------------- 
     90      zqh_cum0(:,0:nlay_i+2) = 0._wp  
     91      zh_cum0 (:,0:nlay_i+2) = 0._wp 
     92      DO jk0 = 1, nlay_i+2 
    16793         DO ji = kideb, kiut 
    168             snind(ji)  = jk        *      NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)))) & 
    169                + snind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji))))) 
    170             zdeltah(ji)= zdeltah(ji) + zh_s(ji) 
    171          END DO ! ji 
    172       END DO ! jk 
    173  
    174       ! snswi(ji) : switch which value equals 1 if snow melts 
    175       !              0 if not 
    176       DO ji = kideb, kiut 
    177          snswi(ji)     = MAX(0,NINT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 
    178       END DO ! ji 
    179  
    180       ! 2.2 icsuind(ji), icsuswi(ji) 
    181       ! ice surface behaviour : computation of icsuind(ji)-icsuswi(ji) 
    182       ! icsuind(ji) : index which equals 
    183       !     0 if nothing happens at the surface 
    184       !     1 if first layer is melting 
    185       !     2 if 2nd layer is reached by melt ... 
    186       DO ji = kideb, kiut 
    187          icsuind(ji) = 0 
    188          zdeltah(ji) = 0._wp 
    189       END DO !ji 
    190       DO jk = 1, nlayi0 
    191          DO ji = kideb, kiut 
    192             icsuind(ji) = jk          *      NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)))) & 
    193                + icsuind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji))))) 
    194             zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    195          END DO ! ji 
    196       ENDDO !jk 
    197  
    198       ! icsuswi(ji) : switch which equals  
    199       !     1 if ice melts at the surface 
    200       !     0 if not 
    201       DO ji = kideb, kiut 
    202          icsuswi(ji)  = MAX(0,NINT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 
     94            zqh_cum0(ji,jk0) = zqh_cum0(ji,jk0-1) + qh_i_old(ji,jk0-1) 
     95            zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + h_i_old (ji,jk0-1) 
     96         ENDDO 
    20397      ENDDO 
    20498 
    205       ! 2.3 icboind(ji), icboswi(ji) 
    206       ! ice bottom behaviour : computation of icboind(ji)-icboswi(ji) 
    207       ! icboind(ji) : index which equals 
    208       !     0 if accretion is on the way 
    209       !     1 if last layer has started to melt 
    210       !     2 if penultiem layer is melting ... and so on 
    211       !            N+1 if all layers melt and that snow transforms into ice 
    212       DO ji = kideb, kiut  
    213          icboind(ji) = 0 
    214          zdeltah(ji) = 0._wp 
    215       END DO 
    216       DO jk = nlayi0, 1, -1 
    217          DO ji = kideb, kiut 
    218             icboind(ji) = (nlayi0+1-jk) *      NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)))) & 
    219                &          + icboind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)))))  
    220             zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    221          END DO 
    222       END DO 
    223  
     99      !------------------------------------ 
     100      !  2) Interpolation on the new layers 
     101      !------------------------------------ 
     102      ! new layer thickesses 
    224103      DO ji = kideb, kiut 
    225          ! case of total ablation with remaining snow 
    226          IF ( ( ht_i_b(ji) .GT. epsi20 ) .AND. & 
    227             ( ht_i_b(ji) - dh_snowice(ji) .LT. epsi20 ) ) icboind(ji) = nlay_i + 1 
    228       END DO 
    229  
    230       ! icboswi(ji) : switch which equals  
    231       !     1 if ice accretion is on the way 
    232       !     0 if ablation is on the way 
    233       DO ji = kideb, kiut  
    234          icboswi(ji) = MAX(0,NINT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 
    235       END DO 
    236  
    237       ! 2.4 snicind(ji), snicswi(ji) 
    238       ! snow ice formation : calcul de snicind(ji)-snicswi(ji) 
    239       ! snicind(ji) : index which equals  
    240       !     0 if no snow-ice forms 
    241       !     1 if last layer of snow has started to melt 
    242       !     2 if penultiem layer ... 
    243       DO ji = kideb, kiut 
    244          snicind(ji) = 0 
    245          zdeltah(ji) = 0._wp 
    246       END DO 
    247       DO jk = nlays0, 1, -1 
    248          DO ji = kideb, kiut 
    249             snicind(ji) = (nlays0+1-jk) & 
    250                *      NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)))) + snicind(ji)   & 
    251                * (1 - NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji))))) 
    252             zdeltah(ji) = zdeltah(ji) + zh_s(ji) 
    253          END DO 
    254       END DO 
    255  
    256       ! snicswi(ji) : switch which equals  
    257       !     1 if snow-ice forms 
    258       !     0 if not 
    259       DO ji = kideb, kiut 
    260          snicswi(ji)   = MAX(0,NINT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 
     104         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i   
    261105      ENDDO 
    262106 
    263       ! 
    264       !------------------------------------------------------------------------------| 
    265       !  3) Snow redistribution                                                      | 
    266       !------------------------------------------------------------------------------| 
    267       ! 
    268       !------------- 
    269       ! Old profile 
    270       !------------- 
    271  
    272       ! by 'old', it is meant that layers coming from accretion are included,  
    273       ! and that interfacial layers which were partly melted are reduced  
    274  
    275       ! indexes of the vectors 
    276       !------------------------ 
    277       ntop0    =  1 
    278       maxnbot0 =  0 
    279  
    280       DO ji = kideb, kiut 
    281          nbot0(ji) =  nlays0  + 1 - snind(ji) + ( 1 - snicind(ji) ) * snicswi(ji) 
    282          ! cotes of the top of the layers 
    283          zm0(ji,0) =  0._wp 
    284          maxnbot0 =  MAX ( maxnbot0 , nbot0(ji) ) 
    285       END DO 
    286       IF( lk_mpp )   CALL mpp_max( maxnbot0, kcom=ncomm_ice ) 
    287  
    288       DO jk = 1, maxnbot0 
     107      ! new layers interfaces 
     108      zh_cum1(:,0:nlay_i) = 0._wp 
     109      DO jk1 = 1, nlay_i 
    289110         DO ji = kideb, kiut 
    290             !change 
    291             limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 
    292             limsum = MIN( limsum , nlay_s ) 
    293             zm0(ji,jk) =  dh_s_tot(ji) + zh_s(ji) * REAL( limsum ) 
    294          END DO 
    295       END DO 
    296  
    297       DO ji = kideb, kiut 
    298          zm0(ji,nbot0(ji)) =  dh_s_tot(ji) - REAL( snicswi(ji) ) * dh_snowice(ji) + zh_s(ji) * REAL( nlays0 ) 
    299          zm0(ji,1)         =  dh_s_tot(ji) * REAL( 1 - snswi(ji) ) + REAL( snswi(ji) ) * zm0(ji,1) 
    300       END DO 
    301  
    302       DO jk = ntop0, maxnbot0 
    303          DO ji = kideb, kiut 
    304             zthick0(ji,jk)  =  zm0(ji,jk) - zm0(ji,jk-1)            ! layer thickness 
    305          END DO 
    306       END DO 
    307  
    308       zqts_in(:) = 0._wp 
    309  
    310       DO ji = kideb, kiut         ! layer heat content 
    311          qm0    (ji,1) =  rhosn * (  cpic * ( rtt - REAL( 1 - snswi(ji) ) * tatm_ice_1d(ji)        & 
    312             &                                         - REAL( snswi(ji) ) * t_s_b      (ji,1)  )   & 
    313             &                      + lfus  ) * zthick0(ji,1) 
    314          zqts_in(ji)   =  zqts_in(ji) + qm0(ji,1)  
    315       END DO 
    316  
    317       DO jk = 2, maxnbot0 
    318          DO ji = kideb, kiut 
    319             limsum      = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 
    320             limsum      = MIN( limsum , nlay_s ) 
    321             qm0(ji,jk)  = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus ) * zthick0(ji,jk) 
    322             zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, - ht_s_b(ji) ) ) 
    323             zqts_in(ji) = zqts_in(ji) + REAL( 1 - snswi(ji) ) * qm0(ji,jk) * zswitch 
    324          END DO ! jk 
    325       END DO ! ji 
    326  
    327       !------------------------------------------------ 
    328       ! Energy given by the snow in snow-ice formation 
    329       !------------------------------------------------ 
    330       ! zqsnow, enthalpy of the flooded snow 
    331       DO ji = kideb, kiut 
    332          zqsnow (ji) =  rhosn * lfus 
    333          zdeltah(ji) =  0._wp 
    334       END DO 
    335  
    336       DO jk =  nlays0, 1, -1 
    337          DO ji = kideb, kiut 
    338             zhsnow =  MAX( 0._wp , dh_snowice(ji)-zdeltah(ji) ) 
    339             zqsnow (ji) =  zqsnow (ji) + rhosn*cpic*(rtt-t_s_b(ji,jk)) 
    340             zdeltah(ji) =  zdeltah(ji) + zh_s(ji) 
    341          END DO 
    342       END DO 
    343  
    344       DO ji = kideb, kiut 
    345          zqsnow(ji) = zqsnow(ji) * dh_snowice(ji) 
    346       END DO 
    347  
    348       !------------------ 
    349       ! new snow profile 
    350       !------------------ 
    351  
    352       !-------------- 
    353       ! Vector index    
    354       !-------------- 
    355       ntop1 =  1 
    356       nbot1 =  nlay_s 
    357  
    358       !------------------- 
    359       ! Layer coordinates  
    360       !------------------- 
    361       DO ji = kideb, kiut 
    362          zh_s(ji)  = ht_s_b(ji) / REAL( nlay_s ) 
    363          z_s(ji,0) =  0._wp 
     111            zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji) 
     112         ENDDO 
    364113      ENDDO 
    365114 
    366       DO jk = 1, nlay_s 
     115      zqh_cum1(:,0:nlay_i) = 0._wp  
     116      ! new cumulative q*h => linear interpolation 
     117      DO jk0 = 1, nlay_i+1 
     118         DO jk1 = 1, nlay_i-1 
     119            DO ji = kideb, kiut 
     120               IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN 
     121                  zqh_cum1(ji,jk1) = ( zqh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1  ) ) +  & 
     122                     &                 zqh_cum0(ji,jk0  ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) )  & 
     123                     &             / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) ) 
     124               ENDIF 
     125            ENDDO 
     126         ENDDO 
     127      ENDDO 
     128      ! to ensure that total heat content is strictly conserved, set: 
     129      zqh_cum1(:,nlay_i) = zqh_cum0(:,nlay_i+2)  
     130 
     131      ! new enthalpies 
     132      DO jk1 = 1, nlay_i 
    367133         DO ji = kideb, kiut 
    368             z_s(ji,jk) =  zh_s(ji) * REAL( jk ) 
    369          END DO 
    370       END DO 
    371  
    372       !----------------- 
    373       ! Layer thickness 
    374       !----------------- 
    375       DO layer0 = ntop0, maxnbot0 
    376          DO ji = kideb, kiut 
    377             zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) 
    378          END DO 
    379       END DO 
    380  
    381       DO layer1 = ntop1, nbot1 
    382          DO ji = kideb, kiut 
    383             q_s_b(ji,layer1) = 0._wp 
    384          END DO 
    385       END DO 
    386  
    387       !---------------- 
    388       ! Weight factors 
    389       !---------------- 
    390       DO layer0 = ntop0, maxnbot0 
    391          DO layer1 = ntop1, nbot1 
    392             DO ji = kideb, kiut 
    393                zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 
    394                zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1))   & 
    395                   &                 - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1))) / MAX(zhl0(ji,layer0),epsi10))  
    396                q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0)   & 
    397                   &                                * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 
    398             END DO 
    399          END DO 
    400       END DO 
    401  
    402       ! Heat conservation 
    403       zqts_fin(:) = 0._wp 
    404       DO jk = 1, nlay_s 
    405          DO ji = kideb, kiut 
    406             zqts_fin(ji) = zqts_fin(ji) + q_s_b(ji,jk) 
    407          END DO 
    408       END DO 
    409  
    410       IF ( con_i .AND. jiindex_1d > 0 ) THEN 
    411          DO ji = kideb, kiut 
    412             IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice  >  1.0e-6 ) THEN 
    413                ii                 = MOD( npb(ji) - 1, jpi ) + 1 
    414                ij                 = ( npb(ji) - 1 ) / jpi + 1 
    415                WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice 
    416                WRITE(numout,*) ' ji, jj   : ', ii, ij 
    417                WRITE(numout,*) ' ht_s_b   : ', ht_s_b(ji) 
    418                WRITE(numout,*) ' zqts_in  : ', zqts_in (ji) * r1_rdtice 
    419                WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) * r1_rdtice 
    420                WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) 
    421                WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 
    422                WRITE(numout,*) ' snswi    : ', snswi(ji) 
    423             ENDIF 
    424          END DO 
    425       ENDIF 
    426  
    427       !--------------------- 
    428       ! Recover heat content 
    429       !--------------------- 
    430       DO jk = 1, nlay_s 
    431          DO ji = kideb, kiut 
    432             zinda = MAX( 0._wp, SIGN( 1._wp , zh_s(ji) - epsi10 ) )         
    433             q_s_b(ji,jk) = zinda * q_s_b(ji,jk) / MAX( zh_s(ji) , epsi10 ) 
    434          END DO !ji 
    435       END DO !jk   
    436  
    437       !--------------------- 
    438       ! Recover temperature 
    439       !--------------------- 
    440       zfac1 = 1. / ( rhosn * cpic ) 
    441       zfac2 = lfus / cpic   
    442       DO jk = 1, nlay_s 
    443          DO ji = kideb, kiut 
    444             zswitch = MAX ( 0.0 , SIGN ( 1.0, - ht_s_b(ji) ) ) 
    445             t_s_b(ji,jk) = rtt + ( 1.0 - zswitch ) * ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 
    446          END DO 
    447       END DO 
    448       ! 
    449       !------------------------------------------------------------------------------| 
    450       !  4) Ice redistribution                                                       | 
    451       !------------------------------------------------------------------------------| 
    452       ! 
    453       !------------- 
    454       ! OLD PROFILE  
    455       !------------- 
    456  
    457       !---------------- 
    458       ! Vector indexes 
    459       !---------------- 
    460       ntop0    =  1 
    461       maxnbot0 =  0 
    462  
    463       DO ji = kideb, kiut 
    464          ! reference number of the bottommost layer 
    465          nbot0(ji) =  MAX( 1 ,  MIN( nlayi0 + ( 1 - icboind(ji) ) +        & 
    466             &                           ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) , nlay_i + 2 ) ) 
    467          ! maximum reference number of the bottommost layer over all domain 
    468          maxnbot0 =  MAX( maxnbot0 , nbot0(ji) ) 
    469       END DO 
    470  
    471       !------------------------- 
    472       ! Cotes of old ice layers 
    473       !------------------------- 
    474       zm0(:,0) =  0._wp 
    475  
    476       DO jk = 1, maxnbot0 
    477          DO ji = kideb, kiut 
    478             ! jk goes from 1 to nbot0 
    479             ! the ice layer number goes from 1 to nlay_i 
    480             ! limsum is the real ice layer number corresponding to present jk 
    481             limsum    =  ( (icsuswi(ji)*(icsuind(ji)+jk-1) + &  
    482                (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji) 
    483             zm0(ji,jk)=  REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) & 
    484                +  REAL(limsum) * zh_i(ji) 
    485          END DO 
    486       END DO 
    487  
    488       DO ji = kideb, kiut 
    489          zm0(ji,nbot0(ji)) =  REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) + dh_i_bott(ji) & 
    490             +  zh_i(ji) * REAL(nlayi0) 
    491          zm0(ji,1)         =  REAL(snicswi(ji))*dh_snowice(ji) + REAL(1-snicswi(ji))*zm0(ji,1) 
    492       END DO 
    493  
    494       !----------------------------- 
    495       ! Thickness of old ice layers 
    496       !----------------------------- 
    497       DO jk = ntop0, maxnbot0 
    498          DO ji = kideb, kiut 
    499             zthick0(ji,jk) =  zm0(ji,jk) - zm0(ji,jk-1) 
    500          END DO 
    501       END DO 
    502  
    503       !--------------------------- 
    504       ! Inner layers heat content 
    505       !--------------------------- 
    506       qm0(:,:) =  0.0 
    507       zqti_in(:) = 0.0 
    508  
    509       DO jk = ntop0, maxnbot0 
    510          DO ji = kideb, kiut 
    511             limsum =  MAX(1,MIN(snicswi(ji)*(jk-1) + icsuswi(ji)*(jk-1+icsuind(ji)) + & 
    512                (1-icsuswi(ji))*(1-snicswi(ji))*jk,nlay_i)) 
    513             ztmelts = -tmut * s_i_b(ji,limsum) + rtt 
    514             qm0(ji,jk) = rhoic * ( cpic * (ztmelts-t_i_b(ji,limsum)) + lfus * ( 1.0-(ztmelts-rtt)/ & 
    515                MIN((t_i_b(ji,limsum)-rtt),-epsi20) ) - rcp*(ztmelts-rtt) ) & 
    516                * zthick0(ji,jk) 
    517          END DO 
    518       END DO 
    519  
    520       !---------------------------- 
    521       ! Bottom layers heat content 
    522       !---------------------------- 
    523       DO ji = kideb, kiut         
    524          ztmelts    = REAL( 1 - icboswi(ji) ) * (-tmut * s_i_b  (ji,nlayi0) )   &   ! case of melting ice 
    525             &       +     REAL( icboswi(ji) ) * (-tmut * s_i_new(ji)        )   &   ! case of forming ice 
    526             &       + rtt                                                         ! in Kelvin 
    527  
    528          ! bottom formation temperature 
    529          ztform = t_i_b(ji,nlay_i) 
    530          IF(  num_sal == 2  )   ztform = t_bo_b(ji) 
    531          qm0(ji,nbot0(ji)) = REAL( 1 - icboswi(ji) )*qm0(ji,nbot0(ji))             &   ! case of melting ice 
    532             &              + REAL( icboswi(ji) ) * rhoic * ( cpic*(ztmelts-ztform)       &   ! case of forming ice 
    533             + lfus *( 1.0-(ztmelts-rtt) / MIN ( (ztform-rtt) , - epsi10 ) )      &  
    534             - rcp*(ztmelts-rtt) ) * zthick0(ji,nbot0(ji)  ) 
    535       END DO 
    536  
    537       !----------------------------- 
    538       ! Snow ice layer heat content 
    539       !----------------------------- 
    540       DO ji = kideb, kiut 
    541          ! energy of the flooding seawater 
    542          zqsnic = rau0 * rcp * ( rtt - t_bo_b(ji) ) * dh_snowice(ji) * & 
    543             (rhoic - rhosn) / rhoic * REAL(snicswi(ji)) ! generally positive 
    544          ! Heat conservation diagnostic 
    545          qt_i_in(ji,jl) = qt_i_in(ji,jl) + zqsnic  
    546  
    547          qldif_1d(ji)   = qldif_1d(ji) + zqsnic * a_i_b(ji) 
    548  
    549          ! enthalpy of the newly formed snow-ice layer 
    550          ! = enthalpy of snow + enthalpy of frozen water 
    551          zqsnic         =  zqsnow(ji) + zqsnic 
    552          qm0(ji,1)      =  REAL(snicswi(ji)) * zqsnic + REAL( 1 - snicswi(ji) ) * qm0(ji,1) 
    553  
    554       END DO ! ji 
    555  
    556       DO jk = ntop0, maxnbot0 
    557          DO ji = kideb, kiut 
    558             ! Heat conservation 
    559             zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi10) ) & 
    560                &                                   * MAX( 0.0 , SIGN( 1. , REAL(nbot0(ji) - jk) ) ) 
    561          END DO 
    562       END DO 
    563  
    564       !------------- 
    565       ! NEW PROFILE 
    566       !------------- 
    567  
    568       !--------------- 
    569       ! Vectors index 
    570       !--------------- 
    571       ntop1 =  1  
    572       nbot1 =  nlay_i 
    573  
    574       !------------------ 
    575       ! Layers thickness  
    576       !------------------ 
    577       DO ji = kideb, kiut 
    578          zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
     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 ) 
     136         ENDDO 
    579137      ENDDO 
    580138 
    581       !------------- 
    582       ! Layer cotes       
    583       !------------- 
    584       z_i(:,0) =  0._wp 
    585       DO jk = 1, nlay_i 
    586          DO ji = kideb, kiut 
    587             z_i(ji,jk) =  zh_i(ji) * jk 
    588          END DO 
     139      ! --- diag error on heat remapping --- ! 
     140      ! comment: if input h_i_old and qh_i_old are already multiplied by a_i (as in limthd_lac),  
     141      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 
     142      DO ji = kideb, kiut 
     143         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  & 
     144            &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( qh_i_old(ji,0:nlay_i+1) ) )  
    589145      END DO 
    590  
    591       !--thicknesses of the layers 
    592       DO layer0 = ntop0, maxnbot0 
    593          DO ji = kideb, kiut 
    594             zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1)   ! thicknesses of the layers 
    595          END DO 
    596       END DO 
    597  
    598       !------------------------ 
    599       ! Weights for relayering 
    600       !------------------------ 
    601       q_i_b(:,:) = 0._wp 
    602       DO layer0 = ntop0, maxnbot0 
    603          DO layer1 = ntop1, nbot1 
    604             DO ji = kideb, kiut 
    605                zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 
    606                zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_i(ji,layer1)) & 
    607                   - MAX(zm0(ji,layer0-1), z_i(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10)) 
    608                q_i_b(ji,layer1) = q_i_b(ji,layer1) &  
    609                   + zrl01(layer1,layer0)*qm0(ji,layer0) & 
    610                   * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi10)) & 
    611                   * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 
    612             END DO 
    613          END DO 
    614       END DO 
    615  
    616       !------------------------- 
    617       ! Heat conservation check 
    618       !------------------------- 
    619       zqti_fin(:) = 0._wp 
    620       DO jk = 1, nlay_i 
    621          DO ji = kideb, kiut 
    622             zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) 
    623          END DO 
    624       END DO 
     146       
    625147      ! 
    626       IF ( con_i .AND. jiindex_1d > 0 ) THEN 
    627          DO ji = kideb, kiut 
    628             IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice  >  1.0e-6 ) THEN 
    629                ii                 = MOD( npb(ji) - 1, jpi ) + 1 
    630                ij                 = ( npb(ji) - 1 ) / jpi + 1 
    631                WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice 
    632                WRITE(numout,*) ' ji, jj   : ', ii, ij 
    633                WRITE(numout,*) ' ht_i_b   : ', ht_i_b(ji) 
    634                WRITE(numout,*) ' zqti_in  : ', zqti_in (ji) * r1_rdtice 
    635                WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) * r1_rdtice 
    636                WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji) 
    637                WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji) 
    638                WRITE(numout,*) ' dh_snowice:', dh_snowice(ji) 
    639                WRITE(numout,*) ' icsuswi  : ', icsuswi(ji) 
    640                WRITE(numout,*) ' icboswi  : ', icboswi(ji) 
    641                WRITE(numout,*) ' snicswi  : ', snicswi(ji) 
    642             ENDIF 
    643          END DO 
    644       ENDIF 
    645  
    646       !---------------------- 
    647       ! Recover heat content  
    648       !---------------------- 
    649       DO jk = 1, nlay_i 
    650          DO ji = kideb, kiut 
    651             zinda = MAX( 0._wp, SIGN( 1._wp , zh_i(ji) - epsi10 ) ) 
    652             q_i_b(ji,jk) = zinda * q_i_b(ji,jk) / MAX( zh_i(ji) , epsi10 ) 
    653          END DO !ji 
    654       END DO !jk   
    655  
    656       ! Heat conservation 
    657       zqti_fin(:) = 0.0 
    658       DO jk = 1, nlay_i 
    659          DO ji = kideb, kiut 
    660             zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) * zh_i(ji) 
    661          END DO 
    662       END DO 
    663  
    664       ! 
    665       !------------------------------------------------------------------------------| 
    666       !  5) Update salinity and recover temperature                                  | 
    667       !------------------------------------------------------------------------------| 
    668       ! 
    669       ! Update salinity (basal entrapment, snow ice formation) 
    670       DO ji = kideb, kiut 
    671          sm_i_b(ji) = sm_i_b(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 
    672       END DO !ji 
    673  
    674       ! Recover temperature 
    675       DO jk = 1, nlay_i 
    676          DO ji = kideb, kiut 
    677             ztmelts    =  -tmut*s_i_b(ji,jk) + rtt 
    678             !Conversion q(S,T) -> T (second order equation) 
    679             zaaa         =  cpic 
    680             zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 
    681             zccc         =  lfus * ( ztmelts - rtt ) 
    682             zdiscrim     =  SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 
    683             t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 
    684          END DO !ji 
    685  
    686       END DO !jk 
    687       ! 
    688       CALL wrk_dealloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind )   ! integer 
    689       CALL wrk_dealloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin )           ! real 
    690       CALL wrk_dealloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 
    691       CALL wrk_dealloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 
     148      CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 
     149      CALL wrk_dealloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 
     150      CALL wrk_dealloc( jpij, zhnew ) 
    692151      ! 
    693152   END SUBROUTINE lim_thd_ent 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r4333 r5832  
    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 
    … …  
    2928   USE lib_mpp        ! MPP library 
    3029   USE wrk_nemo       ! work arrays 
     30   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3131   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     32   USE limthd_ent 
     33   USE limvar 
    3234 
    3335   IMPLICIT NONE 
    … …  
    3537 
    3638   PUBLIC lim_thd_lac     ! called by lim_thd 
    37  
    38    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    39    REAL(wp) ::   zzero  = 0._wp      ! 
    40    REAL(wp) ::   zone   = 1._wp      ! 
    4139 
    4240   !!---------------------------------------------------------------------- 
    … …  
    7169      !!             - Computation of variation of ice volume and mass 
    7270      !!             - Computation of frldb after lateral accretion and  
    73       !!               update ht_s_b, ht_i_b and tbif_1d(:,:)       
     71      !!               update ht_s_1d, ht_i_1d and tbif_1d(:,:)       
    7472      !!------------------------------------------------------------------------ 
    75       INTEGER ::   ji,jj,jk,jl,jm   ! dummy loop indices 
    76       INTEGER ::   layer, nbpac     ! local integers  
    77       INTEGER ::   ii, ij, iter   !   -       - 
    78       REAL(wp)  ::   ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zinda, zde  ! local scalars 
     73      INTEGER ::   ji,jj,jk,jl      ! dummy loop indices 
     74      INTEGER ::   nbpac            ! local integers  
     75      INTEGER ::   ii, ij, iter     !   -       - 
     76      REAL(wp)  ::   ztmelts, zdv, zfrazb, zweight, zde                         ! local scalars 
    7977      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      - 
    8078      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    8179      LOGICAL  ::   iterate_frazil   ! iterate frazil ice collection thickness 
    8280      CHARACTER (len = 15) :: fieldid 
    83       ! 
    84       INTEGER , POINTER, DIMENSION(:) ::   zcatac      ! indexes of categories where new ice grows 
     81 
     82      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 
     83      REAL(wp) ::   zEi          ! sea ice specific enthalpy (J/kg) 
     84      REAL(wp) ::   zEw          ! seawater specific enthalpy (J/kg) 
     85      REAL(wp) ::   zfmdt        ! mass flux x time step (kg/m2, >0 towards ocean) 
     86      
     87      REAL(wp) ::   zv_newfra 
     88   
     89      INTEGER , POINTER, DIMENSION(:) ::   jcat        ! indexes of categories where new ice grows 
    8590      REAL(wp), POINTER, DIMENSION(:) ::   zswinew     ! switch for new ice or not 
    8691 
    … …  
    9398      REAL(wp), POINTER, DIMENSION(:) ::   zdv_res     ! residual volume in case of excessive heat budget 
    9499      REAL(wp), POINTER, DIMENSION(:) ::   zda_res     ! residual area in case of excessive heat budget 
    95       REAL(wp), POINTER, DIMENSION(:) ::   zat_i_ac    ! total ice fraction     
    96       REAL(wp), POINTER, DIMENSION(:) ::   zat_i_lev   ! total ice fraction for level ice only (type 1)    
    97       REAL(wp), POINTER, DIMENSION(:) ::   zdh_frazb   ! accretion of frazil ice at the ice bottom 
    98       REAL(wp), POINTER, DIMENSION(:) ::   zvrel_ac    ! relative ice / frazil velocity (1D vector) 
    99  
    100       REAL(wp), POINTER, DIMENSION(:,:) ::   zhice_old   ! previous ice thickness 
    101       REAL(wp), POINTER, DIMENSION(:,:) ::   zdummy      ! dummy thickness of new ice  
    102       REAL(wp), POINTER, DIMENSION(:,:) ::   zdhicbot    ! thickness of new ice which is accreted vertically 
    103       REAL(wp), POINTER, DIMENSION(:,:) ::   zv_old      ! old volume of ice in category jl 
    104       REAL(wp), POINTER, DIMENSION(:,:) ::   za_old      ! old area of ice in category jl 
    105       REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_ac     ! 1-D version of a_i 
    106       REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_ac     ! 1-D version of v_i 
    107       REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_ac    ! 1-D version of oa_i 
    108       REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_ac   ! 1-D version of smv_i 
    109  
    110       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_ac   !: 1-D version of e_i 
    111  
    112       REAL(wp), POINTER, DIMENSION(:) ::   zqbgow    ! heat budget of the open water (negative) 
    113       REAL(wp), POINTER, DIMENSION(:) ::   zdhex     ! excessively thick accreted sea ice (hlead-hice) 
    114  
    115       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqm0      ! old layer-system heat content 
    116       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zthick0   ! old ice thickness 
    117  
    118       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final   ! ice volume summed over categories 
    119       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   !  snow volume summed over categories 
    120       REAL(wp), POINTER, DIMENSION(:,:) ::   et_i_init, et_i_final   !  ice energy summed over categories 
    121       REAL(wp), POINTER, DIMENSION(:,:) ::   et_s_init               !  snow energy summed over categories 
     100      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_1d    ! total ice fraction     
     101      REAL(wp), POINTER, DIMENSION(:) ::   zv_frazb    ! accretion of frazil ice at the ice bottom 
     102      REAL(wp), POINTER, DIMENSION(:) ::   zvrel_1d    ! relative ice / frazil velocity (1D vector) 
     103 
     104      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_b      ! old volume of ice in category jl 
     105      REAL(wp), POINTER, DIMENSION(:,:) ::   za_b      ! old area of ice in category jl 
     106      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i 
     107      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i 
     108      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i 
     109 
     110      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d   !: 1-D version of e_i 
     111 
    122112      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity 
     113 
     114      REAL(wp) :: zcai = 1.4e-3_wp 
    123115      !!-----------------------------------------------------------------------! 
    124116 
    125       CALL wrk_alloc( jpij, zcatac )   ! integer 
     117      CALL wrk_alloc( jpij, jcat )   ! integer 
    126118      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    127       CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 
    128       CALL wrk_alloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
    129       CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac ) 
    130       CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 
    131       CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 
    132  
    133       et_i_init(:,:) = 0._wp 
    134       et_s_init(:,:) = 0._wp 
    135       vt_i_init(:,:) = 0._wp 
    136       vt_s_init(:,:) = 0._wp 
    137  
    138       !------------------------------------------------------------------------------! 
    139       ! 1) Conservation check and changes in each ice category 
    140       !------------------------------------------------------------------------------! 
    141       IF( con_i ) THEN 
    142          CALL lim_column_sum        ( jpl, v_i          , vt_i_init) 
    143          CALL lim_column_sum        ( jpl, v_s          , vt_s_init) 
    144          CALL lim_column_sum_energy ( jpl, nlay_i , e_i , et_i_init) 
    145          CALL lim_column_sum        ( jpl, e_s(:,:,1,:) , et_s_init) 
    146       ENDIF 
    147  
     119      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_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 ) 
     122      CALL wrk_alloc( jpi,jpj, zvrel ) 
     123 
     124      CALL lim_var_agg(1) 
     125      CALL lim_var_glo2eqv 
    148126      !------------------------------------------------------------------------------| 
    149127      ! 2) Convert units for ice internal energy 
    … …  
    154132               DO ji = 1, jpi 
    155133                  !Energy of melting q(S,T) [J.m-3] 
    156                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * REAL( nlay_i ) 
    157                   zindb = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes 
    158                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 
     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 ) 
    159136               END DO 
    160137            END DO 
    … …  
    179156 
    180157      ! Default new ice thickness  
    181       hicol(:,:) = hiccrit(1) 
    182  
    183       IF( fraz_swi == 1._wp ) THEN 
     158      hicol(:,:) = rn_hnewice 
     159 
     160      IF( ln_frazil ) THEN 
    184161 
    185162         !-------------------- 
    … …  
    190167         zhicrit = 0.04 ! frazil ice thickness 
    191168         ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav 
    192          zsqcd   = 1.0 / SQRT( 1.3 * cai ) ! 1/SQRT(airdensity*drag) 
     169         zsqcd   = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag) 
    193170         zgamafr = 0.03 
    194171 
    195          DO jj = 1, jpj 
    196             DO ji = 1, jpi 
    197  
    198                IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 
     172         DO jj = 2, jpj 
     173            DO ji = 2, jpi 
     174               IF ( qlead(ji,jj) < 0._wp ) THEN 
    199175                  !------------- 
    200176                  ! Wind stress 
    201177                  !------------- 
    202178                  ! C-grid wind stress components 
    203                   ztaux         = ( utau_ice(ji-1,jj  ) * tmu(ji-1,jj  )   & 
    204                      &          +   utau_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) * 0.5_wp 
    205                   ztauy         = ( vtau_ice(ji  ,jj-1) * tmv(ji  ,jj-1)   & 
    206                      &          +   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 
    207183                  ! Square root of wind stress 
    208                   ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
     184                  ztenagm       =  SQRT( SQRT( ztaux**2 + ztauy**2 ) ) 
    209185 
    210186                  !--------------------- 
    211187                  ! Frazil ice velocity 
    212188                  !--------------------- 
    213                   zvfrx         = zgamafr * zsqcd * ztaux / MAX(ztenagm,epsi10) 
    214                   zvfry         = zgamafr * zsqcd * ztauy / MAX(ztenagm,epsi10) 
     189                  rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) ) 
     190                  zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 ) 
     191                  zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 ) 
    215192 
    216193                  !------------------- 
    … …  
    218195                  !------------------- 
    219196                  ! C-grid ice velocity 
    220                   zindb = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  ) 
    221                   zvgx  = zindb * (  u_ice(ji-1,jj  ) * tmu(ji-1,jj  )    & 
    222                      &             + u_ice(ji,jj    ) * tmu(ji  ,jj  )  ) * 0.5_wp 
    223                   zvgy  = zindb * (  v_ice(ji  ,jj-1) * tmv(ji  ,jj-1)    & 
    224                      &             + v_ice(ji,jj    ) * tmv(ji  ,jj  )  ) * 0.5_wp 
     197                  rswitch = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  ) 
     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 
    225200 
    226201                  !----------------------------------- 
    … …  
    248223                  iterate_frazil = .true. 
    249224 
    250                   DO WHILE ( iter .LT. 100 .AND. iterate_frazil )  
     225                  DO WHILE ( iter < 100 .AND. iterate_frazil )  
    251226                     zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) & 
    252227                        - hicol(ji,jj) * zhicrit * ztwogp * zvrel2 
    … …  
    264239            END DO ! loop on ji ends 
    265240         END DO ! loop on jj ends 
     241      !  
     242      CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 
     243      CALL lbc_lnk( hicol(:,:), 'T', 1. ) 
    266244 
    267245      ENDIF ! End of computation of frazil ice collection thickness 
    … …  
    276254      ! This occurs if open water energy budget is negative 
    277255      nbpac = 0 
     256      npac(:) = 0 
     257      ! 
    278258      DO jj = 1, jpj 
    279259         DO ji = 1, jpi 
    280             IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) )  >  0._wp ) THEN 
     260            IF ( qlead(ji,jj)  <  0._wp ) THEN 
    281261               nbpac = nbpac + 1 
    282262               npac( nbpac ) = (jj - 1) * jpi + ji 
    … …  
    287267      ! debug point to follow 
    288268      jiindex_1d = 0 
    289       IF( ln_nicep ) THEN 
    290          DO ji = mi0(jiindx), mi1(jiindx) 
    291             DO jj = mj0(jjindx), mj1(jjindx) 
    292                IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) )  >  0._wp ) THEN 
     269      IF( ln_icectl ) THEN 
     270         DO ji = mi0(iiceprt), mi1(iiceprt) 
     271            DO jj = mj0(jiceprt), mj1(jiceprt) 
     272               IF ( qlead(ji,jj)  <  0._wp ) THEN 
    293273                  jiindex_1d = (jj - 1) * jpi + ji 
    294274               ENDIF 
    … …  
    297277      ENDIF 
    298278    
    299       IF( ln_nicep ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
     279      IF( ln_icectl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
    300280 
    301281      !------------------------------ 
    … …  
    307287      IF ( nbpac > 0 ) THEN 
    308288 
    309          CALL tab_2d_1d( nbpac, zat_i_ac  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) ) 
     289         CALL tab_2d_1d( nbpac, zat_i_1d  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) ) 
    310290         DO jl = 1, jpl 
    311             CALL tab_2d_1d( nbpac, za_i_ac  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    312             CALL tab_2d_1d( nbpac, zv_i_ac  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    313             CALL tab_2d_1d( nbpac, zoa_i_ac (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    314             CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     291            CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     292            CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     293            CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    315294            DO jk = 1, nlay_i 
    316                CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
    317             END DO ! jk 
    318          END DO ! jl 
    319  
    320          CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif  , jpi, jpj, npac(1:nbpac) ) 
    321          CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif  , jpi, jpj, npac(1:nbpac) ) 
    322          CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) ) 
    323          CALL tab_2d_1d( nbpac, sfx_thd_1d(1:nbpac)     , sfx_thd, jpi, jpj, npac(1:nbpac) ) 
    324          CALL tab_2d_1d( nbpac, rdm_ice_1d(1:nbpac)     , rdm_ice, jpi, jpj, npac(1:nbpac) ) 
    325          CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) ) 
    326          CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) ) 
     295               CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
     296            END DO 
     297         END DO 
     298 
     299         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) ) 
     300         CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) ) 
     301         CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw, jpi, jpj, npac(1:nbpac) ) 
     302         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw, jpi, jpj, npac(1:nbpac) ) 
     303         CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) ) 
     304         CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) ) 
     305 
     306         CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd, jpi, jpj, npac(1:nbpac) ) 
     307         CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw, jpi, jpj, npac(1:nbpac) ) 
    327308 
    328309         !------------------------------------------------------------------------------! 
    … …  
    330311         !------------------------------------------------------------------------------! 
    331312 
     313         !----------------------------------------- 
     314         ! Keep old ice areas and volume in memory 
     315         !----------------------------------------- 
     316         zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:)  
     317         za_b(1:nbpac,:) = za_i_1d(1:nbpac,:) 
    332318         !---------------------- 
    333319         ! Thickness of new ice 
    334320         !---------------------- 
    335321         DO ji = 1, nbpac 
    336             zh_newice(ji) = hiccrit(1) 
    337          END DO 
    338          IF( fraz_swi == 1.0 )   zh_newice(:) = hicol_b(:) 
     322            zh_newice(ji) = rn_hnewice 
     323         END DO 
     324         IF( ln_frazil ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 
    339325 
    340326         !---------------------- 
    341327         ! Salinity of new ice  
    342328         !---------------------- 
    343  
    344          SELECT CASE ( num_sal ) 
     329         SELECT CASE ( nn_icesal ) 
    345330         CASE ( 1 )                    ! Sice = constant  
    346             zs_newice(:) = bulk_sal 
     331            zs_newice(1:nbpac) = rn_icesal 
    347332         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)] 
    348333            DO ji = 1, nbpac 
    349334               ii =   MOD( npac(ji) - 1 , jpi ) + 1 
    350335               ij =      ( npac(ji) - 1 ) / jpi + 1 
    351                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)  ) 
    352337            END DO 
    353338         CASE ( 3 )                    ! Sice = F(z) [multiyear ice] 
    354             zs_newice(:) =   2.3 
     339            zs_newice(1:nbpac) =   2.3 
    355340         END SELECT 
    356  
    357341 
    358342         !------------------------- 
    … …  
    361345         ! We assume that new ice is formed at the seawater freezing point 
    362346         DO ji = 1, nbpac 
    363             ztmelts       = - tmut * zs_newice(ji) + rtt                  ! Melting point (K) 
    364             ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                             & 
    365                &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )   & 
    366                &                       - rcp  *         ( ztmelts - rtt )  ) 
    367             ze_newice(ji) =   MAX( ze_newice(ji) , 0._wp )    & 
    368                &          +   MAX(  0.0 , SIGN( 1.0 , - ze_newice(ji) )  ) * rhoic * lfus 
    369          END DO ! ji 
     347            ztmelts       = - tmut * zs_newice(ji) + rt0                  ! Melting point (K) 
     348            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                             & 
     349               &                       + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) )   & 
     350               &                       - rcp  *         ( ztmelts - rt0 )  ) 
     351         END DO 
     352 
    370353         !---------------- 
    371354         ! Age of new ice 
    … …  
    373356         DO ji = 1, nbpac 
    374357            zo_newice(ji) = 0._wp 
    375          END DO ! ji 
    376  
    377          !-------------------------- 
    378          ! Open water energy budget  
    379          !-------------------------- 
    380          DO ji = 1, nbpac 
    381             zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji)     !<0 
    382          END DO ! ji 
     358         END DO 
    383359 
    384360         !------------------- 
    … …  
    386362         !------------------- 
    387363         DO ji = 1, nbpac 
    388             zv_newice(ji) = - zqbgow(ji) / ze_newice(ji) 
     364 
     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] 
     368                                                                   ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied)  
     369                                                                    
     370            zdE           = zEi - zEw                              ! specific enthalpy difference [J/kg] 
     371                                               
     372            zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0)  
     373                                                                   ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point    
     374            zv_newice(ji) = - zfmdt * r1_rhoic 
     375 
     376            zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux   
     377 
     378            ! Contribution to heat flux to the ocean [W.m-2], >0   
     379            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice 
     380            ! Total heat flux used in this process [W.m-2]   
     381            hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice 
     382            ! mass flux 
     383            wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoic * r1_rdtice 
     384            ! salt flux 
     385            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 
    389386 
    390387            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    391             zfrazb        = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 
    392             zdh_frazb(ji) =         zfrazb   * zv_newice(ji) 
     388            rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 
     389            zfrazb        = rswitch * ( TANH ( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb 
     390            zv_frazb(ji)  =         zfrazb   * zv_newice(ji) 
    393391            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
    394392         END DO 
    395  
    396          !------------------------------------ 
    397          ! Diags for energy conservation test 
    398          !------------------------------------ 
    399          DO ji = 1, nbpac 
    400             ii = MOD( npac(ji) - 1 , jpi ) + 1 
    401             ij =    ( npac(ji) - 1 ) / jpi + 1 
    402             ! 
    403             zde = ze_newice(ji) / unit_fac * area(ii,ij) * zv_newice(ji) 
    404             ! 
    405             vt_i_init(ii,ij) = vt_i_init(ii,ij) + zv_newice(ji)             ! volume 
    406             et_i_init(ii,ij) = et_i_init(ii,ij) + zde                       ! Energy 
    407  
    408          END DO 
    409  
    410          ! keep new ice volume in memory 
    411          CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , jpi, jpj ) 
    412393 
    413394         !----------------- 
    … …  
    415396         !----------------- 
    416397         DO ji = 1, nbpac 
    417             ii = MOD( npac(ji) - 1 , jpi ) + 1 
    418             ij =    ( npac(ji) - 1 ) / jpi + 1 
    419398            za_newice(ji) = zv_newice(ji) / zh_newice(ji) 
    420             diag_lat_gr(ii,ij) = diag_lat_gr(ii,ij) + zv_newice(ji) * r1_rdtice ! clem 
    421          END DO !ji 
     399         END DO 
    422400 
    423401         !------------------------------------------------------------------------------! 
    … …  
    425403         !------------------------------------------------------------------------------! 
    426404 
    427          !----------------------------------------- 
    428          ! Keep old ice areas and volume in memory 
    429          !----------------------------------------- 
    430          zv_old(:,:) = zv_i_ac(:,:)  
    431          za_old(:,:) = za_i_ac(:,:) 
    432  
    433          !------------------------------------------- 
    434          ! Compute excessive new ice area and volume 
    435          !------------------------------------------- 
     405         !------------------------ 
     406         ! 6.1) lateral ice growth 
     407         !------------------------ 
    436408         ! If lateral ice growth gives an ice concentration gt 1, then 
    437409         ! we keep the excessive volume in memory and attribute it later to bottom accretion 
    438410         DO ji = 1, nbpac 
    439             IF ( za_newice(ji) >  ( amax - zat_i_ac(ji) ) ) THEN 
    440                zda_res(ji)   = za_newice(ji) - ( amax - zat_i_ac(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) ) 
    441413               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji)  
    442414               za_newice(ji) = za_newice(ji) - zda_res  (ji) 
    … …  
    446418               zdv_res(ji) = 0._wp 
    447419            ENDIF 
    448          END DO ! ji 
    449  
    450          !------------------------------------------------ 
    451          ! Laterally redistribute new ice volume and area 
    452          !------------------------------------------------ 
    453          zat_i_ac(:) = 0._wp 
     420         END DO 
     421 
     422         ! find which category to fill 
     423         zat_i_1d(:) = 0._wp 
    454424         DO jl = 1, jpl 
    455425            DO ji = 1, nbpac 
    456                IF(  hi_max   (jl-1)  <   zh_newice(ji)   .AND.   & 
    457                   & zh_newice(ji)    <=  hi_max   (jl)         ) THEN 
    458                   za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 
    459                   zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) 
    460                   zat_i_ac(ji)    = zat_i_ac(ji)    + za_i_ac  (ji,jl) 
    461                   zcatac  (ji)    = jl 
     426               IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN 
     427                  za_i_1d (ji,jl) = za_i_1d (ji,jl) + za_newice(ji) 
     428                  zv_i_1d (ji,jl) = zv_i_1d (ji,jl) + zv_newice(ji) 
     429                  jcat    (ji)    = jl 
    462430               ENDIF 
    463             END DO 
    464          END DO 
    465  
    466          !---------------------------------- 
    467          ! Heat content - lateral accretion 
    468          !---------------------------------- 
    469          DO ji = 1, nbpac 
    470             jl = zcatac(ji)                                                           ! categroy in which new ice is put 
    471             zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) + epsi10 ) )             ! zindb=1 if ice =0 otherwise 
    472             zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb  ! old ice thickness 
    473             zdhex    (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) )           ! difference in thickness 
    474             zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) )   ! ice totally new in jl category 
     431               zat_i_1d(ji) = zat_i_1d(ji) + za_i_1d  (ji,jl) 
     432            END DO 
     433         END DO 
     434 
     435         ! Heat content 
     436         DO ji = 1, nbpac 
     437            jl = jcat(ji)                                                    ! categroy in which new ice is put 
     438            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) )   ! 0 if old ice 
    475439         END DO 
    476440 
    477441         DO jk = 1, nlay_i 
    478442            DO ji = 1, nbpac 
    479                jl = zcatac(ji) 
    480                zqold   = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 
    481                zalphai = MIN( zhice_old(ji,jl) * REAL( jk )     / REAL( nlay_i ), zh_newice(ji) )   & 
    482                   &    - MIN( zhice_old(ji,jl) * REAL( jk - 1 ) / REAL( nlay_i ), zh_newice(ji) ) 
    483                ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji)                                     & 
    484                   + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / REAL( nlay_i )  & 
    485                   + za_newice(ji)  * ze_newice(ji) * zalphai                                       & 
    486                   + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / REAL( nlay_i ) ) / ( ( zv_i_ac(ji,jl) ) / REAL( nlay_i ) ) 
    487             END DO 
    488          END DO 
    489  
    490          !----------------------------------------------- 
    491          ! Add excessive volume of new ice at the bottom 
    492          !----------------------------------------------- 
    493          ! If the ice concentration exceeds 1, the remaining volume of new ice 
    494          ! is equally redistributed among all ice categories in which there is 
    495          ! ice 
    496  
    497          ! Fraction of level ice 
    498          jm = 1 
    499          zat_i_lev(:) = 0._wp 
    500  
    501          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    502             DO ji = 1, nbpac 
    503                zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl)  
    504             END DO 
    505          END DO 
    506  
    507          IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 
    508          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    509             DO ji = 1, nbpac 
    510                zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) ) 
    511                zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_lev(ji) - epsi10 ) )  ! clem 
    512                zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zinda * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi10 ) 
    513             END DO 
    514          END DO 
    515          IF( ln_nicep .AND. jiindex_1d > 0 )   WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 
    516  
    517          !--------------------------------- 
    518          ! Heat content - bottom accretion 
    519          !--------------------------------- 
    520          jm = 1 
    521          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    522             DO ji = 1, nbpac 
    523                zindb =  1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) + epsi10 ) )       ! zindb=1 if ice =0 otherwise 
    524                zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 
    525                zdhicbot (ji,jl) = zdv_res(ji)    / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    & 
    526                   &             +  zindb * zdh_frazb(ji)                               ! frazil ice may coalesce 
    527                zdummy(ji,jl)    = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb      ! thickness of residual ice 
    528             END DO 
    529          END DO 
    530  
    531          ! old layers thicknesses and enthalpies 
    532          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     443               jl = jcat(ji) 
     444               rswitch = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) ) 
     445               ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                      & 
     446                  &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) )  & 
     447                  &        * rswitch / MAX( zv_i_1d(ji,jl), epsi20 ) 
     448            END DO 
     449         END DO 
     450 
     451         !------------------------------------------------ 
     452         ! 6.2) bottom ice growth + ice enthalpy remapping 
     453         !------------------------------------------------ 
     454         DO jl = 1, jpl 
     455 
     456            ! for remapping 
     457            h_i_old (1:nbpac,0:nlay_i+1) = 0._wp 
     458            qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 
    533459            DO jk = 1, nlay_i 
    534460               DO ji = 1, nbpac 
    535                   zthick0(ji,jk,jl) =  zhice_old(ji,jl) / REAL( nlay_i ) 
    536                   zqm0   (ji,jk,jl) =  ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 
     461                  h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i 
     462                  qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk) 
    537463               END DO 
    538464            END DO 
    539          END DO 
    540 !!gm ???  why the previous do loop  if ocerwriten by the following one ? 
    541          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     465 
     466            ! new volumes including lateral/bottom accretion + residual 
    542467            DO ji = 1, nbpac 
    543                zthick0(ji,nlay_i+1,jl) =  zdhicbot(ji,jl) 
    544                zqm0   (ji,nlay_i+1,jl) =  ze_newice(ji) * zdhicbot(ji,jl) 
    545             END DO ! ji 
    546          END DO ! jl 
    547  
    548          ! Redistributing energy on the new grid 
    549          ze_i_ac(:,:,:) = 0._wp 
    550          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    551             DO jk = 1, nlay_i 
    552                DO layer = 1, nlay_i + 1 
    553                   DO ji = 1, nbpac 
    554                      zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  
    555                      ! Redistributing energy on the new grid 
    556                      zweight = MAX (  MIN( zhice_old(ji,jl) * REAL( layer ), zdummy(ji,jl) * REAL( jk ) )   & 
    557                         &    - MAX( zhice_old(ji,jl) * REAL( layer - 1 ) , zdummy(ji,jl) * REAL( jk - 1 ) ) , 0._wp )   & 
    558                         &    /( MAX(REAL(nlay_i) * zthick0(ji,layer,jl),epsi10) ) * zindb 
    559                      ze_i_ac(ji,jk,jl) =  ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl)   
    560                   END DO ! ji 
    561                END DO ! layer 
    562             END DO ! jk 
    563          END DO ! jl 
    564  
    565          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    566             DO jk = 1, nlay_i 
    567                DO ji = 1, nbpac 
    568                   zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  
    569                   ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl)   & 
    570                      &              / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * REAL( nlay_i ) * zindb 
    571                END DO 
    572             END DO 
    573          END DO 
    574  
    575          !------------ 
    576          ! Update age  
    577          !------------ 
    578          DO jl = 1, jpl 
    579             DO ji = 1, nbpac 
    580                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    581                zoa_i_ac(ji,jl)  = za_old(ji,jl) * zoa_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    
    582             END DO  
    583          END DO    
     468               rswitch        = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) 
     469               zv_newfra      = rswitch * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 ) 
     470               za_i_1d(ji,jl) = rswitch * za_i_1d(ji,jl)                
     471               zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra 
     472               ! for remapping 
     473               h_i_old (ji,nlay_i+1) = zv_newfra 
     474               qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra 
     475            ENDDO 
     476            ! --- Ice enthalpy remapping --- ! 
     477            CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) )  
     478         ENDDO 
    584479 
    585480         !----------------- 
    586481         ! Update salinity 
    587482         !----------------- 
    588          !clem IF(  num_sal == 2  ) THEN 
    589             DO jl = 1, jpl 
    590                DO ji = 1, nbpac 
    591                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    592                   zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    593                   zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) * zindb ! clem modif 
    594                END DO 
    595             END DO    
    596          !clem ENDIF 
    597  
    598          !-------------------------------- 
    599          ! Update mass/salt fluxes (clem) 
    600          !-------------------------------- 
    601483         DO jl = 1, jpl 
    602484            DO ji = 1, nbpac 
    603                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    604                zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    605                rdm_ice_1d(ji) = rdm_ice_1d(ji) + zdv * rhoic * zindb 
    606                sfx_thd_1d(ji)   =   sfx_thd_1d(ji) - zdv * rhoic * zs_newice(ji) * r1_rdtice * zindb 
    607            END DO 
     485               zdv   = zv_i_1d(ji,jl) - zv_b(ji,jl) 
     486               zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji) 
     487            END DO 
    608488         END DO 
    609489 
    610490         !------------------------------------------------------------------------------! 
    611          ! 8) Change 2D vectors to 1D vectors  
     491         ! 7) Change 2D vectors to 1D vectors  
    612492         !------------------------------------------------------------------------------! 
    613493         DO jl = 1, jpl 
    614             CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_ac (1:nbpac,jl), jpi, jpj ) 
    615             CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 
    616             CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 
    617             !clem IF (  num_sal == 2  )   & 
    618                CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 
     494            CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 
     495            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 
     496            CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 
    619497            DO jk = 1, nlay_i 
    620                CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 
    621             END DO 
    622          END DO 
    623          CALL tab_1d_2d( nbpac, sfx_thd, npac(1:nbpac), sfx_thd_1d(1:nbpac), jpi, jpj ) 
    624          CALL tab_1d_2d( nbpac, rdm_ice, npac(1:nbpac), rdm_ice_1d(1:nbpac), jpi, jpj ) 
     498               CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_1d(1:nbpac,jk,jl), jpi, jpj ) 
     499            END DO 
     500         END DO 
     501         CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj ) 
     502         CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 
     503 
     504         CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj ) 
     505         CALL tab_1d_2d( nbpac, hfx_opw, npac(1:nbpac), hfx_opw_1d(1:nbpac), jpi, jpj ) 
    625506         ! 
    626507      ENDIF ! nbpac > 0 
    627508 
    628509      !------------------------------------------------------------------------------! 
    629       ! 9) Change units for e_i 
     510      ! 8) Change units for e_i 
    630511      !------------------------------------------------------------------------------!     
    631512      DO jl = 1, jpl 
    632          DO jk = 1, nlay_i          ! heat content in 10^9 Joules 
    633             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / REAL( nlay_i )  / unit_fac  
     513         DO jk = 1, nlay_i 
     514            DO jj = 1, jpj 
     515               DO ji = 1, jpi 
     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  
     518               END DO 
     519            END DO 
    634520         END DO 
    635521      END DO 
    636522 
    637       !------------------------------------------------------------------------------| 
    638       ! 10) Conservation check and changes in each ice category 
    639       !------------------------------------------------------------------------------| 
    640       IF( con_i ) THEN  
    641          CALL lim_column_sum (jpl,   v_i, vt_i_final) 
    642          fieldid = 'v_i, limthd_lac' 
    643          CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)  
    644          ! 
    645          CALL lim_column_sum_energy(jpl, nlay_i, e_i, et_i_final) 
    646          fieldid = 'e_i, limthd_lac' 
    647          CALL lim_cons_check (et_i_final, et_i_final, 1.0e-3, fieldid)  
    648          ! 
    649          CALL lim_column_sum (jpl,   v_s, vt_s_final) 
    650          fieldid = 'v_s, limthd_lac' 
    651          CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
    652          ! 
    653          !     CALL lim_column_sum (jpl,   e_s(:,:,1,:) , et_s_init) 
    654          !     fieldid = 'e_s, limthd_lac' 
    655          !     CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid)  
    656          IF( ln_nicep ) THEN 
    657             DO ji = mi0(jiindx), mi1(jiindx) 
    658                DO jj = mj0(jjindx), mj1(jjindx) 
    659                   WRITE(numout,*) ' vt_i_init : ', vt_i_init (ji,jj) 
    660                   WRITE(numout,*) ' vt_i_final: ', vt_i_final(ji,jj) 
    661                   WRITE(numout,*) ' et_i_init : ', et_i_init (ji,jj) 
    662                   WRITE(numout,*) ' et_i_final: ', et_i_final(ji,jj) 
    663                END DO 
    664             END DO 
    665          ENDIF 
    666          ! 
    667       ENDIF 
    668523      ! 
    669       CALL wrk_dealloc( jpij, zcatac )   ! integer 
     524      CALL wrk_dealloc( jpij, jcat )   ! integer 
    670525      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    671       CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 
    672       CALL wrk_dealloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
    673       CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac ) 
    674       CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 
    675       CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 
     526      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_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 ) 
     529      CALL wrk_dealloc( jpi,jpj, zvrel ) 
    676530      ! 
    677531   END SUBROUTINE lim_thd_lac 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r4624 r5832  
    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 
    5352      ! 
    5453      INTEGER  ::   ji, jk     ! dummy loop indices  
    55       REAL(wp) ::   zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch,  ztmelts   ! local scalars 
    56       REAL(wp) ::   zaaa, zbbb, zccc, zdiscrim   ! local scalars 
    57       REAL(wp), POINTER, DIMENSION(:) ::   ze_init, zhiold, zsiold 
     54      REAL(wp) ::   iflush, igravdr   ! local scalars 
    5855      !!--------------------------------------------------------------------- 
    5956 
    60       CALL wrk_alloc( jpij, ze_init, zhiold, zsiold ) 
    61  
     57      !--------------------------------------------------------- 
     58      !  0) Update ice salinity from snow-ice and bottom growth 
     59      !--------------------------------------------------------- 
     60      DO ji = kideb, kiut 
     61         sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 
     62      END DO 
     63  
    6264      !------------------------------------------------------------------------------| 
    6365      ! 1) Constant salinity, constant in time                                       | 
    6466      !------------------------------------------------------------------------------| 
    65 !!gm comment: if num_sal = 1 s_i_new, s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !! 
    66 !!gm           ===>>>   simplification of almost all test on num_sal value 
    67       IF(  num_sal == 1  ) THEN 
    68             s_i_b  (kideb:kiut,1:nlay_i) =  bulk_sal 
    69             sm_i_b (kideb:kiut)          =  bulk_sal  
    70             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 
    7173      ENDIF 
    7274 
    … …  
    7476      !  Module 2 : Constant salinity varying in time                                | 
    7577      !------------------------------------------------------------------------------| 
    76  
    77       IF(  num_sal == 2  ) THEN 
    78  
    79          !--------------------------------- 
    80          ! Thickness at previous time step 
    81          !--------------------------------- 
    82          DO ji = kideb, kiut 
    83             zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji) 
    84             zsiold(ji) = sm_i_b(ji) 
    85          END DO 
    86  
    87          !--------------------- 
    88          ! Global heat content 
    89          !--------------------- 
    90          ze_init(:)  =  0._wp 
    91          DO jk = 1, nlay_i 
    92             DO ji = kideb, kiut 
    93                ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / REAL (nlay_i ) 
    94             END DO 
    95          END DO 
     78      IF(  nn_icesal == 2  ) THEN 
    9679 
    9780         DO ji = kideb, kiut 
    … …  
    9982            ! Switches  
    10083            !---------- 
    101             iflush       =         MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt )        )    ! =1 if summer  
    102             igravdr      =         MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) )    ! =1 if t_su < t_bo 
    103             iaccrbo      =         MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) )           )    ! =1 if bottom accretion 
    104             i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) ) 
    105             isnowic      = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch   ! =1 if snow ice formation 
     84            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 )        )     ! =1 if summer  
     85            igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )    ! =1 if t_su < t_bo 
    10686 
    10787            !--------------------- 
    10888            ! Salinity tendencies 
    10989            !--------------------- 
    110             !                                   ! drainage by gravity drainage 
    111             dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice  
    112             !                                   ! drainage by flushing   
    113             dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 
     90            ! drainage by gravity drainage 
     91            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice  
     92            ! drainage by flushing   
     93            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice 
    11494 
    11595            !----------------- 
    … …  
    11898            ! only drainage terms ( gravity drainage and flushing ) 
    11999            ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 
    120             sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
    121  
    122             ! if no ice, salinity = 0.1 
    123             i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 
    124             sm_i_b(ji)   = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch ) 
    125  
    126             !---------------------------- 
    127             ! Heat flux - brine drainage 
    128             !---------------------------- 
    129             fhbri_1d(ji) = 0._wp 
     100            sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
    130101 
    131102            !---------------------------- 
    132103            ! Salt flux - brine drainage 
    133104            !---------------------------- 
    134             sfx_bri_1d(ji) = sfx_bri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) * ( sm_i_b(ji) - zsiold(ji) ) * r1_rdtice 
     105            sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 
    135106 
    136107         END DO 
    … …  
    138109         ! Salinity profile 
    139110         CALL lim_var_salprof1d( kideb, kiut ) 
    140  
    141  
    142          ! Only necessary for conservation check since salinity is modified 
    143          !-------------------- 
    144          ! Temperature update 
    145          !-------------------- 
    146          DO jk = 1, nlay_i 
    147             DO ji = kideb, kiut 
    148                ztmelts    =  -tmut*s_i_b(ji,jk) + rtt 
    149                !Conversion q(S,T) -> T (second order equation) 
    150                zaaa         =  cpic 
    151                zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 
    152                zccc         =  lfus * ( ztmelts - rtt ) 
    153                zdiscrim     =  SQRT(  MAX( zbbb*zbbb - 4.0*zaaa*zccc, 0._wp )  ) 
    154                t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 
    155             END DO 
    156          END DO 
    157111         ! 
    158112      ENDIF  
    … …  
    161115      !  Module 3 : Profile of salinity, constant in time                            | 
    162116      !------------------------------------------------------------------------------| 
     117      IF(  nn_icesal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
    163118 
    164       IF(  num_sal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
    165  
    166       ! 
    167       CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold ) 
    168119      ! 
    169120   END SUBROUTINE lim_thd_sal 
    … …  
    182133      !!------------------------------------------------------------------- 
    183134      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    184       NAMELIST/namicesal/ num_sal, bulk_sal, sal_G, time_G, sal_F, time_F,   & 
    185          &                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  
    186137      !!------------------------------------------------------------------- 
    187138      ! 
    … …  
    199150         WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity ' 
    200151         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    201          WRITE(numout,*) ' switch for salinity num_sal        : ', num_sal 
    202          WRITE(numout,*) ' bulk salinity value if num_sal = 1 : ', bulk_sal 
    203          WRITE(numout,*) ' restoring salinity for GD          : ', sal_G 
    204          WRITE(numout,*) ' restoring time for GD              : ', time_G 
    205          WRITE(numout,*) ' restoring salinity for flushing    : ', sal_F 
    206          WRITE(numout,*) ' restoring time for flushing        : ', time_F 
    207          WRITE(numout,*) ' Maximum tolerated ice salinity     : ', s_i_max 
    208          WRITE(numout,*) ' Minimum tolerated ice salinity     : ', s_i_min 
    209          WRITE(numout,*) ' 1st salinity for salinity profile  : ', s_i_0 
    210          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 
    211160      ENDIF 
    212161      ! 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r4333 r5832  
    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 
     32   USE limcons        ! conservation tests 
     33   USE limctl         ! control prints 
    3234 
    3335   IMPLICIT NONE 
    3436   PRIVATE 
    3537 
    36    PUBLIC   lim_trp    ! called by ice_step 
    37  
    38    REAL(wp)  ::   epsi10 = 1.e-10_wp   
    39    REAL(wp)  ::   rzero  = 0._wp    
    40    REAL(wp)  ::   rone   = 1._wp 
     38   PUBLIC   lim_trp    ! called by sbcice_lim 
     39 
     40   INTEGER  ::   ncfl                 ! number of ice time step with CFL>1/2   
    4141 
    4242   !! * Substitution 
    … …  
    6161      !! ** action : 
    6262      !!--------------------------------------------------------------------- 
    63       INTEGER, INTENT(in) ::   kt   ! number of iteration 
     63      INTEGER, INTENT(in) ::   kt           ! number of iteration 
    6464      ! 
    65       INTEGER  ::   ji, jj, jk, jl, layer   ! dummy loop indices 
     65      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices 
    6666      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    67       INTEGER  ::   ierr                    ! error status 
    68       REAL(wp) ::   zindb  , zindsn , zindic, zindh, zinda      ! local scalar 
    69       REAL(wp) ::   zusvosn, zusvoic, zbigval     !   -      - 
    70       REAL(wp) ::   zcfl , zusnit                 !   -      - 
    71       REAL(wp) ::   ze   , zsal   , zage          !   -      - 
     67      REAL(wp) ::   zcfl , zusnit           !   -      - 
     68      CHARACTER(len=80) ::   cltmp 
    7269      ! 
    73       REAL(wp), POINTER, DIMENSION(:,:)      ::   zui_u, zvi_v, zsm, zs0at, zs0ow 
    74       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 
    75       REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e 
    76       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    77       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset) 
    78       ! mass and salt flux (clem) 
    79       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold   ! old ice volume... 
    80       ! correct ice thickness (clem) 
    81       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaiold, zhimax   ! old ice concentration and thickness 
    82       REAL(wp) :: zdv, zda, zvi, zvs, zsmv 
     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 
    8379      !!--------------------------------------------------------------------- 
    8480      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
    8581 
    86       CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
    87       CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    88       CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 
    89  
    90       CALL wrk_alloc( jpi,jpj,jpl,zviold )   ! clem 
    91       CALL wrk_alloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
    92  
    93       ! ------------------------------- 
    94       !- check conservation (C Rousset) 
    95       IF( ln_limdiahsb ) THEN 
    96          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    97          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    98          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    99          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    100       ENDIF 
    101       !- check conservation (C Rousset) 
    102       ! ------------------------------- 
     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 ) 
    10387 
    10488      IF( numit == nstart .AND. lwp ) THEN 
    … …  
    10892         ENDIF 
    10993         WRITE(numout,*) '~~~~~~~~~~~~' 
     94         ncfl = 0                ! nb of time step with CFL > 1/2 
    11095      ENDIF 
     96 
     97      zsm(:,:) = e12t(:,:) 
    11198       
    112       zsm(:,:) = area(:,:) 
    113  
    11499      !                             !-------------------------------------! 
    115100      IF( ln_limdyn ) THEN          !   Advection of sea ice properties   ! 
    116101         !                          !-------------------------------------! 
    117          ! mass and salt flux init (clem) 
     102 
     103         ! conservation test 
     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 
    118107         zviold(:,:,:)  = v_i(:,:,:) 
    119  
    120          !--- Thickness correction init. (clem) ------------------------------- 
    121          CALL lim_var_glo2eqv 
    122          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 
    123124         !--------------------------------------------------------------------- 
    124          ! Record max of the surrounding ice thicknesses for correction in limupdate 
     125         ! Record max of the surrounding ice thicknesses for correction 
    125126         ! in case advection creates ice too thick. 
    126127         !--------------------------------------------------------------------- 
    127          zhimax(:,:,:) = ht_i(:,:,:) 
     128         zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 
    128129         DO jl = 1, jpl 
    129130            DO jj = 2, jpjm1 
    130131               DO ji = 2, jpim1 
    131                   zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) ) 
    132                   !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) & 
    133                   !     &             + ht_i(ji-1,jj  ,jl) * tmask(ji-1,jj  ,1) + ht_i(ji  ,jj-1,jl) * tmask(ji  ,jj-1,1) & 
    134                   !     &             + ht_i(ji+1,jj  ,jl) * tmask(ji+1,jj  ,1) + ht_i(ji  ,jj+1,jl) * tmask(ji  ,jj+1,1) & 
    135                   !     &             + 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) ) 
    136133               END DO 
    137134            END DO 
    … …  
    139136         END DO 
    140137          
     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 
    141161         !------------------------- 
    142162         ! transported fields                                         
    143163         !------------------------- 
    144          ! Snow vol, ice vol, salt and age contents, area 
    145          zs0ow(:,:) = ato_i(:,:) * area(:,:)               ! Open water area  
    146          DO jl = 1, jpl 
    147             zs0sn (:,:,jl)   = v_s  (:,:,jl) * area(:,:)    ! Snow volume 
    148             zs0ice(:,:,jl)   = v_i  (:,:,jl) * area(:,:)    ! Ice  volume 
    149             zs0a  (:,:,jl)   = a_i  (:,:,jl) * area(:,:)    ! Ice area 
    150             zs0sm (:,:,jl)   = smv_i(:,:,jl) * area(:,:)    ! Salt content 
    151             zs0oi (:,:,jl)   = oa_i (:,:,jl) * area(:,:)    ! Age content 
    152             zs0c0 (:,:,jl)   = e_s  (:,:,1,jl)              ! Snow heat content 
    153             zs0e  (:,:,:,jl) = e_i  (:,:,:,jl)              ! Ice  heat content 
    154          END DO 
    155  
    156          !-------------------------- 
    157          ! Advection of Ice fields  (Prather scheme)                                             
    158          !-------------------------- 
    159          ! If ice drift field is too fast, use an appropriate time step for advection.          
    160          ! CFL test for stability 
    161          zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice / e1u(:,:) ) 
    162          zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) ) 
    163          IF(lk_mpp )   CALL mpp_max( zcfl ) 
    164 !!gm more readability: 
    165 !         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
    166 !         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
    167 !         ENDIF 
    168 !!gm end 
    169          initad = 1 + NINT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
    170          zusnit = 1.0 / REAL( initad )  
    171          IF( zcfl > 0.5 .AND. lwp )   & 
    172             WRITE(numout,*) 'lim_trp   : CFL violation at day ', nday, ', cfl = ', zcfl,   & 
    173                &                        ': 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 
    174177 
    175178         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==! 
    176             DO jk = 1,initad 
    177                CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    178                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    179                CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
    180                   &                                       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(:,:)  ) 
    181184               DO jl = 1, jpl 
    182                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     185                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    183186                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    184                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     187                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   & 
    185188                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    186                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     189                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    187190                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    188                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     191                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   & 
    189192                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    190                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     193                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    191194                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    192                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     195                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   & 
    193196                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    194                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---      
     197                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---      
    195198                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    196                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     199                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0oi (:,:,jl), sxage(:,:,jl),   & 
    197200                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    198                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     201                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations --- 
    199202                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    200                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &  
     203                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &  
    201204                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    202                   CALL lim_adv_x( zusnit, u_ice, rone , 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 --- 
    203206                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    204                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     207                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0es (:,:,jl), sxc0 (:,:,jl),   & 
    205208                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    206                   DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    207                      CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    208                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    209                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    210                      CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    211                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    212                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,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),   &  
     211                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     212                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     213                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     214                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     215                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    213216                  END DO 
    214217               END DO 
    215218            END DO 
    216219         ELSE 
    217             DO jk = 1, initad 
    218                CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    219                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    220                CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
    221                   &                                       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(:,:)  ) 
    222225               DO jl = 1, jpl 
    223                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     226                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    224227                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    225                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     228                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   & 
    226229                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    227                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     230                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    228231                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    229                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     232                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   & 
    230233                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    231                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     234                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    232235                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    233                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     236                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   & 
    234237                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    235  
    236                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
     238                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    237239                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    238                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     240                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0oi (:,:,jl), sxage(:,:,jl),   & 
    239241                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    240                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     242                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    241243                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    242                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
     244                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
    243245                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    244                   CALL lim_adv_y( zusnit, v_ice, rone , 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 --- 
    245247                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    246                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     248                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0es (:,:,jl), sxc0 (:,:,jl),   & 
    247249                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    248                   DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    249                      CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    250                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    251                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    252                      CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    253                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    254                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
     250                  DO jk = 1, nlay_i                                                           !--- ice heat contents --- 
     251                     CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     252                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     253                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     254                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     255                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     256                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    255257                  END DO 
    256258               END DO 
    … …  
    261263         ! Recover the properties from their contents 
    262264         !------------------------------------------- 
    263          zs0ow(:,:) = zs0ow(:,:) / area(:,:) 
    264          DO jl = 1, jpl 
    265             zs0ice(:,:,jl) = zs0ice(:,:,jl) / area(:,:) 
    266             zs0sn (:,:,jl) = zs0sn (:,:,jl) / area(:,:) 
    267             zs0sm (:,:,jl) = zs0sm (:,:,jl) / area(:,:) 
    268             zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:) 
    269             zs0a  (:,:,jl) = zs0a  (:,:,jl) / area(:,:) 
    270             zs0c0 (:,:,jl) = zs0c0 (:,:,jl) / area(:,:) 
     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(:,:) 
    271273            DO jk = 1, nlay_i 
    272                zs0e(:,:,jk,jl) = zs0e(:,:,jk,jl) / area(:,:) 
    273             END DO 
     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) 
    274281         END DO 
    275282 
    276283         !------------------------------------------------------------------------------! 
    277          ! 4) Diffusion of Ice fields                   
     284         ! Diffusion of Ice fields                   
    278285         !------------------------------------------------------------------------------! 
    279286 
     287         ! 
    280288         !-------------------------------- 
    281289         !  diffusion of open water area 
    282290         !-------------------------------- 
    283          zs0at(:,:) = zs0a(:,:,1)      ! total ice fraction 
    284          DO jl = 2, jpl 
    285             zs0at(:,:) = zs0at(:,:) + zs0a(:,:,jl) 
    286          END DO 
    287          ! 
    288291         !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points 
    289292         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    290293            DO ji = 1 , fs_jpim1   ! vector opt. 
    291                pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji  ,jj) ) ) )   & 
    292                   &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    293                pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji,jj  ) ) ) )   & 
    294                   &        * ( 1._wp - MAX( rzero, SIGN( rone,- 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) 
    295298            END DO 
    296299         END DO 
    297300         ! 
    298          CALL lim_hdf( zs0ow (:,:) )   ! Diffusion 
     301         CALL lim_hdf( ato_i (:,:) ) 
    299302 
    300303         !------------------------------------ 
    … …  
    305308            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    306309               DO ji = 1 , fs_jpim1   ! vector opt. 
    307                   pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji  ,jj,jl) ) ) )   & 
    308                      &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
    309                   pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji,jj  ,jl) ) ) )   & 
    310                      &        * ( 1._wp - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
    311                END DO 
    312             END DO 
    313  
    314             CALL lim_hdf( zs0ice (:,:,jl) ) 
    315             CALL lim_hdf( zs0sn  (:,:,jl) ) 
    316             CALL lim_hdf( zs0sm  (:,:,jl) ) 
    317             CALL lim_hdf( zs0oi  (:,:,jl) ) 
    318             CALL lim_hdf( zs0a   (:,:,jl) ) 
    319             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) ) 
    320323            DO jk = 1, nlay_i 
    321                CALL lim_hdf( zs0e (:,:,jk,jl) ) 
     324               CALL lim_hdf( e_i(:,:,jk,jl) ) 
    322325            END DO 
    323326         END DO 
    324327 
    325328         !------------------------------------------------------------------------------! 
    326          ! 5) Update and limit ice properties after transport                            
     329         ! limit ice properties after transport                            
    327330         !------------------------------------------------------------------------------! 
    328  
    329          !-------------------------------------------------- 
    330          ! 5.1) Recover mean values over the grid squares. 
    331          !-------------------------------------------------- 
    332          zs0at(:,:) = 0._wp 
     331!!gm & cr   :  MAX should not be active if adv scheme is positive ! 
    333332         DO jl = 1, jpl 
    334333            DO jj = 1, jpj 
    335334               DO ji = 1, jpi 
    336                   zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl) ) 
    337                   zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl) ) 
    338                   zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl) ) 
    339                   zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl) ) 
    340                   zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl) ) 
    341                   zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl) ) 
    342                   zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl) 
    343                END DO 
    344             END DO 
    345          END DO 
    346  
    347          !--------------------------------------------------------- 
    348          ! 5.2) Snow thickness, Ice thickness, Ice concentrations 
    349          !--------------------------------------------------------- 
    350          DO jj = 1, jpj 
    351             DO ji = 1, jpi 
    352                zindb        = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - epsi10) ) 
    353                zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 
    354                ato_i(ji,jj) = zs0ow(ji,jj) 
    355             END DO 
    356          END DO 
    357  
    358          DO jl = 1, jpl         ! Remove very small areas  
    359             DO jj = 1, jpj 
    360                DO ji = 1, jpi 
    361                   zvi = zs0ice(ji,jj,jl) 
    362                   zvs = zs0sn(ji,jj,jl) 
    363                   ! 
    364                   zindb         = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - epsi10) ) 
    365                   ! 
    366                   v_s(ji,jj,jl)  = zindb * zs0sn (ji,jj,jl)  
    367                   v_i(ji,jj,jl)  = zindb * zs0ice(ji,jj,jl) 
    368                   ! 
    369                   zindsn         = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
    370                   zindic         = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    371                   zindb          = MAX( zindsn, zindic ) 
    372                   ! 
    373                   zs0a(ji,jj,jl) = zindb  * zs0a(ji,jj,jl) !ice concentration 
    374                   a_i (ji,jj,jl) = zs0a(ji,jj,jl) 
    375                   v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 
    376                   v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 
    377                   ! 
    378                   ! Update mass fluxes (clem) 
    379                   rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic  
    380                   rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn  
    381               END DO 
    382             END DO 
    383          END DO 
    384  
    385          !--- Thickness correction in case too high (clem) -------------------------------------------------------- 
    386          CALL lim_var_glo2eqv 
    387          DO jl = 1, jpl 
    388             DO jj = 1, jpj 
    389                DO ji = 1, jpi 
    390  
    391                   IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
    392                      zvi = v_i(ji,jj,jl) 
    393                      zvs = v_s(ji,jj,jl) 
    394                      zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
    395                      !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)    
    396                       
    397                      zindh = 1._wp 
    398                      IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. & 
    399                         & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                           
    400                         ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 
    401                         zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
    402                         a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
    403                      ELSE 
    404                         ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 
    405                         zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
    406                         a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
    407                      ENDIF 
    408  
    409                      ! small correction due to *zindh for a_i 
    410                      v_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) 
    411                      v_s(ji,jj,jl) = zindh * v_s(ji,jj,jl) 
    412  
    413                      ! Update mass fluxes 
    414                      rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 
    415                      rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 
    416  
    417                   ENDIF 
    418  
    419                   diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 
    420  
    421                END DO 
    422             END DO 
    423          END DO 
    424  
    425          ! --- 
    426          DO jj = 1, jpj 
    427             DO ji = 1, jpi 
    428                zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) ! clem@useless?? 
    429             END DO 
    430          END DO 
    431  
    432          !---------------------- 
    433          ! 5.3) Ice properties 
    434          !---------------------- 
    435  
    436          zbigval = 1.e+13 
    437  
    438          DO jl = 1, jpl 
    439             DO jj = 1, jpj 
    440                DO ji = 1, jpi 
    441                   zsmv = zs0sm(ji,jj,jl) 
    442  
    443                   ! Switches and dummy variables 
    444                   zusvosn         = 1.0/MAX( v_s(ji,jj,jl) , epsi10 ) 
    445                   zusvoic         = 1.0/MAX( v_i(ji,jj,jl) , epsi10 ) 
    446                   zindsn          = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
    447                   zindic          = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    448                   zindb           = MAX( zindsn, zindic ) 
    449  
    450                   ! Ice salinity and age 
    451                   !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 
    452                   IF(  num_sal == 2  ) THEN 
    453                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 
    454                   ENDIF 
    455  
    456                   zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) ), 0._wp  ) * a_i(ji,jj,jl) 
    457                   oa_i (ji,jj,jl)  = zindic * zage  
    458  
    459                   ! Snow heat content 
    460                   ze              =  MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval ) 
    461                   e_s(ji,jj,1,jl) = zindsn * ze       
    462  
    463                   ! Update salt fluxes (clem) 
    464                   sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
    465                END DO !ji 
    466             END DO !jj 
    467          END DO ! jl 
    468  
    469          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 
    470344            DO jk = 1, nlay_i 
    471345               DO jj = 1, jpj 
    472346                  DO ji = 1, jpi 
    473                      ! Ice heat content 
    474                      zindic          =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    475                      ze              =  MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval ) 
    476                      e_i(ji,jj,jk,jl) = zindic * ze 
    477                   END DO !ji 
    478                END DO ! jj 
    479             END DO ! jk 
    480          END DO ! jl 
    481  
    482  
    483       ! --- agglomerate variables (clem) ----------------- 
    484       vt_i (:,:) = 0._wp 
    485       vt_s (:,:) = 0._wp 
    486       at_i (:,:) = 0._wp 
    487       ! 
    488       DO jl = 1, jpl 
     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 --- 
    489355         DO jj = 1, jpj 
    490356            DO ji = 1, jpi 
    491                ! 
    492                vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
    493                vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
    494                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    495                ! 
    496                zinda = MAX( rzero , SIGN( rone , at_i(ji,jj) - epsi10 ) ) 
    497                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness 
    498             END DO 
    499          END DO 
    500       END DO 
     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 -------------------------------------------------------- 
     370         DO jl = 1, jpl 
     371            DO jj = 1, jpj 
     372               DO ji = 1, jpi 
     373 
     374                  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                      
     380                     zvi  = v_i  (ji,jj,jl) 
     381                     zvs  = v_s  (ji,jj,jl) 
     382                     zsmv = smv_i(ji,jj,jl) 
     383                     zes  = e_s  (ji,jj,1,jl) 
     384                     zei  = SUM( e_i(ji,jj,1:nlay_i,jl) ) 
     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 
     408                     ENDIF 
     409 
     410                  ENDIF 
     411 
     412               END DO 
     413            END DO 
     414         END DO 
     415         ! ------------------------------------------------- 
     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 
     428 
     429         ! --- agglomerate variables ----------------- 
     430         vt_i (:,:) = 0._wp 
     431         vt_s (:,:) = 0._wp 
     432         at_i (:,:) = 0._wp 
     433         DO jl = 1, jpl 
     434            DO jj = 1, jpj 
     435               DO ji = 1, jpi 
     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 -------------------------------- 
     444         DO jj = 1, jpj 
     445            DO ji = 1, jpi 
     446               rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 
     447               ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj) 
     448            END DO 
     449         END DO       
     450 
     451         ! conservation test 
     452         IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     453 
     454      ENDIF 
     455 
    501456      ! ------------------------------------------------- 
    502  
    503  
    504  
    505       ENDIF 
    506  
    507       IF(ln_ctl) THEN   ! Control print 
    508          CALL prt_ctl_info(' ') 
    509          CALL prt_ctl_info(' - Cell values : ') 
    510          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    511          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_trp  : cell area :') 
    512          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_trp  : at_i      :') 
    513          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_trp  : vt_i      :') 
    514          CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_trp  : vt_s      :') 
    515          DO jl = 1, jpl 
    516             CALL prt_ctl_info(' ') 
    517             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    518             CALL prt_ctl_info('   ~~~~~~~~~~') 
    519             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_trp  : a_i      : ') 
    520             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_trp  : ht_i     : ') 
    521             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_trp  : ht_s     : ') 
    522             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_trp  : v_i      : ') 
    523             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_trp  : v_s      : ') 
    524             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_trp  : e_s      : ') 
    525             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_trp  : t_su     : ') 
    526             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_trp  : t_snow   : ') 
    527             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_trp  : sm_i     : ') 
    528             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_trp  : smv_i    : ') 
    529             DO jk = 1, nlay_i 
    530                CALL prt_ctl_info(' ') 
    531                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    532                CALL prt_ctl_info('   ~~~~~~~') 
    533                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_trp  : t_i      : ') 
    534                CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_trp  : e_i      : ') 
    535             END DO 
    536          END DO 
    537       ENDIF 
    538       ! ------------------------------- 
    539       !- check conservation (C Rousset) 
    540       IF( ln_limdiahsb ) THEN 
    541          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    542          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    543   
    544          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
    545          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
    546  
    547          zchk_vmin = glob_min(v_i) 
    548          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    549          zchk_amin = glob_min(a_i) 
    550          zchk_umax = glob_max(SQRT(u_ice**2 + v_ice**2)) 
    551  
    552          IF(lwp) THEN 
    553             IF ( ABS( zchk_v_i   ) >  1.e-5 ) THEN 
    554                WRITE(numout,*) 'violation volume [m3/day]     (limtrp) = ',(zchk_v_i * rday) 
    555                WRITE(numout,*) 'u_ice max [m/s]               (limtrp) = ',zchk_umax 
    556                WRITE(numout,*) 'number of time steps          (limtrp) =',kt 
    557             ENDIF 
    558             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday) 
    559             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limtrp) = ',(zchk_vmin * 1.e-3) 
    560             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limtrp) = ',zchk_amin 
    561          ENDIF 
    562       ENDIF 
    563       !- check conservation (C Rousset) 
    564       ! ------------------------------- 
     457      ! control prints 
     458      ! ------------------------------------------------- 
     459      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 
    565460      ! 
    566       CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
    567       CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    568       CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e ) 
    569  
    570       CALL wrk_dealloc( jpi,jpj,jpl,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 ) 
    571466      ! 
    572467      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
     468 
    573469   END SUBROUTINE lim_trp 
    574470 
    … …  
    581477   END SUBROUTINE lim_trp 
    582478#endif 
    583  
    584479   !!====================================================================== 
    585480END MODULE limtrp 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    • Property svn:keywords set to Id
    r4333 r5832  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
     7   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_lim3 
    … …  
    1213   !!    lim_update1   : computes update of sea-ice global variables from trend terms 
    1314   !!---------------------------------------------------------------------- 
    14    USE limrhg          ! ice rheology 
    15  
    16    USE dom_oce 
    17    USE oce             ! dynamics and tracers variables 
    18    USE in_out_manager 
    1915   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2016   USE sbc_ice         ! Surface boundary condition: ice fields 
    2117   USE dom_ice 
     18   USE dom_oce 
    2219   USE phycst          ! physical constants 
    2320   USE ice 
    24    USE limdyn 
    25    USE limtrp 
    26    USE limthd 
    27    USE limsbc 
    28    USE limdiahsb 
    29    USE limwri 
    30    USE limrst 
    3121   USE thd_ice         ! LIM thermodynamic sea-ice variables 
    32    USE par_ice 
    3322   USE limitd_th 
    3423   USE limvar 
    35    USE prtctl           ! Print control 
    36    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    37    USE wrk_nemo         ! work arrays 
    38    USE lib_fortran     ! glob_sum 
    39    ! Check budget (Rousset) 
    40    USE in_out_manager   ! I/O manager 
    41    USE iom              ! I/O manager 
    42    USE lib_mpp          ! MPP library 
     24   USE prtctl          ! Print control 
     25   USE wrk_nemo        ! work arrays 
    4326   USE timing          ! Timing 
     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 
    4431 
    4532   IMPLICIT NONE 
    4633   PRIVATE 
    4734 
    48    PUBLIC   lim_update1   ! routine called by ice_step 
    49  
    50       REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
    51       REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    52       REAL(wp)  ::   rone   = 1._wp       !    -       - 
    53           
     35   PUBLIC   lim_update1 
     36 
    5437   !! * Substitutions 
    5538#  include "vectopt_loop_substitute.h90" 
    5639   !!---------------------------------------------------------------------- 
    5740   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    58    !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $ 
     41   !! $Id$ 
    5942   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6043   !!---------------------------------------------------------------------- 
    6144CONTAINS 
    6245 
    63    SUBROUTINE lim_update1 
     46   SUBROUTINE lim_update1( kt ) 
    6447      !!------------------------------------------------------------------- 
    6548      !!               ***  ROUTINE lim_update1  *** 
    6649      !!                
    6750      !! ** Purpose :  Computes update of sea-ice global variables at  
    68       !!               the end of the time step. 
    69       !!               Address pathological cases 
    70       !!               This place is very important 
     51      !!               the end of the dynamics. 
    7152      !!                 
    72       !! ** Method  :   
    73       !!    Ice speed from ice dynamics 
    74       !!    Ice thickness, Snow thickness, Temperatures, Lead fraction 
    75       !!      from advection and ice thermodynamics  
    76       !! 
    77       !! ** Action  : -  
    7853      !!--------------------------------------------------------------------- 
    79       INTEGER ::   ji, jj, jk, jl, jm    ! dummy loop indices 
    80       INTEGER ::   jbnd1, jbnd2 
    81       INTEGER ::   i_ice_switch 
    82       INTEGER ::   ind_im, layer      ! indices for internal melt 
    83       REAL(wp) ::   zweight, zesum, z_da_i, zhimax 
    84       REAL(wp) ::   zinda, zindb, zindsn, zindic 
    85       REAL(wp) ::   zindg, zh, zdvres, zviold2 
    86       REAL(wp) ::   zbigvalue, zvsold2, z_da_ex 
    87       REAL(wp) ::   z_prescr_hi, zat_i_old, ztmelts, ze_s 
    88  
    89       REAL(wp), POINTER, DIMENSION(:) ::   zthick0, zqm0      ! thickness of the layers and heat contents for 
    90       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    91       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    92       ! mass and salt flux (clem) 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
     54      INTEGER, INTENT(in) ::   kt    ! number of iteration 
     55      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     56      REAL(wp) ::   zsal 
     57      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    9458      !!------------------------------------------------------------------- 
    9559      IF( nn_timing == 1 )  CALL timing_start('limupdate1') 
    9660 
    97       CALL wrk_alloc( jkmax, zthick0, zqm0 ) 
    98  
    99       CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    100  
    101       !------------------------------------------------------------------------------ 
    102       ! 1. Update of Global variables                                               | 
    103       !------------------------------------------------------------------------------ 
    104  
    105       !----------------- 
    106       !  Trend terms 
    107       !----------------- 
    108       d_u_ice_dyn(:,:)     = u_ice(:,:)     - old_u_ice(:,:) 
    109       d_v_ice_dyn(:,:)     = v_ice(:,:)     - old_v_ice(:,:) 
    110       d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - old_a_i  (:,:,:) 
    111       d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - old_v_s  (:,:,:)   
    112       d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - old_v_i  (:,:,:)    
    113       d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - old_e_s  (:,:,:,:)   
    114       d_e_i_trp  (:,:,:,:) = e_i  (:,:,:,:) - old_e_i  (:,:,:,:) 
    115       d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - old_oa_i (:,:,:) 
    116       d_smv_i_trp(:,:,:)   = 0._wp 
    117       IF(  num_sal == 2  )   d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:) 
    118  
    119       ! mass and salt flux init (clem) 
    120       zviold(:,:,:) = v_i(:,:,:) 
    121       zvsold(:,:,:) = v_s(:,:,:) 
    122       zsmvold(:,:,:) = smv_i(:,:,:) 
    123  
    124       ! ------------------------------- 
    125       !- check conservation (C Rousset) 
    126       IF (ln_limdiahsb) THEN 
    127          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    128          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    129          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    130          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     61      IF( ln_limdyn ) THEN  
     62 
     63      IF( kt == nit000 .AND. lwp ) THEN 
     64         WRITE(numout,*) ' lim_update1 '  
     65         WRITE(numout,*) ' ~~~~~~~~~~~ ' 
    13166      ENDIF 
    132       !- check conservation (C Rousset) 
    133       ! ------------------------------- 
    134  
    135       CALL lim_var_glo2eqv 
    136  
    137       !-------------------------------------- 
    138       ! 2. Review of all pathological cases 
    139       !-------------------------------------- 
    140  
    141 ! clem: useless now 
    142       !------------------------------------------- 
    143       ! 2.1) Advection of ice in an ice-free cell 
    144       !------------------------------------------- 
    145       ! should be removed since it is treated after dynamics now 
    146 !      zhimax = 5._wp 
    147 !      ! first category 
    148 !      DO jj = 1, jpj 
    149 !         DO ji = 1, jpi 
    150 !            !--- the thickness of such an ice is often out of bounds 
    151 !            !--- thus we recompute a new area while conserving ice volume 
    152 !            zat_i_old = SUM( old_a_i(ji,jj,:) ) 
    153 !            zindb     = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_trp(ji,jj,1) ) - epsi10 ) )  
    154 !            IF( ( ABS( d_v_i_trp(ji,jj,1) ) / MAX( ABS( d_a_i_trp(ji,jj,1) ), epsi10 ) * zindb .GT. zhimax ) & 
    155 !              &   .AND.( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) & 
    156 !              &   .AND.( zat_i_old .LT. 1.e-6 ) )  THEN ! new line 
    157 !               ht_i(ji,jj,1) = hi_max(1) * 0.5_wp 
    158 !               a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1) 
    159 !            ENDIF 
    160 !         END DO 
    161 !      END DO 
    162 ! 
    163 !      zhimax = 20._wp 
    164 !      ! other categories 
    165 !      DO jl = 2, jpl 
    166 !         jm = ice_types(jl) 
    167 !         DO jj = 1, jpj 
    168 !            DO ji = 1, jpi 
    169 !               zindb =  MAX( rzero, SIGN( rone, ABS( d_a_i_trp(ji,jj,jl) ) - epsi10 ) )  
    170 !               ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
    171 !               ! it makes problems when the advected volume and concentration do not seem to be  
    172 !               ! related with each other 
    173 !               ! the new thickness is sometimes very big! 
    174 !               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
    175 !               ! which of course is plausible 
    176 !               ! but fuck! it fucks everything up :) 
    177 !               IF ( ( ABS( d_v_i_trp(ji,jj,jl) ) / MAX( ABS( d_a_i_trp(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) & 
    178 !                  &  .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN 
    179 !                  ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp 
    180 !                  a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl) 
    181 !               ENDIF 
    182 !            END DO ! ji 
    183 !         END DO !jj 
    184 !      END DO !jl 
    185       
     67 
     68      ! conservation test 
     69      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     70 
     71      !---------------------------------------------------- 
     72      ! ice concentration should not exceed amax  
     73      !----------------------------------------------------- 
    18674      at_i(:,:) = 0._wp 
    18775      DO jl = 1, jpl 
    … …  
    18977      END DO 
    19078 
    191       !---------------------------------------------------- 
    192       ! 2.2) Rebin categories with thickness out of bounds 
    193       !---------------------------------------------------- 
    194       DO jm = 1, jpm 
    195          jbnd1 = ice_cat_bounds(jm,1) 
    196          jbnd2 = ice_cat_bounds(jm,2) 
    197          IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    198       END DO 
    199  
    200       at_i(:,:) = 0._wp 
    201       DO jl = 1, jpl 
    202          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    203       END DO 
    204  
    205       zbigvalue      = 1.0e+20 
    206  
    207       DO jl = 1, jpl 
    208          DO jj = 1, jpj  
     79      DO jl  = 1, jpl 
     80         DO jj = 1, jpj 
    20981            DO ji = 1, jpi 
    210  
    211                !switches 
    212                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    213                !switch = 1 if a_i > 1e-06 and 0 if not 
    214                zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 
    215                zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 
    216                ! bug fix 25 avril 2007 
    217                zindb         = zindb*zindic 
    218  
    219                !--- 2.3 Correction to ice age  
    220                !------------------------------ 
    221                !                IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 
    222                !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 
    223                !                ENDIF 
    224                IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    225                   oa_i(ji,jj,jl) = rdt_ice*numit/rday*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) ) ) 
    22685               ENDIF 
    227                oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
    228  
    229                !--- 2.4 Correction to snow thickness 
    230                !------------------------------------- 
    231                !          ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0 
    232                !             v_s(ji,jj,jl)  = MAX( zindb * v_s(ji,jj,jl), 0.0)  
    233                ! snow thickness cannot be smaller than 1e-6 
    234                zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 
    235                v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 
    236  
    237                !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 
    238   
    239                !--- 2.5 Correction to ice thickness 
    240                !------------------------------------- 
    241                zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 
    242                v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 
    243  
    244                !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 
    245                !sfx_res(ji,jj)  = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    246  
    247                !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
    248                !---------------------------------------------------------------------------- 
    249                zindg          = tms(ji,jj) *  MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    250                zdvres         = zindg * rhosn * v_s(ji,jj,jl) / rau0 
    251                v_i(ji,jj,jl)  = v_i(ji,jj,jl)  + zdvres 
    252  
    253                zdvres         = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 
    254                v_s(ji,jj,jl)  = v_s(ji,jj,jl)  + zdvres 
    255  
    256                !--- 2.7 Correction to ice concentrations  
    257                !-------------------------------------------- 
    258                ! if greater than 0, ice concentration cannot be smaller than 1e-10 
    259                a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 
    260  
    261                !------------------------- 
    262                ! 2.8) Snow heat content 
    263                !------------------------- 
    264                e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0._wp, e_s(ji,jj,1,jl) ), zbigvalue ) ) 
    265  
    266             END DO ! ji 
    267          END DO ! jj 
    268       END DO ! jl 
    269  
    270       !------------------------ 
    271       ! 2.9) Ice heat content  
    272       !------------------------ 
    273  
    274       DO jl = 1, jpl 
    275          DO jk = 1, nlay_i 
     86            END DO 
     87         END DO 
     88      END DO 
     89     
     90      !--------------------- 
     91      ! Ice salinity bounds 
     92      !--------------------- 
     93      IF (  nn_icesal == 2  ) THEN  
     94         DO jl = 1, jpl 
    27695            DO jj = 1, jpj  
    27796               DO ji = 1, jpi 
    278                   zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    279                   e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 
    280                END DO ! ji 
    281             END DO ! jj 
    282          END DO !jk 
    283       END DO !jl 
    284   
    285       at_i(:,:) = 0._wp 
    286       DO jl = 1, jpl 
    287          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    288       END DO 
    289  
    290       !--- 2.13 ice concentration should not exceed amax  
    291       !         (it should not be the case)  
    292       !----------------------------------------------------- 
     97                  zsal            = smv_i(ji,jj,jl) 
     98                  ! salinity stays in bounds 
     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) ) 
     101                  ! associated salt flux 
     102                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     103               END DO 
     104            END DO 
     105         END DO 
     106      ENDIF 
     107 
     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 
     118      ! ------------------------------------------------- 
     119      ! Diagnostics 
     120      ! ------------------------------------------------- 
     121      DO jl  = 1, jpl 
     122         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
     123      END DO 
     124 
    293125      DO jj = 1, jpj 
    294          DO ji = 1, jpi 
    295             z_da_ex =  MAX( at_i(ji,jj) - amax , 0.0 )         
    296             zindb   =  MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) )  
    297             DO jl  = 1, jpl 
    298                z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 
    299                a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 
    300                ! 
    301                zinda   =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    302                ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 
    303                !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 
    304             END DO 
    305          END DO 
    306       END DO 
    307       at_i(:,:) = a_i(:,:,1) 
    308       DO jl = 2, jpl 
    309          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    310       END DO 
    311  
    312  
    313       ! Final thickness distribution rebinning 
    314       ! -------------------------------------- 
    315       DO jm = 1, jpm 
    316          jbnd1 = ice_cat_bounds(jm,1) 
    317          jbnd2 = ice_cat_bounds(jm,2) 
    318          IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    319          IF (ice_ncat_types(jm) .EQ. 1 ) THEN 
    320          ENDIF 
    321       END DO 
    322  
    323  
    324       !--------------------- 
    325       ! 2.11) Ice salinity 
    326       !--------------------- 
    327       ! clem correct bug on smv_i 
    328       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    329  
    330       IF (  num_sal == 2  ) THEN ! general case 
    331          DO jl = 1, jpl 
    332             !DO jk = 1, nlay_i 
    333                DO jj = 1, jpj  
    334                   DO ji = 1, jpi 
    335                      ! salinity stays in bounds 
    336                      !clem smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) ) 
    337                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
    338                      i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    339                      smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
    340                   END DO ! ji 
    341                END DO ! jj 
    342             !END DO !jk 
    343          END DO !jl 
    344       ENDIF 
    345  
    346       at_i(:,:) = a_i(:,:,1) 
    347       DO jl = 2, jpl 
    348          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    349       END DO 
    350  
    351  
    352       !-------------------------------- 
    353       ! Update mass/salt fluxes (clem) 
    354       !-------------------------------- 
    355       DO jl = 1, jpl 
    356          DO jj = 1, jpj  
    357             DO ji = 1, jpi 
    358                diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice  
    359                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    360                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    361                sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice  
    362             END DO 
    363          END DO 
    364       END DO 
    365    
    366       ! ------------------------------- 
    367       !- check conservation (C Rousset) 
    368       IF (ln_limdiahsb) THEN 
    369  
    370          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    371          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    372   
    373          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    374          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    375  
    376          zchk_vmin = glob_min(v_i) 
    377          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    378          zchk_amin = glob_min(a_i) 
    379         
    380          IF(lwp) THEN 
    381             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limupdate1) = ',(zchk_v_i * rday) 
    382             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate1) = ',(zchk_smv * rday) 
    383             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limupdate1) = ',(zchk_vmin * 1.e-3) 
    384             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limupdate1) = ',zchk_amax 
    385             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limupdate1) = ',zchk_amin 
    386          ENDIF 
    387       ENDIF 
    388       !- check conservation (C Rousset) 
    389       ! ------------------------------- 
    390  
     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 
     137 
     138      ! conservation test 
     139      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     140 
     141      ! ------------------------------------------------- 
     142      ! control prints 
     143      ! ------------------------------------------------- 
    391144      IF(ln_ctl) THEN   ! Control print 
    392145         CALL prt_ctl_info(' ') 
    393146         CALL prt_ctl_info(' - Cell values : ') 
    394147         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    395          CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update1  : cell area   :') 
     148         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update1  : cell area   :') 
    396149         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :') 
    397150         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :') 
    … …  
    399152         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update1  : strength    :') 
    400153         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    401          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 :') 
    402          CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update1  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_v_ice   :') 
     154         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    403155 
    404156         DO jl = 1, jpl 
    … …  
    413165            CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update1  : o_i         : ') 
    414166            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ') 
    415             CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update1  : old_a_i     : ') 
    416             CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_a_i_trp   : ') 
     167            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ') 
    417168            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ') 
    418             CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update1  : old_v_i     : ') 
    419             CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_i_trp   : ') 
     169            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ') 
    420170            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ') 
    421             CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update1  : old_v_s     : ') 
    422             CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_s_trp   : ') 
    423             CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1        : ') 
    424             CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : old_e_i1    : ') 
    425             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : de_i1_trp   : ') 
    426             CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2        : ') 
    427             CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : old_e_i2    : ') 
    428             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : de_i2_trp   : ') 
     171            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ') 
     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      : ') 
    429176            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ') 
    430             CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update1  : old_e_snow  : ') 
    431             CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : d_e_s_trp   : ') 
     177            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ') 
    432178            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ') 
    433             CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update1  : old_smv_i   : ') 
    434             CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update1  : d_smv_i_trp : ') 
     179            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ') 
    435180            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ') 
    436             CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update1  : old_oa_i    : ') 
    437             CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update1  : d_oa_i_trp  : ') 
     181            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ') 
    438182 
    439183            DO jk = 1, nlay_i 
    … …  
    446190         CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    447191         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    448          CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update1 : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    449192         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update1 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    450          CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update1 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 
    451193 
    452194         CALL prt_ctl_info(' ') 
    … …  
    458200      ENDIF 
    459201    
    460  
    461       CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 
    462  
    463       CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
     202      ENDIF ! ln_limdyn 
    464203 
    465204      IF( nn_timing == 1 )  CALL timing_stop('limupdate1') 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    • Property svn:keywords set to Id
    r4333 r5832  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
     7   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_lim3 
    … …  
    1213   !!    lim_update2   : computes update of sea-ice global variables from trend terms 
    1314   !!---------------------------------------------------------------------- 
    14    USE limrhg          ! ice rheology 
    15  
    16    USE dom_oce 
    17    USE oce             ! dynamics and tracers variables 
    18    USE in_out_manager 
    1915   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2016   USE sbc_ice         ! Surface boundary condition: ice fields 
    2117   USE dom_ice 
     18   USE dom_oce 
    2219   USE phycst          ! physical constants 
    2320   USE ice 
    24    USE limdyn 
    25    USE limtrp 
    26    USE limthd 
    27    USE limsbc 
    28    USE limdiahsb 
    29    USE limwri 
    30    USE limrst 
    3121   USE thd_ice         ! LIM thermodynamic sea-ice variables 
    32    USE par_ice 
    3322   USE limitd_th 
    34    USE limitd_me 
    3523   USE limvar 
    36    USE prtctl           ! Print control 
    37    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    38    USE wrk_nemo         ! work arrays 
    39    USE lib_fortran     ! glob_sum 
     24   USE prtctl          ! Print control 
     25   USE lbclnk          ! lateral boundary condition - MPP exchanges 
     26   USE wrk_nemo        ! work arrays 
    4027   USE timing          ! Timing 
     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 
    4133 
    4234   IMPLICIT NONE 
    … …  
    4537   PUBLIC   lim_update2   ! routine called by ice_step 
    4638 
    47       REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
    48       REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    49       REAL(wp)  ::   rone   = 1._wp       !    -       - 
    50           
    5139   !! * Substitutions 
    5240#  include "vectopt_loop_substitute.h90" 
    5341   !!---------------------------------------------------------------------- 
    5442   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    55    !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $ 
     43   !! $Id$ 
    5644   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5745   !!---------------------------------------------------------------------- 
    5846CONTAINS 
    5947 
    60    SUBROUTINE lim_update2 
     48   SUBROUTINE lim_update2( kt ) 
    6149      !!------------------------------------------------------------------- 
    6250      !!               ***  ROUTINE lim_update2  *** 
    … …  
    6452      !! ** Purpose :  Computes update of sea-ice global variables at  
    6553      !!               the end of the time step. 
    66       !!               Address pathological cases 
    67       !!               This place is very important 
    68       !!                 
    69       !! ** Method  :   
    70       !!    Ice speed from ice dynamics 
    71       !!    Ice thickness, Snow thickness, Temperatures, Lead fraction 
    72       !!      from advection and ice thermodynamics  
    7354      !! 
    74       !! ** Action  : -  
    7555      !!--------------------------------------------------------------------- 
    76       INTEGER ::   ji, jj, jk, jl, jm    ! dummy loop indices 
    77       INTEGER ::   jbnd1, jbnd2 
    78       INTEGER ::   i_ice_switch 
    79       INTEGER ::   ind_im, layer      ! indices for internal melt 
    80       REAL(wp) ::   zweight, zesum, zhimax, z_da_i 
    81       REAL(wp) ::   zinda, zindb, zindsn, zindic 
    82       REAL(wp) ::   zindg, zh, zdvres, zviold2 
    83       REAL(wp) ::   zbigvalue, zvsold2, z_da_ex 
    84       REAL(wp) ::   z_prescr_hi, zat_i_old, ztmelts, ze_s 
    85  
    86       INTEGER , POINTER, DIMENSION(:,:,:) ::  internal_melt 
    87       REAL(wp), POINTER, DIMENSION(:) ::   zthick0, zqm0      ! thickness of the layers and heat contents for 
    88       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    89       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    90       ! mass and salt flux (clem) 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
     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  
    9260      !!------------------------------------------------------------------- 
    9361      IF( nn_timing == 1 )  CALL timing_start('limupdate2') 
    9462 
    95       CALL wrk_alloc( jpi,jpj,jpl, internal_melt )   ! integer 
    96       CALL wrk_alloc( jkmax, zthick0, zqm0 ) 
    97  
    98       CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    99  
    100       !---------------------------------------------------------------------------------------- 
    101       ! 1. Computation of trend terms       
    102       !---------------------------------------------------------------------------------------- 
    103       !- Trend terms 
    104       d_a_i_thd(:,:,:)   = a_i(:,:,:)   - old_a_i(:,:,:)  
    105       d_v_s_thd(:,:,:)   = v_s(:,:,:)   - old_v_s(:,:,:) 
    106       d_v_i_thd(:,:,:)   = v_i(:,:,:)   - old_v_i(:,:,:)   
    107       d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)  
    108       d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 
    109       !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - old_oa_i (:,:,:) 
    110       d_smv_i_thd(:,:,:) = 0._wp 
    111       IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
    112       ! diag only (clem) 
    113       dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    114  
    115       ! mass and salt flux init (clem) 
    116       zviold(:,:,:) = v_i(:,:,:) 
    117       zvsold(:,:,:) = v_s(:,:,:) 
    118       zsmvold(:,:,:) = smv_i(:,:,:) 
    119  
    120       ! ------------------------------- 
    121       !- check conservation (C Rousset) 
    122       IF (ln_limdiahsb) THEN 
    123          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    124          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    125          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    126          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     63      IF( kt == nit000 .AND. lwp ) THEN 
     64         WRITE(numout,*) ' lim_update2 ' 
     65         WRITE(numout,*) ' ~~~~~~~~~~~ ' 
    12766      ENDIF 
    128       !- check conservation (C Rousset) 
    129       ! ------------------------------- 
    130  
    131       CALL lim_var_glo2eqv 
    132  
    133       !-------------------------------------- 
    134       ! 2. Review of all pathological cases 
    135       !-------------------------------------- 
    136  
    137 ! clem: useless now 
    138       !------------------------------------------- 
    139       ! 2.1) Advection of ice in an ice-free cell 
    140       !------------------------------------------- 
    141       ! should be removed since it is treated after dynamics now 
    142 !      zhimax = 5._wp 
    143 !      ! first category 
    144 !      DO jj = 1, jpj 
    145 !         DO ji = 1, jpi 
    146 !            !--- the thickness of such an ice is often out of bounds 
    147 !            !--- thus we recompute a new area while conserving ice volume 
    148 !            zat_i_old = SUM( old_a_i(ji,jj,:) ) 
    149 !            zindb     = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_thd(ji,jj,1) ) - epsi10 ) )  
    150 !            IF ( ( ABS( d_v_i_thd(ji,jj,1) ) / MAX( ABS( d_a_i_thd(ji,jj,1) ),epsi10 ) * zindb .GT. zhimax ) & 
    151 !               &  .AND. ( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) & 
    152 !               &  .AND. ( zat_i_old .LT. 1.e-6 ) )  THEN ! new line 
    153 !               ht_i(ji,jj,1) = hi_max(1) * 0.5_wp 
    154 !               a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1) 
    155 !            ENDIF 
    156 !         END DO 
    157 !      END DO 
    158  
    159 !      zhimax = 20._wp 
    160 !      ! other categories 
    161 !      DO jl = 2, jpl 
    162 !         jm = ice_types(jl) 
    163 !         DO jj = 1, jpj 
    164 !            DO ji = 1, jpi 
    165 !               zindb =  MAX( rzero, SIGN( rone, ABS( d_a_i_thd(ji,jj,jl)) - epsi10 ) )  
    166 !              ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
    167 !               ! it makes problems when the advected volume and concentration do not seem to be  
    168 !               ! related with each other 
    169 !               ! the new thickness is sometimes very big! 
    170 !               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
    171 !               ! which of course is plausible 
    172 !               ! but fuck! it fucks everything up :) 
    173 !               IF ( ( ABS( d_v_i_thd(ji,jj,jl) ) / MAX( ABS( d_a_i_thd(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) & 
    174 !                  &  .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN 
    175 !                  ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp 
    176 !                  a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl) 
    177 !               ENDIF 
    178 !            END DO ! ji 
    179 !         END DO !jj 
    180 !      END DO !jl 
    181       
     67 
     68      ! conservation test 
     69      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     70 
     71      !---------------------------------------------------------------------- 
     72      ! Constrain the thickness of the smallest category above himin 
     73      !---------------------------------------------------------------------- 
     74      DO jj = 1, jpj  
     75         DO ji = 1, jpi 
     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 
     81            ENDIF 
     82         END DO 
     83      END DO 
     84       
     85      !----------------------------------------------------- 
     86      ! ice concentration should not exceed amax  
     87      !----------------------------------------------------- 
    18288      at_i(:,:) = 0._wp 
    18389      DO jl = 1, jpl 
    … …  
    18591      END DO 
    18692 
    187       !---------------------------------------------------- 
    188       ! 2.2) Rebin categories with thickness out of bounds 
    189       !---------------------------------------------------- 
    190       DO jm = 1, jpm 
    191          jbnd1 = ice_cat_bounds(jm,1) 
    192          jbnd2 = ice_cat_bounds(jm,2) 
    193          IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    194       END DO 
    195  
    196       !--------------------------------- 
    197       ! 2.3) Melt of an internal layer 
    198       !--------------------------------- 
    199       internal_melt(:,:,:) = 0 
    200  
    201       DO jl = 1, jpl 
    202          DO jk = 1, nlay_i 
     93      DO jl  = 1, jpl 
     94         DO jj = 1, jpj 
     95            DO ji = 1, jpi 
     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) ) ) 
     99               ENDIF 
     100            END DO 
     101         END DO 
     102      END DO 
     103 
     104      !--------------------- 
     105      ! Ice salinity 
     106      !--------------------- 
     107      IF (  nn_icesal == 2  ) THEN  
     108         DO jl = 1, jpl 
    203109            DO jj = 1, jpj  
    204110               DO ji = 1, jpi 
    205                   ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    206                   IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) & 
    207                     & .AND. ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
    208                      internal_melt(ji,jj,jl) = 1 
    209                   ENDIF 
    210                END DO ! ji 
    211             END DO ! jj 
    212          END DO !jk 
    213       END DO !jl 
    214  
    215       DO jl = 1, jpl 
    216          DO jj = 1, jpj  
    217             DO ji = 1, jpi 
    218                IF( internal_melt(ji,jj,jl) == 1 ) THEN 
    219                   ! initial ice thickness 
    220                   !----------------------- 
    221                   ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    222  
    223                   ! reduce ice thickness 
    224                   !----------------------- 
    225                   ind_im = 0 
    226                   zesum = 0.0 
    227                   DO jk = 1, nlay_i 
    228                      ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    229                      IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) ind_im = ind_im + 1 
    230                      zesum = zesum + e_i(ji,jj,jk,jl) 
    231                   END DO 
    232                   ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) 
    233                   v_i(ji,jj,jl)  = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 
    234  
    235                   !CLEM 
    236                   zdvres = REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) * a_i(ji,jj,jl) 
    237                   !rdm_ice(ji,jj) = rdm_ice(ji,jj) - zdvres * rhoic 
    238                   !sfx_res(ji,jj)  = sfx_res(ji,jj) + sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    239  
    240                   ! redistribute heat 
    241                   !----------------------- 
    242                   ! old thicknesses and enthalpies 
    243                   ind_im = 0 
    244                   DO jk = 1, nlay_i 
    245                      ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    246                      IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND.  &  
    247                         ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN 
    248                         ind_im = ind_im + 1 
    249                         zthick0(ind_im) = ht_i(ji,jj,jl) * REAL(ind_im / nlay_i) 
    250                         zqm0   (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 ) 
    251                      ENDIF 
    252                   END DO 
    253  
    254                   ! Redistributing energy on the new grid 
    255                   IF ( ind_im .GT. 0 ) THEN 
    256  
    257                      DO jk = 1, nlay_i 
    258                         e_i(ji,jj,jk,jl) = 0.0 
    259                         DO layer = 1, ind_im 
    260                            zweight         = MAX (  & 
    261                               MIN( ht_i(ji,jj,jl) * REAL(layer/ind_im) , ht_i(ji,jj,jl) * REAL(jk / nlay_i) ) -       & 
    262                               MAX( ht_i(ji,jj,jl) * REAL((layer-1)/ind_im) , ht_i(ji,jj,jl) * REAL((jk-1) / nlay_i) ) , 0.0 ) & 
    263                               /  ( ht_i(ji,jj,jl) / REAL(ind_im) ) 
    264  
    265                            e_i(ji,jj,jk,jl) =  e_i(ji,jj,jk,jl) + zweight*zqm0(layer) 
    266                         END DO !layer 
    267                      END DO ! jk 
    268  
    269                      zesum = 0.0 
    270                      DO jk = 1, nlay_i 
    271                         zesum = zesum + e_i(ji,jj,jk,jl) 
    272                      END DO 
    273  
    274                   ELSE ! ind_im .EQ. 0, total melt 
    275                      e_i(ji,jj,jk,jl) = 0.0 
    276                   ENDIF 
    277  
    278                ENDIF ! internal_melt 
    279  
    280             END DO ! ji 
    281          END DO !jj 
    282       END DO !jl 
    283  
    284       internal_melt(:,:,:) = 0 
    285  
    286  
    287       ! Melt of snow 
    288       !-------------- 
    289       DO jl = 1, jpl 
    290          DO jj = 1, jpj  
    291             DO ji = 1, jpi 
    292                ! snow energy of melting 
    293                zinda   =  MAX( 0._wp, SIGN( 1._wp, v_s(ji,jj,jl) - epsi10 ) ) 
    294                ze_s = zinda * e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) / MAX( v_s(ji,jj,jl), epsi10 )  ! snow energy of melting 
    295  
    296                ! If snow energy of melting smaller then Lf 
    297                ! Then all snow melts and meltwater, heat go to the ocean 
    298                IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = 1 
    299  
     111                  zsal            = smv_i(ji,jj,jl) 
     112                  ! salinity stays in bounds 
     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) ) 
     115                  ! associated salt flux 
     116                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     117               END DO 
    300118            END DO 
    301119         END DO 
    302       END DO 
    303  
    304       DO jl = 1, jpl 
    305          DO jj = 1, jpj  
    306             DO ji = 1, jpi 
    307                IF ( internal_melt(ji,jj,jl) == 1 ) THEN 
    308                   zdvres = v_s(ji,jj,jl) 
    309                   ! release heat 
    310                   fheat_res(ji,jj) = fheat_res(ji,jj) + ze_s * zdvres / rdt_ice 
    311                   ! release mass 
    312                   !rdm_snw(ji,jj) =  rdm_snw(ji,jj) - zdvres * rhosn 
    313                   ! 
    314                   v_s(ji,jj,jl)   = 0.0 
    315                   e_s(ji,jj,1,jl) = 0.0 
    316                  ENDIF 
    317             END DO 
    318          END DO 
    319       END DO 
    320  
    321       zbigvalue      = 1.0e+20 
    322       DO jl = 1, jpl 
    323          DO jj = 1, jpj  
    324             DO ji = 1, jpi 
    325  
    326                !switches 
    327                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    328                !switch = 1 if a_i > 1e-06 and 0 if not 
    329                zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 
    330                zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 
    331                ! bug fix 25 avril 2007 
    332                zindb         = zindb*zindic 
    333  
    334                !--- 2.3 Correction to ice age  
    335                !------------------------------ 
    336                !                IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 
    337                !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 
    338                !                ENDIF 
    339                IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    340                   oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 
    341                ENDIF 
    342                oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
    343  
    344                !--- 2.4 Correction to snow thickness 
    345                !------------------------------------- 
    346                zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 
    347                v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 
    348  
    349                !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 
    350   
    351                !--- 2.5 Correction to ice thickness 
    352                !------------------------------------- 
    353                zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 
    354                v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 
    355  
    356                !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 
    357                !sfx_res(ji,jj)  = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    358  
    359                !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
    360                !---------------------------------------------------------------------------- 
    361                zindg          = tms(ji,jj) *  MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    362                zdvres         = zindg * rhosn * v_s(ji,jj,jl) / rau0 
    363                v_i(ji,jj,jl)  = v_i(ji,jj,jl)  + zdvres 
    364  
    365                zdvres         = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 
    366                v_s(ji,jj,jl)  = v_s(ji,jj,jl)  + zdvres 
    367  
    368                !--- 2.7 Correction to ice concentrations  
    369                !-------------------------------------------- 
    370                a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 
    371  
    372                !------------------------- 
    373                ! 2.8) Snow heat content 
    374                !------------------------- 
    375                e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) ) 
    376  
    377             END DO ! ji 
    378          END DO ! jj 
    379       END DO ! jl 
    380  
    381       !------------------------ 
    382       ! 2.9) Ice heat content  
    383       !------------------------ 
    384  
    385       DO jl = 1, jpl 
    386          DO jk = 1, nlay_i 
    387             DO jj = 1, jpj  
    388                DO ji = 1, jpi 
    389                   zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    390                   e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 
    391                END DO ! ji 
    392             END DO ! jj 
    393          END DO !jk 
    394       END DO !jl 
    395  
    396  
    397       DO jm = 1, jpm 
    398          DO jj = 1, jpj  
    399             DO ji = 1, jpi 
    400                jl = ice_cat_bounds(jm,1) 
    401                !--- 2.12 Constrain the thickness of the smallest category above 5 cm 
    402                !---------------------------------------------------------------------- 
    403                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    404                ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi10) 
    405                zh            = MAX( rone , zindb * hiclim  / MAX( ht_i(ji,jj,jl) , epsi10 ) ) 
    406                ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh 
    407                ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh 
    408                a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh 
    409                !CLEM 
    410                v_i (ji,jj,jl) = a_i(ji,jj,jl) * ht_i(ji,jj,jl) 
    411                v_s (ji,jj,jl) = a_i(ji,jj,jl) * ht_s(ji,jj,jl) 
    412             END DO !ji 
    413          END DO !jj 
    414       END DO !jm 
    415  
    416       at_i(:,:) = 0.0 
    417       DO jl = 1, jpl 
    418          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    419       END DO 
    420        
    421       !--- 2.13 ice concentration should not exceed amax  
    422       !         (it should not be the case)  
    423       !----------------------------------------------------- 
    424       DO jj = 1, jpj 
    425          DO ji = 1, jpi 
    426             z_da_ex =  MAX( at_i(ji,jj) - amax , 0.0 )         
    427             zindb   =  MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) )  
    428             DO jl  = 1, jpl 
    429                z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 
    430                a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 
    431                ! 
    432                zinda   =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    433                ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 
    434                !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 
    435             END DO 
    436          END DO 
    437       END DO 
    438       at_i(:,:) = 0.0 
    439       DO jl = 1, jpl 
    440          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    441       END DO 
    442  
    443       ! Final thickness distribution rebinning 
    444       ! -------------------------------------- 
    445       DO jm = 1, jpm 
    446          jbnd1 = ice_cat_bounds(jm,1) 
    447          jbnd2 = ice_cat_bounds(jm,2) 
    448          IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    449          IF (ice_ncat_types(jm) .EQ. 1 ) THEN 
    450          ENDIF 
    451       END DO 
    452  
    453       !--------------------- 
    454       ! 2.11) Ice salinity 
    455       !--------------------- 
    456       ! clem correct bug on smv_i 
    457       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    458  
    459       IF (  num_sal == 2  ) THEN ! general case 
    460          DO jl = 1, jpl 
    461             !DO jk = 1, nlay_i 
    462                DO jj = 1, jpj  
    463                   DO ji = 1, jpi 
    464                      ! salinity stays in bounds 
    465                      !clem smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) ) 
    466                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
    467                      i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    468                      smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
    469                   END DO ! ji 
    470                END DO ! jj 
    471             !END DO !jk 
    472          END DO !jl 
    473120      ENDIF 
    474121 
    475       ! ------------------- 
    476       at_i(:,:) = a_i(:,:,1) 
    477       DO jl = 2, jpl 
    478          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    479       END DO 
     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 
    480131 
    481132      !------------------------------------------------------------------------------ 
    482       ! 2) Corrections to avoid wrong values                                        | 
     133      ! Corrections to avoid wrong values                                        | 
    483134      !------------------------------------------------------------------------------ 
    484135      ! Ice drift 
    … …  
    486137      DO jj = 2, jpjm1 
    487138         DO ji = 2, jpim1 
    488             IF ( at_i(ji,jj) .EQ. 0.0 ) THEN ! what to do if there is no ice 
    489                IF ( at_i(ji+1,jj) .EQ. 0.0 ) u_ice(ji,jj)   = 0.0 ! right side 
    490                IF ( at_i(ji-1,jj) .EQ. 0.0 ) u_ice(ji-1,jj) = 0.0 ! left side 
    491                IF ( at_i(ji,jj+1) .EQ. 0.0 ) v_ice(ji,jj)   = 0.0 ! upper side 
    492                IF ( at_i(ji,jj-1) .EQ. 0.0 ) v_ice(ji,jj-1) = 0.0 ! bottom side 
     139            IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 
     140               IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji,jj)   = 0._wp ! right side 
     141               IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side 
     142               IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj)   = 0._wp ! upper side 
     143               IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side 
    493144            ENDIF 
    494145         END DO 
    … …  
    498149      CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    499150      !mask velocities 
    500       u_ice(:,:) = u_ice(:,:) * tmu(:,:) 
    501       v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
     151      u_ice(:,:) = u_ice(:,:) * umask(:,:,1) 
     152      v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 
    502153  
    503       !-------------------------------- 
    504       ! Update mass/salt fluxes (clem) 
    505       !-------------------------------- 
    506       DO jl = 1, jpl 
    507          DO jj = 1, jpj  
    508             DO ji = 1, jpi 
    509                diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice  
    510                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    511                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    512                sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice  
    513             END DO 
    514          END DO 
    515       END DO 
    516  
    517       ! ------------------------------- 
    518       !- check conservation (C Rousset) 
    519       IF (ln_limdiahsb) THEN 
    520  
    521          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    522          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    523   
    524          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    525          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    526  
    527          zchk_vmin = glob_min(v_i) 
    528          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    529          zchk_amin = glob_min(a_i) 
    530  
    531          IF(lwp) THEN 
    532             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limupdate2) = ',(zchk_v_i * rday) 
    533             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate2) = ',(zchk_smv * rday) 
    534             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limupdate2) = ',(zchk_vmin * 1.e-3) 
    535             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limupdate2) = ',zchk_amax 
    536             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limupdate2) = ',zchk_amin 
    537          ENDIF 
    538       ENDIF 
    539       !- check conservation (C Rousset) 
    540       ! ------------------------------- 
     154      ! ------------------------------------------------- 
     155      ! Diagnostics 
     156      ! ------------------------------------------------- 
     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 
     163      DO jj = 1, jpj 
     164         DO ji = 1, jpi             
     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 
     174         END DO 
     175      END DO 
     176 
     177      ! conservation test 
     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 
    541188 
    542189      IF(ln_ctl) THEN   ! Control print 
    … …  
    544191         CALL prt_ctl_info(' - Cell values : ') 
    545192         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    546          CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update2  : cell area   :') 
     193         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update2  : cell area   :') 
    547194         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update2  : at_i        :') 
    548195         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update2  : vt_i        :') 
    … …  
    550197         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update2  : strength    :') 
    551198         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update2  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    552          CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update2  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_v_ice   :') 
     199         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update2  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    553200 
    554201         DO jl = 1, jpl 
    … …  
    563210            CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update2  : o_i         : ') 
    564211            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ') 
    565             CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_a_i     : ') 
    566             CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_a_i_thd   : ') 
     212            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ') 
    567213            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ') 
    568             CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_i     : ') 
    569             CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_i_thd   : ') 
     214            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ') 
    570215            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ') 
    571             CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_s     : ') 
    572             CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_s_thd   : ') 
    573             CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1        : ') 
    574             CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i1    : ') 
    575             CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : de_i1_thd   : ') 
    576             CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2        : ') 
    577             CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i2    : ') 
    578             CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : de_i2_thd   : ') 
     216            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ') 
     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      : ') 
    579221            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ') 
    580             CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update2  : old_e_snow  : ') 
    581             CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : d_e_s_thd   : ') 
     222            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ') 
    582223            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ') 
    583             CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update2  : old_smv_i   : ') 
    584             CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update2  : d_smv_i_thd : ') 
     224            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ') 
    585225            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ') 
    586             CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update2  : old_oa_i    : ') 
    587             CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update2  : d_oa_i_thd  : ') 
     226            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ') 
    588227 
    589228            DO jk = 1, nlay_i 
    … …  
    596235         CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    597236         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    598          CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update2 : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    599237         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update2 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    600          CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update2 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 
    601238 
    602239         CALL prt_ctl_info(' ') 
    … …  
    608245      ENDIF 
    609246    
    610       CALL wrk_dealloc( jpi,jpj,jpl, internal_melt )   ! integer 
    611       CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 
    612  
    613       CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    614  
    615247      IF( nn_timing == 1 )  CALL timing_stop('limupdate2') 
     248 
    616249   END SUBROUTINE lim_update2 
    617250#else 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r4333 r5832  
    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    ! 
    67  
    68    REAL(wp) ::   epsi10 = 1.e-10_wp   !    -       - 
    69    REAL(wp) ::   zzero = 0.e0        !    -       - 
    70    REAL(wp) ::   zone  = 1.e0        !    -       - 
     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 
    7161 
    7262   !!---------------------------------------------------------------------- 
    73    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     63   !! NEMO/LIM3 3.5 , UCL - NEMO Consortium (2011) 
    7464   !! $Id$ 
    7565   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9484      ! 
    9585      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    96       REAL(wp) ::   zinda, zindb 
    9786      !!------------------------------------------------------------------ 
    9887 
    … …  
    113102               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    114103               ! 
    115                zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi10 ) )  
    116                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness 
     104               rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
     105               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch  ! ice thickness 
    117106            END DO 
    118107         END DO 
    … …  
    134123            DO jj = 1, jpj 
    135124               DO ji = 1, jpi 
    136                   zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - epsi10 ) )  
    137                   zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi10 ) )  
    138                   et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content 
    139                   smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda   ! ice salinity 
    140                   ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * zindb   ! 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 
    141130               END DO 
    142131            END DO 
    … …  
    163152      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    164153      REAL(wp) ::   zq_i, zaaa, zbbb, zccc, zdiscrim     ! local scalars 
    165       REAL(wp) ::   ztmelts, zindb, zq_s, zfac1, zfac2   !   -      - 
     154      REAL(wp) ::   ztmelts, zq_s, zfac1, zfac2   !   -      - 
    166155      !!------------------------------------------------------------------ 
    167156 
    … …  
    172161         DO jj = 1, jpj 
    173162            DO ji = 1, jpi 
    174                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
    175                ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
    176                ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
    177                o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
    178             END DO 
    179          END DO 
    180       END DO 
    181  
    182       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 
    183172         DO jl = 1, jpl 
    184173            DO jj = 1, jpj 
    185174               DO ji = 1, jpi 
    186                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
    187                   sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * zindb 
     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 ) 
    188179               END DO 
    189180            END DO 
    … …  
    196187      ! Ice temperatures 
    197188      !------------------- 
    198 !CDIR NOVERRCHK 
    199       DO jl = 1, jpl 
    200 !CDIR NOVERRCHK 
     189      DO jl = 1, jpl 
    201190         DO jk = 1, nlay_i 
    202 !CDIR NOVERRCHK 
    203191            DO jj = 1, jpj 
    204 !CDIR NOVERRCHK 
    205192               DO ji = 1, jpi 
    206193                  !                                                              ! Energy of melting q(S,T) [J.m-3] 
    207                   zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
    208                   zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    209                   zq_i    = zq_i * unit_fac * zindb                              !convert units 
    210                   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 
    211197                  ! 
    212198                  zaaa       =  cpic                  ! Conversion q(S,T) -> T (second order equation) 
    213                   zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus 
    214                   zccc       =  lfus * (ztmelts-rtt) 
     199                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rt0 ) + zq_i * r1_rhoic - lfus 
     200                  zccc       =  lfus * (ztmelts-rt0) 
    215201                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) ) 
    216                   t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 
    217                   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 
    218204               END DO 
    219205            END DO 
    … …  
    231217               DO ji = 1, jpi 
    232218                  !Energy of melting q(S,T) [J.m-3] 
    233                   zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
    234                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    235                   zq_s  = zq_s * unit_fac * zindb                                    ! 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) 
    236221                  ! 
    237                   t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) 
    238                   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 
    239224               END DO 
    240225            END DO 
    … …  
    245230      ! Mean temperature 
    246231      !------------------- 
     232      vt_i (:,:) = 0._wp 
     233      DO jl = 1, jpl 
     234         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
     235      END DO 
     236 
    247237      tm_i(:,:) = 0._wp 
    248238      DO jl = 1, jpl 
    … …  
    250240            DO jj = 1, jpj 
    251241               DO ji = 1, jpi 
    252                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    253                   tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    254                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    255                END DO 
    256             END DO 
    257          END DO 
    258       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 
    259250      ! 
    260251   END SUBROUTINE lim_var_glo2eqv 
    … …  
    275266      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
    276267      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    277       oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:) 
    278268      ! 
    279269   END SUBROUTINE lim_var_eqv2glo 
    … …  
    286276      !! ** Purpose :   computes salinity profile in function of bulk salinity      
    287277      !! 
    288       !! ** Method  : If bulk salinity greater than s_i_1,  
     278      !! ** Method  : If bulk salinity greater than zsi1,  
    289279      !!              the profile is assumed to be constant (S_inf) 
    290       !!              If bulk salinity lower than s_i_0, 
     280      !!              If bulk salinity lower than zsi0, 
    291281      !!              the profile is linear with 0 at the surface (S_zero) 
    292       !!              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 
    293283      !!              alpha-weighted linear combination of s_inf and s_zero 
    294284      !! 
    295       !! ** References : Vancoppenolle et al., 2007 (in preparation) 
     285      !! ** References : Vancoppenolle et al., 2007 
    296286      !!------------------------------------------------------------------ 
    297287      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index 
    298       REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal      ! local scalar 
    299       REAL(wp) ::   zind0, zind01, zindbal, zargtemp , zs_zero   !   -      - 
    300       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 
    301293      !!------------------------------------------------------------------ 
    302294 
    … …  
    306298      ! Vertically constant, constant in time 
    307299      !--------------------------------------- 
    308       IF(  num_sal == 1  )   s_i(:,:,:,:) = bulk_sal 
     300      IF(  nn_icesal == 1  )   s_i(:,:,:,:) = rn_icesal 
    309301 
    310302      !----------------------------------- 
    311303      ! Salinity profile, varying in time 
    312304      !----------------------------------- 
    313       IF(  num_sal == 2  ) THEN 
     305      IF(  nn_icesal == 2  ) THEN 
    314306         ! 
    315307         DO jk = 1, nlay_i 
    … …  
    320312            DO jj = 1, jpj 
    321313               DO ji = 1, jpi 
    322                   z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01 , ht_i(ji,jj,jl) ) 
    323                END DO 
    324             END DO 
    325          END DO 
    326          ! 
    327          dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )       ! Weighting factor between zs_zero and zs_inf 
    328          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 ) 
    329322         ! 
    330323         zalpha(:,:,:) = 0._wp 
    … …  
    332325            DO jj = 1, jpj 
    333326               DO ji = 1, jpi 
    334                   ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    335                   zind0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) )  
    336                   ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    337                   zind01 = ( 1._wp - zind0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) )  
    338                   ! If 2.sm_i GE sss_m then zindbal = 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 
    339332                  ! this is to force a constant salinity profile in the Baltic Sea 
    340                   zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
    341                   zalpha(ji,jj,jl) = zind0  + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
    342                   zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zindbal ) 
    343                END DO 
    344             END DO 
    345          END DO 
    346  
    347          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 
    348341         DO jl = 1, jpl 
    349342            DO jk = 1, nlay_i 
    … …  
    351344                  DO ji = 1, jpi 
    352345                     !                                      ! linear profile with 0 at the surface 
    353                      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 
    354347                     !                                      ! weighting the profile 
    355348                     s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) 
    356                   END DO ! ji 
    357                END DO ! jj 
    358             END DO ! jk 
    359          END DO ! jl 
    360          ! 
    361       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 
    362357 
    363358      !------------------------------------------------------- 
    … …  
    365360      !------------------------------------------------------- 
    366361 
    367       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) 
    368363         ! 
    369364         sm_i(:,:,:) = 2.30_wp 
    370365         ! 
    371366         DO jl = 1, jpl 
    372 !CDIR NOVERRCHK 
    373367            DO jk = 1, nlay_i 
    374                zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp) 
     368               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    375369               zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
    376370               s_i(:,:,jk,jl) =  zsal 
    … …  
    378372         END DO 
    379373         ! 
    380       ENDIF ! num_sal 
     374      ENDIF ! nn_icesal 
    381375      ! 
    382376      CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha ) 
    … …  
    392386      !!------------------------------------------------------------------ 
    393387      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    394       REAL(wp) ::   zindb   !   -      - 
    395388      !!------------------------------------------------------------------ 
    396389 
    397390      ! 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 
    398396      tm_i(:,:) = 0._wp 
    399397      DO jl = 1, jpl 
    … …  
    401399            DO jj = 1, jpj 
    402400               DO ji = 1, jpi 
    403                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    404                   tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    405                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    406                END DO 
    407             END DO 
    408          END DO 
    409       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 
    410409 
    411410   END SUBROUTINE lim_var_icetm 
    … …  
    423422      !!------------------------------------------------------------------ 
    424423      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    425       REAL(wp) ::   zbvi, zinda, zindb      ! local scalars 
    426       !!------------------------------------------------------------------ 
    427       ! 
     424      REAL(wp) ::   zbvi             ! local scalars 
     425      !!------------------------------------------------------------------ 
     426      ! 
     427      vt_i (:,:) = 0._wp 
     428      DO jl = 1, jpl 
     429         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
     430      END DO 
     431 
    428432      bv_i(:,:) = 0._wp 
    429433      DO jl = 1, jpl 
    … …  
    431435            DO jj = 1, jpj 
    432436               DO ji = 1, jpi 
    433                   zinda = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  ) 
    434                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    435                   zbvi  = - zinda * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   & 
    436                      &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp) 
    437                   bv_i(ji,jj) = bv_i(ji,jj) + zindb * 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 ) 
    438442               END DO 
    439443            END DO 
    … …  
    454458      ! 
    455459      INTEGER  ::   ji, jk    ! dummy loop indices 
    456       INTEGER  ::   ii, ij  ! local integers 
    457       REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars 
    458       REAL(wp) ::   zalpha, zind0, zind01, zindbal, 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              !   -      - 
    459463      ! 
    460464      REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s 
     465      REAL(wp), PARAMETER :: zsi0 = 3.5_wp 
     466      REAL(wp), PARAMETER :: zsi1 = 4.5_wp 
    461467      !!--------------------------------------------------------------------- 
    462468 
    … …  
    466472      ! Vertically constant, constant in time 
    467473      !--------------------------------------- 
    468       IF( num_sal == 1 )   s_i_b(:,:) = bulk_sal 
     474      IF( nn_icesal == 1 )   s_i_1d(:,:) = rn_icesal 
    469475 
    470476      !------------------------------------------------------ 
    … …  
    472478      !------------------------------------------------------ 
    473479 
    474       IF(  num_sal == 2  ) THEN 
     480      IF(  nn_icesal == 2  ) THEN 
    475481         ! 
    476482         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero 
    477             z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( 0.01 , ht_i_b(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) ) 
    478485         END DO 
    479486 
    480487         ! Weighting factor between zs_zero and zs_inf 
    481488         !--------------------------------------------- 
    482          dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 ) 
    483          dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 ) 
    484          dummy_fac2 = 1._wp / REAL(nlay_i,wp) 
    485  
    486 !CDIR NOVERRCHK 
     489         zfac0 = 1._wp / ( zsi0 - zsi1 ) 
     490         zfac1 = zsi1 / ( zsi1 - zsi0 ) 
    487491         DO jk = 1, nlay_i 
    488 !CDIR NOVERRCHK 
    489492            DO ji = kideb, kiut 
    490493               ii =  MOD( npb(ji) - 1 , jpi ) + 1 
    491494               ij =     ( npb(ji) - 1 ) / jpi + 1 
    492                ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    493                zind0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_b(ji) ) )  
    494                ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    495                zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_b(ji) ) )  
    496                ! if 2.sm_i GE sss_m then zindbal = 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 
    497500               ! this is to force a constant salinity profile in the Baltic Sea 
    498                zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(ii,ij) ) ) 
     501               rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 
    499502               ! 
    500                zalpha = (  zind0 + zind01 * ( sm_i_b(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zindbal ) 
     503               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 )  ) * ( 1._wp - rswitch ) 
    501504               ! 
    502                zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_b(ji) * dummy_fac2 
     505               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i 
    503506               ! weighting the profile 
    504                s_i_b(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_b(ji) 
    505             END DO ! ji 
    506          END DO ! jk 
    507  
    508       ENDIF ! num_sal 
     507               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 
     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  
    509514 
    510515      !------------------------------------------------------- 
    … …  
    512517      !------------------------------------------------------- 
    513518 
    514       IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    515          ! 
    516          sm_i_b(:) = 2.30_wp 
    517          ! 
    518 !CDIR NOVERRCHK 
     519      IF( nn_icesal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
     520         ! 
     521         sm_i_1d(:) = 2.30_wp 
     522         ! 
    519523         DO jk = 1, nlay_i 
    520             zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp) 
    521             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 ) ) ) ) 
    522526            DO ji = kideb, kiut 
    523                s_i_b(ji,jk) = zsal 
     527               s_i_1d(ji,jk) = zsal 
    524528            END DO 
    525529         END DO 
    … …  
    530534      ! 
    531535   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 
    532784 
    533785#else 
    … …  
    548800   SUBROUTINE lim_var_salprof1d    ! Emtpy routines 
    549801   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 
    550806#endif 
    551807 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r4624 r5832  
    99   !!---------------------------------------------------------------------- 
    1010   !!   lim_wri      : write of the diagnostics variables in ouput file  
    11    !!   lim_wri_init : initialization and namelist read 
    1211   !!   lim_wri_state : write for initial state or/and abandon 
    1312   !!---------------------------------------------------------------------- 
    … …  
    2524   USE lib_mpp         ! MPP library 
    2625   USE wrk_nemo        ! work arrays 
    27    USE par_ice 
    2826   USE iom 
    2927   USE timing          ! Timing 
    … …  
    3634   PUBLIC lim_wri_state  ! called by dia_wri_state  
    3735 
    38    INTEGER, PARAMETER ::   jpnoumax = 43   !: maximum number of variable for ice output 
    39     
    40    INTEGER  ::   noumef             ! number of fields 
    41    INTEGER  ::   noumefa            ! number of additional fields 
    42    INTEGER  ::   add_diag_swi       ! additional diagnostics 
    43    INTEGER  ::   nz                                         ! dimension for the itd field 
    44  
    45    REAL(wp) , DIMENSION(jpnoumax) ::   cmulti         ! multiplicative constant 
    46    REAL(wp) , DIMENSION(jpnoumax) ::   cadd           ! additive constant 
    47    REAL(wp) , DIMENSION(jpnoumax) ::   cmultia        ! multiplicative constant 
    48    REAL(wp) , DIMENSION(jpnoumax) ::   cadda          ! additive constant 
    49    CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn, titna   ! title of the field 
    50    CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam , nama    ! name of the field 
    51    CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni , unia    ! unit of the field 
    52    INTEGER            , DIMENSION(jpnoumax) ::   nc  , nca     ! switch for saving field ( = 1 ) or not ( = 0 ) 
    53  
    54    REAL(wp)  ::   epsi06 = 1.e-6_wp 
    55    REAL(wp)  ::   zzero  = 0._wp 
    56    REAL(wp)  ::   zone   = 1._wp       
    5736   !!---------------------------------------------------------------------- 
    5837   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    … …  
    7857      INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere 
    7958      ! 
    80       INTEGER ::  ji, jj, jk, jl, jf, ipl ! dummy loop indices 
    81       INTEGER ::  ierr 
    82       REAL(wp),DIMENSION(1) ::   zdept 
    83       REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb, zindc 
    84       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zcmo, zcmoa 
    85       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zfield 
    86       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zmaskitd, zoi, zei 
    87  
    88       CHARACTER(len = 60) ::   clhstnam, clop, clhstnama 
    89  
    90       INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid 
    91       INTEGER , SAVE ::   nicea, nhorida, ndimitd 
    92       INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndex51 
    93       INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndexitd 
     59      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices 
     60      REAL(wp) ::  z1_365 
     61      REAL(wp) ::  ztmp 
     62      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei, zt_i, zt_s 
     63      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace 
    9464      !!------------------------------------------------------------------- 
    9565 
    9666      IF( nn_timing == 1 )  CALL timing_start('limwri') 
    9767 
    98       CALL wrk_alloc( jpi, jpj, zfield ) 
    99       CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 
    100       CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 
    101  
    102       ipl = jpl 
    103  
    104       IF( numit == nstart ) THEN  
    105  
    106          ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr ) 
    107          IF( lk_mpp    )   CALL mpp_sum ( ierr ) 
    108          IF( ierr /= 0 ) THEN 
    109             CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' )   ;   RETURN 
    110          ENDIF 
    111  
    112          CALL lim_wri_init  
    113  
    114          IF(lwp) WRITE(numout,*) ' lim_wri, first time step ' 
    115          IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi 
    116  
    117          !-------------------- 
    118          !  1) Initialization 
    119          !-------------------- 
    120  
    121          !------------- 
    122          ! Normal file 
    123          !------------- 
    124          niter    = ( nit000 - 1 ) / nn_fsbc 
    125          CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 
    126          zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    127 !clem 
    128 !         zsto     = rdt_ice 
    129 !         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!) 
    130 !         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time) 
    131 !         ENDIF 
    132 !         zout     = nwrite * rdt_ice / nn_fsbc 
    133 !         zdept(1) = 0. 
    134 ! 
    135 !         CALL dia_nam ( clhstnam, nwrite, 'icemod_old' ) 
    136 !         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice,   & 
    137 !            &           nhorid, nice, domain_id=nidom, snc4chunks=snc4set ) 
    138 !         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 
    139 !         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    140 ! 
    141 !         DO jf = 1 , noumef 
    142 !            IF(lwp) WRITE(numout,*) 'jf', jf 
    143 !            IF ( nc(jf) == 1 ) THEN 
    144 !               CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & 
    145 !                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    146 !               IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout' 
    147 !               IF(lwp) WRITE(numout,*)  nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout  
    148 !            ENDIF 
    149 !         END DO 
    150 ! 
    151 !         CALL histend(nice, snc4set) 
    152 !clem 
    153          ! 
    154          !----------------- 
    155          ! ITD file output 
    156          !----------------- 
    157          zsto     = rdt_ice 
    158          clop     = "ave(x)" 
    159          zout     = nwrite * rdt_ice / nn_fsbc 
    160          zdept(1) = 0. 
    161  
    162          CALL dia_nam ( clhstnama, nwrite, 'icemoa' ) 
    163          CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit,         & 
    164             1, jpi, 1, jpj,            & ! zoom 
    165             niter, zjulian, rdt_ice,   & ! time 
    166             nhorida,                   & ! ? linked with horizontal ... 
    167             nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file  
    168          CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz ) 
     68      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
     69      CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi ) 
     70 
     71      !----------------------------- 
     72      ! Mean category values 
     73      !----------------------------- 
     74      z1_365 = 1._wp / 365._wp 
     75 
     76      CALL lim_var_icetm      ! mean sea ice temperature 
     77 
     78      CALL lim_var_bv         ! brine volume 
     79 
     80      DO jj = 1, jpj          ! presence indicator of ice 
     81         DO ji = 1, jpi 
     82            zswi(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 
     83         END DO 
     84      END DO 
     85      ! 
     86      ! 
     87      !                                              
     88      IF ( iom_use( "icethic_cea" ) ) THEN                       ! mean ice thickness 
     89         DO jj = 1, jpj  
     90            DO ji = 1, jpi 
     91               z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 
     92            END DO 
     93         END DO 
     94         CALL iom_put( "icethic_cea"  , z2d              ) 
     95      ENDIF 
     96 
     97      IF ( iom_use( "snowthic_cea" ) ) THEN                      ! snow thickness = mean snow thickness over the cell  
     98         DO jj = 1, jpj                                             
     99            DO ji = 1, jpi 
     100               z2d(ji,jj)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 
     101            END DO 
     102         END DO 
     103         CALL iom_put( "snowthic_cea" , z2d              )        
     104      ENDIF 
     105      ! 
     106      IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN  
     107         DO jj = 2 , jpjm1 
     108            DO ji = 2 , jpim1 
     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 
     111           END DO 
     112         END DO 
     113         CALL lbc_lnk( z2da, 'T', -1. ) 
     114         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 
     117         DO jj = 1, jpj                                  
     118            DO ji = 1, jpi 
     119               z2d(ji,jj)  = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) )  
     120            END DO 
     121         END DO 
     122         CALL iom_put( "icevel"       , z2d              )       ! ice velocity module 
     123      ENDIF 
     124      ! 
     125      IF ( iom_use( "miceage" ) ) THEN  
     126         z2d(:,:) = 0.e0 
    169127         DO jl = 1, jpl 
    170             zmaskitd(:,:,jl) = tmask(:,:,1) 
    171          END DO 
    172          CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    173          CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd  )   
    174          CALL histdef( nicea, "iice_itd", "Ice area in categories"         , "-"    ,   &   
    175             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    176          CALL histdef( nicea, "iice_hid", "Ice thickness in categories"    , "m"    ,   &   
    177             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    178          CALL histdef( nicea, "iice_hsd", "Snow depth in in categories"    , "m"    ,   &   
    179             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    180          CALL histdef( nicea, "iice_std", "Ice salinity distribution"      , "ppt"  ,   &   
    181             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    182          CALL histdef( nicea, "iice_otd", "Ice age distribution"               , "days",   &   
    183             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    184          CALL histdef( nicea, "iice_etd", "Brine volume distr. "               , "%"    ,   &   
    185             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    186          CALL histend(nicea, snc4set) 
    187       ENDIF 
    188  
    189       !     !-----------------------------------------------------------------------! 
    190       !     !--2. Computation of instantaneous values                               !  
    191       !     !-----------------------------------------------------------------------! 
    192  
    193       !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    194       !IF( ln_nicep ) THEN 
    195       !   WRITE(numout,*) 
    196       !   WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit 
    197       !   WRITE(numout,*) '~~~~~~~ ' 
    198       !   WRITE(numout,*) ' kindic = ', kindic 
    199       !ENDIF 
    200       !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    201  
    202       !-- calculs des valeurs instantanees 
    203       zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 
    204       zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 
    205  
    206       ! Ice surface temperature and some fluxes 
    207       DO jl = 1, jpl 
     128            DO jj = 1, jpj 
     129               DO ji = 1, jpi 
     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 ) 
     132               END DO 
     133            END DO 
     134         END DO 
     135         CALL iom_put( "miceage"     , z2d * z1_365      )        ! mean ice age 
     136      ENDIF 
     137 
     138      IF ( iom_use( "micet" ) ) THEN  
    208139         DO jj = 1, jpj 
    209140            DO ji = 1, jpi 
    210                zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
    211                zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl)  
    212                zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl)  
    213                zcmo(ji,jj,27) = zcmo(ji,jj,27) + zinda*(t_su(ji,jj,jl)-rtt)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 
    214                zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06)  
    215             END DO 
    216          END DO 
    217       END DO 
    218  
    219       ! Mean sea ice temperature 
    220       CALL lim_var_icetm 
    221  
    222       ! Brine volume 
    223       CALL lim_var_bv 
    224  
    225       DO jj = 2 , jpjm1 
    226          DO ji = 2 , jpim1 
    227             zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
    228             zindb  = MAX( zzero , SIGN( zone , at_i(ji,jj) ) ) 
    229  
    230             zcmo(ji,jj,1)  = at_i(ji,jj) 
    231             zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 
    232             zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 
    233             zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * rday     ! Bottom thermodynamic ice production 
    234             zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * rday     ! Dynamic ice production (rid/raft) 
    235             zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * rday     ! Lateral thermodynamic ice production 
    236             zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * rday     ! Snow ice production ice production 
    237             zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda 
    238  
    239             zcmo(ji,jj,6)  = fbif(ji,jj)*at_i(ji,jj) 
    240             zcmo(ji,jj,7)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 
    241             zcmo(ji,jj,8)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 
    242             zcmo(ji,jj,9)  = sst_m(ji,jj) 
    243             zcmo(ji,jj,10) = sss_m(ji,jj) 
    244  
    245             zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
    246             zcmo(ji,jj,12) = qsr(ji,jj) 
    247             zcmo(ji,jj,13) = qns(ji,jj) 
    248             zcmo(ji,jj,14) = fhbri(ji,jj) 
    249             zcmo(ji,jj,15) = utau_ice(ji,jj) 
    250             zcmo(ji,jj,16) = vtau_ice(ji,jj) 
    251             zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj) 
    252             zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj) 
    253             zcmo(ji,jj,19) = sprecip(ji,jj) 
    254             zcmo(ji,jj,20) = smt_i(ji,jj) 
    255             zcmo(ji,jj,25) = et_i(ji,jj) 
    256             zcmo(ji,jj,26) = et_s(ji,jj) 
    257             zcmo(ji,jj,28) = sfx_bri(ji,jj) 
    258             zcmo(ji,jj,29) = sfx_thd(ji,jj) 
    259  
    260             zcmo(ji,jj,30) = bv_i(ji,jj) 
    261             zcmo(ji,jj,31) = hicol(ji,jj) * zindb 
    262             zcmo(ji,jj,32) = strength(ji,jj) 
    263             zcmo(ji,jj,33) = SQRT(  zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8)  ) 
    264             zcmo(ji,jj,34) = diag_sur_me(ji,jj) * rday     ! Surface melt 
    265             zcmo(ji,jj,35) = diag_bot_me(ji,jj) * rday     ! Bottom melt 
    266             zcmo(ji,jj,36) = divu_i(ji,jj) 
    267             zcmo(ji,jj,37) = shear_i(ji,jj) 
    268             zcmo(ji,jj,38) = diag_res_pr(ji,jj) * rday     ! Bottom melt 
    269             zcmo(ji,jj,39) = vt_i(ji,jj)  ! ice volume 
    270             zcmo(ji,jj,40) = vt_s(ji,jj)  ! snow volume 
    271  
    272             zcmo(ji,jj,41) = sfx_mec(ji,jj) 
    273             zcmo(ji,jj,42) = sfx_res(ji,jj) 
    274  
    275             zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * rday     ! transport of ice volume 
    276  
    277         END DO 
    278       END DO 
    279  
    280       ! 
    281       ! ecriture d'un fichier netcdf 
    282       ! 
    283       niter = niter + 1 
    284 !clem 
    285 !      DO jf = 1 , noumef 
    286 !         ! 
    287 !         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) 
    288 !         ! 
    289 !         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN   ;   CALL lbc_lnk( zfield, 'T', -1. ) 
    290 !         ELSE                                                            ;   CALL lbc_lnk( zfield, 'T',  1. ) 
    291 !         ENDIF 
    292 !         ! 
    293 !         IF( ln_nicep ) THEN  
    294 !            WRITE(numout,*) 
    295 !            WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim' 
    296 !            WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 
    297 !         ENDIF 
    298 !         IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 
    299 !         ! 
    300 !      END DO 
    301 ! 
    302 !      IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 
    303 !         IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 
    304 !         CALL histclo( nice ) 
    305 !      ENDIF 
    306 !clem 
    307       ! 
    308        CALL iom_put ('iceconc', zcmo(:,:,1) )          ! field1: ice concentration 
    309        CALL iom_put ('icethic_cea', zcmo(:,:,2) )      ! field2: ice thickness (i.e. icethi(:,:)) 
    310        CALL iom_put ('snowthic_cea', zcmo(:,:,3))      ! field3: snow thickness 
    311        CALL iom_put ('icebopr', zcmo(:,:,4) )   ! field4: daily bottom thermo ice production 
    312        CALL iom_put ('icedypr', zcmo(:,:,5) )   ! field5: daily dynamic ice production 
    313        CALL iom_put ('ioceflxb', zcmo(:,:,6) )         ! field6: Oceanic flux at the ice base 
    314        CALL iom_put ('uice_ipa', zcmo(:,:,7) )         ! field7: ice velocity u component 
    315        CALL iom_put ('vice_ipa', zcmo(:,:,8) )         ! field8: ice velocity v component 
    316        CALL iom_put ('isst', zcmo(:,:,9) )             ! field 9: sea surface temperature 
    317        CALL iom_put ('isss', zcmo(:,:,10) )            ! field 10: sea surface salinity 
    318        CALL iom_put ('qt_oce', zcmo(:,:,11) )           ! field 11: total flux at ocean surface 
    319        CALL iom_put ('qsr_oce', zcmo(:,:,12) )          ! field 12: solar flux at ocean surface 
    320        CALL iom_put ('qns_oce', zcmo(:,:,13) )          ! field 13: non-solar flux at ocean surface 
    321        !CALL iom_put ('hfbri', fhbri )                  ! field 14: heat flux due to brine release 
    322        CALL iom_put( 'utau_ice', zcmo(:,:,15)  )     ! Wind stress over ice along i-axis at I-point 
    323        CALL iom_put( 'vtau_ice', zcmo(:,:,16) )     ! Wind stress over ice along j-axis at I-point 
    324        CALL iom_put ('qsr_io', zcmo(:,:,17) )          ! field 17: solar flux at ice/ocean surface 
    325        CALL iom_put ('qns_io', zcmo(:,:,18) )          ! field 18: non-solar flux at ice/ocean surface 
    326        !CALL iom_put ('snowpre', zcmo(:,:,19) * rday ! field 19 :snow precip           
    327        CALL iom_put ('micesalt', zcmo(:,:,20) )        ! field 20 :mean ice salinity 
    328        CALL iom_put ('miceage', zcmo(:,:,21) / 365)    ! field 21: mean ice age 
    329        CALL iom_put ('icelapr',zcmo(:,:,22) )   ! field 22: daily lateral thermo ice prod. 
    330        CALL iom_put ('icesipr',zcmo(:,:,23) )   ! field 23: daily snowice ice prod. 
    331        CALL iom_put ('micet', zcmo(:,:,24) )           ! field 24: mean ice temperature 
    332        CALL iom_put ('icehc', zcmo(:,:,25) )           ! field 25: ice total heat content 
    333        CALL iom_put ('isnowhc', zcmo(:,:,26) )         ! field 26: snow total heat content 
    334        CALL iom_put ('icest', zcmo(:,:,27) )           ! field 27: ice surface temperature 
    335        CALL iom_put ('sfxbri', zcmo(:,:,28) * rday )           ! field 28: brine salt flux 
    336        CALL iom_put ('sfxthd', zcmo(:,:,29) * rday )           ! field 29: equivalent FW salt flux 
    337        CALL iom_put ('ibrinv', zcmo(:,:,30) *100 )     ! field 30: brine volume 
    338        CALL iom_put ('icecolf', zcmo(:,:,31) )         ! field 31: frazil ice collection thickness 
    339        CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 )  ! field 32: ice strength 
    340        CALL iom_put ('icevel', zcmo(:,:,33) )          ! field 33: ice velocity 
    341        CALL iom_put ('isume', zcmo(:,:,34) )    ! field 34: surface melt 
    342        CALL iom_put ('ibome', zcmo(:,:,35) )     ! field 35: bottom melt 
    343        CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8)    ! field 36: divergence 
    344        CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 )  ! field 37: shear 
    345        CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate 
    346        CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume 
    347        CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume 
    348        CALL iom_put ('sfxmec', zcmo(:,:,41) * rday )           ! field 41: salt flux from ridging rafting 
    349        CALL iom_put ('sfxres', zcmo(:,:,42) * rday )           ! field 42: salt flux from limupdate (resultant) 
    350        CALL iom_put ('icetrp', zcmo(:,:,43) )    ! field 43: ice volume transport 
    351  
    352       !----------------------------- 
    353       ! Thickness distribution file 
    354       !----------------------------- 
    355       IF( add_diag_swi == 1 ) THEN 
    356  
    357          DO jl = 1, jpl  
    358             CALL lbc_lnk( a_i(:,:,jl)  , 'T' ,  1. ) 
    359             CALL lbc_lnk( sm_i(:,:,jl) , 'T' ,  1. ) 
    360             CALL lbc_lnk( oa_i(:,:,jl) , 'T' ,  1. ) 
    361             CALL lbc_lnk( ht_i(:,:,jl) , 'T' ,  1. ) 
    362             CALL lbc_lnk( ht_s(:,:,jl) , 'T' ,  1. ) 
    363          END DO 
    364  
    365          ! Compute ice age 
     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 
     145      ENDIF 
     146      ! 
     147      IF ( iom_use( "icest" ) ) THEN  
     148         z2d(:,:) = 0.e0 
     149         DO jl = 1, jpl 
     150            DO jj = 1, jpj 
     151               DO ji = 1, jpi 
     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 ) 
     153               END DO 
     154            END DO 
     155         END DO 
     156         CALL iom_put( "icest"       , z2d              )        ! ice surface temperature 
     157      ENDIF 
     158 
     159      IF ( iom_use( "icecolf" ) ) THEN  
     160         DO jj = 1, jpj 
     161            DO ji = 1, jpi 
     162               rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) ) 
     163               z2d(ji,jj) = hicol(ji,jj) * rswitch 
     164            END DO 
     165         END DO 
     166         CALL iom_put( "icecolf"     , z2d              )        ! frazil ice collection thickness 
     167      ENDIF 
     168 
     169      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature 
     170      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity 
     171      CALL iom_put( "iceconc"     , at_i                )        ! ice concentration 
     172      CALL iom_put( "icevolu"     , vt_i                )        ! ice volume = mean ice thickness over the cell 
     173      CALL iom_put( "icehc"       , et_i                )        ! ice total heat content 
     174      CALL iom_put( "isnowhc"     , et_s                )        ! snow total heat content 
     175      CALL iom_put( "ibrinv"      , bv_i * 100._wp      )        ! brine volume 
     176      CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point 
     177      CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point 
     178      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation  
     179      CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity 
     180 
     181      CALL iom_put( "icestr"      , strength * 0.001    )        ! ice strength 
     182      CALL iom_put( "idive"       , divu_i * 1.0e8      )        ! divergence 
     183      CALL iom_put( "ishear"      , shear_i * 1.0e8     )        ! shear 
     184      CALL iom_put( "snowvol"     , vt_s                )        ! snow volume 
     185       
     186      CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport 
     187      CALL iom_put( "snwtrp"      , diag_trp_vs * rday  )        ! snw volume transport 
     188      CALL iom_put( "saltrp"      , diag_trp_smv * rday * rhoic ) ! salt content transport 
     189      CALL iom_put( "deitrp"      , diag_trp_ei         )        ! advected ice enthalpy (W/m2) 
     190      CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2) 
     191 
     192      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from brines 
     193      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from brines 
     194      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from brines 
     195      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from brines 
     196      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from brines 
     197      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting 
     198      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant) 
     199      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines 
     200      CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux 
     201 
     202      ztmp = rday / rhoic 
     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  
     237       
     238      !-------------------------------- 
     239      ! Output values for each category 
     240      !-------------------------------- 
     241      CALL iom_put( "iceconc_cat"      , a_i         )        ! area for categories 
     242      CALL iom_put( "icethic_cat"      , ht_i        )        ! thickness for categories 
     243      CALL iom_put( "snowthic_cat"     , ht_s        )        ! snow depth for categories 
     244      CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories 
     245 
     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 
     258      ! Compute ice age 
     259      IF ( iom_use( "iceage_cat" ) ) THEN  
    366260         DO jl = 1, jpl  
    367261            DO jj = 1, jpj 
    368262               DO ji = 1, jpi 
    369                   zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
    370                   zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda 
     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 
    371266               END DO 
    372267            END DO 
    373268         END DO 
    374  
    375          ! Compute brine volume 
     269         CALL iom_put( "iceage_cat"   , zoi * z1_365 )        ! ice age for categories 
     270      ENDIF 
     271 
     272      ! Compute brine volume 
     273      IF ( iom_use( "brinevol_cat" ) ) THEN  
    376274         zei(:,:,:) = 0._wp 
    377275         DO jl = 1, jpl  
    … …  
    379277               DO jj = 1, jpj 
    380278                  DO ji = 1, jpi 
    381                      zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
    382                      zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 
    383                         ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * & 
    384                         zinda / nlay_i 
     279                     rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
     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 
    385283                  END DO 
    386284               END DO 
    387285            END DO 
    388286         END DO 
    389  
    390          DO jl = 1, jpl  
    391             CALL lbc_lnk( zei(:,:,jl) , 'T' ,  1. ) 
    392          END DO 
    393  
    394          CALL histwrite( nicea, "iice_itd", niter, a_i  , ndimitd , ndexitd  )   ! area 
    395          CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd  )   ! thickness 
    396          CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd  )   ! snow depth 
    397          CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd  )   ! salinity 
    398          CALL histwrite( nicea, "iice_otd", niter, zoi  , ndimitd , ndexitd  )   ! age 
    399          CALL histwrite( nicea, "iice_etd", niter, zei  , ndimitd , ndexitd  )   ! brine volume 
    400  
    401          !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
    402          !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' ) 
    403          !     not yet implemented 
    404  
    405          IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 
    406             IF(lwp) WRITE(numout,*) ' Closing the icemod file ' 
    407             CALL histclo( nicea )  
    408          ENDIF 
    409          ! 
    410       ENDIF 
    411  
    412       CALL wrk_dealloc( jpi, jpj, zfield ) 
    413       CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 
    414       CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 
     287         CALL iom_put( "brinevol_cat"     , zei      )        ! brine volume for categories 
     288      ENDIF 
     289 
     290      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
     291      !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' ) 
     292      !     not yet implemented 
     293       
     294      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
     295      CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db ) 
    415296 
    416297      IF( nn_timing == 1 )  CALL timing_stop('limwri') 
    … …  
    419300#endif 
    420301 
    421    SUBROUTINE lim_wri_init 
    422       !!------------------------------------------------------------------- 
    423       !!                    ***   ROUTINE lim_wri_init  *** 
    424       !!                 
    425       !! ** Purpose :   ??? 
    426       !! 
    427       !! ** Method  : Read the namicewri namelist and check the parameter  
    428       !!       values called at the first timestep (nit000) 
    429       !! 
    430       !! ** input   :   Namelist namicewri 
    431       !!------------------------------------------------------------------- 
    432       INTEGER ::   nf      ! ??? 
    433       INTEGER ::   ios     ! Local integer output status for namelist read 
    434  
    435       TYPE FIELD  
    436          CHARACTER(len = 35) :: ztitle  
    437          CHARACTER(len = 8 ) :: zname           
    438          CHARACTER(len = 8 ) :: zunit 
    439          INTEGER             :: znc    
    440          REAL                :: zcmulti  
    441          REAL                :: zcadd         
    442       END TYPE FIELD 
    443  
    444       TYPE(FIELD) ::  & 
    445          field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   & 
    446          field_7 , field_8 , field_9 , field_10, field_11, field_12,   & 
    447          field_13, field_14, field_15, field_16, field_17, field_18,   & 
    448          field_19, field_20, field_21, field_22, field_23, field_24,   & 
    449          field_25, field_26, field_27, field_28, field_29, field_30,   & 
    450          field_31, field_32, field_33, field_34, field_35, field_36,   & 
    451          field_37, field_38, field_39, field_40, field_41, field_42, field_43 
    452  
    453       TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield 
    454       ! 
    455       NAMELIST/namiceout/ noumef, & 
    456          field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   & 
    457          field_7 , field_8 , field_9 , field_10, field_11, field_12,   & 
    458          field_13, field_14, field_15, field_16, field_17, field_18,   & 
    459          field_19, field_20, field_21, field_22, field_23, field_24,   & 
    460          field_25, field_26, field_27, field_28, field_29, field_30,   & 
    461          field_31, field_32, field_33, field_34, field_35, field_36,   & 
    462          field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi 
    463       !!------------------------------------------------------------------- 
    464       REWIND( numnam_ice_ref )              ! Namelist namiceout in reference namelist : Ice outputs 
    465       READ  ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901) 
    466 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp ) 
    467  
    468       REWIND( numnam_ice_cfg )              ! Namelist namiceout in configuration namelist : Ice outputs 
    469       READ  ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 ) 
    470 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp ) 
    471       IF(lwm) WRITE ( numoni, namiceout ) 
    472  
    473       zfield(1)  = field_1 
    474       zfield(2)  = field_2 
    475       zfield(3)  = field_3 
    476       zfield(4)  = field_4 
    477       zfield(5)  = field_5 
    478       zfield(6)  = field_6 
    479       zfield(7)  = field_7 
    480       zfield(8)  = field_8 
    481       zfield(9)  = field_9 
    482       zfield(10) = field_10 
    483       zfield(11) = field_11 
    484       zfield(12) = field_12 
    485       zfield(13) = field_13 
    486       zfield(14) = field_14 
    487       zfield(15) = field_15 
    488       zfield(16) = field_16 
    489       zfield(17) = field_17 
    490       zfield(18) = field_18 
    491       zfield(19) = field_19 
    492       zfield(20) = field_20 
    493       zfield(21) = field_21 
    494       zfield(22) = field_22 
    495       zfield(23) = field_23 
    496       zfield(24) = field_24 
    497       zfield(25) = field_25 
    498       zfield(26) = field_26 
    499       zfield(27) = field_27 
    500       zfield(28) = field_28 
    501       zfield(29) = field_29 
    502       zfield(30) = field_30 
    503       zfield(31) = field_31 
    504       zfield(32) = field_32 
    505       zfield(33) = field_33 
    506       zfield(34) = field_34 
    507       zfield(35) = field_35 
    508       zfield(36) = field_36 
    509       zfield(37) = field_37 
    510       zfield(38) = field_38 
    511       zfield(39) = field_39 
    512       zfield(40) = field_40 
    513       zfield(41) = field_41 
    514       zfield(42) = field_42 
    515       zfield(43) = field_43 
    516  
    517       DO nf = 1, noumef 
    518          titn  (nf) = zfield(nf)%ztitle 
    519          nam   (nf) = zfield(nf)%zname 
    520          uni   (nf) = zfield(nf)%zunit 
    521          nc    (nf) = zfield(nf)%znc 
    522          cmulti(nf) = zfield(nf)%zcmulti 
    523          cadd  (nf) = zfield(nf)%zcadd 
    524       END DO 
    525  
    526       IF(lwp) THEN                        ! control print 
    527          WRITE(numout,*) 
    528          WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs' 
    529          WRITE(numout,*) '~~~~~~~~~~~~' 
    530          WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef 
    531          WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   & 
    532             &            '    multiplicative constant       additive constant ' 
    533          DO nf = 1 , noumef          
    534             WRITE(numout,*) '   ', titn(nf), '   '    , nam   (nf), '      '  , uni (nf),   & 
    535                &            '  ' , nc  (nf),'        ', cmulti(nf), '        ', cadd(nf) 
    536          END DO 
    537          WRITE(numout,*) ' add_diag_swi ', add_diag_swi 
    538       ENDIF 
    539       ! 
    540    END SUBROUTINE lim_wri_init 
    541302  
    542303   SUBROUTINE lim_wri_state( kt, kid, kh_i ) 
    … …  
    555316      INTEGER, INTENT( in ) ::   kid , kh_i        
    556317      !!---------------------------------------------------------------------- 
    557       !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz ) 
    558  
    559       CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    560       CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    561       CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    562       CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    563       CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    564       CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    565       CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    566       CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    567       CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    568       CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    569       CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    570       CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    571       CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    572       CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    573       CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    574       CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    575       CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    576       CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    577       CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    578       CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    579       CALL histdef( kid, "iisfxthd", "Salt flux from thermo"   , ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    580       CALL histdef( kid, "iisfxmec", "Salt flux from dynmics"  , ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    581       CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    582  
    583  
    584       !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
    585       !CALL histdef( kid, "iice_hid", "Ice thickness by cat"    , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
    586       !CALL histdef( kid, "iice_hsd", "Snow thickness by cat"   , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
    587       !CALL histdef( kid, "iice_std", "Ice salinity by cat"     , "PSU"    , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     318 
     319      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      ,   & 
     320      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     321      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      ,   & 
     322      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     323      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      ,   & 
     324      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     325      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    ,   & 
     326      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     327      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    ,   & 
     328      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     329      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa",   & 
     330      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     331      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa",   & 
     332      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     333      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2" ,   & 
     334      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     335      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" ,   & 
     336      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     337      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   & 
     338      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     339      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    ,   & 
     340      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     341      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      ,   & 
     342      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     343      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1",   & 
     344      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     345      CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"    ,   & 
     346      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     347      CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"    ,   & 
     348      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     349      CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"    ,   & 
     350      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     351      CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"    ,   & 
     352      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     353      CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"    ,   & 
     354      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     355      CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"    ,   & 
     356      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     357      CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"    ,   & 
     358      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     359      CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics"  , ""       ,   & 
     360      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     361      CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""       ,   & 
     362      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    588363 
    589364      CALL histend( kid, snc4set )   ! end of the file definition 
    … …  
    591366      CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )     
    592367      CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) ) 
    593       CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) ) 
     368      CALL histwrite( kid, "iicetemp", kt, tm_i - rt0    , jpi*jpj, (/1/) ) 
    594369      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) ) 
    595370      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) ) 
    … …  
    603378      CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) ) 
    604379 
    605       CALL histwrite( kid, "iicebopr", kt, diag_bot_gr        , jpi*jpj, (/1/) ) 
    606       CALL histwrite( kid, "iicedypr", kt, diag_dyn_gr        , jpi*jpj, (/1/) ) 
    607       CALL histwrite( kid, "iicelapr", kt, diag_lat_gr        , jpi*jpj, (/1/) ) 
    608       CALL histwrite( kid, "iicesipr", kt, diag_sni_gr        , jpi*jpj, (/1/) ) 
    609       CALL histwrite( kid, "iicerepr", kt, diag_res_pr        , jpi*jpj, (/1/) ) 
    610       CALL histwrite( kid, "iicebome", kt, diag_bot_me        , jpi*jpj, (/1/) ) 
    611       CALL histwrite( kid, "iicesume", kt, diag_sur_me        , jpi*jpj, (/1/) ) 
    612       CALL histwrite( kid, "iisfxthd", kt, sfx_thd        , jpi*jpj, (/1/) ) 
    613       CALL histwrite( kid, "iisfxmec", kt, sfx_mec        , jpi*jpj, (/1/) ) 
     380      CALL histwrite( kid, "iicebopr", kt, wfx_bog        , jpi*jpj, (/1/) ) 
     381      CALL histwrite( kid, "iicedypr", kt, wfx_dyn        , jpi*jpj, (/1/) ) 
     382      CALL histwrite( kid, "iicelapr", kt, wfx_opw        , jpi*jpj, (/1/) ) 
     383      CALL histwrite( kid, "iicesipr", kt, wfx_sni        , jpi*jpj, (/1/) ) 
     384      CALL histwrite( kid, "iicerepr", kt, wfx_res        , jpi*jpj, (/1/) ) 
     385      CALL histwrite( kid, "iicebome", kt, wfx_bom        , jpi*jpj, (/1/) ) 
     386      CALL histwrite( kid, "iicesume", kt, wfx_sum        , jpi*jpj, (/1/) ) 
     387      CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn        , jpi*jpj, (/1/) ) 
    614388      CALL histwrite( kid, "iisfxres", kt, sfx_res        , jpi*jpj, (/1/) ) 
    615389 
    616       !CALL histwrite( kid, "iice_itd", kt, a_i  , jpi*jpj*jpl, (/1/)  )   ! area 
    617       !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/)  )   ! thickness 
    618       !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/)  )   ! snow depth 
    619       !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/)  )   ! salinity 
     390      ! Close the file 
     391      ! ----------------- 
     392      !CALL histclo( kid ) 
    620393 
    621394    END SUBROUTINE lim_wri_state 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90

    r3764 r5832  
    8989   DO jj = 2 , jpjm1 
    9090      DO ji = 2 , jpim1   ! NO vector opt. 
    91          zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    92          zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
     91         zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
     92         zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    9393         zindb  = zindh * zinda 
    94          ztmu   = MAX( 0.5 * zone , ( 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) 
    97          zcmo(ji,jj,3)  = hicifp(ji,jj) 
     97         zcmo(ji,jj,3)  = 0. 
    9898         zcmo(ji,jj,4)  = frld  (ji,jj) 
    9999         zcmo(ji,jj,5)  = sist  (ji,jj) 
    100          zcmo(ji,jj,6)  = fbif  (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) ) & 
     100         zcmo(ji,jj,6)  = fhtur  (ji,jj) 
     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) 
    … …  
    132132         DO jj = 2 , jpjm1 
    133133            DO ji = 2 , jpim1   ! NO vector opt. 
    134                zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    135                zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
     134               zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
     135               zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    136136               zindb  = zindh * zinda 
    137                ztmu   = MAX( 0.5 * zone , ( 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) 
    140                rcmoy(ji,jj,3)  = hicifp(ji,jj) 
     140               rcmoy(ji,jj,3)  = 0. 
    141141               rcmoy(ji,jj,4)  = frld  (ji,jj) 
    142142               rcmoy(ji,jj,5)  = sist  (ji,jj) 
    143                rcmoy(ji,jj,6)  = fbif  (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) ) & 
     143               rcmoy(ji,jj,6)  = fhtur  (ji,jj) 
     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/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r4205 r5832  
    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 ::   hicmin      !: (REMOVE) 
    23    REAL(wp), PUBLIC ::   hiclim      !: minimum ice thickness 
    24    REAL(wp), PUBLIC ::   sbeta       !: numerical scheme for diffusion in ice  (REMOVE) 
    25    REAL(wp), PUBLIC ::   parlat      !: (REMOVE) 
    26    REAL(wp), PUBLIC ::   hakspl      !: (REMOVE) 
    27    REAL(wp), PUBLIC ::   hibspl      !: (REMOVE) 
    28    REAL(wp), PUBLIC ::   exld        !: (REMOVE) 
    29    REAL(wp), PUBLIC ::   hakdif      !: (REMOVE) 
    30    REAL(wp), PUBLIC ::   thth        !: (REMOVE) 
    31    REAL(wp), PUBLIC ::   hnzst       !: thick. of the surf. layer in temp. comp. 
    32    REAL(wp), PUBLIC ::   parsub      !: switch for snow sublimation or not 
    33    REAL(wp), PUBLIC ::   alphs       !: coef. for snow density when snow-ice formation 
    34    REAL(wp), PUBLIC ::   fraz_swi    !: use of frazil ice collection in function of wind (1.0) or not (0.0) 
    35    REAL(wp), PUBLIC ::   maxfrazb    !: maximum portion of frazil ice collecting at the ice bottom 
    36    REAL(wp), PUBLIC ::   vfrazb      !: threshold drift speed for collection of bottom frazil ice 
    37    REAL(wp), PUBLIC ::   Cfrazb      !: squeezing coefficient for collection of bottom frazil ice 
     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) 
    3826 
    39    REAL(wp), PUBLIC, DIMENSION(2) ::   hiccrit   !: ice th. for lateral accretion in the NH (SH) (m) 
     27   LOGICAL , PUBLIC ::   ln_frazil   !: use of frazil ice collection as function of wind (T) or not (F) 
    4028 
    4129   !!----------------------------- 
    … …  
    4331   !!----------------------------- 
    4432   !: In ice thermodynamics, to spare memory, the vectors are folded 
    45    !: from 1D to 2D vectors. The following variables, with ending _1d (or _b) 
     33   !: from 1D to 2D vectors. The following variables, with ending _1d 
    4634   !: are the variables corresponding to 2d vectors 
    4735 
    48    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: number of points where computations has to be done 
    49    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 
    5039 
    51    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qldif_1d      !: <==> the 2D  qldif 
    52    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcmif_1d      !: <==> the 2D  qcmif 
    53    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fstbif_1d     !: <==> the 2D  fstric 
    54    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fltbif_1d     !: <==> the 2D  ffltbif 
    55    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fscbq_1d      !: <==> the 2D  fscmcbq 
    56    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d    !: <==> the 2D  qsr_ice 
    57    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d     !: <==> the 2D  fr1_i0 
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d     !: <==> the 2D  fr2_i0 
    59    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qnsr_ice_1d   !: <==> the 2D  qns_ice 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qfvbq_1d      !: <==> the 2D  qfvbq 
    61    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_b        !: <==> the 2D  t_bo 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d    
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d   
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d    
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d    
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d   
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d      
     47 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bom_1d 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bog_1d 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dif_1d 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_opw_1d 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d 
     57 
     58   ! heat flux associated with ice-atmosphere mass exchange 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sub_1d 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_spr_1d 
     61 
     62   ! heat flux associated with ice-ocean mass exchange 
     63   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_thd_1d 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_res_1d 
     65 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_1d  
     67   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d 
     68 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d     
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d    
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d   
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d  
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_res_1d  
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_spr_1d 
     76 
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d     
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d     
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d     
     81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d     
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d    
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d   
    6284 
    6385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip 
    6486   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld 
    65    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_b        !: <==> the 2D  frld 
    66    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fbif_1d       !: <==> the 2D  fbif 
    67    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_ice_1d    !: <==> the 2D  rdm_ice 
    68    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_snw_1d    !: <==> the 2D  rdm_snw 
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlbbq_1d      !: <==> the 2D  qlbsbq 
    70    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dmgwi_1d      !: <==> the 2D  dmgwi 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvsbq_1d      !: <==> the 2D  rdvosif 
    72    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvbbq_1d      !: <==> the 2D  rdvobif 
    73    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvlbq_1d      !: <==> the 2D  rdvolif 
    74    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvnbq_1d      !: <==> the 2D  rdvolif 
     87   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d        !: <==> the 2D  at_i 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d      !: <==> the 2D  fhtur 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld 
    7590   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice 
    76    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice 
    77    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqla_ice_1d   !: <==> the 2D  dqla_ice 
    78    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 
    7993   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics 
    80    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsup          !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m 
    81    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   focea         !: Remaining energy in case of total ablation 
    8294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
    83    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_i_b    !: Ice thickness at the beginnning of the time step [m] 
    84    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_s_b    !: Snow thickness at the beginning of the time step [m] 
    85    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d    !: <==> the 2D sfx_bri 
    86    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhbri_1d      !: Heat flux due to brine drainage 
    87    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_thd_1d    !: <==> the 2D sfx_thd 
    8895   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing 
    8996   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage 
    9097   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_se_1d   !: Ice salinity variations due to basal salt entrapment 
    9198   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_si_1d   !: Ice salinity variations due to lateral accretion     
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_b       !: Ice collection thickness accumulated in fleads 
     99   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_1d      !: Ice collection thickness accumulated in leads 
    93100 
    94    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_b      !: <==> the 2D  t_su 
    95    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_b       !: <==> the 2D  a_i 
    96    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_b      !: <==> the 2D  ht_s 
    97    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_b      !: <==> the 2D  ht_i 
    98    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su       !: Surface Conduction flux  
    99    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i     !: Bottom  Conduction flux  
    100    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot    !: Snow accretion/ablation        [m] 
    101    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf   !: Ice surface accretion/ablation [m] 
    102    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott   !: Ice bottom accretion/ablation  [m] 
    103    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice  !: Snow ice formation             [m of ice] 
    104    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_b      !: Ice bulk salinity [ppt] 
    105    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new     !: Salinity of new ice at the bottom 
    106    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_snowice   !: Salinity of new snow ice on top of the ice 
    107    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_b       !: Ice age                        [days] 
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d       !: <==> the 2D  t_su 
     102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d        !: <==> the 2D  a_i 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_1d       !: <==> the 2D  ht_s 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_1d       !: <==> the 2D  ht_i 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su         !: Surface Conduction flux  
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i       !: Bottom  Conduction flux  
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m] 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m] 
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m] 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice] 
     111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_1d       !: Ice bulk salinity [ppt] 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom 
    108113 
    109    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
    110    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s 
     115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_1d   !: corresponding to the 2D var  t_i 
     116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_1d   !: profiled ice salinity 
     117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_1d   !:    Ice  enthalpy per unit volume 
     118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_1d   !:    Snow enthalpy per unit volume 
    111119 
    112    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s 
    113    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i 
    114    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_b   !: profiled ice salinity 
    115    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_b   !:    Ice  enthalpy per unit volume 
    116    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_b   !:    Snow enthalpy per unit volume 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qh_i_old !: ice heat content (q*h, J.m-2) 
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old  !: ice thickness layer (m) 
    117122 
    118    ! Clean the following ... 
    119    ! These variables are coded for conservation checks 
    120    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_in                  !: ice energy summed over categories (initial) 
    121    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_fin                 !: ice energy summed over categories (final) 
    122    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_s_in, qt_s_fin        !: snow energy summed over categories 
    123    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i, sum_fluxq          !: increment of energy, sum of fluxes 
    124    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fatm, foce               !: atmospheric, oceanic, heat flux 
    125    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cons_error, surf_error   !: conservation, surface error 
    126  
    127    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_in        !: goes to trash 
    128    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_fin       !: goes to trash 
    129    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i_layer, radab   !: goes to trash 
    130  
    131    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_in    !: initial total heat flux 
    132    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_fin   !: final total heat flux 
    133  
    134    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_s 
    135    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_i 
    136    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_s_lay 
    137    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_i_lay 
    138     
    139123   INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point 
    140124 
    … …  
    151135      !!---------------------------------------------------------------------! 
    152136      INTEGER ::   thd_ice_alloc   ! return value 
    153       INTEGER ::   ierr(4) 
     137      INTEGER ::   ierr(3) 
    154138      !!---------------------------------------------------------------------! 
    155139 
    156       ALLOCATE( npb      (jpij) , npac     (jpij),                          & 
    157          !                                                                  ! 
    158          &      qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d  (jpij) ,     & 
    159          &      fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) ,     & 
    160          &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) ,     & 
    161          &      qfvbq_1d (jpij) , t_bo_b   (jpij) , iatte_1d   (jpij) ,     & 
    162          &      oatte_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) ) 
    163149      ! 
    164       ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     & 
    165          &      fbif_1d    (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) ,     & 
    166          &      qlbbq_1d   (jpij) , dmgwi_1d   (jpij) , dvsbq_1d   (jpij) ,     & 
    167          &      dvbbq_1d   (jpij) , dvlbq_1d   (jpij) , dvnbq_1d   (jpij) ,     & 
    168          &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     & 
    169          &      tatm_ice_1d(jpij) , fsup       (jpij) , focea      (jpij) ,     &    
    170          &      i0         (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,     &   
    171          &      sfx_bri_1d (jpij) , fhbri_1d   (jpij) , sfx_thd_1d (jpij) ,     & 
    172          &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &      
    173          &      dsm_i_si_1d(jpij) , hicol_b    (jpij)                     , STAT=ierr(2) ) 
     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) ,                     &      
     159         &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) ) 
    174160      ! 
    175       ALLOCATE( t_su_b    (jpij) , a_i_b    (jpij) , ht_i_b   (jpij) ,    &    
    176          &      ht_s_b    (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) ,    &     
    177163         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &     
    178          &      dh_snowice(jpij) , sm_i_b   (jpij) , s_i_new  (jpij) ,    &     
    179          &      s_snowice (jpij) , o_i_b    (jpij)                   ,    & 
    180          !                                                                ! 
    181          &      t_s_b(jpij,nlay_s),                                       & 
    182          !                                                                ! 
    183          &      t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                ,     &             
    184          &      q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                , STAT=ierr(3)) 
     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) ,                        & 
     167         &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 
    185168      ! 
    186       ALLOCATE( qt_i_in   (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in   (jpij,jpl) ,     & 
    187          &      qt_s_fin  (jpij,jpl) , dq_i    (jpij,jpl) , sum_fluxq (jpij,jpl) ,     & 
    188          &      fatm      (jpij,jpl) , foce    (jpij,jpl) , cons_error(jpij,jpl) ,     & 
    189          &      surf_error(jpij,jpl)                                             ,     & 
    190          !                                                                             ! 
    191          &      q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax)             ,     & 
    192          &      dq_i_layer  (jpij,jkmax) , radab        (jpij,jkmax)             ,     & 
    193          !                                                                             ! 
    194          &      ftotal_in(jpij), ftotal_fin(jpij)                                ,     & 
    195          !                                                                             ! 
    196          &      fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s)                      ,     & 
    197          &      fc_i(jpij,0:jkmax)  , de_i_lay(jpij,jkmax)                       , STAT=ierr(4) ) 
    198  
    199169      thd_ice_alloc = MAXVAL( ierr ) 
    200170 
Note: See TracChangeset for help on using the changeset viewer.