Ignore:
Timestamp:
2015-02-17T10:06:39+01:00 (7 years ago)
Author:
timgraham
Message:

Merged head of trunk into branch in preparation for putting code back onto the trunk
In working copy ran the command:
svn merge svn+sshtimgraham@…/ipsl/forge/projets/nemo/svn/trunk

Also recompiled NEMO_book.pdf with merged input files

Location:
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3
Files:
27 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4333 r5086  
    105105   !! ** Global variables                                                 | 
    106106   !!-------------|-------------|---------------------------------|-------| 
    107    !! a_i         | a_i_b       |    Ice concentration            |       | 
     107   !! a_i         | a_i_1d      |    Ice concentration            |       | 
    108108   !! v_i         |      -      |    Ice volume per unit area     | m     | 
    109109   !! v_s         |      -      |    Snow volume per unit area    | m     | 
     
    111111   !! oa_i        !      -      !    Sea ice areal age content    | day   | 
    112112   !! e_i         !      -      !    Ice enthalpy                 | 10^9 J|  
    113    !!      -      ! q_i_b       !    Ice enthalpy per unit vol.   | J/m3  |  
     113   !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  |  
    114114   !! e_s         !      -      !    Snow enthalpy                | 10^9 J|  
    115    !!      -      ! q_s_b       !    Snow enthalpy per unit vol.  | J/m3  |  
     115   !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  |  
    116116   !!                                                                     | 
    117117   !!-------------|-------------|---------------------------------|-------| 
     
    120120   !!-------------|-------------|---------------------------------|-------| 
    121121   !!                                                                     | 
    122    !! ht_i        | ht_i_b      |    Ice thickness                | m     | 
    123    !! ht_s        ! ht_s_b      |    Snow depth                   | m     | 
    124    !! sm_i        ! sm_i_b      |    Sea ice bulk salinity        ! ppt   | 
    125    !! s_i         ! s_i_b       |    Sea ice salinity profile     ! ppt   | 
     122   !! ht_i        | ht_i_1d     |    Ice thickness                | m     | 
     123   !! ht_s        ! ht_s_1d     |    Snow depth                   | m     | 
     124   !! sm_i        ! sm_i_1d     |    Sea ice bulk salinity        ! ppt   | 
     125   !! s_i         ! s_i_1d      |    Sea ice salinity profile     ! ppt   | 
    126126   !! o_i         !      -      |    Sea ice Age                  ! days  | 
    127    !! t_i         ! t_i_b       |    Sea ice temperature          ! K     | 
    128    !! t_s         ! t_s_b       |    Snow temperature             ! K     | 
    129    !! t_su        ! t_su_b      |    Sea ice surface temperature  ! K     | 
     127   !! t_i         ! t_i_1d      |    Sea ice temperature          ! K     | 
     128   !! t_s         ! t_s_1d      |    Snow temperature             ! K     | 
     129   !! t_su        ! t_su_1d     |    Sea ice surface temperature  ! K     | 
    130130   !!                                                                     | 
    131131   !! notes: the ice model only sees a bulk (i.e., vertically averaged)   | 
     
    142142   !! ***         Category-summed state variables (diagnostic)        *** | 
    143143   !! ******************************************************************* | 
    144    !! at_i        | at_i_b      |    Total ice concentration      |       | 
     144   !! at_i        | at_i_1d     |    Total ice concentration      |       | 
    145145   !! vt_i        |      -      |    Total ice vol. per unit area | m     | 
    146146   !! vt_s        |      -      |    Total snow vol. per unit ar. | m     | 
     
    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 
    180    REAL(wp), PUBLIC ::   angvg            !: turning angle for oceanic stress 
    181172   REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79 
    182173   REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength 
    183    REAL(wp), PUBLIC ::   etamn            !: minimun value for viscosity : has to be 0 
    184174   REAL(wp), PUBLIC ::   creepl           !: creep limit : has to be under 1.0e-9 
    185175   REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve 
    186176   REAL(wp), PUBLIC ::   ahi0             !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    187    REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s) !SB 
    188    REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses !SB 
    189    REAL(wp), PUBLIC ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
    190    REAL(wp), PUBLIC ::   hminrhg = 0.001_wp    !: clem : ice volume (a*h, in m) below which ice velocity is set to ocean velocity 
     177   REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s) 
     178   REAL(wp), PUBLIC ::   relast           !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
     179   REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses  
     180   REAL(wp), PUBLIC ::   hminrhg          !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity 
    191181 
    192182   !                                     !!** ice-salinity namelist (namicesal) ** 
     
    202192 
    203193   !                                     !!** ice-salinity namelist (namicesal) ** 
    204    INTEGER , PUBLIC ::   num_sal          !: salinity configuration used in the model 
     194   INTEGER , PUBLIC ::   num_sal             !: salinity configuration used in the model 
    205195   !                                         ! 1 - constant salinity in both space and time 
    206196   !                                         ! 2 - prognostic salinity (s(z,t)) 
    207197   !                                         ! 3 - salinity profile, constant in time 
    208    INTEGER , PUBLIC ::   sal_prof    = 1           !: salinity profile or not  
    209    INTEGER , PUBLIC ::   thcon_i_swi          !: thermal conductivity: =1 Untersteiner (1964) ; =2 Pringle et al (2007) 
     198   INTEGER , PUBLIC ::   thcon_i_swi         !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
    210199 
    211200   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
     
    220209   REAL(wp), PUBLIC ::   Craft            !: coefficient for smoothness of the hyperbolic tangent in rafting 
    221210   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) 
    223211   REAL(wp), PUBLIC ::   betas            !: coef. for partitioning of snowfall between leads and sea ice 
    224212   REAL(wp), PUBLIC ::   kappa_i          !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
     
    228216   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    229217   INTEGER , PUBLIC ::   ridge_scheme_swi !: scheme used for ice ridging 
    230    INTEGER , PUBLIC ::   raftswi          !: rafting of ice or not                         
     218   INTEGER , PUBLIC ::   raft_swi         !: rafting of ice or not                         
    231219   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 
    233220   INTEGER , PUBLIC ::   brinstren_swi    !: use brine volume to diminish ice strength 
    234221 
    235222   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( ecc * ecc ) 
    236223   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cw 
    237    REAL(wp), PUBLIC ::   sangvg, cangvg   !: sin and cos of the turning angle for ocean stress 
    238    REAL(wp), PUBLIC ::   pstarh           !: pstar / 2.0 
     224 
     225   !                                     !!** switch for presence of ice or not  
     226   REAL(wp), PUBLIC ::   rswitch 
     227 
     228   !                                     !!** define some parameters  
     229   REAL(wp), PUBLIC, PARAMETER ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
     230   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number  
     231   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number  
     232   REAL(wp), PUBLIC, PARAMETER ::   epsi20   = 1.e-20_wp  !: small number  
    239233 
    240234   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce   !: surface ocean velocity used in ice dynamics 
     
    249243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i        !: Shear of the velocity field [s-1] 
    250244   ! 
    251    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   firic       !: IR flux over the ice (diag only) 
    252    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcsic       !: Sensible heat flux over the ice (diag only) 
    253    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fleic       !: Latent heat flux over the ice (diag only) 
    254    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlatic      !: latent flux 
    255    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvosif     !: Variation of volume at surface (diag only) 
    256    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvobif     !: Variation of ice volume at the bottom ice (diag only) 
    257    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdvolif     !: Total variation of ice volume (diag only) 
    258    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvonif     !: Lateral Variation of ice volume (diag only) 
    259245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist        !: Average Sea-Ice Surface Temperature [Kelvin] 
    260246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   icethi      !: total ice thickness (for all categories) (diag only) 
    261247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    262    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicifp      !: Ice production/melting==>!obsolete... can be removed 
    263248   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction 
    264249   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld       !: Leads fraction at previous time   
    265250   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif      !: Old ice thickness 
    266    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif        !: Heat flux at the ice base 
    267    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_snw     !: Variation of snow mass over 1 time step     [Kg/m2] 
    268    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_snw     !: Heat content associated with rdm_snw        [J/m2] 
    269    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_ice     !: Variation of ice mass over 1 time step      [Kg/m2] 
    270    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_ice     !: Heat content associated with rdm_ice        [J/m2] 
    271    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif       !: heat balance of the lead (or of the open ocean) 
    272    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif       !: Energy needed to bring the ocean to freezing  
    273    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdtcn       !: net downward heat flux from the ice to the ocean 
    274    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qdtcn       !: energy from the ice to the ocean 
    275    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric      !: transmitted solar radiation under ice 
    276    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fscmbq      !: associated with lead chipotage with solar flux 
    277    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif     !: related to max heat contained in brine pockets (?) 
    278    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbbq       !: Also linked with the solar flux below the ice (?) 
    279    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qfvbq       !: store energy in case of total lateral ablation (?) 
    280    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dmgwi       !: Variation of the mass of snow ice 
    281    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_thd     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
     252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur       !: net downward heat flux from the ice to the ocean 
     253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
     254 
     255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange over 1 time step [kg/m2] 
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice over 1 time step [kg/m2] 
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow sublimation over 1 time step [kg/m2] 
     258 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange over 1 time step [kg/m2] 
     260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice [kg/m2] 
     261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice [kg/m2] 
     262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice [kg/m2] 
     263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg/m2] 
     264   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice [kg/m2] 
     265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice [kg/m2] 
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2] 
     267 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_opw     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    282273   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] 
     274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_dyn     !: salt flux due to porous ridged ice formation          [PSU/m2/s] 
    284275   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 
     276 
     277   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth  
     278   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt  
     279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt  
     280   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation 
     281   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice  
     282   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt  
     283   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion  
     284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping  
     285   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations  
     286   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  
     287 
     288   ! heat flux associated with ice-atmosphere mass exchange 
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation  
     290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  
     291 
     292   ! heat flux associated with ice-ocean mass exchange 
     293   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  
     295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness 
     296 
     297   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice 
    290298 
    291299   ! 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 
     300   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, q_s 
    293301 
    294302   !!-------------------------------------------------------------------------- 
     
    321329   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i          !: mean sea ice salinity averaged over all categories [PSU] 
    322330 
    323    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   at_i_typ     !: total area   contained in each ice type [m^2] 
    324    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   vt_i_typ     !: total volume contained in each ice type [m^3] 
    325  
    326331   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s        !: Snow temperatures [K] 
    327332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s        !: Snow ...       
    328  
    329    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e_i_cat    !: ! go to trash 
    330333       
    331334   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K] 
     
    348351   !! * Old values of global variables 
    349352   !!-------------------------------------------------------------------------- 
    350    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_v_s, old_v_i               !: snow and ice volumes 
    351    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_a_i, old_smv_i, old_oa_i   !: ??? 
    352    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_s                        !: snow heat content 
    353    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_i                        !: ice temperatures 
    354    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   old_u_ice, old_v_ice           !: ice velocity (gv6 and gv7) 
     353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b               !: snow and ice volumes 
     354   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, smv_i_b, oa_i_b     !: 
     355   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content 
     356   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
     357   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
    355358       
    356359 
     
    366369   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_fl  , d_sm_i_gd                 !: 
    367370   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_se  , d_sm_i_si  , d_sm_i_la    !: 
    368    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp , s_i_newice   !: 
     371   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp                !: 
    369372 
    370373   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !: 
     
    375378   !! * Ice thickness distribution variables 
    376379   !!-------------------------------------------------------------------------- 
    377    ! REMOVE 
    378    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_types      !: Vector connecting types and categories 
    379    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ice_cat_bounds !: Matrix containing the integer upper and  
    380    !                                                                       !  lower boundaries of ice thickness categories 
    381    ! REMOVE 
    382    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_ncat_types !: nb of thickness categories in each ice type 
    383380   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    384381   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
    385    ! REMOVE 
    386    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hi_max_typ     !: Boundary of ice thickness categories in thickness space 
    387382 
    388383   !!-------------------------------------------------------------------------- 
     
    404399   LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
    405400   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 
     401   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd     !: thermodynamic growth rates  
     402   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   !: transport of ice volume 
     403   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   !: transport of snw volume 
     404   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_ei   !: transport of ice enthalpy (W/m2) 
     405   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_es   !: transport of snw enthalpy (W/m2) 
     406   ! 
     407   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2]  
     408   ! 
    417409   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    418410 
     
    430422      INTEGER :: ice_alloc 
    431423      ! 
    432       INTEGER :: ierr(20), ii 
     424      INTEGER :: ierr(19), ii 
    433425      !!----------------------------------------------------------------- 
    434426 
     
    447439 
    448440      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) ) 
     441      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,      & 
     442         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,      & 
     443         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,    & 
     444         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     & 
     445         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,  qlead  (jpi,jpj) ,     & 
     446         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl) ,      & 
     447         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,      & 
     448         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,   & 
     449         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 
     450         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,  & 
     451         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & 
     452         &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) ) 
    464453 
    465454      ! * Ice global state variables 
     
    475464         &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) ) 
    476465      ii = ii + 1 
    477       ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , at_i_typ(jpi,jpj,jpm) ,                            & 
    478          &      e_s(jpi,jpj,nlay_s,jpl) , vt_i_typ(jpi,jpj,jpm) , e_i_cat(jpi,jpj,jpl) , STAT=ierr(ii) ) 
    479       ii = ii + 1 
    480       ALLOCATE( t_i(jpi,jpj,jkmax,jpl) , e_i(jpi,jpj,jkmax,jpl) , s_i(jpi,jpj,jkmax,jpl) , STAT=ierr(ii) ) 
     466      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) ,                            & 
     467         &      e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
     468      ii = ii + 1 
     469      ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) ) 
    481470 
    482471      ! * Moments for advection 
     
    494483         &      STAT=ierr(ii) ) 
    495484      ii = ii + 1 
    496       ALLOCATE( sxe (jpi,jpj,jkmax,jpl) , sye (jpi,jpj,jkmax,jpl) , sxxe(jpi,jpj,jkmax,jpl) ,     & 
    497          &      syye(jpi,jpj,jkmax,jpl) , sxye(jpi,jpj,jkmax,jpl)                           , STAT=ierr(ii) ) 
     485      ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) ,     & 
     486         &      syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl)                           , STAT=ierr(ii) ) 
    498487 
    499488      ! * Old values of global variables 
    500489      ii = ii + 1 
    501       ALLOCATE( old_v_s  (jpi,jpj,jpl) , old_v_i  (jpi,jpj,jpl) , old_e_s(jpi,jpj,nlay_s,jpl) ,     & 
    502          &      old_a_i  (jpi,jpj,jpl) , old_smv_i(jpi,jpj,jpl) , old_e_i(jpi,jpj,jkmax ,jpl) ,     & 
    503          &      old_oa_i (jpi,jpj,jpl)                                                        ,     & 
    504          &      old_u_ice(jpi,jpj)     , old_v_ice(jpi,jpj)                                   , STAT=ierr(ii) ) 
     490      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     & 
     491         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) ,     & 
     492         &      oa_i_b (jpi,jpj,jpl)                                                        ,     & 
     493         &      u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)                                   , STAT=ierr(ii) ) 
    505494 
    506495      ! * Increment of global variables 
     
    509498         &      d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) ,   &      
    510499         &      d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se  (jpi,jpj,jpl) , d_sm_i_si  (jpi,jpj,jpl) ,   & 
    511          &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) , s_i_newice (jpi,jpj,jpl) ,   & 
     500         &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) ,   & 
    512501         &     STAT=ierr(ii) ) 
    513502      ii = ii + 1 
    514       ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,jkmax,jpl) , d_u_ice_dyn(jpi,jpj) ,     & 
    515          &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,jkmax,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 
     503      ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) ,     & 
     504         &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 
    516505       
    517506      ! * Ice thickness distribution variables 
    518507      ii = ii + 1 
    519       ALLOCATE( ice_types(jpl) , ice_cat_bounds(jpm,2) , ice_ncat_types  (jpm) ,     & 
    520          &      hi_max (0:jpl) , hi_mean(jpl)          , hi_max_typ(0:jpl,jpm) , STAT=ierr(ii) ) 
     508      ALLOCATE( hi_max(0:jpl), hi_mean(jpl),  STAT=ierr(ii) ) 
    521509 
    522510      ! * Ice diagnostics 
    523511      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) ) 
     512      ALLOCATE( dv_dt_thd(jpi,jpj,jpl),    & 
     513         &      diag_trp_vi(jpi,jpj), diag_trp_vs  (jpi,jpj), diag_trp_ei(jpi,jpj),   &  
     514         &      diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj),  STAT=ierr(ii) ) 
    528515 
    529516      ice_alloc = MAXVAL( ierr(:) ) 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90

    r4624 r5086  
    6666      ! 
    6767      !                                ! adequation jpk versus ice/snow layers/categories 
    68       IF( jpl   > jpk  .OR.  jpm    > jpk .OR.                                    & 
    69           jkmax > jpk  .OR.  nlay_s > jpk      )   CALL ctl_stop( 'STOP',         & 
     68      IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk )   & 
     69         &      CALL ctl_stop( 'STOP',                     & 
    7070         &     'ice_init: the 3rd dimension of workspace arrays is too small.',   & 
    7171         &     'use more ocean levels or less ice/snow layers/categories.' ) 
     
    8989      CALL lim_itd_ini                 ! ice thickness distribution initialization 
    9090      ! 
     91      CALL lim_itd_me_init             ! ice thickness distribution initialization 
    9192      !                                ! Initial sea-ice state 
    9293      IF( .NOT. ln_rstart ) THEN              ! start from rest 
     
    173174      !!              limistate (only) and is changed to 99 m in ice_init 
    174175      !!------------------------------------------------------------------ 
    175       INTEGER  ::   jl, jm               ! dummy loop index 
     176      INTEGER  ::   jl                   ! dummy loop index 
    176177      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars 
    177178      !!------------------------------------------------------------------ 
     
    184185      ! 1) Ice thickness distribution parameters initialization     
    185186      !------------------------------------------------------------------------------! 
    186  
    187       !- Types boundaries (integer) 
    188       !---------------------------- 
    189       ice_cat_bounds(1,1) = 1 
    190       ice_cat_bounds(1,2) = jpl 
    191  
    192       !- Number of ice thickness categories in each ice type 
    193       DO jm = 1, jpm 
    194          ice_ncat_types(jm) = ice_cat_bounds(jm,2) - ice_cat_bounds(jm,1) + 1  
    195       END DO 
    196  
    197       !- Make the correspondence between thickness categories and ice types 
    198       !--------------------------------------------------------------------- 
    199       DO jm = 1, jpm       !over types 
    200          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) !over thickness categories 
    201             ice_types(jl) = jm 
    202          END DO 
    203       END DO 
    204  
    205187      IF(lwp) THEN   
    206          WRITE(numout,*) ' Number of ice types jpm =      ', jpm 
    207188         WRITE(numout,*) ' Number of ice categories jpl = ', jpl 
    208          DO jm = 1, jpm 
    209             WRITE(numout,*) ' Ice type ', jm 
    210             WRITE(numout,*) ' Number of thickness categories ', ice_ncat_types(jm) 
    211             WRITE(numout,*) ' Thickness category boundaries  ', ice_cat_bounds(jm,1:2) 
    212          END DO 
    213          WRITE(numout,*) 'Ice type vector', ice_types(1:jpl) 
    214          WRITE(numout,*) 
    215189      ENDIF 
    216190 
     
    218192      !---------------------------------- 
    219193      hi_max(:) = 0._wp 
    220       hi_max_typ(:,:) = 0._wp 
    221  
    222       !- Type 1 - undeformed ice 
    223       zc1 =  3._wp / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp ) 
     194 
     195      zc1 =  3._wp / REAL( jpl, wp ) 
    224196      zc2 = 10._wp * zc1 
    225197      zc3 =  3._wp 
    226198 
    227       DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
    228          zx1 = REAL( jl-1 , wp ) / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp ) 
     199      DO jl = 1, jpl 
     200         zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 
    229201         hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 
    230202      END DO 
    231203 
    232       !- Fill in the hi_max_typ vector, useful in other circumstances 
    233       ! Tricky trick: hi_max_typ is actually not used in the code and will be removed in a 
    234       ! next flyspray at this time, the tricky trick will also be removed (Martin, march 08) 
    235       DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
    236          hi_max_typ(jl,1) = hi_max(jl) 
    237       END DO 
    238  
    239       IF(lwp) WRITE(numout,*) ' Thickness category boundaries independently of ice type ' 
     204      IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 
    240205      IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 
    241206 
    242       IF(lwp) WRITE(numout,*) ' Thickness category boundaries inside ice types ' 
    243       IF(lwp) THEN  
    244          DO jm = 1, jpm 
    245             WRITE(numout,*) ' Type number ', jm 
    246             WRITE(numout,*) ' hi_max_typ : ', hi_max_typ(0:ice_ncat_types(jm),jm) 
    247          END DO 
    248       ENDIF 
    249207      ! 
    250208      DO jl = 1, jpl 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r4161 r5086  
    3030   PUBLIC   lim_adv_x   ! called by lim_trp 
    3131   PUBLIC   lim_adv_y   ! called by lim_trp 
    32  
    33    REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values 
    34    REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    35    REAL(wp)  ::   rone   = 1._wp       !    -       - 
    3632 
    3733   !! * Substitutions 
     
    8480      DO jj = 1, jpj 
    8581         DO ji = 1, jpi 
    86             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     82            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    8783            zs1max  = 1.5 * zslpmax 
    8884            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 
    8985            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    9086               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    91             zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     87            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    9288 
    9389            ps0 (ji,jj) = zslpmax   
     
    106102      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0  
    107103         DO ji = 1, jpi 
    108             zbet(ji,jj)  =  MAX( rzero, SIGN( rone, put(ji,jj) ) ) 
    109             zalf         =  MAX( rzero, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
     104            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
     105            zalf         =  MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
    110106            zalfq        =  zalf * zalf 
    111107            zalf1        =  1.0 - zalf 
     
    133129      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0. 
    134130         DO ji = 1, fs_jpim1 
    135             zalf          = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
     131            zalf          = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
    136132            zalg  (ji,jj) = zalf 
    137133            zalfq         = zalf * zalf 
     
    269265      DO jj = 1, jpj 
    270266         DO ji = 1, jpi 
    271             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     267            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    272268            zs1max  = 1.5 * zslpmax 
    273269            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 
    274270            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    275271               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    276             zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     272            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    277273            ! 
    278274            ps0 (ji,jj) = zslpmax   
     
    291287      DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0    
    292288         DO ji = 1, jpi 
    293             zbet(ji,jj)  =  MAX( rzero, SIGN( rone, pvt(ji,jj) ) ) 
    294             zalf         =  MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
     289            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
     290            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
    295291            zalfq        =  zalf * zalf 
    296292            zalf1        =  1.0 - zalf 
     
    318314      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    319315         DO ji = 1, jpi 
    320             zalf          = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
     316            zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
    321317            zalg  (ji,jj) = zalf 
    322318            zalfq         = zalf * zalf 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r4161 r5086  
    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   !!---------------------------------------------------------------------- 
     
    7073      !! ** Method  : Arithmetics 
    7174      !!--------------------------------------------------------------------- 
    72       INTEGER                               , INTENT(in   ) ::   ksum   !: number of categories 
    73       INTEGER                               , INTENT(in   ) ::   klay   !: number of vertical layers 
    74       REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl), INTENT(in   ) ::   pin   !: input field 
    75       REAL(wp), DIMENSION(jpi,jpj)          , INTENT(  out) ::   pout   !: output field 
     75      INTEGER                                  , INTENT(in   ) ::   ksum   !: number of categories 
     76      INTEGER                                  , INTENT(in   ) ::   klay   !: number of vertical layers 
     77      REAL(wp), DIMENSION(jpi,jpj,nlay_i+1,jpl), INTENT(in   ) ::   pin   !: input field 
     78      REAL(wp), DIMENSION(jpi,jpj)             , INTENT(  out) ::   pout   !: output field 
    7679      ! 
    7780      INTEGER ::   jk, jl   ! dummy loop indices 
     
    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(:,:)    & 
     178            &             ) * area(:,:) * tms(:,:) ) 
     179         zfs_b  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     180            &                   sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
     181            &                 ) * area(:,:) * tms(:,:) ) 
     182         zft_b  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     183            &                 - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
     184            &                  ) * area(:,:) / unit_fac * tms(:,:) ) 
     185 
     186      ELSEIF( icount == 1 ) THEN 
     187 
     188         zfs  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     189            &                 sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &  
     190            &                ) * area(:,:) * tms(:,:) ) - zfs_b 
     191         zfw  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
     192            &                 wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     193            &                ) * area(:,:) * tms(:,:) ) - zfw_b 
     194         zft  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     195            &               - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
     196            &                ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b 
     197  
     198         zvi  = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw  
     199         zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zsmv_b ) * r1_rdtice + ( zfs / rhoic ) 
     200         zei  =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zei_b * r1_rdtice + zft 
     201 
     202         zvmin = glob_min(v_i) 
     203         zamax = glob_max(SUM(a_i,dim=3)) 
     204         zamin = glob_min(a_i) 
     205        
     206         IF(lwp) THEN 
     207            IF ( ABS( zvi    ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (',cd_routine,') = ',(zvi * rday) 
     208            IF ( ABS( zsmv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday) 
     209            IF ( ABS( zei    ) >  1.    ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (',cd_routine,') = ',(zei) 
     210            IF ( zvmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin) 
     211            IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN 
     212                                          WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     213            ENDIF 
     214            IF ( zamin <  0.            ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
     215         ENDIF 
     216 
     217      ENDIF 
     218 
     219   END SUBROUTINE lim_cons_hsm 
     220 
    153221#else 
    154222   !!---------------------------------------------------------------------- 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r4346 r5086  
    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 
     
    3435   !!PUBLIC   lim_diahsb_rst   ! routine called by ice_init.F90 
    3536 
    36    REAL(dp) ::   frc_sal, frc_vol   ! global forcing trends 
    37    REAL(dp) ::   bg_grme            ! global ice growth+melt trends 
    38    REAL(wp) ::   epsi06 = 1.e-6_wp  ! small number 
    39    REAL(wp) ::   epsi03 = 1.e-3_wp  ! small number 
    40  
     37   real(wp) ::   frc_sal, frc_vol   ! global forcing trends 
     38   real(wp) ::   bg_grme            ! global ice growth+melt trends 
    4139 
    4240   !! * Substitutions 
     
    5957      !!--------------------------------------------------------------------------- 
    6058      !! 
    61       REAL(dp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
    62       REAL(dp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_thd, zbg_sfx_res, zbg_sfx_mec  
    63       REAL(dp)   ::   zbg_emp, zbg_emp_bog, zbg_emp_lag, zbg_emp_sig, zbg_emp_dyg, zbg_emp_bom, zbg_emp_sum, zbg_emp_res  
    64       REAL(dp)   ::   z_frc_vol, z_frc_sal, z_bg_grme  
    65       REAL(dp)   ::   z1_area                     !    -     - 
    66       REAL(dp)   ::   zinda, zindb 
     59      real(wp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
     60      real(wp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni,   & 
     61      &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn  
     62      real(wp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 
     63      real(wp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub   
     64      real(wp)   ::   zbg_hfx_dhc, zbg_hfx_spr 
     65      real(wp)   ::   zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in    
     66      real(wp)   ::   zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 
     67      real(wp)   ::   z_frc_vol, z_frc_sal, z_bg_grme  
     68      real(wp)   ::   z1_area                     !    -     - 
     69      REAL(wp)   ::   ztmp 
    6770      !!--------------------------------------------------------------------------- 
    6871      IF( nn_timing == 1 )   CALL timing_start('lim_diahsb') 
     
    7174 
    7275      ! 1/area 
    73       z1_area = 1.d0 / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
    74  
    75       zinda = MAX( 0.d0 , SIGN( 1.d0 , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 
     76      z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
     77 
     78      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 
    7679      ! ----------------------- ! 
    7780      ! 1 -  Content variations ! 
     
    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  
    100       zbg_sfx     = zinda * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    101       zbg_sfx_bri = zinda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    102       zbg_sfx_thd = zinda * glob_sum( sfx_thd(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    103       zbg_sfx_res = zinda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    104       zbg_sfx_mec = zinda * glob_sum( sfx_mec(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    105        
     91      ! Volume 
     92      ztmp = rswitch * z1_area * r1_rau0 * rday 
     93      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * area(:,:) * tms(:,:) ) 
     94      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) 
     95      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) 
     96      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) 
     97      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) 
     98      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) 
     99      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) 
     100      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) 
     101      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) 
     102      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) 
     103      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) 
     104 
     105      ! Salt 
     106      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) 
     107      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) 
     108      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) 
     109      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) 
     110 
     111      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) 
     112      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) 
     113      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) 
     114      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) 
     115      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) 
     116 
     117      ! Heat budget 
     118      zbg_ihc      = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content  [1.e-20 J] 
     119      zbg_shc      = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J] 
     120      zbg_hfx_dhc  = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     121      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     122 
     123      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     124      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     125      zbg_hfx_res  = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     126      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     127      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     128      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     129      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     130      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     131      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     132      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     133      zbg_hfx_out  = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     134      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     135     
    106136      ! --------------------------------------------- ! 
    107137      ! 2 - Trends due to forcing and ice growth/melt ! 
     
    109139      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 
    110140      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 
     141      z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
     142                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 
    113143      ! 
    114144      frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
     
    123153      ! 3 - Diagnostics writing ! 
    124154      ! ----------------------- ! 
    125       zindb = MAX( 0.d0 , SIGN( 1.d0 , zbg_ivo - epsi06 ) ) 
    126       ! 
     155      rswitch = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 
     156      ! 
     157      IF( iom_use('ibgvoltot') )   & 
    127158      CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9        )   ! ice volume (km3 equivalent liquid)          
     159      IF( iom_use('sbgvoltot') )   & 
    128160      CALL iom_put( 'sbgvoltot' , zbg_svo * rhosn * r1_rau0 * 1.e-9        )   ! snw volume (km3 equivalent liquid)        
     161      IF( iom_use('ibgarea') )   & 
    129162      CALL iom_put( 'ibgarea'   , zbg_are * 1.e-6                          )   ! ice area   (km2) 
    130       CALL iom_put( 'ibgsaline' , zindb * zbg_sal / MAX( zbg_ivo, epsi06 ) )   ! ice saline (psu) 
    131       CALL iom_put( 'ibgtemper' , zindb * zbg_tem / MAX( zbg_ivo, epsi06 ) )   ! ice temper (C) 
     163      IF( iom_use('ibgsaline') )   & 
     164      CALL iom_put( 'ibgsaline' , rswitch * zbg_sal / MAX( zbg_ivo, epsi06 ) )   ! ice saline (psu) 
     165      IF( iom_use('ibgtemper') )   & 
     166      CALL iom_put( 'ibgtemper' , rswitch * zbg_tem / MAX( zbg_ivo, epsi06 ) )   ! ice temper (C) 
    132167      CALL iom_put( 'ibgheatco' , zbg_ihc                                  )   ! ice heat content (1.e20 J)         
    133168      CALL iom_put( 'sbgheatco' , zbg_shc                                  )   ! snw heat content (1.e20 J) 
     169      IF( iom_use('ibgsaltco') )   & 
    134170      CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9        )   ! ice salt content (psu*km3 equivalent liquid)         
    135171 
    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         - 
     172      CALL iom_put( 'ibgvfx'    , zbg_vfx                                  )   ! volume flux emp (m/day liquid) 
     173      CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog                              )   ! volume flux bottom growth     -(m/day equivalent liquid) 
     174      CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw                              )   ! volume flux open water growth - 
     175      CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni                              )   ! volume flux snow ice growth   - 
     176      CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn                              )   ! volume flux dynamic growth    - 
     177      CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom                              )   ! volume flux bottom melt       - 
     178      CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum                              )   ! volume flux surface melt      - 
     179      CALL iom_put( 'ibgvfxres' , zbg_vfx_res                              )   ! volume flux resultant         - 
     180      CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr                              )   ! volume flux from snow precip         - 
     181      CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw                              )   ! volume flux from snow melt         - 
     182      CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub                              )   ! volume flux from sublimation         - 
    144183           
    145184      CALL iom_put( 'ibgsfx'    , zbg_sfx                                  )   ! salt flux         -(psu*m/day equivalent liquid)        
    146185      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 -     
     186      CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn                              )   ! salt flux dynamic -     
    149187      CALL iom_put( 'ibgsfxres' , zbg_sfx_res                              )   ! salt flux result  -     
     188      CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog                              )   ! salt flux bottom growth    
     189      CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw                              )   ! salt flux open water growth - 
     190      CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni                              )   ! salt flux snow ice growth   - 
     191      CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom                              )   ! salt flux bottom melt       - 
     192      CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum                              )   ! salt flux surface melt      - 
     193 
     194      CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc                              )   ! Heat content variation in snow and ice [W] 
     195      CALL iom_put( 'ibghfxspr' , zbg_hfx_spr                              )   ! Heat content of snow precip [W] 
     196 
     197      CALL iom_put( 'ibghfxres' , zbg_hfx_res                              )   !  
     198      CALL iom_put( 'ibghfxsub' , zbg_hfx_sub                              )   !  
     199      CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn                              )   !  
     200      CALL iom_put( 'ibghfxthd' , zbg_hfx_thd                              )   !  
     201      CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw                              )   !  
     202      CALL iom_put( 'ibghfxsum' , zbg_hfx_sum                              )   !  
     203      CALL iom_put( 'ibghfxbom' , zbg_hfx_bom                              )   !  
     204      CALL iom_put( 'ibghfxbog' , zbg_hfx_bog                              )   !  
     205      CALL iom_put( 'ibghfxdif' , zbg_hfx_dif                              )   !  
     206      CALL iom_put( 'ibghfxopw' , zbg_hfx_opw                              )   !  
     207      CALL iom_put( 'ibghfxout' , zbg_hfx_out                              )   !  
     208      CALL iom_put( 'ibghfxin'  , zbg_hfx_in                               )   !  
    150209 
    151210      CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9                          )   ! vol - forcing     (km3 equivalent liquid)  
    152211      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)          
     212      IF( iom_use('ibgvolgrm') )   & 
     213      CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9                )   ! vol growth + melt (km3 equivalent liquid)          
     214 
    154215      ! 
    155216      IF( lrst_ice )   CALL lim_diahsb_rst( numit, 'WRITE' ) 
     
    190251      ! 2 - initial conservation variables ! 
    191252      ! ---------------------------------- ! 
    192       !frc_vol = 0.d0                                           ! volume       trend due to forcing 
    193       !frc_sal = 0.d0                                           ! salt content   -    -   -    -          
    194       !bg_grme = 0.d0                                           ! ice growth + melt volume trend 
     253      !frc_vol = 0._wp                                          ! volume       trend due to forcing 
     254      !frc_sal = 0._wp                                          ! salt content   -    -   -    -          
     255      !bg_grme = 0._wp                                          ! ice growth + melt volume trend 
    195256      ! 
    196257      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files 
     
    226287           IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' 
    227288           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    228            frc_vol  = 0.d0                                            
    229            frc_sal  = 0.d0                                                   
    230            bg_grme  = 0.d0                                         
    231        ENDIF    
     289           frc_vol  = 0._wp                                           
     290           frc_sal  = 0._wp                                                  
     291           bg_grme  = 0._wp                                        
     292       ENDIF 
    232293 
    233294     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4624 r5086  
    3030   USE lib_fortran      ! glob_sum 
    3131   USE timing          ! Timing 
     32   USE limcons        ! conservation tests 
    3233 
    3334   IMPLICIT NONE 
     
    6364      INTEGER  ::   i_j1, i_jpj       ! Starting/ending j-indices for rheology 
    6465      REAL(wp) ::   zcoef             ! local scalar 
    65       REAL(wp), POINTER, DIMENSION(:)   ::   zind           ! i-averaged indicator of sea-ice 
     66      REAL(wp), POINTER, DIMENSION(:)   ::   zswitch        ! i-averaged indicator of sea-ice 
    6667      REAL(wp), POINTER, DIMENSION(:)   ::   zmsk           ! i-averaged of tmask 
    6768      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io   ! ice-ocean velocity 
    68       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    69       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     69      ! 
     70      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7071     !!--------------------------------------------------------------------- 
    7172 
     
    7374 
    7475      CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 
    75       CALL wrk_alloc( jpj, zind, zmsk ) 
    76  
    77       ! ------------------------------- 
    78       !- check conservation (C Rousset) 
    79       IF (ln_limdiahsb) THEN 
    80          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    81          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    82          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    83          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    84       ENDIF 
    85       !- check conservation (C Rousset) 
    86       ! ------------------------------- 
     76      CALL wrk_alloc( jpj, zswitch, zmsk ) 
    8777 
    8878      IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
     
    9080      IF( ln_limdyn ) THEN 
    9181         ! 
    92          old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 
    93          old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
     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 
     85         u_ice_b(:,:) = u_ice(:,:) * tmu(:,:) 
     86         v_ice_b(:,:) = v_ice(:,:) * tmv(:,:) 
    9487 
    9588         ! Rheology (ice dynamics) 
     
    107100            ! 
    108101            DO jj = 1, jpj 
    109                zind(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line 
     102               zswitch(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line 
    110103               zmsk(jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line 
    111104            END DO 
     
    117110               i_j1  = njeq 
    118111               i_jpj = jpj 
    119                DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
     112               DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
    120113                  i_j1 = i_j1 + 1 
    121114               END DO 
     
    127120               i_j1  =  1 
    128121               i_jpj = njeq 
    129                DO WHILE ( i_jpj >= 1 .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
     122               DO WHILE ( i_jpj >= 1 .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
    130123                  i_jpj = i_jpj - 1 
    131124               END DO 
     
    139132               !                                 ! latitude strip 
    140133               i_j1  = 1 
    141                DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
     134               DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
    142135                  i_j1 = i_j1 + 1 
    143136               END DO 
     
    145138 
    146139               i_jpj  = jpj 
    147                DO WHILE ( i_jpj >= 1  .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
     140               DO WHILE ( i_jpj >= 1  .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
    148141                  i_jpj = i_jpj - 1 
    149142               END DO 
     
    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 ) 
    251       CALL wrk_dealloc( jpj, zind, zmsk ) 
     223      CALL wrk_dealloc( jpj, zswitch, zmsk ) 
    252224      ! 
    253225      IF( nn_timing == 1 )  CALL timing_stop('limdyn') 
     
    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, & 
    274          &                nevp, telast, alphaevp, hminrhg 
     243      NAMELIST/namicedyn/ epsd, om, cw, pstar,   & 
     244         &                c_rhg, creepl, ecc, ahi0,     & 
     245         &                nevp, relast, alphaevp, hminrhg 
    275246      !!------------------------------------------------------------------- 
    276247 
     
    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 
    298          WRITE(numout,*) '   turning angle for oceanic stress                 angvg  = ', angvg 
    299264         WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar 
    300265         WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg 
    301          WRITE(numout,*) '   minimun value for viscosity                      etamn  = ', etamn 
    302266         WRITE(numout,*) '   creep limit                                      creepl = ', creepl 
    303267         WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc 
    304268         WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
    305269         WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp 
    306          WRITE(numout,*) '   timescale for elastic waves                      telast = ', telast 
     270         WRITE(numout,*) '   ratio of elastic timescale over ice time step    relast = ', relast 
    307271         WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp 
    308272         WRITE(numout,*) '   min ice thickness for rheology calculations     hminrhg = ', hminrhg 
    309273      ENDIF 
    310274      ! 
    311       IF( angvg /= 0._wp ) THEN 
    312          CALL ctl_warn( 'lim_dyn_init: turning angle for oceanic stress not properly coded for EVP ',   & 
    313             &           '(see limsbc module). We force  angvg = 0._wp'  ) 
    314          angvg = 0._wp 
    315       ENDIF 
    316        
    317275      usecc2 = 1._wp / ( ecc * ecc ) 
    318276      rhoco  = rau0  * cw 
    319       angvg  = angvg * rad 
    320       sangvg = SIN( angvg ) 
    321       cangvg = COS( angvg ) 
    322       pstarh = pstar * 0.5_wp 
     277 
     278      ! elastic damping 
     279      telast = relast * rdt_ice 
    323280 
    324281      !  Diffusion coefficients. 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r4333 r5086  
    8383      zdiv0(:, 1 ) = 0._wp 
    8484      zdiv0(:,jpj) = 0._wp 
    85       IF( .NOT.lk_vopt_loop ) THEN 
    86          zflu (jpi,:) = 0._wp    
    87          zflv (jpi,:) = 0._wp 
    88          zdiv0(1,  :) = 0._wp 
    89          zdiv0(jpi,:) = 0._wp 
    90       ENDIF 
     85      zflu (jpi,:) = 0._wp    
     86      zflv (jpi,:) = 0._wp 
     87      zdiv0(1,  :) = 0._wp 
     88      zdiv0(jpi,:) = 0._wp 
    9189 
    9290      zconv = 1._wp           !==  horizontal diffusion using a Crant-Nicholson scheme  ==! 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4624 r5086  
    66   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code 
    77   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
    8    !!             -   ! 2012    (C. Rousset) add par_oce (for jp_sal)...bug? 
     8   !!             -   ! 2014    (C. Rousset) add N/S initializations 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_lim3 
     
    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)   
     
    3635   PUBLIC   lim_istate      ! routine called by lim_init.F90 
    3736 
    38    !! * Module variables 
    3937   !                          !!** 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  
     38   REAL(wp) ::   thres_sst   ! threshold water temperature for initial sea ice 
     39   REAL(wp) ::   hts_ini_n   ! initial snow thickness in the north 
     40   REAL(wp) ::   hts_ini_s   ! initial snow thickness in the south 
     41   REAL(wp) ::   hti_ini_n   ! initial ice thickness in the north 
     42   REAL(wp) ::   hti_ini_s   ! initial ice thickness in the south 
     43   REAL(wp) ::   ati_ini_n   ! initial leads area in the north 
     44   REAL(wp) ::   ati_ini_s   ! initial leads area in the south 
     45   REAL(wp) ::   smi_ini_n   ! initial salinity  
     46   REAL(wp) ::   smi_ini_s   ! initial salinity 
     47   REAL(wp) ::   tmi_ini_n   ! initial temperature 
     48   REAL(wp) ::   tmi_ini_s   ! initial temperature 
     49 
     50   LOGICAL  ::  ln_limini    ! initialization or not 
    5051   !!---------------------------------------------------------------------- 
    5152   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
     
    5354   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5455   !!---------------------------------------------------------------------- 
    55  
    5656CONTAINS 
    5757 
     
    7777      !! 
    7878      !! ** Notes   : o_i, t_su, t_s, t_i, s_i must be filled everywhere, even 
    79       !!              where there is no ice (clem: I do not know why but it is mandatory)  
     79      !!              where there is no ice (clem: I do not know why, is it mandatory?)  
    8080      !! 
    8181      !! History : 
     
    9090      INTEGER    :: i_hemis, i_fill, jl0   
    9191      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 
     92      REAL(wp), POINTER, DIMENSION(:)     :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini 
     93      REAL(wp), POINTER, DIMENSION(:,:)   :: zh_i_ini, za_i_ini, zv_i_ini 
     94      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator 
    9595      INTEGER,  POINTER, DIMENSION(:,:)   :: zhemis   ! hemispheric index 
    9696      !-------------------------------------------------------------------- 
    9797 
    98       CALL wrk_alloc( jpi, jpj, zidto ) 
     98      CALL wrk_alloc( jpi, jpj, zswitch ) 
    9999      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 
     100      CALL wrk_alloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     101      CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
     102 
     103      epsi20   = 1.e-20_wp 
     104 
    104105      IF(lwp) WRITE(numout,*) 
    105106      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
     
    112113      CALL lim_istate_init     !  reading the initials parameters of the ice 
    113114 
    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... 
     115      ! surface temperature 
     116      DO jl = 1, jpl ! loop over categories 
     117         t_su  (:,:,jl) = rtt * tms(:,:) 
     118         tn_ice(:,:,jl) = rtt * tms(:,:) 
     119      END DO 
     120 
     121      ! basal temperature (considered at freezing point) 
     122      t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:)  
     123 
     124      IF( ln_limini ) THEN 
    117125 
    118126      !-------------------------------------------------------------------- 
    119127      ! 2) Basal temperature, ice mask and hemispheric index 
    120128      !-------------------------------------------------------------------- 
    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] 
    124129 
    125130      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    126131         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 
     132            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN  
     133               zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice 
     134            ELSE                                                                                    
     135               zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice 
    129136            ENDIF 
    130137         END DO 
    131138      END DO 
    132139 
    133       t_bo(:,:) = t_bo(:,:) + rt0                          ! conversion to Kelvin 
    134140 
    135141      ! Hemispheric index 
    136       ! MV 2011 new initialization 
    137142      DO jj = 1, jpj 
    138143         DO ji = 1, jpi 
     
    144149         END DO 
    145150      END DO 
    146       ! END MV 2011 new initialization 
    147151 
    148152      !-------------------------------------------------------------------- 
     
    153157      ! 3.1) Hemisphere-dependent arrays 
    154158      !----------------------------- 
    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 
     159      ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
     160      zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s  ! ice thickness 
     161      zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s  ! snow depth 
     162      zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s  ! ice concentration 
     163      zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s  ! bulk ice salinity 
     164      ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s  ! temperature (ice and snow) 
     165 
     166      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume 
    162167 
    163168      !--------------------------------------------------------------------- 
     
    183188            ! *** 1 category to fill 
    184189            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 
     190               zh_i_ini(1,i_hemis)       = zht_i_ini(i_hemis) 
     191               za_i_ini(1,i_hemis)       = zat_i_ini(i_hemis) 
     192               zh_i_ini(2:jpl,i_hemis)   = 0._wp 
     193               za_i_ini(2:jpl,i_hemis)   = 0._wp 
    189194            ELSE 
    190195 
    191             ! *** >1 categores to fill 
    192             !--- Ice thicknesses in the i_fill - 1 first categories 
     196               ! *** >1 categores to fill 
     197               !--- Ice thicknesses in the i_fill - 1 first categories 
    193198               DO jl = 1, i_fill - 1 
    194                   zht_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
     199                  zh_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
    195200               END DO 
    196  
    197             !--- jl0: most likely index where cc will be maximum 
     201                
     202               !--- jl0: most likely index where cc will be maximum 
    198203               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 
     204                  IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
     205                     ( zht_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
    201206                     jl0 = jl 
    202207                  ENDIF 
    203208               END DO 
    204209               jl0 = MIN(jl0, i_fill) 
    205  
    206             !--- Concentrations 
     210                
     211               !--- Concentrations 
    207212               za_i_ini(jl0,i_hemis)      = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 
    208213               DO jl = 1, i_fill - 1 
    209214                  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 
     215                     zsigma               = 0.5 * zht_i_ini(i_hemis) 
     216                     zarg                 = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma 
    212217                     za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 
    213218                  ENDIF 
    214                END DO  
    215  
     219               END DO 
     220                
    216221               zA = 0. ! sum of the areas in the jpl categories  
    217222               DO jl = 1, i_fill - 1 
     
    221226               IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    222227          
    223             !--- Ice thickness in the last category 
     228               !--- Ice thickness in the last category 
    224229               zV = 0. ! sum of the volumes of the N-1 categories 
    225230               DO jl = 1, i_fill - 1 
    226                   zV = zV + za_i_ini(jl,i_hemis)*zht_i_ini(jl,i_hemis) 
     231                  zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis) 
    227232               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) 
     233               zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
     234               IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
     235 
     236               !--- volumes 
     237               zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis) 
    233238               IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    234239 
     
    262267 
    263268            ! 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 
     269            IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
    265270               ztest_3 = 1 
    266271            ELSE 
    267272               ! 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) 
     273               IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 
     274               zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
    270275               ztest_3 = 0 
    271276            ENDIF 
     
    288293 
    289294      IF(lwp) THEN  
    290          WRITE(numout,*), ' ztests : ', ztests 
     295         WRITE(numout,*) ' ztests : ', ztests 
    291296         IF ( ztests .NE. 4 ) THEN 
    292297            WRITE(numout,*) 
    293             WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
    294             WRITE(numout,*), ' !!!! RED ALERT                  !!! ' 
    295             WRITE(numout,*), ' !!!! BIIIIP BIIIP BIIIIP BIIIIP !!!' 
    296             WRITE(numout,*), ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    297             WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
     298            WRITE(numout,*) ' !!!! ALERT                  !!! ' 
     299            WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    298300            WRITE(numout,*) 
    299             WRITE(numout,*), ' *** ztests is not equal to 4 ' 
    300             WRITE(numout,*), ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    301             WRITE(numout,*), ' zat_i_ini : ', zat_i_ini(i_hemis) 
    302             WRITE(numout,*), ' zhm_i_ini : ', zhm_i_ini(i_hemis) 
     301            WRITE(numout,*) ' *** ztests is not equal to 4 ' 
     302            WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
     303            WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(i_hemis) 
     304            WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(i_hemis) 
    303305         ENDIF ! ztests .NE. 4 
    304306      ENDIF 
     
    314316         DO jj = 1, jpj 
    315317            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 
     318               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
     319               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
     320               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth 
     321               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity 
     322               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 
     323               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp 
    322324 
    323325               ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
     
    343345            DO jj = 1, jpj 
    344346               DO ji = 1, jpi 
    345                    t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * rtt 
     347                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 
    346348                   ! Snow energy of melting 
    347                    e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
     349                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    348350                   ! Change dimensions 
    349351                   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 
     352                   ! Multiply by volume, so that heat content in Joules 
    351353                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
    352354               END DO ! ji 
     
    360362            DO jj = 1, jpj 
    361363               DO ji = 1, jpi 
    362                    t_i(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1._wp - zidto(ji,jj) ) * rtt  
    363                    s_i(ji,jj,jk,jl) = zidto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min 
     364                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt  
     365                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min 
    364366                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    365367 
    366368                   ! heat content per unit volume 
    367                    e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     369                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    368370                      +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
    369371                      -   rcp     * ( ztmelts - rtt ) ) 
     
    372374                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    373375 
    374                    ! Mutliply by ice volume, and divide by number of layers  
    375                    ! to get heat content in 10^9 J 
     376                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J 
    376377                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 
    377378               END DO ! ji 
     
    380381      END DO ! jk 
    381382 
     383      tn_ice (:,:,:) = t_su (:,:,:) 
     384 
     385      ELSE  
     386         ! if ln_limini=false 
     387         a_i  (:,:,:) = 0._wp 
     388         v_i  (:,:,:) = 0._wp 
     389         v_s  (:,:,:) = 0._wp 
     390         smv_i(:,:,:) = 0._wp 
     391         oa_i (:,:,:) = 0._wp 
     392         ht_i (:,:,:) = 0._wp 
     393         ht_s (:,:,:) = 0._wp 
     394         sm_i (:,:,:) = 0._wp 
     395         o_i  (:,:,:) = 0._wp 
     396 
     397         e_i(:,:,:,:) = 0._wp 
     398         e_s(:,:,:,:) = 0._wp 
     399 
     400         DO jl = 1, jpl 
     401            DO jk = 1, nlay_i 
     402               t_i(:,:,jk,jl) = rtt * tms(:,:) 
     403            END DO 
     404            DO jk = 1, nlay_s 
     405               t_s(:,:,jk,jl) = rtt * tms(:,:) 
     406            END DO 
     407         END DO 
     408       
     409      ENDIF ! ln_limini 
     410       
     411      at_i (:,:) = 0.0_wp 
     412      DO jl = 1, jpl 
     413         at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
     414      END DO 
     415      ! 
    382416      !-------------------------------------------------------------------- 
    383417      ! 4) Global ice variables for output diagnostics                    |  
    384418      !-------------------------------------------------------------------- 
    385       fsbbq (:,:)     = 0._wp 
    386419      u_ice (:,:)     = 0._wp 
    387420      v_ice (:,:)     = 0._wp 
     
    390423      stress12_i(:,:) = 0._wp 
    391424 
    392 # if defined key_coupled 
    393       albege(:,:)   = 0.8 * tms(:,:) 
    394 # endif 
    395  
    396425      !-------------------------------------------------------------------- 
    397426      ! 5) Moments for advection 
     
    428457      sxyage (:,:,:)  = 0._wp 
    429458 
    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 ) 
     459 
     460      CALL wrk_dealloc( jpi, jpj, zswitch ) 
    475461      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 ) 
     462      CALL wrk_dealloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     463      CALL wrk_dealloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    478464 
    479465   END SUBROUTINE lim_istate 
     
    495481      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    496482      !!----------------------------------------------------------------------------- 
    497       NAMELIST/namiceini/ ttest, hninn, hnins, hginn, hgins, aginn, agins, sinn, sins 
    498       ! 
     483      NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s,  & 
     484         &                                      ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s 
    499485      INTEGER :: ios                 ! Local integer output status for namelist read 
    500486      !!----------------------------------------------------------------------------- 
     
    516502         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    517503         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 
     504         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini   = ', ln_limini 
     505         WRITE(numout,*) '   threshold water temp. for initial sea-ice    thres_sst  = ', thres_sst 
     506         WRITE(numout,*) '   initial snow thickness in the north          hts_ini_n  = ', hts_ini_n 
     507         WRITE(numout,*) '   initial snow thickness in the south          hts_ini_s  = ', hts_ini_s  
     508         WRITE(numout,*) '   initial ice thickness  in the north          hti_ini_n  = ', hti_ini_n 
     509         WRITE(numout,*) '   initial ice thickness  in the south          hti_ini_s  = ', hti_ini_s 
     510         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_n  = ', ati_ini_n 
     511         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_s  = ', ati_ini_s 
     512         WRITE(numout,*) '   initial  ice salinity  in the north          smi_ini_n  = ', smi_ini_n 
     513         WRITE(numout,*) '   initial  ice salinity  in the south          smi_ini_s  = ', smi_ini_s 
     514         WRITE(numout,*) '   initial  ice/snw temp  in the north          tmi_ini_n  = ', tmi_ini_n 
     515         WRITE(numout,*) '   initial  ice/snw temp  in the south          tmi_ini_s  = ', tmi_ini_s 
    527516      ENDIF 
    528517 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4624 r5086  
    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 
     
    4242   PUBLIC   lim_itd_me_zapsmall 
    4343   PUBLIC   lim_itd_me_alloc        ! called by iceini.F90 
    44  
    45    REAL(wp) ::   epsi20 = 1.e-20_wp   ! constant values 
    46    REAL(wp) ::   epsi10 = 1.e-10_wp   ! constant values 
    47    REAL(wp) ::   epsi06 = 1.e-06_wp   ! constant values 
    4844 
    4945   !----------------------------------------------------------------------- 
     
    143139      REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    144140      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... 
     141      ! 
     142      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    149143      !!----------------------------------------------------------------------------- 
    150144      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    151145 
    152146      CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    153  
    154       CALL wrk_alloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    155  
    156       IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only) 
    157147 
    158148      IF(ln_ctl) THEN 
     
    162152 
    163153      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(:,:,:) 
     154 
     155      ! conservation test 
     156      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    179157 
    180158      !-----------------------------------------------------------------------------! 
     
    362340            ! 5) Heat, salt and freshwater fluxes 
    363341            !-----------------------------------------------------------------------------! 
    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 
     342            wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
     343            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice  ! heat sink for ocean (<0, W.m-2) 
    366344 
    367345         END DO 
     
    399377      CALL lim_itd_me_zapsmall 
    400378 
    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 
    414379 
    415380      IF(ln_ctl) THEN     ! Control print 
     
    445410      ENDIF 
    446411 
    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       ! ------------------------------- 
     412      ! conservation test 
     413      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    470414 
    471415      ENDIF  ! ln_limdyn=.true. 
    472416      ! 
    473417      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 
    476418      ! 
    477419      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
     
    670612      !!---------------------------------------------------------------------! 
    671613      INTEGER ::   ji,jj, jl    ! dummy loop indices 
    672       INTEGER ::   krdg_index   !  
    673614      REAL(wp) ::   Gstari, astari, hi, hrmean, zdummy   ! local scalar 
    674615      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here 
     
    746687      !----------------------------------------------------------------- 
    747688 
    748       krdg_index = 1 
    749  
    750       IF( krdg_index == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    751          DO jl = 0, ice_cat_bounds(1,2)       ! only undeformed ice participates 
     689      IF( partfun_swi == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
     690         DO jl = 0, jpl     
    752691            DO jj = 1, jpj  
    753692               DO ji = 1, jpi 
     
    772711            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 
    773712         END DO !jl 
    774          DO jl = 0, ice_cat_bounds(1,2) 
     713         DO jl = 0, jpl 
    775714             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 
    776715         END DO 
    777716         ! 
    778       ENDIF ! krdg_index 
    779  
    780       IF( raftswi == 1 ) THEN      ! Ridging and rafting ice participation functions 
     717      ENDIF ! partfun_swi 
     718 
     719      IF( raft_swi == 1 ) THEN      ! Ridging and rafting ice participation functions 
    781720         ! 
    782721         DO jl = 1, jpl 
     
    794733         END DO ! jl 
    795734 
    796       ELSE  ! raftswi = 0 
     735      ELSE  ! raft_swi = 0 
    797736         ! 
    798737         DO jl = 1, jpl 
     
    802741      ENDIF 
    803742 
    804       IF ( raftswi == 1 ) THEN 
     743      IF ( raft_swi == 1 ) THEN 
    805744 
    806745         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN 
     
    908847      INTEGER ::   ij                ! horizontal index, combines i and j loops 
    909848      INTEGER ::   icells            ! number of cells with aicen > puny 
    910       REAL(wp) ::   zindb, zsrdg2   ! local scalar 
    911849      REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration 
     850      REAL(wp) ::   zsstK            ! SST in Kelvin 
    912851 
    913852      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices 
     
    917856 
    918857      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 
     858      REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnwn_init, esnwn_init   ! snow volume  & energy before ridging 
    920859      REAL(wp), POINTER, DIMENSION(:,:,:) ::   smv_i_init, oa_i_init    ! ice salinity & age    before ridging 
    921860 
     
    952891      CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    953892      CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    954       CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 
    955       CALL wrk_alloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    956       CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init ) 
     893      CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     894      CALL wrk_alloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
     895      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
    957896 
    958897      ! Conservation check 
     
    1008947         aicen_init(:,:,jl) = a_i(:,:,jl) 
    1009948         vicen_init(:,:,jl) = v_i(:,:,jl) 
    1010          vsnon_init(:,:,jl) = v_s(:,:,jl) 
     949         vsnwn_init(:,:,jl) = v_s(:,:,jl) 
    1011950         ! 
    1012951         smv_i_init(:,:,jl) = smv_i(:,:,jl) 
     
    1014953      END DO !jl 
    1015954 
    1016       esnon_init(:,:,:) = e_s(:,:,1,:) 
     955      esnwn_init(:,:,:) = e_s(:,:,1,:) 
    1017956 
    1018957      DO jl = 1, jpl   
     
    10911030            !     / rafting category n1. 
    10921031            !-------------------------------------------------------------------------- 
    1093             vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
     1032            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 
    10941033            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 
    10951034            vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por 
    10961035 
    1097             vsrdg(ji,jj) = vsnon_init(ji,jj,jl1) * afrac(ji,jj) 
    1098             esrdg(ji,jj) = esnon_init(ji,jj,jl1) * afrac(ji,jj) 
    1099             srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
    1100             srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
     1036            vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     1037            esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     1038            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
     1039            srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 
    11011040 
    11021041            ! rafting volumes, heat contents ... 
    11031042            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) 
     1043            vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     1044            esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    11061045            smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
    11071046 
     
    11201059            ! Salinity 
    11211060            !------------- 
    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 
     1061            smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014 
     1062            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
     1063 
     1064            !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
    11271065             
    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              
     1066            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
     1067            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! gurvan: increase in ice volume du to seawater frozen in voids              
    11321068 
    11331069            !------------------------------------             
     
    11581094               &                                + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 
    11591095 
    1160             esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
    1161                &                                + esrft(ji,jj)*(1.0-fsnowrft)           
     1096            ! in 1e-9 Joules (same as e_s) 
     1097            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
     1098               &                                - esrft(ji,jj)*(1.0-fsnowrft)           
    11621099 
    11631100            !----------------------------------------------------------------- 
     
    11841121               jj = indxj(ij) 
    11851122               ! heat content of ridged ice 
    1186                erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )  
     1123               erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj)  
    11871124               eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 
    11881125               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 
     1126                
     1127                
     1128               ! enthalpy of the trapped seawater (J/m2, >0) 
     1129               ! clem: if sst>0, then ersw <0 (is that possible?) 
     1130               zsstK  = sst_m(ji,jj) + rt0 
     1131               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i ) 
     1132 
     1133               ! heat flux to the ocean 
     1134               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux  
    12031135 
    12041136               ! 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 ) 
     1137               ersw(ji,jj,jk)   = ersw(ji,jj,jk) / unit_fac 
     1138 
     1139               ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J 
     1140               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean  
     1141               !! MV HC 2014 
     1142               ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) 
    12091143 
    12101144               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
     1145 
    12111146            END DO ! ij 
    12121147         END DO !jk 
     
    12531188         !------------------------------------------------------------------------------- 
    12541189         !        jl1 looping 1-jpl 
    1255          DO jl2  = ice_cat_bounds(1,1), ice_cat_bounds(1,2)  
     1190         DO jl2  = 1, jpl  
    12561191            ! over categories to which ridged ice is transferred 
    12571192!CDIR NODEP 
     
    12981233         END DO                 ! jl2 (new ridges)             
    12991234 
    1300          DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2)  
     1235         DO jl2 = 1, jpl  
    13011236 
    13021237!CDIR NODEP 
     
    13611296      CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    13621297      CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    1363       CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 
    1364       CALL wrk_dealloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    1365       CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init ) 
     1298      CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     1299      CALL wrk_dealloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
     1300      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
    13661301      ! 
    13671302   END SUBROUTINE lim_itd_me_ridgeshift 
     
    14041339      !!------------------------------------------------------------------- 
    14051340      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 
     1341      NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,              &  
     1342        &                   Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, & 
     1343        &                   partfun_swi, brinstren_swi 
    14111344      !!------------------------------------------------------------------- 
    14121345      ! 
     
    14321365         WRITE(numout,*)'   Equivalent to G* for an exponential part function       astar           ', astar 
    14331366         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     Hstar           ', Hstar 
    1434          WRITE(numout,*)'   Rafting of ice sheets or not                            raftswi         ', raftswi 
     1367         WRITE(numout,*)'   Rafting of ice sheets or not                            raft_swi        ', raft_swi 
    14351368         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       hparmeter       ', hparmeter 
    14361369         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  Craft           ', Craft   
    14371370         WRITE(numout,*)'   Initial porosity of ridges                              ridge_por       ', ridge_por 
    1438          WRITE(numout,*)'   Maximum salinity of ridging ice                         sal_max_ridge   ', sal_max_ridge 
    14391371         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 
    14411372         WRITE(numout,*)'   Switch for including brine volume in ice strength comp. brinstren_swi   ', brinstren_swi 
    14421373      ENDIF 
     
    14621393 
    14631394      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask   ! 2D workspace 
    1464       REAL(wp)                          ::   zmask_glo 
     1395      REAL(wp)                          ::   zmask_glo, zsal, zvi, zvs, zei, zes 
    14651396!!gm      REAL(wp) ::   xtmp      ! temporary variable 
    14661397      !!------------------------------------------------------------------- 
     
    14681399      CALL wrk_alloc( jpi, jpj, zmask ) 
    14691400 
     1401      ! to be sure that at_i is the sum of a_i(jl) 
     1402      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     1403 
    14701404      DO jl = 1, jpl 
    1471  
    14721405         !----------------------------------------------------------------- 
    14731406         ! Count categories to be zapped. 
    1474          ! Abort model in case of negative area. 
    14751407         !----------------------------------------------------------------- 
    14761408         icells = 0 
     
    14781410         DO jj = 1, jpj 
    14791411            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 
     1412               IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN 
     1413                  zmask(ji,jj) = 1._wp 
     1414               ENDIF 
    14841415            END DO 
    14851416         END DO 
     
    14941425            DO jj = 1 , jpj 
    14951426               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 
     1427                  zei  = e_i(ji,jj,jk,jl) 
    14991428                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 
     1429                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj) 
     1430                  ! update exchanges with ocean 
     1431                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    15001432               END DO 
    15011433            END DO 
     
    15041436         DO jj = 1 , jpj 
    15051437            DO ji = 1 , jpi 
    1506  
     1438                
     1439               zsal = smv_i(ji,jj,jl) 
     1440               zvi  = v_i(ji,jj,jl) 
     1441               zvs  = v_s(ji,jj,jl) 
     1442               zes  = e_s(ji,jj,1,jl) 
    15071443               !----------------------------------------------------------------- 
    15081444               ! Zap snow energy and use ocean heat to melt snow 
     
    15141450               ! fluxes are positive to the ocean 
    15151451               ! 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  
    15211452               t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
    15221453 
     
    15241455               ! zap ice and snow volume, add water and salt to ocean 
    15251456               !----------------------------------------------------------------- 
    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) 
     1457               ato_i(ji,jj)    = a_i  (ji,jj,jl) *           zmask(ji,jj)   + ato_i(ji,jj) 
    15351458               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    15361459               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
     
    15391462               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    15401463               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1541                ! 
     1464               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
     1465               ! additional condition 
     1466               IF( v_s(ji,jj,jl) <= epsi10 ) THEN 
     1467                  v_s(ji,jj,jl)   = 0._wp 
     1468                  e_s(ji,jj,1,jl) = 0._wp 
     1469               ENDIF 
     1470               ! update exchanges with ocean 
     1471               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     1472               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice 
     1473               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice 
     1474               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    15421475            END DO 
    15431476         END DO 
    1544          ! 
    1545       END DO                 ! jl  
     1477      END DO ! jl  
     1478 
     1479      ! to be sure that at_i is the sum of a_i(jl) 
     1480      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    15461481      ! 
    15471482      CALL wrk_dealloc( jpi, jpj, zmask ) 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r4333 r5086  
    66   !! History :   -   !          (W. H. Lipscomb and E.C. Hunke) CICE (c) original code 
    77   !!            3.0  ! 2005-12  (M. Vancoppenolle) adaptation to LIM-3 
    8    !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age and types 
     8   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age 
    99   !!             -   ! 2007-04  (M. Vancoppenolle) Mass conservation checked 
    1010   !!---------------------------------------------------------------------- 
     
    3535   USE lib_fortran      ! to use key_nosignedzero 
    3636   USE timing          ! Timing 
     37   USE limcons        ! conservation tests 
    3738 
    3839   IMPLICIT NONE 
     
    4445   PUBLIC   lim_itd_fitline 
    4546   PUBLIC   lim_itd_shiftice 
    46  
    47    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    48    REAL(wp) ::   epsi06 = 1.e-6_wp   ! 
    4947 
    5048   !!---------------------------------------------------------------------- 
     
    6563      INTEGER, INTENT(in) ::   kt   ! time step index 
    6664      ! 
    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) 
     65      INTEGER ::   ji, jj, jk, jl   ! dummy loop index          
     66      ! 
     67      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7068      !!------------------------------------------------------------------ 
    7169      IF( nn_timing == 1 )  CALL timing_start('limitd_th') 
    7270 
    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       ! ------------------------------- 
     71      ! conservation test 
     72      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    8373 
    8474      IF( kt == nit000 .AND. lwp ) THEN 
     
    9383      ! Given thermodynamic growth rates, transport ice between 
    9484      ! thickness categories. 
    95       DO jm = 1, jpm 
    96          jbnd1 = ice_cat_bounds(jm,1) 
    97          jbnd2 = ice_cat_bounds(jm,2) 
    98          IF( ice_ncat_types(jm) > 1 )   CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt ) 
    99       END DO 
     85      IF( jpl > 1 )   CALL lim_itd_th_rem( 1, jpl, kt ) 
    10086      ! 
    10187      CALL lim_var_glo2eqv    ! only for info 
     
    10591      !  3) Add frazil ice growing in leads. 
    10692      !------------------------------------------------------------------------------| 
    107  
    10893      CALL lim_thd_lac 
    10994      CALL lim_var_glo2eqv    ! only for info 
    110  
    111      IF(ln_ctl) THEN   ! Control print 
     95      
     96      IF(ln_ctl) THEN   ! Control print 
    11297         CALL prt_ctl_info(' ') 
    11398         CALL prt_ctl_info(' - Cell values : ') 
     
    131116            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ') 
    132117            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ') 
    133             DO ja = 1, nlay_i 
     118            DO jk = 1, nlay_i 
    134119               CALL prt_ctl_info(' ') 
    135                CALL prt_ctl_info(' - Layer : ', ivar1=ja) 
     120               CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    136121               CALL prt_ctl_info('   ~~~~~~~') 
    137                CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : t_i      : ') 
    138                CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : e_i      : ') 
     122               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ') 
     123               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ') 
    139124            END DO 
    140125         END DO 
    141126      ENDIF 
    142127      ! 
    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       ! ------------------------------- 
     128      ! conservation test 
     129      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    166130      ! 
    167131     IF( nn_timing == 1 )  CALL timing_stop('limitd_th') 
     
    169133   ! 
    170134 
    171    SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp, kt ) 
     135   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt ) 
    172136      !!------------------------------------------------------------------ 
    173137      !!                ***  ROUTINE lim_itd_th_rem *** 
     
    182146      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point 
    183147      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied 
    184       INTEGER , INTENT (in) ::   ntyp    ! Number of the type used 
    185148      INTEGER , INTENT (in) ::   kt      ! Ocean time step  
    186149      ! 
     
    190153      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars 
    191154      REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      - 
    192       REAL(wp) ::   zx3,             zareamin, zindb   !   -      - 
     155      REAL(wp) ::   zx3,             zareamin          !   -      - 
    193156      CHARACTER (len = 15) :: fieldid 
    194157 
     
    200163      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hL          ! left boundary for the ITD for each thickness 
    201164      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hR          ! left boundary for the ITD for each thickness 
    202       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_o     ! old ice thickness 
     165      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_b     ! old ice thickness 
    203166      REAL(wp), POINTER, DIMENSION(:,:,:) ::   dummy_es 
    204167      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice          ! local increment of ice area and volume 
     
    218181      CALL wrk_alloc( jpi,jpj, zremap_flag )    ! integer 
    219182      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer 
    220       CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es ) 
     183      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    221184      CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    222185      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
     
    247210         WRITE(numout,*) ' klbnd :       ', klbnd 
    248211         WRITE(numout,*) ' kubnd :       ', kubnd 
    249          WRITE(numout,*) ' ntyp  :       ', ntyp  
    250212      ENDIF 
    251213 
     
    254216         DO jj = 1, jpj 
    255217            DO ji = 1, jpi 
    256                zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes 
    257                ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb 
    258                zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 
    259                zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb 
    260                IF( a_i(ji,jj,jl) > epsi06 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
     218               rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes 
     219               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch 
     220               rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 
     221               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 
     222               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)  
    261223            END DO 
    262224         END DO 
     
    302264            ij = nind_j(ji) 
    303265            ! 
    304             IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. &  
    305                ( zht_i_o(ii,ij,jl+1) .GT. epsi10 ) ) THEN 
     266            zhbnew(ii,ij,jl) = hi_max(jl) 
     267            IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 
    306268               !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 
     269               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) ) 
     270               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) ) 
     271            ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN 
    312272               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 
    313             ELSEIF (zht_i_o(ii,ij,jl+1).gt.epsi10) THEN 
     273            ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN 
    314274               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 
    315             ELSE 
    316                zhbnew(ii,ij,jl) = hi_max(jl) 
    317275            ENDIF 
    318276         END DO 
     
    320278         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
    321279         DO ji = 1, nbrem 
    322             ! jl, ji 
    323280            ii = nind_i(ji) 
    324281            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 
     282            IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 
    329283               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 
     284            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 
    333285               zremap_flag(ii,ij) = 0 
    334286            ENDIF 
    335287 
    336288            !- 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 
     289            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 
     290            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     291         END DO 
     292 
    348293      END DO !jl 
    349294 
     
    354299      DO jj = 1, jpj 
    355300         DO ji = 1, jpi 
    356             IF ( zremap_flag(ji,jj) == 1 ) THEN 
     301            IF( zremap_flag(ji,jj) == 1 ) THEN 
    357302               nbrem         = nbrem + 1 
    358303               nind_i(nbrem) = ji 
    359304               nind_j(nbrem) = jj 
    360305            ENDIF 
    361          END DO !ji 
    362       END DO !jj 
     306         END DO  
     307      END DO  
    363308 
    364309      !----------------------------------------------------------------------------------------------- 
     
    367312      DO jj = 1, jpj 
    368313         DO ji = 1, jpi 
    369             zhb0(ji,jj) = hi_max_typ(0,ntyp) ! 0eme 
    370             zhb1(ji,jj) = hi_max_typ(1,ntyp) ! 1er 
     314            zhb0(ji,jj) = hi_max(0) ! 0eme 
     315            zhb1(ji,jj) = hi_max(1) ! 1er 
    371316 
    372317            zhbnew(ji,jj,klbnd-1) = 0._wp 
     
    380325            ENDIF 
    381326 
    382             IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) )   zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
     327            IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
    383328 
    384329         END DO !jj 
     
    389334      !----------------------------------------------------------------------------------------------- 
    390335      !- 7.1 g(h) for category 1 at start of time step 
    391       CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_o(:,:,klbnd),         & 
     336      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd),         & 
    392337         &                  g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   & 
    393338         &                  hR(:,:,klbnd), zremap_flag ) 
     
    414359                  ! Constrain new thickness <= ht_i 
    415360                  zdamax = a_i(ii,ij,klbnd) * &  
    416                      (1.0 - ht_i(ii,ij,klbnd)/zht_i_o(ii,ij,klbnd)) ! zdamax > 0 
     361                     (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0 
    417362                  !ice area lost due to melting of thin ice 
    418363                  zda0   = MIN(zda0, zdamax) 
     
    428373            ELSE ! if ice accretion 
    429374               ! ji, a_i > epsi10; zdh0 > 0 
    430                IF ( ntyp .EQ. 1 ) zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
     375               zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
    431376               ! zhbnew was 0, and is shifted to the right to account for thin ice 
    432377               ! growth in openwater (F0 = f1) 
    433                IF ( ntyp .NE. 1 ) zhbnew(ii,ij,0) = 0  
    434                ! in other types there is 
    435                ! no open water growth (F0 = 0) 
    436378            ENDIF ! zdh0  
    437379 
     
    444386      DO jl = klbnd, kubnd 
    445387         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) 
     388            g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag) 
    448389      END DO 
    449390 
     
    493434            nd   = zdonor(ii,ij,jl) 
    494435            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) 
     436            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 
    497437 
    498438         END DO ! ji 
     
    511451         ii = nind_i(ji) 
    512452         ij = nind_j(ji) 
    513          IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim ) ) THEN 
     453         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN 
    514454            a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim  
    515455            ht_i(ii,ij,1) = hiclim 
    516             v_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless 
    517456         ENDIF 
    518457      END DO !ji 
     
    542481      CALL wrk_dealloc( jpi,jpj, zremap_flag )    ! integer 
    543482      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer 
    544       CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es ) 
     483      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    545484      CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    546485      CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
     
    647586      REAL(wp) ::   zdo_aice           ! ice age times volume transferred 
    648587      REAL(wp) ::   zdaTsf             ! aicen*Tsfcn transferred 
    649       REAL(wp) ::   zindsn             ! snow or not 
    650       REAL(wp) ::   zindb              ! ice or not 
    651588 
    652589      INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions 
     
    775712 
    776713            jl1 = zdonor(ii,ij,jl) 
    777             zindb             = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) ) 
    778             zworka(ii,ij)   = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * zindb 
     714            rswitch             = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) ) 
     715            zworka(ii,ij)   = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * rswitch 
    779716            IF( jl1 == jl) THEN   ;   jl2 = jl1+1 
    780717            ELSE                    ;   jl2 = jl  
     
    799736            !-------------- 
    800737 
    801             zdvsnow          = v_s(ii,ij,jl1) * zworka(ii,ij) 
     738            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij) 
    802739            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 
    803740            v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow  
     
    807744            !-------------------- 
    808745 
    809             zdesnow              = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
     746            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
    810747            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow 
    811748            e_s(ii,ij,1,jl2)   = e_s(ii,ij,1,jl2) + zdesnow 
     
    815752            !-------------- 
    816753 
    817             zdo_aice             = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
     754            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
    818755            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice 
    819756            oa_i(ii,ij,jl2)    = oa_i(ii,ij,jl2) + zdo_aice 
     
    823760            !-------------- 
    824761 
    825             zdsm_vice            = smv_i(ii,ij,jl1) * zworka(ii,ij) 
     762            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij) 
    826763            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice 
    827764            smv_i(ii,ij,jl2)   = smv_i(ii,ij,jl2) + zdsm_vice 
     
    831768            !--------------------- 
    832769 
    833             zdaTsf               = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
     770            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
    834771            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf 
    835772            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf  
     
    872809                  ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl)  
    873810                  t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl)  
    874                   zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes 
     811                  rswitch         =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes 
    875812               ELSE 
    876813                  ht_i(ji,jj,jl)  = 0._wp 
     
    888825    
    889826 
    890    SUBROUTINE lim_itd_th_reb( klbnd, kubnd, ntyp ) 
     827   SUBROUTINE lim_itd_th_reb( klbnd, kubnd ) 
    891828      !!------------------------------------------------------------------ 
    892829      !!                ***  ROUTINE lim_itd_th_reb *** 
     
    898835      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point 
    899836      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied 
    900       INTEGER , INTENT (in) ::   ntyp    ! number of the ice type involved in the rebinning process 
    901837      ! 
    902838      INTEGER ::   ji,jj, jl   ! dummy loop indices 
     
    910846      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories 
    911847      !!------------------------------------------------------------------ 
     848      !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate 
    912849       
    913850      CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger 
     
    937874 
    938875      !------------------------------------------------------------------------------ 
    939       ! 2) Make sure thickness of cat klbnd is at least hi_max_typ(klbnd) 
     876      ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd) 
    940877      !------------------------------------------------------------------------------ 
    941878      DO jj = 1, jpj  
    942879         DO ji = 1, jpi  
    943880            IF( a_i(ji,jj,klbnd) > epsi10 ) THEN 
    944                IF( ht_i(ji,jj,klbnd) <= hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN 
    945                   a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max_typ(0,ntyp)  
    946                   ht_i(ji,jj,klbnd) = hi_max_typ(0,ntyp) 
     881               IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN 
     882                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max(0)  
     883                  ht_i(ji,jj,klbnd) = hi_max(0) 
    947884               ENDIF 
    948885            ENDIF 
     
    1015952 
    1016953!clem-change 
     954         DO jj = 1, jpj 
     955            DO ji = 1, jpi 
     956               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     957                  ! 
     958                  zshiftflag = 1 
     959                  zdonor(ji,jj,jl) = jl + 1 
     960                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1)  
     961                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
     962               ENDIF 
     963            END DO                 ! ji 
     964         END DO                 ! jj 
     965 
     966         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
     967          
     968         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories 
     969            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
     970            ! Reset shift parameters 
     971            zdonor(:,:,jl) = 0 
     972            zdaice(:,:,jl) = 0._wp 
     973            zdvice(:,:,jl) = 0._wp 
     974         ENDIF 
     975!clem-change 
     976 
     977!         ! clem-change begin: why not doing that? 
    1017978!         DO jj = 1, jpj 
    1018979!            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) 
     980!               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     981!                  ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
     982!                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    1026983!               ENDIF 
    1027984!            END DO                 ! ji 
    1028985!         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 
    1051986         ! clem-change end 
    1052987 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r4346 r5086  
    5050   PUBLIC   lim_rhg        ! routine called by lim_dyn (or lim_dyn_2) 
    5151 
    52    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   rzero   = 0._wp   ! constant values 
    54    REAL(wp) ::   rone    = 1._wp   ! constant values 
    55        
    5652   !! * Substitutions 
    5753#  include "vectopt_loop_substitute.h90" 
     
    121117      CHARACTER (len=50) ::   charout 
    122118      REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         ! 
    123       REAL(wp) ::   za, zstms, zsang, zmask   ! local scalars 
     119      REAL(wp) ::   za, zstms, zmask   ! local scalars 
     120      REAL(wp) ::   zc1, zc2, zc3             ! ice mass 
    124121 
    125122      REAL(wp) ::   dtevp              ! time step for subcycling 
     
    127124      REAL(wp) ::   z0, zr, zcca, zccb ! temporary scalars 
    128125      REAL(wp) ::   zu_ice2, zv_ice1   ! 
    129       REAL(wp) ::   zddc, zdtc, zzdst   ! delta on corners and on centre 
     126      REAL(wp) ::   zddc, zdtc         ! delta on corners and on centre 
     127      REAL(wp) ::   zdst               ! shear at the center of the grid point 
    130128      REAL(wp) ::   zdsshx, zdsshy     ! term for the gradient of ocean surface 
    131129      REAL(wp) ::   sigma1, sigma2     ! internal ice stress 
    132130 
    133131      REAL(wp) ::   zresm         ! Maximal error on ice velocity 
    134       REAL(wp) ::   zindb         ! ice (1) or not (0)       
    135132      REAL(wp) ::   zdummy        ! dummy argument 
    136133      REAL(wp) ::   zintb, zintn  ! dummy argument 
     
    142139      REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points 
    143140      REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays 
    144       REAL(wp), POINTER, DIMENSION(:,:) ::   zc1              ! ice mass 
    145       REAL(wp), POINTER, DIMENSION(:,:) ::   zusw             ! temporary weight for ice strength computation 
    146141      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                            
    147142      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2, v_oce2   ! ocean u/v component on V points 
     
    149144      REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses 
    150145       
    151       REAL(wp), POINTER, DIMENSION(:,:) ::   zdd   , zdt      ! Divergence and tension at centre of grid cells 
     146      REAL(wp), POINTER, DIMENSION(:,:) ::   zdt              ! tension at centre of grid cells 
    152147      REAL(wp), POINTER, DIMENSION(:,:) ::   zds              ! Shear on northeast corner of grid cells 
    153       REAL(wp), POINTER, DIMENSION(:,:) ::   zdst             ! Shear on centre of grid cells 
    154       REAL(wp), POINTER, DIMENSION(:,:) ::   deltat, deltac   ! Delta at centre and corners of grid cells 
    155148      REAL(wp), POINTER, DIMENSION(:,:) ::   zs1   , zs2      ! Diagonal stress tensor components zs1 and zs2  
    156149      REAL(wp), POINTER, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12 
     
    162155 
    163156      CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 
    164       CALL wrk_alloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                ) 
    165       CALL wrk_alloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  ) 
    166       CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
     157      CALL wrk_alloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                ) 
     158      CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
     159      CALL wrk_alloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
    167160 
    168161#if  defined key_lim2 && ! defined key_lim2_vp 
     
    181174      ! 
    182175      !------------------------------------------------------------------------------! 
    183       ! 1) Ice-Snow mass (zc1), ice strength (zpresh)                                ! 
     176      ! 1) Ice strength (zpresh)                                ! 
    184177      !------------------------------------------------------------------------------! 
    185178      ! 
    186179      ! Put every vector to 0 
    187       zpresh (:,:) = 0._wp   ;   zc1   (:,:) = 0._wp 
     180      delta_i(:,:) = 0._wp   ; 
     181      zpresh (:,:) = 0._wp   ;   
    188182      zpreshc(:,:) = 0._wp 
    189183      u_ice2 (:,:) = 0._wp   ;   v_ice1(:,:) = 0._wp 
    190       zdd    (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp 
     184      divu_i (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp 
     185      shear_i(:,:) = 0._wp 
    191186 
    192187#if defined key_lim3 
     
    198193!CDIR NOVERRCHK 
    199194         DO ji = 1 , jpi 
    200             zc1(ji,jj)    = tms(ji,jj) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) ) 
    201195#if defined key_lim3 
    202196            zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj) 
     
    220214               &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + & 
    221215               &              tms(ji,jj)     * wght(ji+1,jj+1,1,1) 
    222             zusw(ji,jj)    = 1.0 / MAX( zstms, epsd ) 
    223216            zpreshc(ji,jj) = (  zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
    224217               &                zpresh(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
    225218               &                zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &  
    226219               &                zpresh(ji,jj)     * wght(ji+1,jj+1,1,1)   & 
    227                &             ) * zusw(ji,jj) 
     220               &             ) / MAX( zstms, epsd ) 
    228221         END DO 
    229222      END DO 
     
    267260         DO ji = fs_2, fs_jpim1 
    268261 
     262            zc1 = tms(ji  ,jj  ) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) ) 
     263            zc2 = tms(ji+1,jj  ) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) ) 
     264            zc3 = tms(ji  ,jj+1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) ) 
     265 
    269266            zt11 = tms(ji  ,jj) * e1t(ji  ,jj) 
    270267            zt12 = tms(ji+1,jj) * e1t(ji+1,jj) 
     
    277274 
    278275            ! Mass, coriolis coeff. and currents 
    279             zmass1(ji,jj) = ( zt12*zc1(ji,jj) + zt11*zc1(ji+1,jj) ) / (zt11+zt12+epsd) 
    280             zmass2(ji,jj) = ( zt22*zc1(ji,jj) + zt21*zc1(ji,jj+1) ) / (zt21+zt22+epsd) 
     276            zmass1(ji,jj) = ( zt12*zc1 + zt11*zc2 ) / (zt11+zt12+epsd) 
     277            zmass2(ji,jj) = ( zt22*zc1 + zt21*zc3 ) / (zt21+zt22+epsd) 
    281278            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) )   & 
    282279               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd ) 
     
    346343               !   
    347344               !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002) 
    348                !- zdd(:,:), zdt(:,:): divergence and tension at centre of grid cells 
     345               !- divu_i(:,:), zdt(:,:): divergence and tension at centre of grid cells 
    349346               !- zds(:,:): shear on northeast corner of grid cells 
    350347               ! 
     
    355352               !                      bugs (Martin, for Miguel). 
    356353               ! 
    357                !- ALSO: arrays zdd, zdt, zds and delta could  
     354               !- ALSO: arrays zdt, zds and delta could  
    358355               !  be removed in the future to minimise memory demand. 
    359356               ! 
     
    363360               ! 
    364361               ! 
    365                zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    366                   &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
    367                   &          +e1v(ji,jj)*v_ice(ji,jj)                      & 
    368                   &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
    369                   &          )                                             & 
    370                   &         / area(ji,jj) 
     362               divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
     363                  &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
     364                  &             +e1v(ji,jj)*v_ice(ji,jj)                      & 
     365                  &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
     366                  &             )                                             & 
     367                  &            / area(ji,jj) 
    371368 
    372369               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
     
    410407 
    411408               !- Calculate Delta at centre of grid cells 
    412                zzdst      = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          & 
     409               zdst      = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          & 
    413410                  &          - e2u(ji-1, jj) * v_ice1(ji-1,jj)          & 
    414411                  &          + e1v(ji, jj  ) * u_ice2(ji,jj  )          & 
     
    417414                  &         / area(ji,jj) 
    418415 
    419                delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zzdst*zzdst ) * usecc2 )   
    420                ! MV rewriting 
    421                ! deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 + (zdt(ji,jj)**2 + zzdst**2)*usecc2), creepl ) 
    422                !!gm faster to replace the line above with simply: 
    423                !!                deltat(ji,jj) = MAX( delta, creepl ) 
    424                !!gm end   
    425                deltat(ji,jj) = delta + creepl 
    426                ! END MV 
     416               delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )   
     417               delta_i(ji,jj) = delta + creepl 
    427418               !-Calculate stress tensor components zs1 and zs2  
    428419               !-at centre of grid cells (see section 3.5 of CICE user's guide). 
    429                !zs1(ji,jj) = ( zs1(ji,jj) - dtotel*( ( 1._wp - alphaevp) * zs1(ji,jj) +   & 
    430                !   &          ( delta / deltat(ji,jj) - zdd(ji,jj) / deltat(ji,jj) ) * zpresh(ji,jj) ) )  &        
    431                !   &          / ( 1._wp + alphaevp * dtotel ) 
    432  
    433                !zs2(ji,jj) = ( zs2(ji,jj) - dtotel * ( ( 1._wp - alphaevp ) * ecc2 * zs2(ji,jj) -   & 
    434                !              zdt(ji,jj) / deltat(ji,jj) * zpresh(ji,jj) ) )   & 
    435                !   &          / ( 1._wp + alphaevp * ecc2 * dtotel ) 
    436  
    437                ! new formulation from S. Bouillon to help stabilizing the code (no need of alphaevp) 
    438                zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( zdd(ji,jj) / deltat(ji,jj) - delta / deltat(ji,jj) )  & 
     420               zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( divu_i(ji,jj) / delta_i(ji,jj) - delta / delta_i(ji,jj) )  & 
    439421                  &         * zpresh(ji,jj) ) ) / ( 1._wp + dtotel ) 
    440                zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / deltat(ji,jj) * zpresh(ji,jj) ) )  & 
     422               zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) ) )  & 
    441423                  &         / ( 1._wp + dtotel ) 
    442424 
     
    470452                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
    471453 
    472                deltac(ji,jj) = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl 
     454               zddc = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl 
    473455 
    474456               !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide). 
    475                !zs12(ji,jj) = ( zs12(ji,jj) - dtotel * ( (1.0-alphaevp) * ecc2 * zs12(ji,jj) - zds(ji,jj) /  & 
    476                !   &          ( 2._wp * deltac(ji,jj) ) * zpreshc(ji,jj) ) )  & 
    477                !   &          / ( 1._wp + alphaevp * ecc2 * dtotel )  
    478  
    479                ! new formulation from S. Bouillon to help stabilizing the code (no need of alphaevp) 
    480457               zs12(ji,jj) = ( zs12(ji,jj) + dtotel *  & 
    481                   &          ( ecci * zds(ji,jj) / ( 2._wp * deltac(ji,jj) ) * zpreshc(ji,jj) ) )  & 
     458                  &          ( ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) ) )  & 
    482459                  &          / ( 1.0 + dtotel )  
    483460 
     
    514491!CDIR NOVERRCHK 
    515492               DO ji = fs_2, fs_jpim1 
    516                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
    517                   zsang        = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 
     493                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    518494                  z0           = zmass1(ji,jj)/dtevp 
    519495 
     
    525501                     (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj)) 
    526502                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    527                      za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj)) 
    528                   zcca         = z0+za*cangvg 
    529                   zccb         = zcorl1(ji,jj)+za*zsang 
     503                     za*(u_oce1(ji,jj)) 
     504                  zcca         = z0+za 
     505                  zccb         = zcorl1(ji,jj) 
    530506                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    531507 
     
    538514#endif 
    539515#if defined key_bdy 
    540          ! clem: change u_ice and v_ice at the boundary for each iteration 
    541516         CALL bdy_ice_lim_dyn( 'U' ) 
    542517#endif          
     
    547522               DO ji = fs_2, fs_jpim1 
    548523 
    549                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
    550                   zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
     524                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    551525                  z0           = zmass2(ji,jj)/dtevp 
    552526                  ! SB modif because ocean has no slip boundary condition 
     
    557531                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    558532                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    559                      za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj)) 
    560                   zcca         = z0+za*cangvg 
    561                   zccb         = zcorl2(ji,jj)+za*zsang 
     533                     za2ct(ji,jj) + za*(v_oce2(ji,jj)) 
     534                  zcca         = z0+za 
     535                  zccb         = zcorl2(ji,jj) 
    562536                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    563537 
     
    570544#endif 
    571545#if defined key_bdy 
    572          ! clem: change u_ice and v_ice at the boundary for each iteration 
    573546         CALL bdy_ice_lim_dyn( 'V' ) 
    574547#endif          
     
    579552!CDIR NOVERRCHK 
    580553               DO ji = fs_2, fs_jpim1 
    581                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
    582                   zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
     554                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    583555                  z0           = zmass2(ji,jj)/dtevp 
    584556                  ! SB modif because ocean has no slip boundary condition 
     
    590562                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    591563                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    592                      za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj)) 
    593                   zcca         = z0+za*cangvg 
    594                   zccb         = zcorl2(ji,jj)+za*zsang 
     564                     za2ct(ji,jj) + za*(v_oce2(ji,jj)) 
     565                  zcca         = z0+za 
     566                  zccb         = zcorl2(ji,jj) 
    595567                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    596568 
     
    603575#endif 
    604576#if defined key_bdy 
    605          ! clem: change u_ice and v_ice at the boundary for each iteration 
    606577         CALL bdy_ice_lim_dyn( 'V' ) 
    607578#endif          
     
    611582!CDIR NOVERRCHK 
    612583               DO ji = fs_2, fs_jpim1 
    613                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
    614                   zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
     584                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    615585                  z0           = zmass1(ji,jj)/dtevp 
    616                   ! SB modif because ocean has no slip boundary condition 
    617                   ! GG Bug 
    618                   !                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)      & 
    619                   !                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj))   & 
    620                   !                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    621586                  zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      & 
    622587                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
     
    626591                     (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj)) 
    627592                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    628                      za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj)) 
    629                   zcca         = z0+za*cangvg 
    630                   zccb         = zcorl1(ji,jj)+za*zsang 
     593                     za*(u_oce1(ji,jj)) 
     594                  zcca         = z0+za 
     595                  zccb         = zcorl1(ji,jj) 
    631596                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    632597               END DO ! ji 
     
    638603#endif 
    639604#if defined key_bdy 
    640          ! clem: change u_ice and v_ice at the boundary for each iteration 
    641605         CALL bdy_ice_lim_dyn( 'U' ) 
    642606#endif          
     
    661625      ! 4) Prevent ice velocities when the ice is thin 
    662626      !------------------------------------------------------------------------------! 
    663       !clem : add hminrhg in the namelist 
    664       ! 
    665627      ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 
    666628      ! ocean velocity,  
     
    670632!CDIR NOVERRCHK 
    671633         DO ji = fs_2, fs_jpim1 
    672             zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - epsi10 ) )  
    673             !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , epsi10 ) 
    674634            zdummy = vt_i(ji,jj) 
    675635            IF ( zdummy .LE. hminrhg ) THEN 
     
    687647#endif 
    688648#if defined key_bdy 
    689       ! clem: change u_ice and v_ice at the boundary 
    690649      CALL bdy_ice_lim_dyn( 'U' ) 
    691650      CALL bdy_ice_lim_dyn( 'V' ) 
     
    694653      DO jj = k_j1+1, k_jpj-1  
    695654         DO ji = fs_2, fs_jpim1 
    696             zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - epsi10 ) )  
    697             !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , epsi10 ) 
    698655            zdummy = vt_i(ji,jj) 
    699656            IF ( zdummy .LE. hminrhg ) THEN 
     
    717674!CDIR NOVERRCHK 
    718675         DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi 
    719             !- zdd(:,:), zdt(:,:): divergence and tension at centre  
     676            !- divu_i(:,:), zdt(:,:): divergence and tension at centre  
    720677            !- zds(:,:): shear on northeast corner of grid cells 
    721             zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - epsi10 ) )  
    722             !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , epsi10 ) 
    723678            zdummy = vt_i(ji,jj) 
    724679            IF ( zdummy .LE. hminrhg ) THEN 
    725680 
    726                zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    727                   &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
    728                   &          +e1v(ji,jj)*v_ice(ji,jj)                      & 
    729                   &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
    730                   &         )                                              & 
    731                   &         / area(ji,jj) 
     681               divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
     682                  &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
     683                  &             +e1v(ji,jj)*v_ice(ji,jj)                      & 
     684                  &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
     685                  &            )                                              & 
     686                  &            / area(ji,jj) 
    732687 
    733688               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
     
    751706                  &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
    752707 
    753                zdst(ji,jj) = (  e2u( ji  , jj   ) * v_ice1(ji  ,jj  )    & 
     708               zdst = (  e2u( ji  , jj   ) * v_ice1(ji  ,jj  )    & 
    754709                  &           - e2u( ji-1, jj   ) * v_ice1(ji-1,jj  )    & 
    755710                  &           + e1v( ji  , jj   ) * u_ice2(ji  ,jj  )    & 
    756711                  &           - e1v( ji  , jj-1 ) * u_ice2(ji  ,jj-1)  ) / area(ji,jj) 
    757712 
    758 !              deltat(ji,jj) = SQRT(    zdd(ji,jj)*zdd(ji,jj)   &  
    759 !                  &                 + ( zdt(ji,jj)*zdt(ji,jj) + zdst(ji,jj)*zdst(ji,jj) ) * usecc2 &  
    760 !                  &                          ) + creepl 
    761                ! MV rewriting 
    762                delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst(ji,jj)*zdst(ji,jj) ) * usecc2 )   
    763                deltat(ji,jj) = delta + creepl 
    764                ! END MV 
     713               delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )   
     714               delta_i(ji,jj) = delta + creepl 
    765715             
    766716            ENDIF ! zdummy 
     
    777727      DO jj = k_j1+1, k_jpj-1 
    778728         DO ji = fs_2, fs_jpim1 
    779             divu_i (ji,jj) = zdd   (ji,jj) 
    780             delta_i(ji,jj) = deltat(ji,jj) 
    781729            ! begin TECLIM change  
    782             zdst(ji,jj)= (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &    
     730            zdst= (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &    
    783731               &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         &    
    784732               &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           &    
    785733               &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) / area(ji,jj)  
    786             shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst(ji,jj) * zdst(ji,jj) ) 
     734            shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 
    787735            ! end TECLIM change 
    788736         END DO 
     
    838786      ! 
    839787      CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 
    840       CALL wrk_dealloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                ) 
    841       CALL wrk_dealloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  ) 
    842       CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
     788      CALL wrk_dealloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                ) 
     789      CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
     790      CALL wrk_dealloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
    843791 
    844792   END SUBROUTINE lim_rhg 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r4205 r5086  
    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  ) 
     
    309308      INTEGER :: ji, jj, jk, jl, indx 
    310309      REAL(wp) ::   zfice, ziter 
    311       REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb   ! local scalars used for the salinity profile 
    312       REAL(wp), POINTER, DIMENSION(:)  ::   zs_zero  
     310      REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha   ! local scalars used for the salinity profile 
     311      REAL(wp), POINTER, DIMENSION(:)   ::   zs_zero  
    313312      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d 
    314313      CHARACTER(len=15) ::   znam 
     
    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      ! 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4614 r5086  
    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 
    3332   USE sbc_oce          ! Surface boundary condition: ocean fields 
    3433   USE sbccpl 
    35    USE cpl_oasis3, ONLY : lk_cpl 
    36    USE oce       , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     34   USE oce       , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    3735   USE albedo           ! albedo parameters 
    3836   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
     
    4341   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4442   USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget 
     43   USE iom 
     44   USE domvvl           ! Variable volume 
    4545 
    4646   IMPLICIT NONE 
     
    5050   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim 
    5151   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
    52  
    53    REAL(wp)  ::   rzero  = 0._wp     
    54    REAL(wp)  ::   rone   = 1._wp 
    5552 
    5653   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2] 
     
    9794      !!              - fr_i    : ice fraction 
    9895      !!              - tn_ice  : sea-ice surface temperature 
    99       !!              - alb_ice : sea-ice alberdo (lk_cpl=T) 
     96      !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
    10097      !! 
    10198      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
    10299      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
     100      !!              These refs are now obsolete since everything has been revised 
     101      !!              The ref should be Rousset et al., 2015? 
    103102      !!--------------------------------------------------------------------- 
    104       INTEGER, INTENT(in) ::   kt    ! number of iteration 
    105       ! 
    106       INTEGER  ::   ji, jj, jl           ! dummy loop indices 
    107       INTEGER  ::   ierr, ifvt, i1mfr, idfr           ! local integer 
    108       INTEGER  ::   iflt, ial , iadv , ifral, ifrdv   !   -      - 
    109       REAL(wp) ::   zinda, zemp, zemp_snow, zfmm      ! local scalars 
    110       REAL(wp) ::   zemp_snw                          !   -      - 
    111       REAL(wp) ::   zfcm1 , zfcm2                     !   -      - 
    112       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
    113       REAL(wp) ::   zzfcm1, zfscmbq ! clem: for light penetration 
     103      INTEGER, INTENT(in) ::   kt                                   ! number of iteration 
     104      ! 
     105      INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices 
     106      ! 
     107      REAL(wp) ::   zemp                                            !  local scalars 
     108      REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     109      REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean 
     110      ! 
     111      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
    114112      !!--------------------------------------------------------------------- 
    115        
    116       IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 
    117  
    118       !------------------------------------------! 
    119       !      heat flux at the ocean surface      ! 
    120       !------------------------------------------! 
     113 
     114      ! make calls for heat fluxes before it is modified 
     115      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface 
     116      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface 
     117      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux at ice surface 
     118      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 
     119      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux transmitted thru ice 
     120      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )   
     121      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 
     122 
    121123      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    122       ! changed to old_frld and old ht_i 
    123  
    124124      DO jj = 1, jpj 
    125125         DO ji = 1, jpi 
    126             zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    127             ifvt    = zinda  *  MAX( rzero , SIGN( rone, - phicif(ji,jj) ) )  !subscripts are bad here 
    128             i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - at_i(ji,jj) ) ) 
    129             idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 
    130             iflt    = zinda  * (1 - i1mfr) * (1 - ifvt ) 
    131             ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr 
    132             iadv    = ( 1  - i1mfr ) * zinda 
    133             ifral   = ( 1  - i1mfr * ( 1 - ial ) )    
    134             ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv  
    135  
    136             ! switch --- 1.0 ---------------- 0.0 -------------------- 
    137             ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    138             ! zinda   | if pfrld = 1       | if pfrld < 1            | 
    139             !  -> ifvt| if pfrld old_ht_i 
    140             ! i1mfr   | if frld = 1        | if frld  < 1            | 
    141             ! idfr    | if frld <= pfrld    | if frld > pfrld        | 
    142             ! iflt    |  
    143             ! ial     | 
    144             ! iadv    | 
    145             ! ifral 
    146             ! ifrdv 
    147  
    148             !   computation the solar flux at ocean surface 
    149             IF (lk_cpl) THEN ! be carfeful: not been tested yet 
    150                ! original line 
    151                !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 
    152                ! new line to include solar penetration (not tested) 
    153                zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     126 
     127            !------------------------------------------! 
     128            !      heat flux at the ocean surface      ! 
     129            !------------------------------------------! 
     130            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
     131            !--------------------------------------------------- 
     132            IF( lk_cpl ) THEN  
     133               !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
     134               zfcm1 = qsr_tot(ji,jj) 
    154135               DO jl = 1, jpl 
    155                   zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 
     136                  zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 
    156137               END DO 
    157138            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) ) 
     139               !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
     140               zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
     141               DO jl = 1, jpl 
     142                  zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 
     143               END DO 
    160144            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 
     145 
     146            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
     147            !--------------------------------------------------- 
     148            zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     149            hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 
     150 
     151            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
     152            !--------------------------------------------------- 
     153            qsr(ji,jj) = zfcm1                                       
     154            qns(ji,jj) = hfx_out(ji,jj) - zfcm1               
     155 
     156            !------------------------------------------! 
     157            !      mass flux at the ocean surface      ! 
     158            !------------------------------------------! 
    202159            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 
    203160            !  -------------------------------------------------------------------------------------  
     
    208165            !                     Even if i see Ice melting as a FW and SALT flux 
    209166            !         
    210  
    211167            !  computing freshwater exchanges at the ice/ocean interface 
    212             IF (lk_cpl) THEN  
     168            IF( lk_cpl ) THEN  
    213169               zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
    214                   &   - rdm_snw(ji,jj) / rdt_ice 
     170                  &   + wfx_snw(ji,jj) 
    215171            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 
     172               zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
     173                  &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean 
     174                  &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas )       ! except solid precip intercepted by sea-ice 
    220175            ENDIF 
    221176 
    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) 
     177            ! mass flux from ice/ocean 
     178            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
     179                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     180 
     181            ! mass flux at the ocean/ice interface 
     182            fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice                    ! F/M mass flux save at least for biogeochemical model 
     183            emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)       ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    229184             
    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) 
    233185         END DO 
    234186      END DO 
     
    237189      !      salt flux at the ocean surface      ! 
    238190      !------------------------------------------! 
    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 
     191      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
     192         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 
     193 
     194      !-------------------------------------------------------------! 
     195      !   mass of snow and ice per unit area for embedded sea-ice   ! 
     196      !-------------------------------------------------------------! 
     197      IF( nn_ice_embd /= 0 ) THEN 
     198         ! save mass from the previous ice time step 
     199         snwice_mass_b(:,:) = snwice_mass(:,:)                   
     200         ! new mass per unit area 
    251201         snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
    252          !                                                      ! time evolution of snow+ice mass 
     202         ! time evolution of snow+ice mass 
    253203         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
    254204      ENDIF 
     
    261211 
    262212      !------------------------------------------------! 
    263       !    Computation of snow/ice and ocean albedo    ! 
     213      !    Snow/ice albedo (only if sent to coupler)   ! 
    264214      !------------------------------------------------! 
    265215      IF( lk_cpl ) THEN          ! coupled case 
    266          CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo 
    267          ! 
    268          alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys) 
    269       ENDIF 
     216 
     217            CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
     218 
     219            CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
     220 
     221            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     222 
     223            CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
     224 
     225      ENDIF 
     226 
    270227 
    271228      IF(ln_ctl) THEN 
     
    275232         CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    276233      ENDIF 
    277       ! 
    278       IF( lk_cpl )   CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 
    279       !  
     234 
    280235   END SUBROUTINE lim_sbc_flx 
    281236 
     
    390345      ! clem modif 
    391346      IF( .NOT. ln_rstart ) THEN 
    392          iatte(:,:) = 1._wp 
    393          oatte(:,:) = 1._wp 
     347         fraqsr_1lev(:,:) = 1._wp 
    394348      ENDIF 
    395349      ! 
  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4624 r5086  
    88   !!            3.0  ! 2005-11 (M. Vancoppenolle)  LIM-3 : Multi-layer thermodynamics + salinity variations 
    99   !!             -   ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif 
    10    !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw 
     10   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw 
    1111   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 
    1212   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain variables 
    24    USE oce     , ONLY :  iatte, oatte 
     24   USE oce     , ONLY : fraqsr_1lev  
    2525   USE ice            ! LIM: sea-ice variables 
    2626   USE par_ice        ! LIM: sea-ice parameters 
     
    4343   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4444   USE timing         ! Timing 
     45   USE limcons        ! conservation tests 
    4546 
    4647   IMPLICIT NONE 
     
    4950   PUBLIC   lim_thd        ! called by limstp module 
    5051   PUBLIC   lim_thd_init   ! called by iceini module 
    51  
    52    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   zzero  = 0._wp      ! 
    54    REAL(wp) ::   zone   = 1._wp      ! 
    5552 
    5653   !! * Substitutions 
     
    6865      !!                ***  ROUTINE lim_thd  ***        
    6966      !!   
    70       !! ** Purpose : This routine manages the ice thermodynamic. 
     67      !! ** Purpose : This routine manages ice thermodynamics 
    7168      !!          
    7269      !! ** Action : - Initialisation of some variables 
     
    7471      !!               at the ice base, snow acc.,heat budget of the leads) 
    7572      !!             - selection of the icy points and put them in an array 
    76       !!             - call lim_vert_ther for vert ice thermodynamic 
    77       !!             - back to the geographic grid 
    78       !!             - selection of points for lateral accretion 
    79       !!             - call lim_lat_acc  for the ice accretion 
     73      !!             - call lim_thd_dif  for vertical heat diffusion 
     74      !!             - call lim_thd_dh   for vertical ice growth and melt 
     75      !!             - call lim_thd_ent  for enthalpy remapping 
     76      !!             - call lim_thd_sal  for ice desalination 
     77      !!             - call lim_thd_temp to  retrieve temperature from ice enthalpy 
    8078      !!             - back to the geographic grid 
    8179      !!      
    82       !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
     80      !! ** References :  
    8381      !!--------------------------------------------------------------------- 
    8482      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    8583      !! 
    86       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    87       INTEGER  ::   nbpb             ! nb of icy pts for thermo. cal. 
    88       REAL(wp) ::   zfric_umin = 5e-03_wp    ! lower bound for the friction velocity 
    89       REAL(wp) ::   zfric_umax = 2e-02_wp    ! upper bound for the friction velocity 
    90       REAL(wp) ::   zinda, zindb, zthsnice, zfric_u     ! local scalar 
    91       REAL(wp) ::   zfntlat, zpareff, zareamin, zcoef   !    -         - 
    92       REAL(wp), POINTER, DIMENSION(:,:) ::   zqlbsbq   ! link with lead energy budget qldif 
    93       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    94       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     84      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
     85      INTEGER  :: nbpb             ! nb of icy pts for thermo. cal. 
     86      INTEGER  :: ii, ij           ! temporary dummy loop index 
     87      REAL(wp) :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04) 
     88      REAL(wp) :: zch        = 0.0057_wp    ! heat transfer coefficient 
     89      REAL(wp) :: zareamin  
     90      REAL(wp) :: zfric_u, zqld, zqfr 
     91      ! 
     92      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     93      ! 
     94      REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns 
    9595      !!------------------------------------------------------------------- 
     96      CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 
     97 
    9698      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    9799 
    98       CALL wrk_alloc( jpi, jpj, zqlbsbq ) 
    99     
    100       ! ------------------------------- 
    101       !- check conservation (C Rousset) 
    102       IF (ln_limdiahsb) THEN 
    103          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    104          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    105          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    106          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    107       ENDIF 
    108       !- check conservation (C Rousset) 
    109       ! ------------------------------- 
    110  
    111       !------------------------------------------------------------------------------! 
    112       ! 1) Initialization of diagnostic variables                                    ! 
    113       !------------------------------------------------------------------------------! 
     100      ! conservation test 
     101      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     102 
     103      !------------------------------------------------------------------------! 
     104      ! 1) Initialization of some variables                                    ! 
     105      !------------------------------------------------------------------------! 
     106      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice 
     107 
    114108 
    115109      !-------------------- 
     
    121115            DO jj = 1, jpj 
    122116               DO ji = 1, jpi 
     117                  !0 if no ice and 1 if yes 
     118                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  ) 
    123119                  !Energy of melting q(S,T) [J.m-3] 
    124                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 
    125                   !0 if no ice and 1 if yes 
    126                   zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  ) 
    127                   !convert units ! very important that this line is here 
    128                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb  
     120                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 
     121                  !convert units ! very important that this line is here         
     122                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac  
    129123               END DO 
    130124            END DO 
     
    133127            DO jj = 1, jpj 
    134128               DO ji = 1, jpi 
     129                  !0 if no ice and 1 if yes 
     130                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  ) 
    135131                  !Energy of melting q(S,T) [J.m-3] 
    136                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 
    137                   !0 if no ice and 1 if yes 
    138                   zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  ) 
     132                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 
    139133                  !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  
     134                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac  
    141135               END DO 
    142136            END DO 
    143137         END DO 
    144138      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 
    155139 
    156140      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    157141      !-----------------------------------------------------------------------------! 
     142 
     143      !--- Ocean solar and non solar fluxes to be used in zqld 
     144      IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean 
     145         ! 
     146         zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:) 
     147         ! 
     148      ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted 
     149         ! 
     150         zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:) 
     151         ! 
     152         DO jl = 1, jpl 
     153            DO jj = 1, jpj 
     154               DO ji = 1, jpi 
     155                  zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
     156                  zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
     157               END DO 
     158            END DO 
     159         END DO 
     160         ! 
     161      ENDIF 
    158162 
    159163!CDIR NOVERRCHK 
     
    161165!CDIR NOVERRCHK 
    162166         DO ji = 1, jpi 
    163             zinda          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) + epsi10 ) ) ) 
     167            rswitch          = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 
    164168            ! 
    165169            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
     
    168172            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
    169173            !           !  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 
    187174            ! 
    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 ) ) 
     175 
     176            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
     177            ! REMARK valid at least in forced mode from clem 
     178            ! precip is included in qns but not in qns_ice 
     179            IF ( lk_cpl ) THEN 
     180               zqld =  tms(ji,jj) * rdt_ice *  & 
     181                  &    (   zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj)               &   ! pfrld already included in coupled mode 
     182                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *     &   ! heat content of precip 
     183                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )   & 
     184                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     185            ELSE 
     186               zqld =  tms(ji,jj) * rdt_ice *  & 
     187                  &      ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) )    & 
     188                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *             &  ! heat content of precip 
     189                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )           & 
     190                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     191            ENDIF 
     192 
     193            !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     194            zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     195 
     196            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 
     197            qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )  
     198 
     199            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting  
     200            IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN 
     201               fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90 
     202               qlead(ji,jj) = 0._wp 
     203            ELSE 
     204               fhld (ji,jj) = 0._wp 
     205            ENDIF 
    194206            ! 
    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             ! 
     207            !-- Energy from the turbulent oceanic heat flux --- ! 
     208            !clem zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) 
     209            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
     210            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2  
     211            ! upper bound for fhtur: we do not want SST to drop below Tfreeze.  
     212            ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)    
     213            ! This is not a clean budget, so that should be corrected at some point 
     214            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     215 
     216            ! ----------------------------------------- 
     217            ! Net heat flux on top of ice-ocean [W.m-2] 
     218            ! ----------------------------------------- 
     219            !     First  step here      : heat flux at the ocean surface + precip 
     220            !     Second step below     : heat flux at the ice   surface (after limthd_dif)  
     221            hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
     222               ! heat flux above the ocean 
     223               &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  & 
     224               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     225               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     226               &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) 
     227 
     228            ! ----------------------------------------------------------------------------- 
     229            ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 
     230            ! ----------------------------------------------------------------------------- 
     231            !     First  step here              :  non solar + precip - qlead - qturb 
     232            !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
     233            !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     234            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                       &  
     235               ! Non solar heat flux received by the ocean 
     236               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                            & 
     237               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     238               &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)       & 
     239               &         * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     240               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )       & 
     241               ! heat flux taken from the ocean where there is open water ice formation 
     242               &    -      qlead(ji,jj) * r1_rdtice                                                                               & 
     243               ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 
     244               &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                             & 
     245               &    -      at_i(ji,jj) *  fhld(ji,jj) 
     246 
    205247         END DO 
    206248      END DO 
     
    234276               DO jj = mj0(jjindx), mj1(jjindx) 
    235277                  jiindex_1d = (jj - 1) * jpi + ji 
     278                  WRITE(numout,*) ' lim_thd : Category no : ', jl  
    236279               END DO 
    237280            END DO 
     
    250293            !------------------------- 
    251294 
    252             CALL tab_2d_1d( nbpb, at_i_b     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
    253             CALL tab_2d_1d( nbpb, a_i_b      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
    254             CALL tab_2d_1d( nbpb, ht_i_b     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    255             CALL tab_2d_1d( nbpb, ht_s_b     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    256  
    257             CALL tab_2d_1d( nbpb, t_su_b     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    258             CALL tab_2d_1d( nbpb, sm_i_b     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     295            CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
     296            CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
     297            CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     298            CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     299 
     300            CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     301            CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    259302            DO jk = 1, nlay_s 
    260                CALL tab_2d_1d( nbpb, t_s_b(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    261                CALL tab_2d_1d( nbpb, q_s_b(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     303               CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     304               CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    262305            END DO 
    263306            DO jk = 1, nlay_i 
    264                CALL tab_2d_1d( nbpb, t_i_b(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    265                CALL tab_2d_1d( nbpb, q_i_b(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    266                CALL tab_2d_1d( nbpb, s_i_b(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     307               CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     308               CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     309               CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    267310            END DO 
    268311 
     
    271314            CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
    272315            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 
     316            CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     317            CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     318            IF( .NOT. lk_cpl ) THEN 
     319               CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     320               CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     321            ENDIF 
    278322            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    279             CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
     323            CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
    280324            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) ) 
     325            CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) ) 
     326            CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
     327            CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
     328 
     329            CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     330            CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     331 
     332            CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     333            CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     334            CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     335            CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) ) 
     336            CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) ) 
     337            CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     338 
     339            CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     340            CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     341            CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     342            CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) ) 
    289343            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 
     344            CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
     345 
     346            CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     347            CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     348            CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     349            CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     350            CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     351            CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) ) 
     352            CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) ) 
     353            CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     354            CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     355            CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) ) 
     356            CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) ) 
     357            CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
     358 
    296359            !-------------------------------- 
    297360            ! 4.3) Thermodynamic processes 
    298361            !-------------------------------- 
    299362 
    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 ) 
     363            !---------------------------------! 
     364            ! Ice/Snow Temperature profile    ! 
     365            !---------------------------------! 
     366            CALL lim_thd_dif( 1, nbpb ) 
     367 
     368            !---------------------------------! 
     369            ! Ice/Snow thicnkess              ! 
     370            !---------------------------------! 
     371            CALL lim_thd_dh( 1, nbpb )     
     372 
     373            ! --- Ice enthalpy remapping --- ! 
     374            CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  
     375                                             
     376            !---------------------------------! 
     377            ! --- Ice salinity --- ! 
     378            !---------------------------------! 
     379            CALL lim_thd_sal( 1, nbpb )     
     380 
     381            !---------------------------------! 
     382            ! --- temperature update --- ! 
     383            !---------------------------------! 
     384            CALL lim_thd_temp( 1, nbpb ) 
    327385 
    328386            !-------------------------------- 
     
    330388            !-------------------------------- 
    331389 
    332                CALL tab_1d_2d( nbpb, at_i          , npb, at_i_b    (1:nbpb)   , jpi, jpj ) 
    333                CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_b    (1:nbpb)   , jpi, jpj ) 
    334                CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_b    (1:nbpb)   , jpi, jpj ) 
    335                CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_b     (1:nbpb)   , jpi, jpj ) 
    336                CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_b    (1:nbpb)   , jpi, jpj ) 
    337                CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_b    (1:nbpb)   , jpi, jpj ) 
     390               CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj ) 
     391               CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj ) 
     392               CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj ) 
     393               CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj ) 
     394               CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj ) 
     395               CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj ) 
    338396            DO jk = 1, nlay_s 
    339                CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b     (1:nbpb,jk), jpi, jpj) 
    340                CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b     (1:nbpb,jk), jpi, jpj) 
     397               CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj) 
     398               CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj) 
    341399            END DO 
    342400            DO jk = 1, nlay_i 
    343                CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b     (1:nbpb,jk), jpi, jpj) 
    344                CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b     (1:nbpb,jk), jpi, jpj) 
    345                CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b     (1:nbpb,jk), jpi, jpj) 
    346             END DO 
    347                CALL tab_1d_2d( nbpb, fstric        , npb, fstbif_1d (1:nbpb)   , jpi, jpj ) 
    348                CALL tab_1d_2d( nbpb, qldif         , npb, qldif_1d  (1:nbpb)   , jpi, jpj ) 
    349                CALL tab_1d_2d( nbpb, qfvbq         , npb, qfvbq_1d  (1:nbpb)   , jpi, jpj ) 
    350                CALL tab_1d_2d( nbpb, rdm_ice       , npb, rdm_ice_1d(1:nbpb)   , jpi, jpj ) 
    351                CALL tab_1d_2d( nbpb, rdm_snw       , npb, rdm_snw_1d(1:nbpb)   , jpi, jpj ) 
    352                CALL tab_1d_2d( nbpb, dmgwi         , npb, dmgwi_1d  (1:nbpb)   , jpi, jpj ) 
    353                CALL tab_1d_2d( nbpb, rdvosif       , npb, dvsbq_1d  (1:nbpb)   , jpi, jpj ) 
    354                CALL tab_1d_2d( nbpb, rdvobif       , npb, dvbbq_1d  (1:nbpb)   , jpi, jpj ) 
    355                CALL tab_1d_2d( nbpb, fdvolif       , npb, dvlbq_1d  (1:nbpb)   , jpi, jpj ) 
    356                CALL tab_1d_2d( nbpb, rdvonif       , npb, dvnbq_1d  (1:nbpb)   , jpi, jpj )  
    357                CALL tab_1d_2d( nbpb, sfx_thd       , npb, sfx_thd_1d(1:nbpb)   , jpi, jpj ) 
     401               CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj) 
     402               CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj) 
     403               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj) 
     404            END DO 
     405               CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
     406 
     407               CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     408               CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     409 
     410               CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     411               CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     412               CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     413               CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     414               CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj ) 
     415               CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     416 
     417               CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     418               CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     419               CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     420               CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     421               CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
     422               CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
     423 
     424              CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
     425              CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     426              CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     427              CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     428              CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     429              CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj ) 
     430              CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj ) 
     431              CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     432              CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     433              CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj ) 
     434              CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
     435              CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj ) 
    358436            ! 
    359             IF( num_sal == 2 ) THEN 
    360                CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
    361                CALL tab_1d_2d( nbpb, fhbri         , npb, fhbri_1d  (1:nbpb)   , jpi, jpj ) 
    362             ENDIF 
    363             ! 
    364             !+++++       temporary stuff for a dummy version 
    365             CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj ) 
    366             CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj ) 
    367             CALL tab_1d_2d( nbpb, fsup2D     , npb, fsup     (1:nbpb)      , jpi, jpj ) 
    368             CALL tab_1d_2d( nbpb, focea2D    , npb, focea    (1:nbpb)      , jpi, jpj ) 
    369             CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj ) 
    370             CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj ) 
    371             CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 
    372             !+++++ 
     437              CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
     438              CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
    373439            ! 
    374440            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
     
    384450      ! 5.1) Ice heat content               
    385451      !------------------------ 
    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 ) ) 
     452      ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
    388453      DO jl = 1, jpl 
    389454         DO jk = 1, nlay_i 
    390             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef 
     455            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) ) 
    391456         END DO 
    392457      END DO 
     
    395460      ! 5.2) Snow heat content               
    396461      !------------------------ 
    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 ) ) 
     462      ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
    399463      DO jl = 1, jpl 
    400464         DO jk = 1, nlay_s 
    401             e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef 
     465            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) ) 
    402466         END DO 
    403467      END DO 
     
    411475      ! 5.4) Diagnostic thermodynamic growth rates 
    412476      !-------------------------------------------- 
    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  
    418477      IF(ln_ctl) THEN            ! Control print 
    419478         CALL prt_ctl_info(' ') 
     
    448507      ENDIF 
    449508      ! 
    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 ) 
     509      ! 
     510      CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 
     511 
     512      ! 
     513      ! conservation test 
     514      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    475515      ! 
    476516      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 ) 
     517 
     518   END SUBROUTINE lim_thd  
     519 
     520   SUBROUTINE lim_thd_temp( kideb, kiut ) 
    481521      !!----------------------------------------------------------------------- 
    482       !!                   ***  ROUTINE lim_thd_glohec ***  
     522      !!                   ***  ROUTINE lim_thd_temp ***  
    483523      !!                  
    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) 
     524      !! ** Purpose :   Computes sea ice temperature (Kelvin) from enthalpy 
    780525      !! 
    781526      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
     
    784529      !! 
    785530      INTEGER  ::   ji, jk   ! dummy loop indices 
    786       REAL(wp) ::   ztmelts  ! local scalar  
     531      REAL(wp) ::   ztmelts, zaaa, zbbb, zccc, zdiscrim  ! local scalar  
    787532      !!------------------------------------------------------------------- 
    788       ! 
    789       DO jk = 1, nlay_i             ! Sea ice energy of melting 
     533      ! Recover ice temperature 
     534      DO jk = 1, nlay_i 
    790535         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