Changeset 4688


Ignore:
Timestamp:
2014-06-25T01:39:59+02:00 (7 years ago)
Author:
clem
Message:

new version of LIM3 with perfect conservation of heat, see ticket #1352

Location:
trunk/NEMOGCM/NEMO/LIM_SRC_3
Files:
25 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4333 r4688  
    166166 
    167167   !                                     !!** 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 
    170168   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) ** 
    174169   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 
    177170   REAL(wp), PUBLIC ::   om               !: relaxation constant 
    178    REAL(wp), PUBLIC ::   resl             !: maximum value for the residual of relaxation 
    179171   REAL(wp), PUBLIC ::   cw               !: drag coefficient for oceanic stress 
    180172   REAL(wp), PUBLIC ::   angvg            !: turning angle for oceanic stress 
    181173   REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79 
    182174   REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength 
    183    REAL(wp), PUBLIC ::   etamn            !: minimun value for viscosity : has to be 0 
    184175   REAL(wp), PUBLIC ::   creepl           !: creep limit : has to be under 1.0e-9 
    185176   REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve 
     
    188179   REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses !SB 
    189180   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 
     181   REAL(wp), PUBLIC ::   hminrhg          !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity 
    191182 
    192183   !                                     !!** ice-salinity namelist (namicesal) ** 
     
    202193 
    203194   !                                     !!** ice-salinity namelist (namicesal) ** 
    204    INTEGER , PUBLIC ::   num_sal          !: salinity configuration used in the model 
     195   INTEGER , PUBLIC ::   num_sal             !: salinity configuration used in the model 
    205196   !                                         ! 1 - constant salinity in both space and time 
    206197   !                                         ! 2 - prognostic salinity (s(z,t)) 
    207198   !                                         ! 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) 
     199   INTEGER , PUBLIC ::   thcon_i_swi         !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
    210200 
    211201   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
     
    220210   REAL(wp), PUBLIC ::   Craft            !: coefficient for smoothness of the hyperbolic tangent in rafting 
    221211   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) 
    223212   REAL(wp), PUBLIC ::   betas            !: coef. for partitioning of snowfall between leads and sea ice 
    224213   REAL(wp), PUBLIC ::   kappa_i          !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
     
    228217   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    229218   INTEGER , PUBLIC ::   ridge_scheme_swi !: scheme used for ice ridging 
    230    INTEGER , PUBLIC ::   raftswi          !: rafting of ice or not                         
     219   INTEGER , PUBLIC ::   raft_swi         !: rafting of ice or not                         
    231220   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 
    233221   INTEGER , PUBLIC ::   brinstren_swi    !: use brine volume to diminish ice strength 
    234222 
     
    249237   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i        !: Shear of the velocity field [s-1] 
    250238   ! 
    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) 
    259239   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist        !: Average Sea-Ice Surface Temperature [Kelvin] 
    260240   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   icethi      !: total ice thickness (for all categories) (diag only) 
    261241   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 
    263242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction 
    264243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld       !: Leads fraction at previous time   
    265244   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] 
     245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
     246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur       !: net downward heat flux from the ice to the ocean 
     247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
     248 
     249   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: Variation of snow mass over 1 time step     [Kg/m2] 
     250   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: Variation of ice mass over 1 time step      [Kg/m2] 
     251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: Variation of snow mass over 1 time step due to sublimation [Kg/m2] 
     252 
     253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni     !: snow ice growth  
     254   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw     !: lateral ice growth  
     255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog     !: bottom ice growth  
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn     !: dynamical ice growth  
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom     !: vertical bottom melt  
     258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum     !: vertical surface melt 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res     !: production (growth+melt) due to limupdate 
     260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: snow precipitation on ice 
     261 
     262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     264   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_opw     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    282267   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] 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_dyn     !: salt flux due to porous ridged ice formation          [PSU/m2/s] 
    284269   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 
     270 
     271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth  
     272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt  
     273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt  
     274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation 
     275   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice  
     276   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt  
     277   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion  
     278   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping  
     279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations  
     280   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  
     281 
     282   ! heat flux associated with ice-atmosphere mass exchange 
     283   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation  
     284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  
     285 
     286   ! heat flux associated with ice-ocean mass exchange 
     287   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness 
     290 
     291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice 
    290292 
    291293   ! 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 
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, q_s 
    293295 
    294296   !!-------------------------------------------------------------------------- 
     
    404406   LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
    405407   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 
     408   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd     !: thermodynamic growth rates  
     409   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   izero 
     410   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   !: transport of ice volume 
     411   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   !: transport of snw volume 
     412   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_ei   !: transport of ice enthalpy (W/m2) 
     413   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_es   !: transport of snw enthalpy (W/m2) 
     414   ! 
     415   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2]  
     416   ! 
    417417   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    418418 
     
    447447 
    448448      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) ) 
     449      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,      & 
     450         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,      & 
     451         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,    & 
     452         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     & 
     453         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,  qlead  (jpi,jpj) ,     & 
     454         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl) ,      & 
     455         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,      & 
     456         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,   & 
     457         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 
     458         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,  & 
     459         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & 
     460         &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) ) 
     461 
     462      ii = ii + 1 
     463      ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) ) 
    464464 
    465465      ! * Ice global state variables 
     
    522522      ! * Ice diagnostics 
    523523      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) ) 
     524      ALLOCATE( dv_dt_thd(jpi,jpj,jpl) ,     & 
     525         &      izero    (jpi,jpj,jpl)  , diag_trp_vi(jpi,jpj) , diag_trp_vs(jpi,jpj), diag_trp_ei(jpi,jpj), diag_trp_es(jpi,jpj),     &  
     526         &      diag_heat_dhc(jpi,jpj) ,  STAT=ierr(ii) ) 
    528527 
    529528      ice_alloc = MAXVAL( ierr(:) ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r4161 r4688  
    3232 
    3333   REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values 
    34    REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    35    REAL(wp)  ::   rone   = 1._wp       !    -       - 
    3634 
    3735   !! * Substitutions 
     
    8482      DO jj = 1, jpj 
    8583         DO ji = 1, jpi 
    86             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     84            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    8785            zs1max  = 1.5 * zslpmax 
    8886            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 
    8987            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    9088               &            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 
     89            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    9290 
    9391            ps0 (ji,jj) = zslpmax   
     
    106104      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0  
    107105         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) 
     106            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
     107            zalf         =  MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
    110108            zalfq        =  zalf * zalf 
    111109            zalf1        =  1.0 - zalf 
     
    133131      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0. 
    134132         DO ji = 1, fs_jpim1 
    135             zalf          = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
     133            zalf          = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
    136134            zalg  (ji,jj) = zalf 
    137135            zalfq         = zalf * zalf 
     
    269267      DO jj = 1, jpj 
    270268         DO ji = 1, jpi 
    271             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     269            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    272270            zs1max  = 1.5 * zslpmax 
    273271            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 
    274272            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    275273               &             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 
     274            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    277275            ! 
    278276            ps0 (ji,jj) = zslpmax   
     
    291289      DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0    
    292290         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) 
     291            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
     292            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
    295293            zalfq        =  zalf * zalf 
    296294            zalf1        =  1.0 - zalf 
     
    318316      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    319317         DO ji = 1, jpi 
    320             zalf          = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
     318            zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
    321319            zalg  (ji,jj) = zalf 
    322320            zalfq         = zalf * zalf 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r4161 r4688  
    77   !!            3.0  ! 2004-06  (M. Vancoppenolle)   Energy Conservation  
    88   !!            4.0  ! 2011-02  (G. Madec)  add mpp considerations 
     9   !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_lim3 
     
    1415   !!    lim_cons     :   checks whether energy, mass and salt are conserved  
    1516   !!---------------------------------------------------------------------- 
     17   USE phycst         ! physical constants 
    1618   USE par_ice        ! LIM-3 parameter 
    1719   USE ice            ! LIM-3 variables 
     
    2830   PUBLIC   lim_column_sum_energy 
    2931   PUBLIC   lim_cons_check 
     32   PUBLIC   lim_cons_hsm 
    3033 
    3134   !!---------------------------------------------------------------------- 
     
    151154   END SUBROUTINE lim_cons_check 
    152155 
     156 
     157   SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
     158      !!------------------------------------------------------------------- 
     159      !!               ***  ROUTINE lim_cons_hsm *** 
     160      !! 
     161      !! ** Purpose : Test the conservation of heat, salt and mass for each routine 
     162      !! 
     163      !! ** Method  : 
     164      !!--------------------------------------------------------------------- 
     165      INTEGER         , INTENT(in)    :: icount      ! determine wether this is the beggining of the routine (0) or the end (1) 
     166      CHARACTER(len=*), INTENT(in)    :: cd_routine  ! name of the routine 
     167      REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     168      REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft 
     169      REAL(wp)                        :: zvmin, zamin, zamax  
     170 
     171      IF( icount == 0 ) THEN 
     172 
     173         zvi_b  = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 
     174         zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     175         zei_b  = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 
     176         zfw_b  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
     177            &                   wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) ) * area(:,:) * tms(:,:) ) 
     178         zfs_b  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     179            &                   sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 
     180         zft_b  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     181            &                 - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 
     182 
     183      ELSEIF( icount == 1 ) THEN 
     184 
     185         zfs  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     186            &                 sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zfs_b 
     187         zfw  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
     188            &                 wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) ) * area(:,:) * tms(:,:) ) - zfw_b 
     189         zft  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     190            &               - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b 
     191  
     192         zvi  = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw  
     193         zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zsmv_b ) * r1_rdtice + ( zfs / rhoic ) 
     194         zei  =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zei_b * r1_rdtice + zft 
     195 
     196         zvmin = glob_min(v_i) 
     197         zamax = glob_max(SUM(a_i,dim=3)) 
     198         zamin = glob_min(a_i) 
     199        
     200         IF(lwp) THEN 
     201            IF ( ABS( zvi    ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (',cd_routine,') = ',(zvi * rday) 
     202            IF ( ABS( zsmv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday) 
     203            IF ( ABS( zei    ) >  1.    ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (',cd_routine,') = ',(zei) 
     204            IF ( zvmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin) 
     205            IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN 
     206                                          WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     207            ENDIF 
     208            IF ( zamin <  0.            ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
     209         ENDIF 
     210 
     211      ENDIF 
     212 
     213   END SUBROUTINE lim_cons_hsm 
     214 
    153215#else 
    154216   !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r4346 r4688  
    1818   USE dom_oce         ! ocean domain 
    1919   USE sbc_oce         ! surface boundary condition: ocean fields 
     20   USE sbc_ice         ! Surface boundary condition: sea-ice fields 
    2021   USE daymod          ! model calendar 
    2122   USE phycst          ! physical constant 
     
    3738   REAL(dp) ::   bg_grme            ! global ice growth+melt trends 
    3839   REAL(wp) ::   epsi06 = 1.e-6_wp  ! small number 
    39    REAL(wp) ::   epsi03 = 1.e-3_wp  ! small number 
    40  
    4140 
    4241   !! * Substitutions 
     
    6059      !! 
    6160      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  
     61      REAL(dp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn  
     62      REAL(dp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 
     63      REAL(dp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub   
     64      REAL(dp)   ::   zbg_hfx_dhc, zbg_hfx_spr 
     65      REAL(dp)   ::   zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in    
     66      REAL(dp)   ::   zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 
    6467      REAL(dp)   ::   z_frc_vol, z_frc_sal, z_bg_grme  
    6568      REAL(dp)   ::   z1_area                     !    -     - 
     
    8689      !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
    8790 
    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  
     91      ! Volume 
     92      zbg_vfx     = zinda * glob_sum(      emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     93      zbg_vfx_bog = zinda * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     94      zbg_vfx_opw = zinda * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     95      zbg_vfx_sni = zinda * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     96      zbg_vfx_dyn = zinda * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     97      zbg_vfx_bom = zinda * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     98      zbg_vfx_sum = zinda * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     99      zbg_vfx_res = zinda * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     100      zbg_vfx_spr = zinda * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     101      zbg_vfx_snw = zinda * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     102      zbg_vfx_sub = zinda * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     103 
     104      ! Salt 
    100105      zbg_sfx     = zinda * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    101106      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 
    103107      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        
     108      zbg_sfx_dyn = zinda * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     109 
     110      zbg_sfx_bog = zinda * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     111      zbg_sfx_opw = zinda * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     112      zbg_sfx_sni = zinda * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     113      zbg_sfx_bom = zinda * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     114      zbg_sfx_sum = zinda * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     115 
     116      ! Heat budget 
     117      zbg_ihc      = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content  [1.e-20 J] 
     118      zbg_shc      = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J] 
     119      zbg_hfx_dhc  = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     120      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     121 
     122      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     123      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     124      zbg_hfx_res  = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     125      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     126      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     127      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     128      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     129      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     130      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     131      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     132      zbg_hfx_out  = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     133      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     134     
    106135      ! --------------------------------------------- ! 
    107136      ! 2 - Trends due to forcing and ice growth/melt ! 
     
    109138      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 
    110139      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 
     140      z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
     141                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 
    113142      ! 
    114143      frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
     
    134163      CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9        )   ! ice salt content (psu*km3 equivalent liquid)         
    135164 
    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         - 
     165      CALL iom_put( 'ibgvfx'    , zbg_vfx                                  )   ! volume flux emp (m/day liquid) 
     166      CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog                              )   ! volume flux bottom growth     -(m/day equivalent liquid) 
     167      CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw                              )   ! volume flux open water growth - 
     168      CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni                              )   ! volume flux snow ice growth   - 
     169      CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn                              )   ! volume flux dynamic growth    - 
     170      CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom                              )   ! volume flux bottom melt       - 
     171      CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum                              )   ! volume flux surface melt      - 
     172      CALL iom_put( 'ibgvfxres' , zbg_vfx_res                              )   ! volume flux resultant         - 
     173      CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr                              )   ! volume flux from snow precip         - 
     174      CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw                              )   ! volume flux from snow melt         - 
     175      CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub                              )   ! volume flux from sublimation         - 
    144176           
    145177      CALL iom_put( 'ibgsfx'    , zbg_sfx                                  )   ! salt flux         -(psu*m/day equivalent liquid)        
    146178      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 -     
     179      CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn                              )   ! salt flux dynamic -     
    149180      CALL iom_put( 'ibgsfxres' , zbg_sfx_res                              )   ! salt flux result  -     
     181      CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog                              )   ! salt flux bottom growth    
     182      CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw                              )   ! salt flux open water growth - 
     183      CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni                              )   ! salt flux snow ice growth   - 
     184      CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom                              )   ! salt flux bottom melt       - 
     185      CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum                              )   ! salt flux surface melt      - 
     186 
     187      CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc                              )   ! Heat content variation in snow and ice [W] 
     188      CALL iom_put( 'ibghfxspr' , zbg_hfx_spr                              )   ! Heat content of snow precip [W] 
     189 
     190      CALL iom_put( 'ibghfxres' , zbg_hfx_res                              )   !  
     191      CALL iom_put( 'ibghfxsub' , zbg_hfx_sub                              )   !  
     192      CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn                              )   !  
     193      CALL iom_put( 'ibghfxthd' , zbg_hfx_thd                              )   !  
     194      CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw                              )   !  
     195      CALL iom_put( 'ibghfxsum' , zbg_hfx_sum                              )   !  
     196      CALL iom_put( 'ibghfxbom' , zbg_hfx_bom                              )   !  
     197      CALL iom_put( 'ibghfxbog' , zbg_hfx_bog                              )   !  
     198      CALL iom_put( 'ibghfxdif' , zbg_hfx_dif                              )   !  
     199      CALL iom_put( 'ibghfxopw' , zbg_hfx_opw                              )   !  
     200      CALL iom_put( 'ibghfxout' , zbg_hfx_out                              )   !  
     201      CALL iom_put( 'ibghfxin'  , zbg_hfx_in                               )   !  
    150202 
    151203      CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9                          )   ! vol - forcing     (km3 equivalent liquid)  
    152204      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)          
     205      CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9                )   ! vol growth + melt (km3 equivalent liquid)          
     206 
    154207      ! 
    155208      IF( lrst_ice )   CALL lim_diahsb_rst( numit, 'WRITE' ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4624 r4688  
    3030   USE lib_fortran      ! glob_sum 
    3131   USE timing          ! Timing 
     32   USE limcons        ! conservation tests 
    3233 
    3334   IMPLICIT NONE 
     
    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 
     
    7576      CALL wrk_alloc( jpj, zind, zmsk ) 
    7677 
    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       ! ------------------------------- 
    87  
    8878      IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    8979 
    9080      IF( ln_limdyn ) THEN 
    9181         ! 
     82         ! conservation test 
     83         IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     84 
    9285         old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 
    9386         old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
     
    171164            END DO 
    172165         END DO 
     166         ! 
     167         ! conservation test 
     168         IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    173169         ! 
    174170      ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
     
    224220      ENDIF 
    225221      ! 
    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  
    250222      CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 
    251223      CALL wrk_dealloc( jpj, zind, zmsk ) 
     
    269241      !!------------------------------------------------------------------- 
    270242      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, & 
     243      NAMELIST/namicedyn/ epsd, om, cw, angvg, pstar,   & 
     244         &                c_rhg, creepl, ecc, ahi0,     & 
    274245         &                nevp, telast, alphaevp, hminrhg 
    275246      !!------------------------------------------------------------------- 
     
    289260         WRITE(numout,*) '~~~~~~~~~~~~' 
    290261         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 
    295262         WRITE(numout,*) '   relaxation constant                              om     = ', om 
    296          WRITE(numout,*) '   maximum value for the residual of relaxation     resl   = ', resl 
    297263         WRITE(numout,*) '   drag coefficient for oceanic stress              cw     = ', cw 
    298264         WRITE(numout,*) '   turning angle for oceanic stress                 angvg  = ', angvg 
    299265         WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar 
    300266         WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg 
    301          WRITE(numout,*) '   minimun value for viscosity                      etamn  = ', etamn 
    302267         WRITE(numout,*) '   creep limit                                      creepl = ', creepl 
    303268         WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4624 r4688  
    2626   USE dom_ice          ! sea-ice domain 
    2727   USE in_out_manager   ! I/O manager 
    28    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    2928   USE lib_mpp          ! MPP library 
    3029   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3130   USE wrk_nemo         ! work arrays 
     31   USE cpl_oasis3, ONLY : lk_cpl 
    3232 
    3333   IMPLICIT NONE 
     
    3838   !! * Module variables 
    3939   !                          !!** 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  
     40   REAL(wp) ::   thres_sst   ! threshold water temperature for initial sea ice 
     41   REAL(wp) ::   hts_ini_n   ! initial snow thickness in the north 
     42   REAL(wp) ::   hts_ini_s   ! initial snow thickness in the south 
     43   REAL(wp) ::   hti_ini_n   ! initial ice thickness in the north 
     44   REAL(wp) ::   hti_ini_s   ! initial ice thickness in the south 
     45   REAL(wp) ::   ati_ini_n   ! initial leads area in the north 
     46   REAL(wp) ::   ati_ini_s   ! initial leads area in the south 
     47   REAL(wp) ::   smi_ini_n   ! initial salinity  
     48   REAL(wp) ::   smi_ini_s   ! initial salinity 
     49   REAL(wp) ::   tmi_ini_n   ! initial temperature 
     50   REAL(wp) ::   tmi_ini_s   ! initial temperature 
     51 
     52   LOGICAL  ::  ln_limini    ! initialization or not 
    5053   !!---------------------------------------------------------------------- 
    5154   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
     
    9093      INTEGER    :: i_hemis, i_fill, jl0   
    9194      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 
     95      REAL(wp), POINTER, DIMENSION(:)     :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini 
     96      REAL(wp), POINTER, DIMENSION(:,:)   :: zh_i_ini, za_i_ini, zv_i_ini 
     97      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator 
    9598      INTEGER,  POINTER, DIMENSION(:,:)   :: zhemis   ! hemispheric index 
    9699      !-------------------------------------------------------------------- 
    97100 
    98       CALL wrk_alloc( jpi, jpj, zidto ) 
     101      CALL wrk_alloc( jpi, jpj, zswitch ) 
    99102      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 
     103      CALL wrk_alloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     104      CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
     105 
     106      epsi20   = 1.e-20_wp 
     107 
    104108      IF(lwp) WRITE(numout,*) 
    105109      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
     
    112116      CALL lim_istate_init     !  reading the initials parameters of the ice 
    113117 
    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... 
     118# if defined key_coupled 
     119      albege(:,:)   = 0.8 * tms(:,:) 
     120# endif 
     121 
     122      ! surface temperature 
     123      DO jl = 1, jpl ! loop over categories 
     124         t_su  (:,:,jl) = rtt * tms(:,:) 
     125         tn_ice(:,:,jl) = rtt * tms(:,:) 
     126      END DO 
     127      ! Basal temperature is set to the freezing point of seawater in Kelvin 
     128      t_bo(:,:) = ( tfreez( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:)  
     129 
     130      IF( ln_limini ) THEN 
    117131 
    118132      !-------------------------------------------------------------------- 
    119133      ! 2) Basal temperature, ice mask and hemispheric index 
    120134      !-------------------------------------------------------------------- 
    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] 
    124  
    125       DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
     135      ! ice if sst <= t-freez + thres_sst 
     136      DO jj = 1, jpj                                        
    126137         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 
     138            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN  ; zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice 
     139            ELSE                                                                                   ; zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice 
    129140            ENDIF 
    130141         END DO 
    131142      END DO 
    132143 
    133       t_bo(:,:) = t_bo(:,:) + rt0                          ! conversion to Kelvin 
    134144 
    135145      ! Hemispheric index 
     
    153163      ! 3.1) Hemisphere-dependent arrays 
    154164      !----------------------------- 
    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 
     165      ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
     166      zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s  ! ice thickness 
     167      zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s  ! snow depth 
     168      zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s  ! ice concentration 
     169      zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s  ! bulk ice salinity 
     170      ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s  ! temperature (ice and snow) 
     171 
     172      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume 
    162173 
    163174      !--------------------------------------------------------------------- 
     
    183194            ! *** 1 category to fill 
    184195            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 
     196               zh_i_ini(1,i_hemis)       = zht_i_ini(i_hemis) 
     197               za_i_ini(1,i_hemis)       = zat_i_ini(i_hemis) 
     198               zh_i_ini(2:jpl,i_hemis)   = 0._wp 
     199               za_i_ini(2:jpl,i_hemis)   = 0._wp 
    189200            ELSE 
    190201 
    191             ! *** >1 categores to fill 
    192             !--- Ice thicknesses in the i_fill - 1 first categories 
     202               ! *** >1 categores to fill 
     203               !--- Ice thicknesses in the i_fill - 1 first categories 
    193204               DO jl = 1, i_fill - 1 
    194                   zht_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
     205                  zh_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
    195206               END DO 
    196  
    197             !--- jl0: most likely index where cc will be maximum 
     207                
     208               !--- jl0: most likely index where cc will be maximum 
    198209               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 
     210                  IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
     211                     ( zht_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
    201212                     jl0 = jl 
    202213                  ENDIF 
    203214               END DO 
    204215               jl0 = MIN(jl0, i_fill) 
    205  
    206             !--- Concentrations 
     216                
     217               !--- Concentrations 
    207218               za_i_ini(jl0,i_hemis)      = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 
    208219               DO jl = 1, i_fill - 1 
    209220                  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 
     221                     zsigma               = 0.5 * zht_i_ini(i_hemis) 
     222                     zarg                 = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma 
    212223                     za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 
    213224                  ENDIF 
    214                END DO  
    215  
     225               END DO 
     226                
    216227               zA = 0. ! sum of the areas in the jpl categories  
    217228               DO jl = 1, i_fill - 1 
     
    221232               IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    222233          
    223             !--- Ice thickness in the last category 
     234               !--- Ice thickness in the last category 
    224235               zV = 0. ! sum of the volumes of the N-1 categories 
    225236               DO jl = 1, i_fill - 1 
    226                   zV = zV + za_i_ini(jl,i_hemis)*zht_i_ini(jl,i_hemis) 
     237                  zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis) 
    227238               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) 
     239               zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
     240               IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
     241 
     242               !--- volumes 
     243               zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis) 
    233244               IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    234245 
     
    262273 
    263274            ! 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 
     275            IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
    265276               ztest_3 = 1 
    266277            ELSE 
    267278               ! 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) 
     279               IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 
     280               zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
    270281               ztest_3 = 0 
    271282            ENDIF 
     
    291302         IF ( ztests .NE. 4 ) THEN 
    292303            WRITE(numout,*) 
    293             WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
    294             WRITE(numout,*), ' !!!! RED ALERT                  !!! ' 
    295             WRITE(numout,*), ' !!!! BIIIIP BIIIP BIIIIP BIIIIP !!!' 
     304            WRITE(numout,*), ' !!!! ALERT                  !!! ' 
    296305            WRITE(numout,*), ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    297             WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
    298306            WRITE(numout,*) 
    299307            WRITE(numout,*), ' *** ztests is not equal to 4 ' 
    300308            WRITE(numout,*), ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    301309            WRITE(numout,*), ' zat_i_ini : ', zat_i_ini(i_hemis) 
    302             WRITE(numout,*), ' zhm_i_ini : ', zhm_i_ini(i_hemis) 
     310            WRITE(numout,*), ' zht_i_ini : ', zht_i_ini(i_hemis) 
    303311         ENDIF ! ztests .NE. 4 
    304312      ENDIF 
     
    314322         DO jj = 1, jpj 
    315323            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 
     324               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
     325               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
     326               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth 
     327               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity 
     328               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 
     329               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp 
    322330 
    323331               ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
     
    343351            DO jj = 1, jpj 
    344352               DO ji = 1, jpi 
    345                    t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * rtt 
     353                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 
    346354                   ! Snow energy of melting 
    347                    e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
     355                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    348356                   ! Change dimensions 
    349357                   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 
     358                   ! Multiply by volume, so that heat content in Joules 
    351359                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
    352360               END DO ! ji 
     
    360368            DO jj = 1, jpj 
    361369               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 
     370                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt  
     371                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min 
    364372                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    365373 
    366374                   ! heat content per unit volume 
    367                    e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     375                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    368376                      +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
    369377                      -   rcp     * ( ztmelts - rtt ) ) 
     
    372380                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    373381 
    374                    ! Mutliply by ice volume, and divide by number of layers  
    375                    ! to get heat content in 10^9 J 
     382                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J 
    376383                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 
    377384               END DO ! ji 
     
    380387      END DO ! jk 
    381388 
     389      tn_ice (:,:,:) = t_su (:,:,:) 
     390 
     391      ELSE  
     392         ! if ln_limini=false 
     393         a_i  (:,:,:) = 0._wp 
     394         v_i  (:,:,:) = 0._wp 
     395         v_s  (:,:,:) = 0._wp 
     396         smv_i(:,:,:) = 0._wp 
     397         oa_i (:,:,:) = 0._wp 
     398         ht_i (:,:,:) = 0._wp 
     399         ht_s (:,:,:) = 0._wp 
     400         sm_i (:,:,:) = 0._wp 
     401         o_i  (:,:,:) = 0._wp 
     402 
     403         e_i(:,:,:,:) = 0._wp 
     404         e_s(:,:,:,:) = 0._wp 
     405 
     406         DO jl = 1, jpl 
     407            DO jk = 1, nlay_i 
     408               t_i(:,:,jk,jl) = rtt * tms(:,:) 
     409            END DO 
     410            DO jk = 1, nlay_s 
     411               t_s(:,:,jk,jl) = rtt * tms(:,:) 
     412            END DO 
     413         END DO 
     414       
     415      ENDIF ! ln_limini 
     416       
     417      at_i (:,:) = 0.0_wp 
     418      DO jl = 1, jpl 
     419         at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
     420      END DO 
     421      ! 
    382422      !-------------------------------------------------------------------- 
    383423      ! 4) Global ice variables for output diagnostics                    |  
    384424      !-------------------------------------------------------------------- 
    385       fsbbq (:,:)     = 0._wp 
    386425      u_ice (:,:)     = 0._wp 
    387426      v_ice (:,:)     = 0._wp 
     
    390429      stress12_i(:,:) = 0._wp 
    391430 
    392 # if defined key_coupled 
    393       albege(:,:)   = 0.8 * tms(:,:) 
    394 # endif 
    395  
    396431      !-------------------------------------------------------------------- 
    397432      ! 5) Moments for advection 
     
    428463      sxyage (:,:,:)  = 0._wp 
    429464 
    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 ) 
     465 
     466      CALL wrk_dealloc( jpi, jpj, zswitch ) 
    475467      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 ) 
     468      CALL wrk_dealloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     469      CALL wrk_dealloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    478470 
    479471   END SUBROUTINE lim_istate 
     
    495487      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    496488      !!----------------------------------------------------------------------------- 
    497       NAMELIST/namiceini/ ttest, hninn, hnins, hginn, hgins, aginn, agins, sinn, sins 
    498       ! 
     489      NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s,  & 
     490         &                                      ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s 
    499491      INTEGER :: ios                 ! Local integer output status for namelist read 
    500492      !!----------------------------------------------------------------------------- 
     
    516508         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    517509         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 
     510         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini   = ', ln_limini 
     511         WRITE(numout,*) '   threshold water temp. for initial sea-ice    thres_sst  = ', thres_sst 
     512         WRITE(numout,*) '   initial snow thickness in the north          hts_ini_n  = ', hts_ini_n 
     513         WRITE(numout,*) '   initial snow thickness in the south          hts_ini_s  = ', hts_ini_s  
     514         WRITE(numout,*) '   initial ice thickness  in the north          hti_ini_n  = ', hti_ini_n 
     515         WRITE(numout,*) '   initial ice thickness  in the south          hti_ini_s  = ', hti_ini_s 
     516         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_n  = ', ati_ini_n 
     517         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_s  = ', ati_ini_s 
     518         WRITE(numout,*) '   initial  ice salinity  in the north          smi_ini_n  = ', smi_ini_n 
     519         WRITE(numout,*) '   initial  ice salinity  in the south          smi_ini_s  = ', smi_ini_s 
     520         WRITE(numout,*) '   initial  ice/snw temp  in the north          tmi_ini_n  = ', tmi_ini_n 
     521         WRITE(numout,*) '   initial  ice/snw temp  in the south          tmi_ini_s  = ', tmi_ini_s 
    527522      ENDIF 
    528523 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4624 r4688  
    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   !!---------------------------------------------------------------------- 
     
    2222   USE limthd_lac       ! LIM 
    2323   USE limvar           ! LIM 
    24    USE limcons          ! LIM 
    2524   USE in_out_manager   ! I/O manager 
    2625   USE lbclnk           ! lateral boundary condition - MPP exchanges 
     
    3029  ! Check budget (Rousset) 
    3130   USE iom              ! I/O manager 
    32    USE lib_fortran     ! glob_sum 
     31   USE lib_fortran      ! glob_sum 
    3332   USE limdiahsb 
    34    USE timing          ! Timing 
     33   USE timing           ! Timing 
     34   USE limcons          ! conservation tests 
    3535 
    3636   IMPLICIT NONE 
     
    143143      REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    144144      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... 
     145      ! 
     146      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    149147      !!----------------------------------------------------------------------------- 
    150148      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    151149 
    152150      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 
    155151 
    156152      IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only) 
     
    162158 
    163159      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(:,:,:) 
     160 
     161      ! conservation test 
     162      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    179163 
    180164      !-----------------------------------------------------------------------------! 
     
    362346            ! 5) Heat, salt and freshwater fluxes 
    363347            !-----------------------------------------------------------------------------! 
    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 
     348            wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
     349            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice  ! heat sink for ocean (<0, W.m-2) 
    366350 
    367351         END DO 
     
    399383      CALL lim_itd_me_zapsmall 
    400384 
    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 
    414385 
    415386      IF(ln_ctl) THEN     ! Control print 
     
    445416      ENDIF 
    446417 
    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       ! ------------------------------- 
     418      ! conservation test 
     419      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    470420 
    471421      ENDIF  ! ln_limdyn=.true. 
    472422      ! 
    473423      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 
    476424      ! 
    477425      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
     
    670618      !!---------------------------------------------------------------------! 
    671619      INTEGER ::   ji,jj, jl    ! dummy loop indices 
    672       INTEGER ::   krdg_index   !  
    673620      REAL(wp) ::   Gstari, astari, hi, hrmean, zdummy   ! local scalar 
    674621      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here 
     
    746693      !----------------------------------------------------------------- 
    747694 
    748       krdg_index = 1 
    749  
    750       IF( krdg_index == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
     695      IF( partfun_swi == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    751696         DO jl = 0, ice_cat_bounds(1,2)       ! only undeformed ice participates 
    752697            DO jj = 1, jpj  
     
    776721         END DO 
    777722         ! 
    778       ENDIF ! krdg_index 
    779  
    780       IF( raftswi == 1 ) THEN      ! Ridging and rafting ice participation functions 
     723      ENDIF ! partfun_swi 
     724 
     725      IF( raft_swi == 1 ) THEN      ! Ridging and rafting ice participation functions 
    781726         ! 
    782727         DO jl = 1, jpl 
     
    794739         END DO ! jl 
    795740 
    796       ELSE  ! raftswi = 0 
     741      ELSE  ! raft_swi = 0 
    797742         ! 
    798743         DO jl = 1, jpl 
     
    802747      ENDIF 
    803748 
    804       IF ( raftswi == 1 ) THEN 
     749      IF ( raft_swi == 1 ) THEN 
    805750 
    806751         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN 
     
    908853      INTEGER ::   ij                ! horizontal index, combines i and j loops 
    909854      INTEGER ::   icells            ! number of cells with aicen > puny 
    910       REAL(wp) ::   zindb, zsrdg2   ! local scalar 
     855      REAL(wp) ::   zindb    ! local scalar 
    911856      REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration 
     857      REAL(wp) ::   zsstK            ! SST in Kelvin 
    912858 
    913859      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices 
     
    917863 
    918864      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 
     865      REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnwn_init, esnwn_init   ! snow volume  & energy before ridging 
    920866      REAL(wp), POINTER, DIMENSION(:,:,:) ::   smv_i_init, oa_i_init    ! ice salinity & age    before ridging 
    921867 
     
    952898      CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    953899      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 ) 
     900      CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    955901      CALL wrk_alloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    956902      CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init ) 
     
    1008954         aicen_init(:,:,jl) = a_i(:,:,jl) 
    1009955         vicen_init(:,:,jl) = v_i(:,:,jl) 
    1010          vsnon_init(:,:,jl) = v_s(:,:,jl) 
     956         vsnwn_init(:,:,jl) = v_s(:,:,jl) 
    1011957         ! 
    1012958         smv_i_init(:,:,jl) = smv_i(:,:,jl) 
     
    1014960      END DO !jl 
    1015961 
    1016       esnon_init(:,:,:) = e_s(:,:,1,:) 
     962      esnwn_init(:,:,:) = e_s(:,:,1,:) 
    1017963 
    1018964      DO jl = 1, jpl   
     
    10951041            vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por 
    10961042 
    1097             vsrdg(ji,jj) = vsnon_init(ji,jj,jl1) * afrac(ji,jj) 
    1098             esrdg(ji,jj) = esnon_init(ji,jj,jl1) * afrac(ji,jj) 
     1043            vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     1044            esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    10991045            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) 
     1046            srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 
    11011047 
    11021048            ! rafting volumes, heat contents ... 
    11031049            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) 
     1050            vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     1051            esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    11061052            smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
    11071053 
     
    11201066            ! Salinity 
    11211067            !------------- 
    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 
     1068            smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014 
     1069            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
     1070 
     1071            !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
    11271072             
    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              
     1073            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
     1074            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! gurvan: increase in ice volume du to seawater frozen in voids              
    11321075 
    11331076            !------------------------------------             
     
    11581101               &                                + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 
    11591102 
    1160             esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
    1161                &                                + esrft(ji,jj)*(1.0-fsnowrft)           
     1103            ! in 1e-9 Joules (same as e_s) 
     1104            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
     1105               &                                - esrft(ji,jj)*(1.0-fsnowrft)           
    11621106 
    11631107            !----------------------------------------------------------------- 
     
    11871131               eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 
    11881132               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 
     1133                
     1134                
     1135               ! enthalpy of the trapped seawater (J/m2, >0) 
     1136               ! clem: if sst>0, then ersw <0 (is that possible?) 
     1137               zsstK  = sst_m(ji,jj) + rt0 
     1138               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i ) 
     1139 
     1140               ! heat flux to the ocean 
     1141               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux  
    12031142 
    12041143               ! 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 ) 
     1144               ersw(ji,jj,jk)   = ersw(ji,jj,jk) / unit_fac 
     1145 
     1146               ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J 
     1147               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean  
     1148               !! MV HC 2014 
     1149               ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) 
    12091150 
    12101151               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
     1152 
    12111153            END DO ! ij 
    12121154         END DO !jk 
     
    13611303      CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    13621304      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 ) 
     1305      CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    13641306      CALL wrk_dealloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    13651307      CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init ) 
     
    14041346      !!------------------------------------------------------------------- 
    14051347      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 
     1348      NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,              &  
     1349        &                   Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, & 
     1350        &                   partfun_swi, brinstren_swi 
    14111351      !!------------------------------------------------------------------- 
    14121352      ! 
     
    14321372         WRITE(numout,*)'   Equivalent to G* for an exponential part function       astar           ', astar 
    14331373         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     Hstar           ', Hstar 
    1434          WRITE(numout,*)'   Rafting of ice sheets or not                            raftswi         ', raftswi 
     1374         WRITE(numout,*)'   Rafting of ice sheets or not                            raft_swi        ', raft_swi 
    14351375         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       hparmeter       ', hparmeter 
    14361376         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  Craft           ', Craft   
    14371377         WRITE(numout,*)'   Initial porosity of ridges                              ridge_por       ', ridge_por 
    1438          WRITE(numout,*)'   Maximum salinity of ridging ice                         sal_max_ridge   ', sal_max_ridge 
    14391378         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 
    14411379         WRITE(numout,*)'   Switch for including brine volume in ice strength comp. brinstren_swi   ', brinstren_swi 
    14421380      ENDIF 
     
    14621400 
    14631401      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask   ! 2D workspace 
    1464       REAL(wp)                          ::   zmask_glo 
     1402      REAL(wp)                          ::   zmask_glo, zsal, zvi, zvs, zei, zes 
    14651403!!gm      REAL(wp) ::   xtmp      ! temporary variable 
    14661404      !!------------------------------------------------------------------- 
     
    14681406      CALL wrk_alloc( jpi, jpj, zmask ) 
    14691407 
     1408      ! to be sure that at_i is the sum of a_i(jl) 
     1409      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     1410 
    14701411      DO jl = 1, jpl 
    1471  
    14721412         !----------------------------------------------------------------- 
    14731413         ! Count categories to be zapped. 
    1474          ! Abort model in case of negative area. 
    14751414         !----------------------------------------------------------------- 
    14761415         icells = 0 
     
    14781417         DO jj = 1, jpj 
    14791418            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 
     1419               IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN 
     1420                  zmask(ji,jj) = 1._wp 
     1421               ENDIF 
    14841422            END DO 
    14851423         END DO 
     
    14941432            DO jj = 1 , jpj 
    14951433               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 
     1434                  zei  = e_i(ji,jj,jk,jl) 
    14991435                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 
     1436                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj) 
     1437                  ! update exchanges with ocean 
     1438                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    15001439               END DO 
    15011440            END DO 
     
    15041443         DO jj = 1 , jpj 
    15051444            DO ji = 1 , jpi 
    1506  
     1445                
     1446               zsal = smv_i(ji,jj,jl) 
     1447               zvi  = v_i(ji,jj,jl) 
     1448               zvs  = v_s(ji,jj,jl) 
     1449               zes  = e_s(ji,jj,1,jl) 
    15071450               !----------------------------------------------------------------- 
    15081451               ! Zap snow energy and use ocean heat to melt snow 
     
    15141457               ! fluxes are positive to the ocean 
    15151458               ! 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  
    15211459               t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
    15221460 
     
    15241462               ! zap ice and snow volume, add water and salt to ocean 
    15251463               !----------------------------------------------------------------- 
    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) 
     1464               ato_i(ji,jj)    = a_i  (ji,jj,jl) *           zmask(ji,jj)   + ato_i(ji,jj) 
    15351465               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    15361466               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
     
    15391469               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    15401470               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1541                ! 
     1471               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
     1472               ! additional condition 
     1473               IF( v_s(ji,jj,jl) <= epsi10 ) THEN 
     1474                  v_s(ji,jj,jl)   = 0._wp 
     1475                  e_s(ji,jj,1,jl) = 0._wp 
     1476               ENDIF 
     1477               ! update exchanges with ocean 
     1478               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     1479               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice 
     1480               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice 
     1481               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    15421482            END DO 
    15431483         END DO 
    1544          ! 
    1545       END DO                 ! jl  
     1484      END DO ! jl  
     1485 
     1486      ! to be sure that at_i is the sum of a_i(jl) 
     1487      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    15461488      ! 
    15471489      CALL wrk_dealloc( jpi, jpj, zmask ) 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r4333 r4688  
    3535   USE lib_fortran      ! to use key_nosignedzero 
    3636   USE timing          ! Timing 
     37   USE limcons        ! conservation tests 
    3738 
    3839   IMPLICIT NONE 
     
    6566      INTEGER, INTENT(in) ::   kt   ! time step index 
    6667      ! 
    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) 
     68      INTEGER ::   ji,jj, jk, jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index          
     69      ! 
     70      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7071      !!------------------------------------------------------------------ 
    7172      IF( nn_timing == 1 )  CALL timing_start('limitd_th') 
    7273 
    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       ! ------------------------------- 
     74      ! conservation test 
     75      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    8376 
    8477      IF( kt == nit000 .AND. lwp ) THEN 
     
    10598      !  3) Add frazil ice growing in leads. 
    10699      !------------------------------------------------------------------------------| 
    107  
    108100      CALL lim_thd_lac 
    109101      CALL lim_var_glo2eqv    ! only for info 
    110  
    111      IF(ln_ctl) THEN   ! Control print 
     102      
     103      IF(ln_ctl) THEN   ! Control print 
    112104         CALL prt_ctl_info(' ') 
    113105         CALL prt_ctl_info(' - Cell values : ') 
     
    141133      ENDIF 
    142134      ! 
    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       ! ------------------------------- 
     135      ! conservation test 
     136      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    166137      ! 
    167138     IF( nn_timing == 1 )  CALL timing_stop('limitd_th') 
     
    258229               zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 
    259230               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)  
     231               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
    261232            END DO 
    262233         END DO 
     
    302273            ij = nind_j(ji) 
    303274            ! 
    304             IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. &  
    305                ( zht_i_o(ii,ij,jl+1) .GT. epsi10 ) ) THEN 
     275            zhbnew(ii,ij,jl) = hi_max(jl) 
     276            IF ( old_a_i(ii,ij,jl) > epsi10 .AND. old_a_i(ii,ij,jl+1) > epsi10 ) THEN 
    306277               !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 
     278               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_o(ii,ij,jl+1) - zht_i_o(ii,ij,jl) ) 
     279               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 
     280            ELSEIF ( old_a_i(ii,ij,jl) > epsi10) THEN 
    312281               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 
    313             ELSEIF (zht_i_o(ii,ij,jl+1).gt.epsi10) THEN 
     282            ELSEIF ( old_a_i(ii,ij,jl+1) > epsi10) THEN 
    314283               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 
    315             ELSE 
    316                zhbnew(ii,ij,jl) = hi_max(jl) 
    317284            ENDIF 
    318285         END DO 
     
    320287         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
    321288         DO ji = 1, nbrem 
    322             ! jl, ji 
    323289            ii = nind_i(ji) 
    324290            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 
     291            IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 
    329292               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 
     293            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 
    333294               zremap_flag(ii,ij) = 0 
    334295            ENDIF 
    335296 
    336297            !- 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 
     298            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 
     299            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     300         END DO 
     301 
    348302      END DO !jl 
    349303 
     
    354308      DO jj = 1, jpj 
    355309         DO ji = 1, jpi 
    356             IF ( zremap_flag(ji,jj) == 1 ) THEN 
     310            IF( zremap_flag(ji,jj) == 1 ) THEN 
    357311               nbrem         = nbrem + 1 
    358312               nind_i(nbrem) = ji 
    359313               nind_j(nbrem) = jj 
    360314            ENDIF 
    361          END DO !ji 
    362       END DO !jj 
     315         END DO  
     316      END DO  
    363317 
    364318      !----------------------------------------------------------------------------------------------- 
     
    380334            ENDIF 
    381335 
    382             IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) )   zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
     336            IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
    383337 
    384338         END DO !jj 
     
    444398      DO jl = klbnd, kubnd 
    445399         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) 
     400            g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag) 
    448401      END DO 
    449402 
     
    493446            nd   = zdonor(ii,ij,jl) 
    494447            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) 
     448            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 
    497449 
    498450         END DO ! ji 
     
    511463         ii = nind_i(ji) 
    512464         ij = nind_j(ji) 
    513          IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim ) ) THEN 
     465         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN 
    514466            a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim  
    515467            ht_i(ii,ij,1) = hiclim 
    516             v_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless 
    517468         ENDIF 
    518469      END DO !ji 
     
    799750            !-------------- 
    800751 
    801             zdvsnow          = v_s(ii,ij,jl1) * zworka(ii,ij) 
     752            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij) 
    802753            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 
    803754            v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow  
     
    807758            !-------------------- 
    808759 
    809             zdesnow              = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
     760            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
    810761            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow 
    811762            e_s(ii,ij,1,jl2)   = e_s(ii,ij,1,jl2) + zdesnow 
     
    815766            !-------------- 
    816767 
    817             zdo_aice             = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
     768            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
    818769            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice 
    819770            oa_i(ii,ij,jl2)    = oa_i(ii,ij,jl2) + zdo_aice 
     
    823774            !-------------- 
    824775 
    825             zdsm_vice            = smv_i(ii,ij,jl1) * zworka(ii,ij) 
     776            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij) 
    826777            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice 
    827778            smv_i(ii,ij,jl2)   = smv_i(ii,ij,jl2) + zdsm_vice 
     
    831782            !--------------------- 
    832783 
    833             zdaTsf               = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
     784            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
    834785            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf 
    835786            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf  
     
    910861      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories 
    911862      !!------------------------------------------------------------------ 
     863      !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate 
    912864       
    913865      CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger 
     
    1015967 
    1016968!clem-change 
     969         DO jj = 1, jpj 
     970            DO ji = 1, jpi 
     971               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     972                  ! 
     973                  zshiftflag = 1 
     974                  zdonor(ji,jj,jl) = jl + 1 
     975                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1)  
     976                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
     977               ENDIF 
     978            END DO                 ! ji 
     979         END DO                 ! jj 
     980 
     981         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
     982          
     983         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories 
     984            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
     985            ! Reset shift parameters 
     986            zdonor(:,:,jl) = 0 
     987            zdaice(:,:,jl) = 0._wp 
     988            zdvice(:,:,jl) = 0._wp 
     989         ENDIF 
     990!clem-change 
     991 
     992!         ! clem-change begin: why not doing that? 
    1017993!         DO jj = 1, jpj 
    1018994!            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) 
     995!               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     996!                  ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
     997!                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    1026998!               ENDIF 
    1027999!            END DO                 ! ji 
    10281000!         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? 
    1042          DO jj = 1, jpj 
    1043             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)  
    1048                ENDIF 
    1049             END DO                 ! ji 
    1050          END DO                 ! jj 
    10511001         ! clem-change end 
    10521002 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r4346 r4688  
    5151 
    5252   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   rzero   = 0._wp   ! constant values 
    54    REAL(wp) ::   rone    = 1._wp   ! constant values 
    5553       
    5654   !! * Substitutions 
     
    514512!CDIR NOVERRCHK 
    515513               DO ji = fs_2, fs_jpim1 
    516                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
     514                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    517515                  zsang        = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 
    518516                  z0           = zmass1(ji,jj)/dtevp 
     
    547545               DO ji = fs_2, fs_jpim1 
    548546 
    549                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
     547                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    550548                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    551549                  z0           = zmass2(ji,jj)/dtevp 
     
    579577!CDIR NOVERRCHK 
    580578               DO ji = fs_2, fs_jpim1 
    581                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
     579                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    582580                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    583581                  z0           = zmass2(ji,jj)/dtevp 
     
    611609!CDIR NOVERRCHK 
    612610               DO ji = fs_2, fs_jpim1 
    613                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
     611                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    614612                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    615613                  z0           = zmass1(ji,jj)/dtevp 
     
    661659      ! 4) Prevent ice velocities when the ice is thin 
    662660      !------------------------------------------------------------------------------! 
    663       !clem : add hminrhg in the namelist 
    664       ! 
    665661      ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 
    666662      ! ocean velocity,  
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r4205 r4688  
    142142         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    143143      END DO 
    144  
     144       
    145145      DO jl = 1, jpl  
    146146         WRITE(zchar,'(I1)') jl 
     
    162162      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'        , u_ice      ) 
    163163      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'        , v_ice      ) 
    164       CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'        , fsbbq      ) 
    165164      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'    , stress1_i  ) 
    166165      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  ) 
     
    393392      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      ) 
    394393      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      ) 
    395       CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      ) 
    396394      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  ) 
    397395      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  ) 
     
    522520      END DO 
    523521      ! 
     522      ! clem: I do not understand why the following IF is needed 
     523      !       I suspect something inconsistent in the main code with option num_sal=1 
     524      IF( num_sal == 1 ) THEN 
     525         DO jl = 1, jpl  
     526            sm_i(:,:,jl) = bulk_sal 
     527            DO jk = 1, nlay_i  
     528               s_i(:,:,jk,jl) = bulk_sal 
     529            END DO 
     530         END DO 
     531      ENDIF 
     532      ! 
    524533      !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 
    525534      ! 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4614 r4688  
    2727   USE par_ice          ! ice parameters 
    2828   USE dom_oce          ! ocean domain 
    29    USE domvvl           ! ocean vertical scale factors 
    30    USE dom_ice,    ONLY : tms 
     29   USE dom_ice,    ONLY : tms, area 
    3130   USE ice              ! LIM sea-ice variables 
    3231   USE sbc_ice          ! Surface boundary condition: sea-ice fields 
     
    4342   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4443   USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget 
     44   USE iom 
     45   USE domvvl           ! Variable volume 
    4546 
    4647   IMPLICIT NONE 
     
    5152   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
    5253 
    53    REAL(wp)  ::   rzero  = 0._wp     
    54    REAL(wp)  ::   rone   = 1._wp 
     54   REAL(wp)  ::   epsi10 = 1.e-10   ! 
     55   REAL(wp)  ::   epsi20 = 1.e-20   ! 
    5556 
    5657   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2] 
     
    104105      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    105106      ! 
    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                     !   -      - 
     107      INTEGER  ::   ji, jj, jl, jk           ! dummy loop indices 
     108      REAL(wp) ::   zinda, zemp      ! local scalars 
     109      REAL(wp) ::   zf_mass         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     110      REAL(wp) ::   zfcm1           ! New solar flux received by the ocean 
    112111      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
    113       REAL(wp) ::   zzfcm1, zfscmbq ! clem: for light penetration 
    114112      !!--------------------------------------------------------------------- 
    115113       
    116114      IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 
    117115 
    118       !------------------------------------------! 
    119       !      heat flux at the ocean surface      ! 
    120       !------------------------------------------! 
     116      ! make calls for heat fluxes before it is modified 
     117      CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface 
     118      CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface 
     119      CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) )  !     solar flux at ice surface 
     120      CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) )  ! non-solar flux at ice surface 
     121      CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) )  !     solar flux transmitted thru ice 
     122      CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )   
     123      CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * old_a_i(:,:,:), dim=3 ) ) 
     124 
    121125      ! 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  
    124126      DO jj = 1, jpj 
    125127         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 
     128 
     129            !------------------------------------------! 
     130            !      heat flux at the ocean surface      ! 
     131            !------------------------------------------! 
     132            zinda   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice 
     133 
     134            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
     135            !--------------------------------------------------- 
     136            IF( lk_cpl ) THEN ! be carfeful: not been tested yet 
    150137               ! 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) ) 
     138               zfcm1 = qsr_tot(ji,jj) 
     139               !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
    154140               DO jl = 1, jpl 
    155                   zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 
     141                  zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) 
    156142               END DO 
    157143            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) ) 
     144               !!!zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
     145               !!!     &    ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
     146               zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
     147               DO jl = 1, jpl 
     148                  zfcm1   = zfcm1 + old_a_i(ji,jj,jl) * ftr_ice(ji,jj,jl) 
     149               END DO 
    160150            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 
     151 
     152            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
     153            !--------------------------------------------------- 
     154            zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     155            hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 
     156 
     157            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
     158            !--------------------------------------------------- 
     159            qsr(ji,jj) = zfcm1                                       
     160            qns(ji,jj) = hfx_out(ji,jj) - zfcm1               
     161 
     162            !------------------------------------------! 
     163            !      mass flux at the ocean surface      ! 
     164            !------------------------------------------! 
    202165            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 
    203166            !  -------------------------------------------------------------------------------------  
     
    208171            !                     Even if i see Ice melting as a FW and SALT flux 
    209172            !         
    210  
    211173            !  computing freshwater exchanges at the ice/ocean interface 
    212             IF (lk_cpl) THEN  
     174            IF( lk_cpl ) THEN  
    213175               zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
    214                   &   - rdm_snw(ji,jj) / rdt_ice 
     176                  &   + wfx_snw(ji,jj) 
    215177            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 
     178               zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
     179                  &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean 
     180                  &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas )       ! except solid precip intercepted by sea-ice 
    220181            ENDIF 
    221182 
    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) 
     183            ! mass flux from ice/ocean 
     184            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     185 
     186            ! mass flux at the ocean/ice interface 
     187            fmmflx(ji,jj) = - wfx_ice(ji,jj) * rdt_ice                   ! F/M mass flux save at least for biogeochemical model 
     188            emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    229189             
    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) 
    233190         END DO 
    234191      END DO 
     
    237194      !      salt flux at the ocean surface      ! 
    238195      !------------------------------------------! 
    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 
     196      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 
     197 
     198      !-------------------------------------------------------------! 
     199      !   mass of snow and ice per unit area for embedded sea-ice   ! 
     200      !-------------------------------------------------------------! 
     201      IF( nn_ice_embd /= 0 ) THEN 
     202         ! save mass from the previous ice time step 
     203         snwice_mass_b(:,:) = snwice_mass(:,:)                   
     204         ! new mass per unit area 
    251205         snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
    252          !                                                      ! time evolution of snow+ice mass 
     206         ! time evolution of snow+ice mass 
    253207         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
    254208      ENDIF 
     
    265219      IF( lk_cpl ) THEN          ! coupled case 
    266220         CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo 
    267          ! 
    268221         alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys) 
    269222      ENDIF 
     223 
    270224 
    271225      IF(ln_ctl) THEN 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4624 r4688  
    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 
     
    4343   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4444   USE timing         ! Timing 
     45   USE cpl_oasis3, ONLY : lk_cpl 
     46   USE limcons        ! conservation tests 
    4547 
    4648   IMPLICIT NONE 
     
    5153 
    5254   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   zzero  = 0._wp      ! 
    54    REAL(wp) ::   zone   = 1._wp      ! 
    5555 
    5656   !! * Substitutions 
     
    8484      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    8585      !! 
    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) 
     86      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
     87      INTEGER  :: nbpb             ! nb of icy pts for thermo. cal. 
     88      INTEGER  :: ii, ij           ! temporary dummy loop index 
     89      REAL(wp) :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04) 
     90      REAL(wp) :: zch        = 0.0057_wp    ! heat transfer coefficient 
     91      REAL(wp) :: zinda, zindb, zareamin  
     92      REAL(wp) :: zfric_u, zqld, zqfr 
     93      ! 
     94      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    9595      !!------------------------------------------------------------------- 
    9696      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    9797 
    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       ! ------------------------------- 
     98      ! conservation test 
     99      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    110100 
    111101      !------------------------------------------------------------------------------! 
     
    121111            DO jj = 1, jpj 
    122112               DO ji = 1, jpi 
    123                   !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 ) 
    125113                  !0 if no ice and 1 if yes 
    126114                  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  
     115                  !Energy of melting q(S,T) [J.m-3] 
     116                  e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 
     117                  !convert units ! very important that this line is here         
     118                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac  
    129119               END DO 
    130120            END DO 
     
    133123            DO jj = 1, jpj 
    134124               DO ji = 1, jpi 
    135                   !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 ) 
    137125                  !0 if no ice and 1 if yes 
    138126                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  ) 
     127                  !Energy of melting q(S,T) [J.m-3] 
     128                  e_s(ji,jj,jk,jl) = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 
    139129                  !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  
     130                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac  
    141131               END DO 
    142132            END DO 
    143133         END DO 
    144134      END DO 
    145  
    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 
    155135 
    156136      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
     
    161141!CDIR NOVERRCHK 
    162142         DO ji = 1, jpi 
    163             zinda          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) + epsi10 ) ) ) 
     143            zinda          = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 
    164144            ! 
    165145            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
     
    168148            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
    169149            !           !  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 
    187150            ! 
    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 ) ) 
     151            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
     152            zqld =  tms(ji,jj) * rdt_ice *                                       & 
     153               &  ( pfrld(ji,jj)         * ( qsr(ji,jj) * oatte(ji,jj)           &   ! solar heat + clem modif 
     154               &                           + qns(ji,jj) )                        &   ! non solar heat 
     155               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     156               &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     157               &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     158 
     159            !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     160            zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     161 
     162            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 
     163            qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )  
     164 
     165            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting  
     166            IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN 
     167               fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90 
     168               qlead(ji,jj) = 0._wp 
     169            ENDIF 
    194170            ! 
    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             ! 
     171            !-- Energy from the turbulent oceanic heat flux --- ! 
     172            !clem zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) 
     173            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
     174            fhtur(ji,jj) = MAX( 0._wp, zinda * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2  
     175            ! upper bound for fhtur: we do not want SST to drop below Tfreeze.  
     176            ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)    
     177            ! This is not a clean budget, so that should be corrected at some point 
     178            fhtur(ji,jj) = zinda * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     179 
     180            ! ----------------------------------------- 
     181            ! Net heat flux on top of ice-ocean [W.m-2] 
     182            ! ----------------------------------------- 
     183            !     First  step here      : heat flux at the ocean surface + precip 
     184            !     Second step below     : heat flux at the ice   surface (after limthd_dif)  
     185            hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
     186               ! heat flux above the ocean 
     187               &    +             pfrld(ji,jj)   * ( qns(ji,jj) + qsr(ji,jj) )                                                    & 
     188               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     189               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     190               &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) 
     191 
     192            ! ----------------------------------------------------------------------------- 
     193            ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 
     194            ! ----------------------------------------------------------------------------- 
     195            !     First  step here              :  non solar + precip - qlead - qturb 
     196            !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
     197            !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     198            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                                        &  
     199               ! Non solar heat flux received by the ocean 
     200               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                                             & 
     201               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     202               &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     203               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )                        & 
     204               ! heat flux taken from the ocean where there is open water ice formation 
     205               &    -      qlead(ji,jj) * r1_rdtice                                                                                                & 
     206               ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 
     207               &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                                              & 
     208               &    -      at_i(ji,jj) *  fhld(ji,jj) 
     209 
    205210         END DO 
    206211      END DO 
     
    234239               DO jj = mj0(jjindx), mj1(jjindx) 
    235240                  jiindex_1d = (jj - 1) * jpi + ji 
     241                  WRITE(numout,*) ' lim_thd : Category no : ', jl  
    236242               END DO 
    237243            END DO 
     
    271277            CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
    272278            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 
     279            CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     280            CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     281            IF( .NOT. lk_cpl ) THEN 
     282               CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     283               CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     284            ENDIF 
    278285            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    279286            CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
    280287            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) ) 
     288            CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) ) 
     289            CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
     290            CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
     291 
     292            CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     293            CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     294 
     295            CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     296            CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     297            CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     298            CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) ) 
     299            CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) ) 
     300            CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     301 
     302            CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     303            CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     304            CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     305            CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) ) 
    289306            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 
     307            CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
     308 
     309            CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) )  
     310            CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) )  
     311 
     312            CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     313            CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     314            CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     315            CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     316            CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     317            CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) ) 
     318            CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) ) 
     319            CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     320            CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     321            CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) ) 
     322            CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) ) 
     323            CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
     324 
    296325            !-------------------------------- 
    297326            ! 4.3) Thermodynamic processes 
    298327            !-------------------------------- 
    299328 
    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 ) 
     329            !---------------------------------! 
     330            ! Ice/Snow Temperature profile    ! 
     331            !---------------------------------! 
     332            CALL lim_thd_dif( 1, nbpb ) 
     333 
     334            !---------------------------------! 
     335            ! Ice/Snow thicnkess              ! 
     336            !---------------------------------! 
     337            CALL lim_thd_dh( 1, nbpb )     
     338 
     339            ! --- Ice enthalpy remapping --- ! 
     340            CALL lim_thd_ent( 1, nbpb, q_i_b(1:nbpb,:) )  
     341                                             
     342            !---------------------------------! 
     343            ! --- Ice salinity --- ! 
     344            !---------------------------------! 
     345            CALL lim_thd_sal( 1, nbpb )     
     346 
     347            !---------------------------------! 
     348            ! --- temperature update --- ! 
     349            !---------------------------------! 
     350            CALL lim_thd_temp( 1, nbpb ) 
    327351 
    328352            !-------------------------------- 
     
    345369               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b     (1:nbpb,jk), jpi, jpj) 
    346370            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 ) 
     371               CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
     372 
     373               CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     374               CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     375 
     376               CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     377               CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     378               CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     379               CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     380               CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj ) 
     381               CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     382 
     383               CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     384               CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     385               CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     386               CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     387               CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
    358388            ! 
    359389            IF( num_sal == 2 ) THEN 
    360390               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 ) 
    362391            ENDIF 
     392 
     393              CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
     394              CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     395              CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     396              CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     397              CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     398              CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj ) 
     399              CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj ) 
     400              CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     401              CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     402              CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj ) 
     403              CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
     404              CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj ) 
    363405            ! 
    364406            !+++++       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) 
     407              CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj ) 
     408              CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj ) 
     409              CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj ) 
     410              CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj ) 
    372411            !+++++ 
     412              CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
     413              CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
    373414            ! 
    374415            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
     
    384425      ! 5.1) Ice heat content               
    385426      !------------------------ 
    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 ) ) 
     427      ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
    388428      DO jl = 1, jpl 
    389429         DO jk = 1, nlay_i 
    390             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef 
     430            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) ) 
    391431         END DO 
    392432      END DO 
     
    395435      ! 5.2) Snow heat content               
    396436      !------------------------ 
    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 ) ) 
     437      ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
    399438      DO jl = 1, jpl 
    400439         DO jk = 1, nlay_s 
    401             e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef 
     440            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) ) 
    402441         END DO 
    403442      END DO 
     
    411450      ! 5.4) Diagnostic thermodynamic growth rates 
    412451      !-------------------------------------------- 
    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(:,:) 
    417  
    418452      IF(ln_ctl) THEN            ! Control print 
    419453         CALL prt_ctl_info(' ') 
     
    448482      ENDIF 
    449483      ! 
    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 
    455   
    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 ) 
     484      ! conservation test 
     485      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    475486      ! 
    476487      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 ) 
     488   END SUBROUTINE lim_thd  
     489 
     490   SUBROUTINE lim_thd_temp( kideb, kiut ) 
    481491      !!----------------------------------------------------------------------- 
    482       !!                   ***  ROUTINE lim_thd_glohec ***  
     492      !!                   ***  ROUTINE lim_thd_temp ***  
    483493      !!                  
    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) 
     494      !! ** Purpose :   Computes sea ice temperature (Kelvin) from enthalpy 
    780495      !! 
    781496      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
     
    784499      !! 
    785500      INTEGER  ::   ji, jk   ! dummy loop indices 
    786       REAL(wp) ::   ztmelts  ! local scalar  
     501      REAL(wp) ::   ztmelts, zswitch, zaaa, zbbb, zccc, zdiscrim  ! local scalar  
    787502      !!------------------------------------------------------------------- 
    788       ! 
    789       DO jk = 1, nlay_i             ! Sea ice energy of melting 
     503      ! Recover ice temperature 
     504      DO jk = 1, nlay_i 
    790505         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 
    796       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 
    804  
     506            ztmelts       =  -tmut * s_i_b(ji,jk) + rtt 
     507            ! Conversion q(S,T) -> T (second order equation) 
     508            zaaa          =  cpic 
     509            zbbb          =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 
     510            zccc          =  lfus * ( ztmelts - rtt ) 
     511            zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 
     512            t_i_b(ji,jk)  =  rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 
     513             
     514            ! mask temperature 
     515            zswitch      =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_b(ji) ) )  
     516            t_i_b(ji,jk) =  zswitch * t_i_b(ji,jk) + ( 1._wp - zswitch ) * rtt 
     517         END DO  
     518      END DO  
     519 
     520   END SUBROUTINE lim_thd_temp 
    805521 
    806522   SUBROUTINE lim_thd_init 
     
    818534      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    819535      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,         &  
     536         &                hiclim, hnzst, parsub, betas,                          &  
    823537         &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi 
    824538      !!------------------------------------------------------------------- 
     
    843557         WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation ' 
    844558         WRITE(numout,*)'      maximum melting at the bottom                           hmelt        = ', hmelt 
    845          WRITE(numout,*)'      ice thick. for lateral accretion in NH (SH)             hiccrit(1/2) = ', hiccrit 
     559         WRITE(numout,*)'      ice thick. for lateral accretion                        hiccrit      = ', hiccrit 
    846560         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       fraz_swi     = ', fraz_swi 
    847561         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   maxfrazb     = ', maxfrazb 
    848562         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  vfrazb       = ', vfrazb 
    849563         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   
    851564         WRITE(numout,*)'      minimum ice thickness                                   hiclim       = ', hiclim  
    852565         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  
    860566         WRITE(numout,*)'      thickness of the surf. layer in temp. computation       hnzst        = ', hnzst 
    861567         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 
    863568         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          betas        = ', betas 
    864569         WRITE(numout,*)'      extinction radiation parameter in sea ice (1.0)         kappa_i      = ', kappa_i 
     
    866571         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd 
    867572         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     thcon_i_swi  = ', thcon_i_swi 
     573         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
    868574      ENDIF 
    869       ! 
    870       rcdsn = hakdif * rcdsn  
    871       rcdic = hakdif * rcdic 
    872575      ! 
    873576   END SUBROUTINE lim_thd_init 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r4333 r4688  
    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  
     
    2626   USE wrk_nemo       ! work arrays 
    2727   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    28  
     28   USE cpl_oasis3, ONLY : lk_cpl 
     29    
    2930   IMPLICIT NONE 
    3031   PRIVATE 
     
    3435   REAL(wp) ::   epsi20 = 1.e-20   ! constant values 
    3536   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    ! 
    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) ::   zdh, zfdum  ! 
    8577      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment 
    8678      REAL(wp) ::   zcoeff       ! dummy argument for snowfall partitioning over ice and leads 
    87       REAL(wp) ::   zsm_snowice  ! snow-ice salinity 
     79      REAL(wp) ::   zs_snic  ! snow-ice salinity 
    8880      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity 
    8981      REAL(wp) ::   zswi12       ! switch for computation of bottom salinity 
    9082      REAL(wp) ::   zswi2        ! switch for computation of bottom salinity 
    9183      REAL(wp) ::   zgrr         ! bottom growth rate 
    92       REAL(wp) ::   ztform       ! bottom formation temperature 
    93       ! 
    94       REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness 
     84      REAL(wp) ::   zt_i_new     ! bottom formation temperature 
     85 
     86      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean 
     87      REAL(wp) ::   zEi          ! specific enthalpy of sea ice (J/kg) 
     88      REAL(wp) ::   zEw          ! specific enthalpy of exchanged water (J/kg) 
     89      REAL(wp) ::   zdE          ! specific enthalpy difference (J/kg) 
     90      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean 
     91      REAL(wp) ::   zsstK        ! SST in Kelvin 
     92 
    9593      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    !  
     94      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3) 
     95      REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2) 
     96      REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2) 
     97      REAL(wp), POINTER, DIMENSION(:) ::   zq_1cat     ! corrected heat in case 1-cat and hmelt>15cm (J.m-2) 
     98      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2) 
     99      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt     ! Heat budget to determine melting or freezing(W.m-2) 
     100      INTEGER , POINTER, DIMENSION(:) ::   icount      ! number of layers vanished by melting  
    104101 
    105102      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt  
     
    108105 
    109106      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 
     107      REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness 
     108 
     109      REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2) 
     110      REAL(wp), POINTER, DIMENSION(:) ::   zqh_s       ! total snow heat content (J.m-2) 
     111      REAL(wp), POINTER, DIMENSION(:) ::   zq_s        ! total snow enthalpy     (J.m-3) 
    119112 
    120113      ! mass and salt flux (clem) 
    121       REAL(wp) :: zdvres, zdvsur, zdvbot 
    122       REAL(wp), POINTER, DIMENSION(:) ::   zviold, zvsold   ! old ice volume... 
     114      REAL(wp) :: zdvres, zswitch_sal, zswitch 
    123115 
    124116      ! 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 
     117      INTEGER  ::   num_iter_max 
     118      REAL(wp) ::   zinda, zindq, zindh  
     119      REAL(wp), POINTER, DIMENSION(:) ::   zintermelt   ! debug 
     120 
    130121      !!------------------------------------------------------------------ 
    131122 
    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 
     123      ! Discriminate between varying salinity (num_sal=2) and prescribed cases (other values) 
     124      SELECT CASE( num_sal )                       ! varying salinity or not 
     125         CASE( 1, 3, 4 ) ;   zswitch_sal = 0       ! prescribed salinity profile 
     126         CASE( 2 )       ;   zswitch_sal = 1       ! varying salinity profile 
     127      END SELECT 
     128 
     129      CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 
     130      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     131      CALL wrk_alloc( jpij, zintermelt ) 
     132      CALL wrk_alloc( jpij, jkmax, zdeltah, zh_i ) 
     133      CALL wrk_alloc( jpij, icount ) 
    138134       
    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 
     135      dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp 
     136      dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp    
     137  
     138      zqprec (:) = 0._wp ; zq_su  (:) = 0._wp ; zq_bo  (:) = 0._wp ; zf_tt  (:) = 0._wp 
     139      zq_1cat(:) = 0._wp ; zq_rema(:) = 0._wp 
     140 
     141      zh_s     (:) = 0._wp        
     142      zdh_s_pre(:) = 0._wp 
     143      zdh_s_mel(:) = 0._wp 
     144      zdh_s_sub(:) = 0._wp 
     145      zqh_s    (:) = 0._wp       
     146      zqh_i    (:) = 0._wp    
     147 
     148      zh_i      (:,:) = 0._wp        
     149      zdeltah   (:,:) = 0._wp        
     150      zintermelt(:)   = 0._wp 
     151      icount    (:)   = 0 
     152 
     153      ! initialize layer thicknesses and enthalpies 
     154      h_i_old (:,0:nlay_i+1) = 0._wp 
     155      qh_i_old(:,0:nlay_i+1) = 0._wp 
     156      DO jk = 1, nlay_i 
     157         DO ji = kideb, kiut 
     158            h_i_old (ji,jk) = ht_i_b(ji) / REAL( nlay_i ) 
     159            qh_i_old(ji,jk) = q_i_b(ji,jk) * h_i_old(ji,jk) 
     160         ENDDO 
     161      ENDDO 
    153162      ! 
    154163      !------------------------------------------------------------------------------! 
    155       !  1) Calculate available heat for surface ablation                            ! 
     164      !  1) Calculate available heat for surface and bottom ablation                 ! 
    156165      !------------------------------------------------------------------------------! 
    157166      ! 
    158167      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    
     168         zinda         = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 
     169         ztmelts       = zinda * rtt + ( 1._wp - zinda ) * rtt 
     170 
     171         zfdum     = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
     172         zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
     173 
     174         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_b(ji) - ztmelts ) ) 
     175         zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 
     176      END DO 
     177 
    170178      ! 
    171179      !------------------------------------------------------------------------------! 
    172       !  2) Computing layer thicknesses and  snow and sea-ice enthalpies.            ! 
     180      ! If snow temperature is above freezing point, then snow melts  
     181      ! (should not happen but sometimes it does) 
    173182      !------------------------------------------------------------------------------! 
    174       ! 
    175       DO ji = kideb, kiut     ! Layer thickness 
    176          zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
     183      DO ji = kideb, kiut 
     184         IF( t_s_b(ji,1) > rtt ) THEN !!! Internal melting 
     185            ! Contribution to heat flux to the ocean [W.m-2], < 0   
     186            hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_b(ji,1) * ht_s_b(ji) * a_i_b(ji) * r1_rdtice 
     187            ! Contribution to mass flux 
     188            wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_b(ji) * a_i_b(ji) * r1_rdtice 
     189            ! updates 
     190            ht_s_b(ji)   = 0._wp 
     191            q_s_b (ji,1) = 0._wp 
     192            t_s_b (ji,1) = rtt 
     193         END IF 
     194      END DO 
     195 
     196      !------------------------------------------------------------! 
     197      !  2) Computing layer thicknesses and enthalpies.            ! 
     198      !------------------------------------------------------------! 
     199      ! 
     200      DO ji = kideb, kiut      
    177201         zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 
    178202      END DO 
    179203      ! 
    180       zqt_s(:) = 0._wp        ! Total enthalpy of the snow 
    181204      DO jk = 1, nlay_s 
    182205         DO ji = kideb, kiut 
    183             zqt_s(ji) =  zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s ) 
     206            zqh_s(ji) =  zqh_s(ji) + q_s_b(ji,jk) * zh_s(ji) 
    184207         END DO 
    185208      END DO 
    186209      ! 
    187       zqt_i(:) = 0._wp        ! Total enthalpy of the ice 
    188210      DO jk = 1, nlay_i 
    189211         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 
     212            zh_i(ji,jk) = ht_i_b(ji) / REAL( nlay_i ) 
     213            zqh_i(ji)   = zqh_i(ji) + q_i_b(ji,jk) * zh_i(ji,jk) 
    193214         END DO 
    194215      END DO 
     
    212233      ! Martin Vancoppenolle, December 2006 
    213234 
    214       ! Snow fall 
    215       DO ji = kideb, kiut 
    216          zcoeff = ( 1.0 - ( 1.0 - at_i_b(ji) )**betas ) / at_i_b(ji)  
     235      DO ji = kideb, kiut 
     236         !----------- 
     237         ! Snow fall 
     238         !----------- 
     239         ! thickness change 
     240         zcoeff = ( 1._wp - ( 1._wp - at_i_b(ji) )**betas ) / at_i_b(ji)  
    217241         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 
     242         ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 
     243         zqprec   (ji) = rhosn * ( cpic * ( rtt - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus )    
     244         IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 
     245         ! heat flux from snow precip (>0, W.m-2) 
     246         hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_b(ji) * zqprec(ji) * r1_rdtice 
     247         ! mass flux, <0 
     248         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_b(ji) * zdh_s_pre(ji) * r1_rdtice 
     249         ! update thickness 
     250         ht_s_b    (ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_pre(ji) ) 
     251 
     252         !--------------------- 
     253         ! Melt of falling snow 
     254         !--------------------- 
     255         ! thickness change 
     256         IF( zdh_s_pre(ji) > 0._wp ) THEN 
     257         zindq          = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) ) 
     258         zdh_s_mel (ji) = - zindq * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 
     259         zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting  
     260         ! heat used to melt snow (W.m-2, >0) 
     261         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_b(ji) * zqprec(ji) * r1_rdtice 
     262         ! snow melting only = water into the ocean (then without snow precip), >0 
     263         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdh_s_mel(ji) * r1_rdtice 
     264          
     265         ! updates available heat + thickness 
     266         zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) )       
     267         ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_mel(ji) ) 
     268         zh_s  (ji) = ht_s_b(ji) / REAL( nlay_s ) 
     269 
     270         ENDIF 
     271      END DO 
     272 
     273      ! If heat still available, then melt more snow 
     274      zdeltah(:,:) = 0._wp ! important 
    238275      DO jk = 1, nlay_s 
    239276         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     
     277            ! thickness change 
     278            zindh            = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_b(ji) ) )  
     279            zindq            = 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_b(ji,jk) + epsi20 ) )  
     280            zdeltah  (ji,jk) = - zindh * zindq * zq_su(ji) / MAX( q_s_b(ji,jk), epsi20 ) 
     281            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting 
     282            zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)     
     283            ! heat used to melt snow(W.m-2, >0) 
     284            hfx_snw_1d(ji)   = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_b(ji) * q_s_b(ji,jk) * r1_rdtice  
     285            ! snow melting only = water into the ocean (then without snow precip) 
     286            wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 
     287 
     288            ! updates available heat + thickness 
     289            zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_b(ji,jk) ) 
     290            ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdeltah(ji,jk) ) 
     291 
    244292         END DO 
    245293      END DO 
    246294 
    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) 
     295      !---------------------- 
     296      ! 3.2 Snow sublimation  
     297      !---------------------- 
     298      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
     299      ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean) 
     300      ! clem comment: ice should also sublimate 
     301      IF( lk_cpl ) THEN 
     302         ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 
     303         zdh_s_sub(:)      =  0._wp  
     304      ELSE 
     305         ! forced  mode: snow thickness change due to sublimation 
     306         DO ji = kideb, kiut 
     307            zdh_s_sub(ji)  =  MAX( - ht_s_b(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 
     308            ! Heat flux by sublimation [W.m-2], < 0 
     309            !      sublimate first snow that had fallen, then pre-existing snow 
     310            zcoeff         =      ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) )   * zqprec(ji) +   & 
     311               &  ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_b(ji,1) )  & 
     312               &  * a_i_b(ji) * r1_rdtice 
     313            hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff 
     314            ! Mass flux by sublimation 
     315            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_b(ji) * zdh_s_sub(ji) * r1_rdtice 
     316            ! new snow thickness 
     317            ht_s_b(ji)     =  MAX( 0._wp , ht_s_b(ji) + zdh_s_sub(ji) ) 
     318         END DO 
     319      ENDIF 
     320 
     321      ! --- Update snow diags --- ! 
     322      DO ji = kideb, kiut 
     323         dh_s_tot(ji)   = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
     324         zh_s(ji)       = ht_s_b(ji) / REAL( nlay_s ) 
    262325      END DO ! ji 
    263326 
     327      !------------------------------------------- 
     328      ! 3.3 Update temperature, energy 
     329      !------------------------------------------- 
     330      ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 
     331      zq_s(:) = 0._wp  
     332      DO jk = 1, nlay_s 
     333         DO ji = kideb,kiut 
     334            zindh  =  MAX(  0._wp , SIGN( 1._wp, - ht_s_b(ji) + epsi20 )  ) 
     335            q_s_b(ji,jk) = ( 1._wp - zindh ) / MAX( ht_s_b(ji), epsi20 ) *             & 
     336              &            ( (   MAX( 0._wp, dh_s_tot(ji) )              ) * zqprec(ji) +  & 
     337              &              ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_b(ji) ) * rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) ) 
     338            zq_s(ji)     =  zq_s(ji) + q_s_b(ji,jk) 
     339         END DO 
     340      END DO 
     341 
    264342      !-------------------------- 
    265       ! 3.2 Surface ice ablation  
     343      ! 3.4 Surface ice ablation  
    266344      !-------------------------- 
    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  
     345      zdeltah(:,:) = 0._wp ! important 
    272346      DO jk = 1, nlay_i 
    273347         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 
     348            zEi            = - q_i_b(ji,jk) / rhoic                ! Specific enthalpy of layer k [J/kg, <0] 
     349 
     350            ztmelts        = - tmut * s_i_b(ji,jk) + rtt           ! Melting point of layer k [K] 
     351 
     352            zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0] 
     353 
     354            zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0 
     355 
     356            zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0] 
     357 
     358            zdeltah(ji,jk) = - zfmdt / rhoic                       ! Melt of layer jk [m, <0] 
     359 
     360            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] 
     361 
     362            zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 
     363 
     364            dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt 
     365 
     366            zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
     367 
     368            zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
     369 
     370            ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok) 
     371            sfx_sum_1d(ji)   = sfx_sum_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     372 
     373            ! Contribution to heat flux [W.m-2], < 0 
     374            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 
     375 
     376            ! Total heat flux used in this process [W.m-2], > 0   
     377            hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice 
     378 
     379            ! Contribution to mass flux 
     380            wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 
     381            
     382            ! record which layers have disappeared (for bottom melting)  
     383            !    => icount=0 : no layer has vanished 
     384            !    => icount=5 : 5 layers have vanished 
     385            zindh       = NINT( MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) )  
     386            icount(ji)  = icount(ji) + zindh 
     387            zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 
     388 
     389            ! update heat content (J.m-2) and layer thickness 
     390            qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk) 
     391            h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    288392         END DO 
    289393      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  
    324       !---------------------- 
    325       ! 3.3 Snow sublimation 
    326       !---------------------- 
    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 
    345       DO jk = 1, nlay_s 
    346          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 
    349          END DO 
    350       END DO 
    351  
    352       DO jk = 1, nlay_s 
    353          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) 
    358          END DO 
     394      ! update ice thickness 
     395      DO ji = kideb, kiut 
     396         ht_i_b(ji) =  MAX( 0._wp , ht_i_b(ji) + dh_i_surf(ji) ) 
    359397      END DO 
    360398 
     
    364402      !------------------------------------------------------------------------------! 
    365403      ! 
    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 
     404      !------------------ 
     405      ! 4.1 Basal growth  
     406      !------------------ 
     407      ! Basal growth is driven by heat imbalance at the ice-ocean interface, 
     408      ! between the inner conductive flux  (fc_bo_i), from the open water heat flux  
     409      ! (fhld) and the turbulent ocean flux (fhtur).  
     410      ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice  
     411 
     412      ! If salinity varies in time, an iterative procedure is required, because 
     413      ! the involved quantities are inter-dependent. 
     414      ! Basal growth (dh_i_bott) depends upon new ice specific enthalpy (zEi), 
     415      ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bott) 
     416      ! -> need for an iterative procedure, which converges quickly 
     417 
     418      IF ( num_sal == 2 ) THEN 
     419         num_iter_max = 5 
     420      ELSE 
     421         num_iter_max = 1 
     422      ENDIF 
     423 
     424      !clem debug. Just to be sure that enthalpy at nlay_i+1 is null 
     425      DO ji = kideb, kiut 
     426         q_i_b(ji,nlay_i+1) = 0._wp 
     427      END DO 
     428 
     429      ! Iterative procedure 
     430      DO iter = 1, num_iter_max 
    376431         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 
    390             ENDIF 
    391          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 
     432            IF(  zf_tt(ji) < 0._wp  ) THEN 
     433 
     434               ! New bottom ice salinity (Cox & Weeks, JGR88 ) 
     435               !--- zswi1  if dh/dt < 2.0e-8 
     436               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7  
     437               !--- zswi2  if dh/dt > 3.6e-7 
     438               zgrr               = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi10 ) ) 
     439               zswi2              = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) ) 
     440               zswi12             = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 
     441               zswi1              = 1. - zswi2 * zswi12 
     442               zfracs             = MIN ( zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   & 
     443                  &               + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  , 0.5 ) 
     444 
     445               ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     446 
     447               s_i_new(ji)        = zswitch_sal * zfracs * sss_m(ii,ij)  &  ! New ice salinity 
     448                                  + ( 1. - zswitch_sal ) * sm_i_b(ji)  
     449               ! New ice growth 
     450               ztmelts            = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K) 
     451 
     452               zt_i_new           = zswitch_sal * t_bo_b(ji) + ( 1. - zswitch_sal) * t_i_b(ji, nlay_i) 
     453                
     454               zEi                = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)       
     455                  &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   & 
     456                  &               + rcp  * ( ztmelts-rtt )           
     457 
     458               zEw                = rcp  * ( t_bo_b(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0) 
     459 
     460               zdE                = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0) 
     461 
     462               dh_i_bott(ji)      = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) ) 
     463 
     464               q_i_b(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0) 
     465                
     466            ENDIF ! fc_bo_i 
     467         END DO ! ji 
     468      END DO ! iter 
     469 
     470      ! Contribution to Energy and Salt Fluxes 
     471      DO ji = kideb, kiut 
     472         IF(  zf_tt(ji) < 0._wp  ) THEN 
     473            ! New ice growth 
     474                                     
     475            zfmdt          = - rhoic * dh_i_bott(ji)             ! Mass flux x time step (kg/m2, < 0) 
     476 
     477            ztmelts        = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K) 
     478             
     479            zt_i_new       = zswitch_sal * t_bo_b(ji) + ( 1. - zswitch_sal) * t_i_b(ji, nlay_i) 
     480             
     481            zEi            = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)       
     482               &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   & 
     483               &               + rcp  * ( ztmelts-rtt )           
     484             
     485            zEw            = rcp  * ( t_bo_b(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0) 
     486             
     487            zdE            = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0) 
     488             
     489            ! Contribution to heat flux to the ocean [W.m-2], >0   
     490            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 
     491 
     492            ! Total heat flux used in this process [W.m-2], <0   
     493            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice 
     494             
     495            ! Contribution to salt flux, <0 
     496            sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_b(ji) * zfmdt * r1_rdtice 
     497 
     498            ! Contribution to mass flux, <0 
     499            wfx_bog_1d(ji) =  wfx_bog_1d(ji) - rhoic * a_i_b(ji) * dh_i_bott(ji) * r1_rdtice 
     500 
     501            ! update heat content (J.m-2) and layer thickness 
     502            qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_b(ji,nlay_i+1) 
     503            h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji) 
     504         ENDIF 
     505      END DO 
    456506 
    457507      !---------------- 
    458508      ! 4.2 Basal melt 
    459509      !---------------- 
    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  
     510      zdeltah(:,:) = 0._wp ! important 
    475511      DO jk = nlay_i, 1, -1 
    476512         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 
     513            IF(  zf_tt(ji)  >=  0._wp  .AND. jk > icount(ji) ) THEN   ! do not calculate where layer has already disappeared from surface melting  
     514 
     515               ztmelts = - tmut * s_i_b(ji,jk) + rtt  ! Melting point of layer jk (K) 
     516 
     517               IF( t_i_b(ji,jk) >= ztmelts ) THEN !!! Internal melting 
     518                  zintermelt(ji)    = 1._wp 
     519 
     520                  zEi               = - q_i_b(ji,jk) / rhoic        ! Specific enthalpy of melting ice (J/kg, <0) 
     521 
     522                  !!zEw               = rcp * ( t_i_b(ji,jk) - rtt )  ! Specific enthalpy of meltwater at T = t_i_b (J/kg, <0) 
     523 
     524                  zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
     525                                                                    ! set up at 0 since no energy is needed to melt water...(it is already melted) 
     526 
     527                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing      
     528                                                                   ! this should normally not happen, but sometimes, heat diffusion leads to this 
     529 
     530                  dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk) 
     531 
     532                  zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
     533 
     534                  ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean)  
     535                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_b(ji) * zEi * r1_rdtice 
     536 
     537                  ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok) 
     538                  sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     539                                     
     540                  ! Contribution to mass flux 
     541                  wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 
     542 
     543                  ! update heat content (J.m-2) and layer thickness 
     544                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk) 
     545                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
     546 
     547               ELSE                               !!! Basal melting 
     548 
     549                  zEi               = - q_i_b(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0) 
     550 
     551                  zEw               = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0) 
     552 
     553                  zdE               = zEi - zEw              ! Specific enthalpy difference   (J/kg, <0) 
     554 
     555                  zfmdt             = - zq_bo(ji) / zdE  ! Mass flux x time step (kg/m2, >0) 
     556 
     557                  zdeltah(ji,jk)    = - zfmdt / rhoic        ! Gross thickness change 
     558 
     559                  zdeltah(ji,jk)    = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 
     560                   
     561                  zq_bo(ji)         = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 
     562 
     563                  dh_i_bott(ji)     = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt 
     564 
     565                  zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
     566 
     567                  zQm               = zfmdt * zEw         ! Heat exchanged with ocean 
     568 
     569                  ! Contribution to heat flux to the ocean [W.m-2], <0   
     570                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 
     571 
     572                  ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok) 
     573                  sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     574                   
     575                  ! Total heat flux used in this process [W.m-2], >0   
     576                  hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice 
     577                   
     578                  ! Contribution to mass flux 
     579                  wfx_bom_1d(ji) =  wfx_bom_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 
     580 
     581                  ! update heat content (J.m-2) and layer thickness 
     582                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk) 
     583                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    489584               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 
     585            
    493586            ENDIF 
    494587         END DO ! ji 
    495588      END DO ! jk 
    496589 
    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 
    520             ENDIF 
    521          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       ! 
    530590      !------------------------------------------------------------------------------! 
    531       !  5) Pathological cases                                                       ! 
     591      ! Excessive ablation in a 1-category model 
     592      !     in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 
    532593      !------------------------------------------------------------------------------! 
    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 
     594      ! ??? keep ??? 
     595      ! clem bug: I think this should be included above, so we would not have to  
     596      !           track heat/salt/mass fluxes backwards 
     597!      IF( jpl == 1 ) THEN 
     598!         DO ji = kideb, kiut 
     599!            IF(  zf_tt(ji)  >=  0._wp  ) THEN 
     600!               zdh            = MAX( hmelt , dh_i_bott(ji) ) 
     601!               zdvres         = zdh - dh_i_bott(ji) ! >=0 
     602!               dh_i_bott(ji)  = zdh 
     603! 
     604!               ! excessive energy is sent to lateral ablation 
     605!               zinda = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_b(ji) - epsi20 ) ) 
     606!               zq_1cat(ji) =  zinda * rhoic * lfus * at_i_b(ji) / MAX( 1._wp - at_i_b(ji) , epsi20 ) * zdvres ! J.m-2 >=0 
     607! 
     608!               ! correct salt and mass fluxes 
     609!               sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation 
     610!               wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_b(ji) * zdvres * r1_rdtice 
     611!            ENDIF 
     612!         END DO 
     613!      ENDIF 
     614 
     615      !------------------------------------------- 
     616      ! Update temperature, energy 
     617      !------------------------------------------- 
     618      DO ji = kideb, kiut 
     619         ht_i_b(ji) =  MAX( 0._wp , ht_i_b(ji) + dh_i_bott(ji) ) 
     620      END DO   
     621 
     622      !------------------------------------------- 
     623      ! 5. What to do with remaining energy 
     624      !------------------------------------------- 
     625      ! If heat still available for melting and snow remains, then melt more snow 
     626      !------------------------------------------- 
     627      zdeltah(:,:) = 0._wp ! important 
     628      DO ji = kideb, kiut 
     629         zq_rema(ji)     = zq_su(ji) + zq_bo(ji)  
     630!         zindh           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_b(ji) ) )   ! =1 if snow 
     631!         zindq           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) ) 
     632!         zdeltah  (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 ) 
     633!         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_b(ji) ) ) ! bound melting 
     634!         zdh_s_mel(ji)   = zdh_s_mel(ji) + zdeltah(ji,1)     
     635!         dh_s_tot (ji)   = dh_s_tot(ji) + zdeltah(ji,1) 
     636!         ht_s_b   (ji)   = ht_s_b(ji)   + zdeltah(ji,1) 
     637!         
     638!         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji)                ! update available heat (J.m-2) 
     639!         ! heat used to melt snow 
     640!         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_b(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0) 
     641!         ! Contribution to mass flux 
     642!         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdeltah(ji,1) * r1_rdtice 
     643!     
     644         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     645         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 
     646         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_b(ji) ) * r1_rdtice 
     647 
     648         IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
     649      END DO 
     650       
    664651      ! 
    665652      !------------------------------------------------------------------------------| 
     
    670657      DO ji = kideb, kiut 
    671658         ! 
    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 
     659         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic )  ) 
     660 
     661         ht_i_b(ji)     = ht_i_b(ji) + dh_snowice(ji) 
     662         ht_s_b(ji)     = ht_s_b(ji) - dh_snowice(ji) 
     663 
     664         ! Salinity of snow ice 
     665         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     666         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_b(ji) 
     667 
    691668         ! entrapment during snow ice formation 
    692          ! clem: new salinity difference stored (to be used in limthd_ent.F90) 
     669         ! new salinity difference stored (to be used in limthd_ent.F90) 
    693670         IF (  num_sal == 2  ) THEN 
    694             i_ice_switch = MAX( 0._wp , SIGN( 1._wp , zhgnew(ji) - epsi10 ) ) 
     671            zswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_b(ji) - epsi10 ) ) 
    695672            ! 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      
     673            dsm_i_si_1d(ji) = ( zs_snic - sm_i_b(ji) ) * dh_snowice(ji) / MAX( ht_i_b(ji), epsi10 ) * zswitch      
    697674            ! 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 
     675            IF (  zf_tt(ji)  < 0._wp ) THEN 
     676               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_b(ji) ) * dh_i_bott(ji) / MAX( ht_i_b(ji), epsi10 ) * zswitch 
    700677            ENDIF 
    701678         ENDIF 
    702679 
    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 
     680         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 
     681         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     682         zfmdt          = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp )    ! <0 
     683         zsstK          = sst_m(ii,ij) + rt0                                 
     684         zEw            = rcp * ( zsstK - rt0 ) 
     685         zQm            = zfmdt * zEw  
     686          
     687         ! Contribution to heat flux 
     688         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice  
     689 
     690         ! Contribution to salt flux 
     691         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_b(ji) * zfmdt * r1_rdtice  
     692           
     693         ! Contribution to mass flux 
     694         ! All snow is thrown in the ocean, and seawater is taken to replace the volume 
     695         wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 
     696         wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_b(ji) * dh_snowice(ji) * rhosn * r1_rdtice 
     697 
     698         ! update heat content (J.m-2) and layer thickness 
     699         qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_b(ji,1) + zfmdt * zEw 
     700         h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 
     701          
     702         ! Total ablation (to debug) 
    708703         IF( ht_i_b(ji) <= 0._wp )   a_i_b(ji) = 0._wp 
    709704 
    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  
    723705      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 
     706 
     707      ! 
     708      !------------------------------------------- 
     709      ! Update temperature, energy 
     710      !------------------------------------------- 
     711      !clem bug: we should take snow into account here 
     712      DO ji = kideb, kiut 
     713         zindh    =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_b(ji) ) )  
     714         t_su_b(ji) =  zindh * t_su_b(ji) + ( 1.0 - zindh ) * rtt 
     715      END DO  ! ji 
     716 
     717      DO jk = 1, nlay_s 
     718         DO ji = kideb,kiut 
     719            ! mask enthalpy 
     720            zinda        =  MAX(  0._wp , SIGN( 1._wp, - ht_s_b(ji) )  ) 
     721            q_s_b(ji,jk) = ( 1.0 - zinda ) * q_s_b(ji,jk) 
     722            ! recalculate t_s_b from q_s_b 
     723            t_s_b(ji,jk) = rtt + ( 1._wp - zinda ) * ( - q_s_b(ji,jk) / ( rhosn * cpic ) + lfus / cpic ) 
     724         END DO 
     725      END DO 
     726 
     727      CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 
     728      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     729      CALL wrk_dealloc( jpij, zintermelt ) 
     730      CALL wrk_dealloc( jpij, jkmax, zdeltah, zh_i ) 
     731      CALL wrk_dealloc( jpij, icount ) 
     732      ! 
    731733      ! 
    732734   END SUBROUTINE lim_thd_dh 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r4333 r4688  
    2525   USE wrk_nemo       ! work arrays 
    2626   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     27   USE cpl_oasis3, ONLY : lk_cpl 
    2728 
    2829   IMPLICIT NONE 
     
    3132   PUBLIC   lim_thd_dif   ! called by lim_thd 
    3233 
    33    REAL(wp) ::   epsi10      = 1.e-10_wp    ! 
     34   REAL(wp) ::   epsi10 = 1.e-10_wp    ! 
    3435   !!---------------------------------------------------------------------- 
    3536   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     
    3940CONTAINS 
    4041 
    41    SUBROUTINE lim_thd_dif( kideb , kiut , jl ) 
     42   SUBROUTINE lim_thd_dif( kideb , kiut ) 
    4243      !!------------------------------------------------------------------ 
    4344      !!                ***  ROUTINE lim_thd_dif  *** 
     
    9192      !!           (04-2007) Energy conservation tested by M. Vancoppenolle 
    9293      !!------------------------------------------------------------------ 
    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 
     94      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    9695 
    9796      !! * Local variables 
     
    102101      INTEGER ::   nconv       ! number of iterations in iterative procedure 
    103102      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 
     103      INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation 
     104      INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation 
     105      INTEGER, POINTER, DIMENSION(:) ::   isnow      ! switch for presence (1) or absence (0) of snow 
    107106      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
    108107      REAL(wp) ::   zg1       =  2._wp        ! 
     
    111110      REAL(wp) ::   zraext_s  =  1.e+8_wp     ! extinction coefficient of radiation in the snow 
    112111      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
     112      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered as 0°C  
    113113      REAL(wp) ::   ztmelt_i    ! ice melting temperature 
    114114      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 
     115      REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! ice melting point 
     116      REAL(wp), POINTER, DIMENSION(:) ::   ztsuold     ! old surface temperature (before the iterative procedure ) 
     117      REAL(wp), POINTER, DIMENSION(:) ::   ztsuoldit   ! 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(:) ::   zf          ! surface flux function 
     122      REAL(wp), POINTER, DIMENSION(:) ::   dzf         ! derivative of the surface flux function 
     123      REAL(wp), POINTER, DIMENSION(:) ::   zerrit      ! current error on temperature 
     124      REAL(wp), POINTER, DIMENSION(:) ::   zdifcase    ! case of the equation resolution (1->4) 
     125      REAL(wp), POINTER, DIMENSION(:) ::   zftrice     ! solar radiation transmitted through the ice 
     126      REAL(wp), POINTER, DIMENSION(:) ::   zihic, zhsu 
     127      REAL(wp), POINTER, DIMENSION(:,:) ::   ztcond_i    ! Ice thermal conductivity 
     128      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_i    ! Radiation transmitted through the ice 
     129      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_i    ! Radiation absorbed in the ice 
     130      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_i    ! Kappa factor in the ice 
     131      REAL(wp), POINTER, DIMENSION(:,:) ::   ztiold      ! Old temperature in the ice 
     132      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_i      ! Eta factor in the ice 
     133      REAL(wp), POINTER, DIMENSION(:,:) ::   ztitemp     ! Temporary temperature in the ice to check the convergence 
     134      REAL(wp), POINTER, DIMENSION(:,:) ::   zspeche_i   ! Ice specific heat 
     135      REAL(wp), POINTER, DIMENSION(:,:) ::   z_i         ! Vertical cotes of the layers in the ice 
     136      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_s    ! Radiation transmited through the snow 
     137      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_s    ! Radiation absorbed in the snow 
     138      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_s    ! Kappa factor in the snow 
     139      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_s       ! Eta factor in the snow 
     140      REAL(wp), POINTER, DIMENSION(:,:) ::   ztstemp      ! Temporary temperature in the snow to check the convergence 
     141      REAL(wp), POINTER, DIMENSION(:,:) ::   ztsold       ! Temporary temperature in the snow 
     142      REAL(wp), POINTER, DIMENSION(:,:) ::   z_s          ! Vertical cotes of the layers in the snow 
     143      REAL(wp), POINTER, DIMENSION(:,:) ::   zindterm   ! Independent term 
     144      REAL(wp), POINTER, DIMENSION(:,:) ::   zindtbis   ! temporary independent term 
     145      REAL(wp), POINTER, DIMENSION(:,:) ::   zdiagbis 
     146      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid   ! tridiagonal system terms 
     147      ! diag errors on heat 
     148      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 
     149      REAL(wp)                        :: zhfx_err 
    147150      !!------------------------------------------------------------------      
    148151      !  
     152      CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow ) 
     153      CALL wrk_alloc( jpij, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw ) 
     154      CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 
     155      CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0) 
     156      CALL wrk_alloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsold, zeta_s, ztstemp, z_s, kjstart=0) 
     157      CALL wrk_alloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis  ) 
     158      CALL wrk_alloc( jpij, jkmax+2, 3, ztrid ) 
     159 
     160      CALL wrk_alloc( jpij, zdq, zq_ini ) 
     161 
     162      ! --- diag error on heat diffusion - PART 1 --- ! 
     163      zdq(:) = 0._wp ; zq_ini(:) = 0._wp       
     164      DO ji = kideb, kiut 
     165         zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  & 
     166            &           SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) )  
     167      END DO 
     168 
    149169      !------------------------------------------------------------------------------! 
    150170      ! 1) Initialization                                                            ! 
    151171      !------------------------------------------------------------------------------! 
    152       ! 
     172      ! clem clean: replace just ztfs by rtt 
    153173      DO ji = kideb , kiut 
    154174         ! is there snow or not 
    155175         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
    156176         ! surface temperature of fusion 
    157 !!gm ???  ztfs(ji) = rtt !!!???? 
    158177         ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 
    159178         ! layer thickness 
     
    194213      ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface  
    195214      ! zftrice = io.qsr_ice       is below the surface  
    196       ! fstbif = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
     215      ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
    197216 
    198217      DO ji = kideb , kiut 
     
    253272 
    254273      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 
     274         !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 
     275         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i)  
    271276      END DO 
    272277 
     
    279284         ztsuold  (ji) =  t_su_b(ji)                              ! temperature at the beg of iter pr. 
    280285         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 
     286         t_su_b   (ji) =  MIN( t_su_b(ji), ztfs(ji) - ztsu_err )  ! necessary 
    282287         zerrit   (ji) =  1000._wp                                ! initial value of error 
    283288      END DO 
     
    403408         ! 
    404409         DO ji = kideb , kiut 
    405  
    406410            ! 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) ) 
     411            qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 
    409412 
    410413            ! update incoming flux 
    411414            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    412                + qnsr_ice_1d(ji)           ! non solar total flux  
     415               + qns_ice_1d(ji)                  ! non solar total flux  
    413416            ! (LWup, LWdw, SH, LH) 
    414  
    415417         END DO 
    416418 
     
    678680         DO layer  =  1, nlay_s 
    679681            DO ji = kideb , kiut 
    680                ii = MOD( npb(ji) - 1, jpi ) + 1 
    681                ij = ( npb(ji) - 1 ) / jpi + 1 
    682682               t_s_b(ji,layer) = MAX(  MIN( t_s_b(ji,layer), rtt ), 190._wp  ) 
    683683               zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer))) 
     
    713713      !-------------------------------------------------------------------------! 
    714714      DO ji = kideb, kiut 
    715 #if ! defined key_coupled 
    716715         ! 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 
     716         IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 
    719717         !                                ! surface ice conduction flux 
    720718         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  ) 
     
    725723      END DO 
    726724 
    727       !-------------------------! 
    728       ! Heat conservation       ! 
    729       !-------------------------! 
    730       IF( con_i .AND. jiindex_1d > 0 ) THEN 
     725      !----------------------------------------- 
     726      ! Heat flux used to warm/cool ice in W.m-2 
     727      !----------------------------------------- 
     728      DO ji = kideb, kiut 
     729         IF( t_su_b(ji) < rtt ) THEN  ! case T_su < 0degC 
     730            hfx_dif_1d(ji) = hfx_dif_1d(ji) + ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 
     731         ELSE                         ! case T_su = 0degC 
     732            hfx_dif_1d(ji) = hfx_dif_1d(ji) + ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 
     733         ENDIF 
     734      END DO 
     735 
     736      ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 
     737      CALL lim_thd_enmelt( kideb, kiut ) 
     738 
     739      ! --- diag error on heat diffusion - PART 2 --- ! 
     740      DO ji = kideb, kiut 
     741         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  & 
     742            &                              SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 
     743         zhfx_err    = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
     744         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 
     745         ! --- correction of qns_ice and surface conduction flux --- ! 
     746         qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err  
     747         fc_su     (ji) = fc_su     (ji) - zhfx_err  
     748         ! --- Heat flux at the ice surface in W.m-2 --- ! 
     749         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     750         hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 
     751      END DO 
     752    
     753      ! 
     754      CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow ) 
     755      CALL wrk_dealloc( jpij, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw ) 
     756      CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 
     757      CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 
     758      CALL wrk_dealloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsold, zeta_s, ztstemp, z_s, kjstart = 0 ) 
     759      CALL wrk_dealloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 
     760      CALL wrk_dealloc( jpij, jkmax+2, 3, ztrid ) 
     761      CALL wrk_dealloc( jpij, zdq, zq_ini ) 
     762 
     763   END SUBROUTINE lim_thd_dif 
     764 
     765   SUBROUTINE lim_thd_enmelt( kideb, kiut ) 
     766      !!----------------------------------------------------------------------- 
     767      !!                   ***  ROUTINE lim_thd_enmelt ***  
     768      !!                  
     769      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature 
     770      !! 
     771      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
     772      !!------------------------------------------------------------------- 
     773      INTEGER, INTENT(in) ::   kideb, kiut