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

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

Ignore:
Timestamp:
2015-01-15T14:48:42+01:00 (9 years ago)
Author:
andrewryan
Message:

merge with trunk

Location:
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3
Files:
27 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4333 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90

    r4624 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r4161 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r4161 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r4346 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4624 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r4333 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4624 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4624 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r4333 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r4346 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r4205 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4614 r5034  
    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_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4624 r5034  
    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       DO jk = 1, nlay_s             ! Snow energy of melting 
    798          DO ji = kideb, kiut 
    799             q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 
    800          END DO 
    801       END DO 
    802       ! 
    803    END SUBROUTINE lim_thd_enmelt 
    804  
     536            ztmelts       =  -tmut * s_i_1d(ji,jk) + rtt 
     537            ! Conversion q(S,T) -> T (second order equation) 
     538            zaaa          =  cpic 
     539            zbbb          =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus 
     540            zccc          =  lfus * ( ztmelts - rtt ) 
     541            zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 
     542            t_i_1d(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 
     543             
     544            ! mask temperature 
     545            rswitch       =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )  
     546            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rtt 
     547         END DO  
     548      END DO  
     549 
     550   END SUBROUTINE lim_thd_temp 
    805551 
    806552   SUBROUTINE lim_thd_init 
     
    818564      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    819565      NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   & 
    820          &                hicmin, hiclim,                                        & 
    821          &                sbeta  , parlat, hakspl, hibspl, exld,                 & 
    822          &                hakdif, hnzst  , thth  , parsub, alphs, betas,         &  
     566         &                hiclim, hnzst, parsub, betas,                          &  
    823567         &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi 
    824568      !!------------------------------------------------------------------- 
     
    838582902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 
    839583      IF(lwm) WRITE ( numoni, namicethd ) 
     584 
     585      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
    840586      ! 
    841587      IF(lwp) THEN                          ! control print 
     
    843589         WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation ' 
    844590         WRITE(numout,*)'      maximum melting at the bottom                           hmelt        = ', hmelt 
    845          WRITE(numout,*)'      ice thick. for lateral accretion in NH (SH)             hiccrit(1/2) = ', hiccrit 
     591         WRITE(numout,*)'      ice thick. for lateral accretion                        hiccrit      = ', hiccrit 
    846592         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       fraz_swi     = ', fraz_swi 
    847593         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   maxfrazb     = ', maxfrazb 
    848594         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  vfrazb       = ', vfrazb 
    849595         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          Cfrazb       = ', Cfrazb 
    850          WRITE(numout,*)'      ice thick. corr. to max. energy stored in brine pocket  hicmin       = ', hicmin   
    851596         WRITE(numout,*)'      minimum ice thickness                                   hiclim       = ', hiclim  
    852597         WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice ' 
    853          WRITE(numout,*)'      Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)   sbeta        = ', sbeta 
    854          WRITE(numout,*)'      percentage of energy used for lateral ablation          parlat       = ', parlat 
    855          WRITE(numout,*)'      slope of distr. for Hakkinen-Mellor lateral melting     hakspl       = ', hakspl   
    856          WRITE(numout,*)'      slope of distribution for Hibler lateral melting        hibspl       = ', hibspl 
    857          WRITE(numout,*)'      exponent for leads-closure rate                         exld         = ', exld 
    858          WRITE(numout,*)'      coefficient for diffusions of ice and snow              hakdif       = ', hakdif 
    859          WRITE(numout,*)'      threshold thick. for comp. of eq. thermal conductivity  zhth         = ', thth  
    860598         WRITE(numout,*)'      thickness of the surf. layer in temp. computation       hnzst        = ', hnzst 
    861599         WRITE(numout,*)'      switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub   
    862          WRITE(numout,*)'      coefficient for snow density when snow ice formation    alphs        = ', alphs 
    863600         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          betas        = ', betas 
    864601         WRITE(numout,*)'      extinction radiation parameter in sea ice (1.0)         kappa_i      = ', kappa_i 
     
    866603         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd 
    867604         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     thcon_i_swi  = ', thcon_i_swi 
     605         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
    868606      ENDIF 
    869       ! 
    870       rcdsn = hakdif * rcdsn  
    871       rcdic = hakdif * rcdic 
    872607      ! 
    873608   END SUBROUTINE lim_thd_init 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

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

    r4333 r5034  
    2525   USE wrk_nemo       ! work arrays 
    2626   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     27   USE sbc_oce, ONLY : lk_cpl 
    2728 
    2829   IMPLICIT NONE 
     
    3132   PUBLIC   lim_thd_dif   ! called by lim_thd 
    3233 
    33    REAL(wp) ::   epsi10      =  1.e-10_wp    ! 
    3434   !!---------------------------------------------------------------------- 
    3535   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     
    3939CONTAINS 
    4040 
    41    SUBROUTINE lim_thd_dif( kideb , kiut , jl ) 
     41   SUBROUTINE lim_thd_dif( kideb , kiut ) 
    4242      !!------------------------------------------------------------------ 
    4343      !!                ***  ROUTINE lim_thd_dif  *** 
     
    7474      !! 
    7575      !! ** Inputs / Ouputs : (global commons) 
    76       !!           surface temperature : t_su_b 
    77       !!           ice/snow temperatures   : t_i_b, t_s_b 
    78       !!           ice salinities          : s_i_b 
     76      !!           surface temperature : t_su_1d 
     77      !!           ice/snow temperatures   : t_i_1d, t_s_1d 
     78      !!           ice salinities          : s_i_1d 
    7979      !!           number of layers in the ice/snow: nlay_i, nlay_s 
    8080      !!           profile of the ice/snow layers : z_i, z_s 
    81       !!           total ice/snow thickness : ht_i_b, ht_s_b 
     81      !!           total ice/snow thickness : ht_i_1d, ht_s_1d 
    8282      !! 
    8383      !! ** External :  
     
    9191      !!           (04-2007) Energy conservation tested by M. Vancoppenolle 
    9292      !!------------------------------------------------------------------ 
    93       INTEGER , INTENT (in) ::   kideb   ! Start point on which the  the computation is applied 
    94       INTEGER , INTENT (in) ::   kiut    ! End point on which the  the computation is applied 
    95       INTEGER , INTENT (in) ::   jl      ! Category number 
     93      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    9694 
    9795      !! * Local variables 
     
    9997      INTEGER ::   ii, ij      ! temporary dummy loop index 
    10098      INTEGER ::   numeq       ! current reference number of equation 
    101       INTEGER ::   layer       ! vertical dummy loop index  
     99      INTEGER ::   jk       ! vertical dummy loop index  
    102100      INTEGER ::   nconv       ! number of iterations in iterative procedure 
    103101      INTEGER ::   minnumeqmin, maxnumeqmax 
    104       INTEGER, DIMENSION(kiut) ::   numeqmin   ! reference number of top equation 
    105       INTEGER, DIMENSION(kiut) ::   numeqmax   ! reference number of bottom equation 
    106       INTEGER, DIMENSION(kiut) ::   isnow      ! switch for presence (1) or absence (0) of snow 
     102      INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation 
     103      INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation 
     104      INTEGER, POINTER, DIMENSION(:) ::   isnow      ! switch for presence (1) or absence (0) of snow 
    107105      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
    108106      REAL(wp) ::   zg1       =  2._wp        ! 
    109107      REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat 
    110108      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13) 
    111       REAL(wp) ::   zraext_s  =  1.e+8_wp     ! extinction coefficient of radiation in the snow 
     109      REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow 
    112110      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
     111      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered as 0°C  
    113112      REAL(wp) ::   ztmelt_i    ! ice melting temperature 
    114113      REAL(wp) ::   zerritmax   ! current maximal error on temperature  
    115       REAL(wp), DIMENSION(kiut) ::   ztfs        ! ice melting point 
    116       REAL(wp), DIMENSION(kiut) ::   ztsuold     ! old surface temperature (before the iterative procedure ) 
    117       REAL(wp), DIMENSION(kiut) ::   ztsuoldit   ! surface temperature at previous iteration 
    118       REAL(wp), DIMENSION(kiut) ::   zh_i        ! ice layer thickness 
    119       REAL(wp), DIMENSION(kiut) ::   zh_s        ! snow layer thickness 
    120       REAL(wp), DIMENSION(kiut) ::   zfsw        ! solar radiation absorbed at the surface 
    121       REAL(wp), DIMENSION(kiut) ::   zf          ! surface flux function 
    122       REAL(wp), DIMENSION(kiut) ::   dzf         ! derivative of the surface flux function 
    123       REAL(wp), DIMENSION(kiut) ::   zerrit      ! current error on temperature 
    124       REAL(wp), DIMENSION(kiut) ::   zdifcase    ! case of the equation resolution (1->4) 
    125       REAL(wp), DIMENSION(kiut) ::   zftrice     ! solar radiation transmitted through the ice 
    126       REAL(wp), DIMENSION(kiut) ::   zihic, zhsu 
    127       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztcond_i    ! Ice thermal conductivity 
    128       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradtr_i    ! Radiation transmitted through the ice 
    129       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradab_i    ! Radiation absorbed in the ice 
    130       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zkappa_i    ! Kappa factor in the ice 
    131       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztiold      ! Old temperature in the ice 
    132       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zeta_i      ! Eta factor in the ice 
    133       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztitemp     ! Temporary temperature in the ice to check the convergence 
    134       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zspeche_i   ! Ice specific heat 
    135       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   z_i         ! Vertical cotes of the layers in the ice 
    136       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradtr_s    ! Radiation transmited through the snow 
    137       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradab_s    ! Radiation absorbed in the snow 
    138       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zkappa_s    ! Kappa factor in the snow 
    139       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zeta_s       ! Eta factor in the snow 
    140       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztstemp      ! Temporary temperature in the snow to check the convergence 
    141       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztsold       ! Temporary temperature in the snow 
    142       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   z_s          ! Vertical cotes of the layers in the snow 
    143       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindterm   ! Independent term 
    144       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindtbis   ! temporary independent term 
    145       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zdiagbis 
    146       REAL(wp), DIMENSION(kiut,jkmax+2,3) ::   ztrid   ! tridiagonal system terms 
     114      REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! ice melting point 
     115      REAL(wp), POINTER, DIMENSION(:) ::   ztsub       ! old surface temperature (before the iterative procedure ) 
     116      REAL(wp), POINTER, DIMENSION(:) ::   ztsubit     ! surface temperature at previous iteration 
     117      REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness 
     118      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness 
     119      REAL(wp), POINTER, DIMENSION(:) ::   zfsw        ! solar radiation absorbed at the surface 
     120      REAL(wp), POINTER, DIMENSION(:) ::   zf          ! surface flux function 
     121      REAL(wp), POINTER, DIMENSION(:) ::   dzf         ! derivative of the surface flux function 
     122      REAL(wp), POINTER, DIMENSION(:) ::   zerrit      ! current error on temperature 
     123      REAL(wp), POINTER, DIMENSION(:) ::   zdifcase    ! case of the equation resolution (1->4) 
     124      REAL(wp), POINTER, DIMENSION(:) ::   zftrice     ! solar radiation transmitted through the ice 
     125      REAL(wp), POINTER, DIMENSION(:) ::   zihic, zhsu 
     126      REAL(wp), POINTER, DIMENSION(:,:) ::   ztcond_i    ! Ice thermal conductivity 
     127      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_i    ! Radiation transmitted through the ice 
     128      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_i    ! Radiation absorbed in the ice 
     129      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_i    ! Kappa factor in the ice 
     130      REAL(wp), POINTER, DIMENSION(:,:) ::   ztib        ! Old temperature in the ice 
     131      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_i      ! Eta factor in the ice 
     132      REAL(wp), POINTER, DIMENSION(:,:) ::   ztitemp     ! Temporary temperature in the ice to check the convergence 
     133      REAL(wp), POINTER, DIMENSION(:,:) ::   zspeche_i   ! Ice specific heat 
     134      REAL(wp), POINTER, DIMENSION(:,:) ::   z_i         ! Vertical cotes of the layers in the ice 
     135      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_s    ! Radiation transmited through the snow 
     136      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_s    ! Radiation absorbed in the snow 
     137      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_s    ! Kappa factor in the snow 
     138      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_s      ! Eta factor in the snow 
     139      REAL(wp), POINTER, DIMENSION(:,:) ::   ztstemp     ! Temporary temperature in the snow to check the convergence 
     140      REAL(wp), POINTER, DIMENSION(:,:) ::   ztsb        ! Temporary temperature in the snow 
     141      REAL(wp), POINTER, DIMENSION(:,:) ::   z_s         ! Vertical cotes of the layers in the snow 
     142      REAL(wp), POINTER, DIMENSION(:,:) ::   zswiterm    ! Independent term 
     143      REAL(wp), POINTER, DIMENSION(:,:) ::   zswitbis    ! temporary independent term 
     144      REAL(wp), POINTER, DIMENSION(:,:) ::   zdiagbis 
     145      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid     ! tridiagonal system terms 
     146      ! diag errors on heat 
     147      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 
    147148      !!------------------------------------------------------------------      
    148149      !  
     150      CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow ) 
     151      CALL wrk_alloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
     152      CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 
     153      CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0) 
     154      CALL wrk_alloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0) 
     155      CALL wrk_alloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis  ) 
     156      CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid ) 
     157 
     158      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 
     159 
     160      ! --- diag error on heat diffusion - PART 1 --- ! 
     161      zdq(:) = 0._wp ; zq_ini(:) = 0._wp       
     162      DO ji = kideb, kiut 
     163         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  & 
     164            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) )  
     165      END DO 
     166 
    149167      !------------------------------------------------------------------------------! 
    150168      ! 1) Initialization                                                            ! 
    151169      !------------------------------------------------------------------------------! 
    152       ! 
     170      ! clem clean: replace just ztfs by rtt 
    153171      DO ji = kideb , kiut 
    154172         ! is there snow or not 
    155          isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
     173         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  ) 
    156174         ! surface temperature of fusion 
    157 !!gm ???  ztfs(ji) = rtt !!!???? 
    158175         ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 
    159176         ! layer thickness 
    160          zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
    161          zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 
     177         zh_i(ji) = ht_i_1d(ji) / REAL( nlay_i ) 
     178         zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s ) 
    162179      END DO 
    163180 
     
    169186      z_i(:,0) = 0._wp   ! vert. coord. of the up. lim. of the 1st ice layer 
    170187 
    171       DO layer = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
    172          DO ji = kideb , kiut 
    173             z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / REAL( nlay_s ) 
    174          END DO 
    175       END DO 
    176  
    177       DO layer = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
    178          DO ji = kideb , kiut 
    179             z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / REAL( nlay_i ) 
     188      DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
     189         DO ji = kideb , kiut 
     190            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) / REAL( nlay_s ) 
     191         END DO 
     192      END DO 
     193 
     194      DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
     195         DO ji = kideb , kiut 
     196            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) / REAL( nlay_i ) 
    180197         END DO 
    181198      END DO 
     
    194211      ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface  
    195212      ! zftrice = io.qsr_ice       is below the surface  
    196       ! fstbif = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
     213      ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
    197214 
    198215      DO ji = kideb , kiut 
    199216         ! switches 
    200          isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  )  
     217         isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )  )  
    201218         ! hs > 0, isnow = 1 
    202219         zhsu (ji) = hnzst  ! threshold for the computation of i0 
    203          zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_b(ji) / zhsu(ji) ) )      
     220         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu(ji) ) )      
    204221 
    205222         i0(ji)    = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
     
    208225         !            a function of the cloud cover 
    209226         ! 
    210          !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_b(ji)+10.0) 
     227         !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_1d(ji)+10.0) 
    211228         !formula used in Cice 
    212229      END DO 
     
    230247      END DO 
    231248 
    232       DO layer = 1, nlay_s          ! Radiation through snow 
     249      DO jk = 1, nlay_s          ! Radiation through snow 
    233250         DO ji = kideb, kiut 
    234251            !                             ! radiation transmitted below the layer-th snow layer 
    235             zradtr_s(ji,layer) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,layer) ) ) ) 
     252            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,jk) ) ) ) 
    236253            !                             ! radiation absorbed by the layer-th snow layer 
    237             zradab_s(ji,layer) = zradtr_s(ji,layer-1) - zradtr_s(ji,layer) 
     254            zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk) 
    238255         END DO 
    239256      END DO 
     
    243260      END DO 
    244261 
    245       DO layer = 1, nlay_i          ! Radiation through ice 
     262      DO jk = 1, nlay_i          ! Radiation through ice 
    246263         DO ji = kideb, kiut 
    247264            !                             ! radiation transmitted below the layer-th ice layer 
    248             zradtr_i(ji,layer) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,layer) ) ) ) 
     265            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) ) 
    249266            !                             ! radiation absorbed by the layer-th ice layer 
    250             zradab_i(ji,layer) = zradtr_i(ji,layer-1) - zradtr_i(ji,layer) 
     267            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) 
    251268         END DO 
    252269      END DO 
    253270 
    254271      DO ji = kideb, kiut           ! Radiation transmitted below the ice 
    255          fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 
    256       END DO 
    257  
    258       ! +++++ 
    259       ! just to check energy conservation 
    260       DO ji = kideb, kiut 
    261          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    262          ij =    ( npb(ji) - 1 ) / jpi + 1 
    263          fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 
    264       END DO 
    265       ! +++++ 
    266  
    267       DO layer = 1, nlay_i 
    268          DO ji = kideb, kiut 
    269             radab(ji,layer) = zradab_i(ji,layer) 
    270          END DO 
     272         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i)  
    271273      END DO 
    272274 
     
    277279      ! 
    278280      DO ji = kideb, kiut        ! Old surface temperature 
    279          ztsuold  (ji) =  t_su_b(ji)                              ! temperature at the beg of iter pr. 
    280          ztsuoldit(ji) =  t_su_b(ji)                              ! temperature at the previous iter 
    281          t_su_b   (ji) =  MIN( t_su_b(ji), ztfs(ji)-0.00001 )     ! necessary 
     281         ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr. 
     282         ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter 
     283         t_su_1d   (ji) =  MIN( t_su_1d(ji), ztfs(ji) - ztsu_err )  ! necessary 
    282284         zerrit   (ji) =  1000._wp                                ! initial value of error 
    283285      END DO 
    284286 
    285       DO layer = 1, nlay_s       ! Old snow temperature 
    286          DO ji = kideb , kiut 
    287             ztsold(ji,layer) =  t_s_b(ji,layer) 
    288          END DO 
    289       END DO 
    290  
    291       DO layer = 1, nlay_i       ! Old ice temperature 
    292          DO ji = kideb , kiut 
    293             ztiold(ji,layer) =  t_i_b(ji,layer) 
     287      DO jk = 1, nlay_s       ! Old snow temperature 
     288         DO ji = kideb , kiut 
     289            ztsb(ji,jk) =  t_s_1d(ji,jk) 
     290         END DO 
     291      END DO 
     292 
     293      DO jk = 1, nlay_i       ! Old ice temperature 
     294         DO ji = kideb , kiut 
     295            ztib(ji,jk) =  t_i_1d(ji,jk) 
    294296         END DO 
    295297      END DO 
     
    308310         IF( thcon_i_swi == 0 ) THEN      ! Untersteiner (1964) formula 
    309311            DO ji = kideb , kiut 
    310                ztcond_i(ji,0)        = rcdic + zbeta*s_i_b(ji,1) / MIN(-epsi10,t_i_b(ji,1)-rtt) 
     312               ztcond_i(ji,0)        = rcdic + zbeta*s_i_1d(ji,1) / MIN(-epsi10,t_i_1d(ji,1)-rtt) 
    311313               ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin) 
    312314            END DO 
    313             DO layer = 1, nlay_i-1 
     315            DO jk = 1, nlay_i-1 
    314316               DO ji = kideb , kiut 
    315                   ztcond_i(ji,layer) = rcdic + zbeta*( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) /  & 
    316                      MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt) 
    317                   ztcond_i(ji,layer) = MAX(ztcond_i(ji,layer),zkimin) 
     317                  ztcond_i(ji,jk) = rcdic + zbeta*( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  & 
     318                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt) 
     319                  ztcond_i(ji,jk) = MAX(ztcond_i(ji,jk),zkimin) 
    318320               END DO 
    319321            END DO 
     
    322324         IF( thcon_i_swi == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T 
    323325            DO ji = kideb , kiut 
    324                ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_b(ji,1) / MIN( -epsi10, t_i_b(ji,1)-rtt )   & 
    325                   &                   - 0.011_wp * ( t_i_b(ji,1) - rtt )   
     326               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1)-rtt )   & 
     327                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rtt )   
    326328               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 
    327329            END DO 
    328             DO layer = 1, nlay_i-1 
     330            DO jk = 1, nlay_i-1 
    329331               DO ji = kideb , kiut 
    330                   ztcond_i(ji,layer) = rcdic + 0.090_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) )   & 
    331                      &                                  / MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt)   & 
    332                      &                       - 0.0055_wp* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt )   
    333                   ztcond_i(ji,layer) = MAX( ztcond_i(ji,layer), zkimin ) 
     332                  ztcond_i(ji,jk) = rcdic +                                                                     &  
     333                     &                 0.090_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                          & 
     334                     &                 / MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)   & 
     335                     &               - 0.0055_wp* ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0*rtt )   
     336                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin ) 
    334337               END DO 
    335338            END DO 
    336339            DO ji = kideb , kiut 
    337                ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN(-epsi10,t_bo_b(ji)-rtt)   & 
    338                   &                        - 0.011_wp * ( t_bo_b(ji) - rtt )   
     340               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN(-epsi10,t_bo_1d(ji)-rtt)   & 
     341                  &                        - 0.011_wp * ( t_bo_1d(ji) - rtt )   
    339342               ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin ) 
    340343            END DO 
     
    352355         END DO 
    353356 
    354          DO layer = 1, nlay_s-1 
    355             DO ji = kideb , kiut 
    356                zkappa_s(ji,layer)  = 2.0 * rcdsn / & 
     357         DO jk = 1, nlay_s-1 
     358            DO ji = kideb , kiut 
     359               zkappa_s(ji,jk)  = 2.0 * rcdsn / & 
    357360                  MAX(epsi10,2.0*zh_s(ji)) 
    358361            END DO 
    359362         END DO 
    360363 
    361          DO layer = 1, nlay_i-1 
     364         DO jk = 1, nlay_i-1 
    362365            DO ji = kideb , kiut 
    363366               !-- Ice kappa factors 
    364                zkappa_i(ji,layer)  = 2.0*ztcond_i(ji,layer)/ & 
     367               zkappa_i(ji,jk)  = 2.0*ztcond_i(ji,jk)/ & 
    365368                  MAX(epsi10,2.0*zh_i(ji))  
    366369            END DO 
     
    381384         !------------------------------------------------------------------------------| 
    382385         ! 
    383          DO layer = 1, nlay_i 
    384             DO ji = kideb , kiut 
    385                ztitemp(ji,layer)   = t_i_b(ji,layer) 
    386                zspeche_i(ji,layer) = cpic + zgamma*s_i_b(ji,layer)/ & 
    387                   MAX((t_i_b(ji,layer)-rtt)*(ztiold(ji,layer)-rtt),epsi10) 
    388                zeta_i(ji,layer)    = rdt_ice / MAX(rhoic*zspeche_i(ji,layer)*zh_i(ji), & 
     386         DO jk = 1, nlay_i 
     387            DO ji = kideb , kiut 
     388               ztitemp(ji,jk)   = t_i_1d(ji,jk) 
     389               zspeche_i(ji,jk) = cpic + zgamma*s_i_1d(ji,jk)/ & 
     390                  MAX((t_i_1d(ji,jk)-rtt)*(ztib(ji,jk)-rtt),epsi10) 
     391               zeta_i(ji,jk)    = rdt_ice / MAX(rhoic*zspeche_i(ji,jk)*zh_i(ji), & 
    389392                  epsi10) 
    390393            END DO 
    391394         END DO 
    392395 
    393          DO layer = 1, nlay_s 
    394             DO ji = kideb , kiut 
    395                ztstemp(ji,layer) = t_s_b(ji,layer) 
    396                zeta_s(ji,layer)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10) 
     396         DO jk = 1, nlay_s 
     397            DO ji = kideb , kiut 
     398               ztstemp(ji,jk) = t_s_1d(ji,jk) 
     399               zeta_s(ji,jk)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10) 
    397400            END DO 
    398401         END DO 
     
    402405         !------------------------------------------------------------------------------| 
    403406         ! 
    404          DO ji = kideb , kiut 
    405  
    406             ! update of the non solar flux according to the update in T_su 
    407             qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * &  
    408                ( t_su_b(ji) - ztsuoldit(ji) ) 
    409  
     407         IF( .NOT. lk_cpl ) THEN   !--- forced atmosphere case 
     408            DO ji = kideb , kiut 
     409               ! update of the non solar flux according to the update in T_su 
     410               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) ) 
     411            END DO 
     412         ENDIF 
     413 
     414         ! Update incoming flux 
     415         DO ji = kideb , kiut 
    410416            ! update incoming flux 
    411417            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    412                + qnsr_ice_1d(ji)           ! non solar total flux  
     418               + qns_ice_1d(ji)                   ! non solar total flux  
    413419            ! (LWup, LWdw, SH, LH) 
    414  
    415420         END DO 
    416421 
     
    427432         !!ice interior terms (top equation has the same form as the others) 
    428433 
    429          DO numeq=1,jkmax+2 
     434         DO numeq=1,nlay_i+3 
    430435            DO ji = kideb , kiut 
    431436               ztrid(ji,numeq,1) = 0. 
    432437               ztrid(ji,numeq,2) = 0. 
    433438               ztrid(ji,numeq,3) = 0. 
    434                zindterm(ji,numeq)= 0. 
    435                zindtbis(ji,numeq)= 0. 
     439               zswiterm(ji,numeq)= 0. 
     440               zswitbis(ji,numeq)= 0. 
    436441               zdiagbis(ji,numeq)= 0. 
    437442            ENDDO 
     
    440445         DO numeq = nlay_s + 2, nlay_s + nlay_i  
    441446            DO ji = kideb , kiut 
    442                layer              = numeq - nlay_s - 1 
    443                ztrid(ji,numeq,1)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer-1) 
    444                ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,layer)*(zkappa_i(ji,layer-1) + & 
    445                   zkappa_i(ji,layer)) 
    446                ztrid(ji,numeq,3)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer) 
    447                zindterm(ji,numeq) =  ztiold(ji,layer) + zeta_i(ji,layer)* & 
    448                   zradab_i(ji,layer) 
     447               jk              = numeq - nlay_s - 1 
     448               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk-1) 
     449               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk)*(zkappa_i(ji,jk-1) + & 
     450                  zkappa_i(ji,jk)) 
     451               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk) 
     452               zswiterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk)* & 
     453                  zradab_i(ji,jk) 
    449454            END DO 
    450455         ENDDO 
     
    457462               +  zkappa_i(ji,nlay_i-1) ) 
    458463            ztrid(ji,numeq,3)  =  0.0 
    459             zindterm(ji,numeq) =  ztiold(ji,nlay_i) + zeta_i(ji,nlay_i)* & 
     464            zswiterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i)* & 
    460465               ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 & 
    461                *  t_bo_b(ji) )  
     466               *  t_bo_1d(ji) )  
    462467         ENDDO 
    463468 
    464469 
    465470         DO ji = kideb , kiut 
    466             IF ( ht_s_b(ji).gt.0.0 ) THEN 
     471            IF ( ht_s_1d(ji).gt.0.0 ) THEN 
    467472               ! 
    468473               !------------------------------------------------------------------------------| 
     
    472477               !!snow interior terms (bottom equation has the same form as the others) 
    473478               DO numeq = 3, nlay_s + 1 
    474                   layer =  numeq - 1 
    475                   ztrid(ji,numeq,1)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer-1) 
    476                   ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,layer)*( zkappa_s(ji,layer-1) + & 
    477                      zkappa_s(ji,layer) ) 
    478                   ztrid(ji,numeq,3)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer) 
    479                   zindterm(ji,numeq)  =  ztsold(ji,layer) + zeta_s(ji,layer)* & 
    480                      zradab_s(ji,layer) 
     479                  jk =  numeq - 1 
     480                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk-1) 
     481                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk)*( zkappa_s(ji,jk-1) + & 
     482                     zkappa_s(ji,jk) ) 
     483                  ztrid(ji,numeq,3)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk) 
     484                  zswiterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk)* & 
     485                     zradab_s(ji,jk) 
    481486               END DO 
    482487 
     
    484489               IF ( nlay_i.eq.1 ) THEN 
    485490                  ztrid(ji,nlay_s+2,3)    =  0.0 
    486                   zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1)* & 
    487                      t_bo_b(ji)  
     491                  zswiterm(ji,nlay_s+2)   =  zswiterm(ji,nlay_s+2) + zkappa_i(ji,1)* & 
     492                     t_bo_1d(ji)  
    488493               ENDIF 
    489494 
    490                IF ( t_su_b(ji) .LT. rtt ) THEN 
     495               IF ( t_su_1d(ji) .LT. rtt ) THEN 
    491496 
    492497                  !------------------------------------------------------------------------------| 
     
    501506                  ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0) 
    502507                  ztrid(ji,1,3) = zg1s*zkappa_s(ji,0) 
    503                   zindterm(ji,1) = dzf(ji)*t_su_b(ji)   - zf(ji) 
     508                  zswiterm(ji,1) = dzf(ji)*t_su_1d(ji)   - zf(ji) 
    504509 
    505510                  !!first layer of snow equation 
     
    507512                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s) 
    508513                  ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1) 
    509                   zindterm(ji,2) =  ztsold(ji,1) + zeta_s(ji,1)*zradab_s(ji,1) 
     514                  zswiterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1)*zradab_s(ji,1) 
    510515 
    511516               ELSE  
     
    524529                     zkappa_s(ji,0) * zg1s ) 
    525530                  ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1)  
    526                   zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) *            & 
     531                  zswiterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *            & 
    527532                     ( zradab_s(ji,1) +                         & 
    528                      zkappa_s(ji,0) * zg1s * t_su_b(ji) )  
     533                     zkappa_s(ji,0) * zg1s * t_su_1d(ji) )  
    529534               ENDIF 
    530535            ELSE 
     
    534539               !------------------------------------------------------------------------------| 
    535540               ! 
    536                IF (t_su_b(ji) .LT. rtt) THEN 
     541               IF (t_su_1d(ji) .LT. rtt) THEN 
    537542                  ! 
    538543                  !------------------------------------------------------------------------------| 
     
    548553                  ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1     
    549554                  ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1 
    550                   zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_b(ji) - zf(ji) 
     555                  zswiterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji) 
    551556 
    552557                  !!first layer of ice equation 
     
    555560                     + zkappa_i(ji,0) * zg1 ) 
    556561                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1)*zkappa_i(ji,1)   
    557                   zindterm(ji,numeqmin(ji)+1)=  ztiold(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)   
     562                  zswiterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)   
    558563 
    559564                  !!case of only one layer in the ice (surface & ice equations are altered) 
     
    568573                     ztrid(ji,numeqmin(ji)+1,3)  =  0.0 
    569574 
    570                      zindterm(ji,numeqmin(ji)+1) =  ztiold(ji,1) + zeta_i(ji,1)* & 
    571                         ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji) ) 
     575                     zswiterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1)* & 
     576                        ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji) ) 
    572577                  ENDIF 
    573578 
     
    588593                     zg1)   
    589594                  ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1) 
    590                   zindterm(ji,numeqmin(ji))     =  ztiold(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + & 
    591                      zkappa_i(ji,0) * zg1 * t_su_b(ji) )  
     595                  zswiterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + & 
     596                     zkappa_i(ji,0) * zg1 * t_su_1d(ji) )  
    592597 
    593598                  !!case of only one layer in the ice (surface & ice equations are altered) 
     
    597602                        zkappa_i(ji,1)) 
    598603                     ztrid(ji,numeqmin(ji),3)  =  0.0 
    599                      zindterm(ji,numeqmin(ji)) =  ztiold(ji,1) + zeta_i(ji,1)* & 
    600                         (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji)) & 
    601                         + t_su_b(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0 
     604                     zswiterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1)* & 
     605                        (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji)) & 
     606                        + t_su_1d(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0 
    602607                  ENDIF 
    603608 
     
    618623 
    619624         maxnumeqmax = 0 
    620          minnumeqmin = jkmax+4 
    621  
    622          DO ji = kideb , kiut 
    623             zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji)) 
     625         minnumeqmin = nlay_i+5 
     626 
     627         DO ji = kideb , kiut 
     628            zswitbis(ji,numeqmin(ji)) =  zswiterm(ji,numeqmin(ji)) 
    624629            zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2) 
    625630            minnumeqmin               =  MIN(numeqmin(ji),minnumeqmin) 
     
    627632         END DO 
    628633 
    629          DO layer = minnumeqmin+1, maxnumeqmax 
    630             DO ji = kideb , kiut 
    631                numeq               =  min(max(numeqmin(ji)+1,layer),numeqmax(ji)) 
     634         DO jk = minnumeqmin+1, maxnumeqmax 
     635            DO ji = kideb , kiut 
     636               numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji)) 
    632637               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* & 
    633638                  ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1) 
    634                zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1)* & 
    635                   zindtbis(ji,numeq-1)/zdiagbis(ji,numeq-1) 
     639               zswitbis(ji,numeq)  =  zswiterm(ji,numeq) - ztrid(ji,numeq,1)* & 
     640                  zswitbis(ji,numeq-1)/zdiagbis(ji,numeq-1) 
    636641            END DO 
    637642         END DO 
     
    639644         DO ji = kideb , kiut 
    640645            ! ice temperatures 
    641             t_i_b(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji)) 
     646            t_i_1d(ji,nlay_i)    =  zswitbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji)) 
    642647         END DO 
    643648 
    644649         DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1 
    645650            DO ji = kideb , kiut 
    646                layer    =  numeq - nlay_s - 1 
    647                t_i_b(ji,layer)  =  (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* & 
    648                   t_i_b(ji,layer+1))/zdiagbis(ji,numeq) 
     651               jk    =  numeq - nlay_s - 1 
     652               t_i_1d(ji,jk)  =  (zswitbis(ji,numeq) - ztrid(ji,numeq,3)* & 
     653                  t_i_1d(ji,jk+1))/zdiagbis(ji,numeq) 
    649654            END DO 
    650655         END DO 
     
    652657         DO ji = kideb , kiut 
    653658            ! snow temperatures       
    654             IF (ht_s_b(ji).GT.0._wp) & 
    655                t_s_b(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
    656                *  t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) & 
    657                *        MAX(0.0,SIGN(1.0,ht_s_b(ji)))  
     659            IF (ht_s_1d(ji).GT.0._wp) & 
     660               t_s_1d(ji,nlay_s)     =  (zswitbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
     661               *  t_i_1d(ji,1))/zdiagbis(ji,nlay_s+1) & 
     662               *        MAX(0.0,SIGN(1.0,ht_s_1d(ji)))  
    658663 
    659664            ! surface temperature 
    660             isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) )  )  ) 
    661             ztsuoldit(ji) = t_su_b(ji) 
    662             IF( t_su_b(ji) < ztfs(ji) ) & 
    663                t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_b(ji,1)   & 
    664                &          + REAL( 1 - isnow(ji) )*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
     665            isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_1d(ji) )  )  ) 
     666            ztsubit(ji) = t_su_1d(ji) 
     667            IF( t_su_1d(ji) < ztfs(ji) ) & 
     668               t_su_1d(ji) = ( zswitbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_1d(ji,1)   & 
     669               &          + REAL( 1 - isnow(ji) )*t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
    665670         END DO 
    666671         ! 
     
    672677         ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd 
    673678         DO ji = kideb , kiut 
    674             t_su_b(ji) =  MAX(  MIN( t_su_b(ji) , ztfs(ji) ) , 190._wp  ) 
    675             zerrit(ji) =  ABS( t_su_b(ji) - ztsuoldit(ji) )      
    676          END DO 
    677  
    678          DO layer  =  1, nlay_s 
    679             DO ji = kideb , kiut 
    680                ii = MOD( npb(ji) - 1, jpi ) + 1 
    681                ij = ( npb(ji) - 1 ) / jpi + 1 
    682                t_s_b(ji,layer) = MAX(  MIN( t_s_b(ji,layer), rtt ), 190._wp  ) 
    683                zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer))) 
    684             END DO 
    685          END DO 
    686  
    687          DO layer  =  1, nlay_i 
    688             DO ji = kideb , kiut 
    689                ztmelt_i        = -tmut * s_i_b(ji,layer) + rtt  
    690                t_i_b(ji,layer) =  MAX(MIN(t_i_b(ji,layer),ztmelt_i), 190._wp) 
    691                zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_b(ji,layer) - ztitemp(ji,layer))) 
     679            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , ztfs(ji) ) , 190._wp  ) 
     680            zerrit(ji) =  ABS( t_su_1d(ji) - ztsubit(ji) )      
     681         END DO 
     682 
     683         DO jk  =  1, nlay_s 
     684            DO ji = kideb , kiut 
     685               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rtt ), 190._wp  ) 
     686               zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_1d(ji,jk) - ztstemp(ji,jk))) 
     687            END DO 
     688         END DO 
     689 
     690         DO jk  =  1, nlay_i 
     691            DO ji = kideb , kiut 
     692               ztmelt_i        = -tmut * s_i_1d(ji,jk) + rtt  
     693               t_i_1d(ji,jk) =  MAX(MIN(t_i_1d(ji,jk),ztmelt_i), 190._wp) 
     694               zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_1d(ji,jk) - ztitemp(ji,jk))) 
    692695            END DO 
    693696         END DO 
     
    713716      !-------------------------------------------------------------------------! 
    714717      DO ji = kideb, kiut 
    715 #if ! defined key_coupled 
    716718         ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux)  
    717          qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 
    718 #endif 
     719         IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) ) 
    719720         !                                ! surface ice conduction flux 
    720          isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  ) 
    721          fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji))   & 
    722             &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_b(ji,1) - t_su_b(ji)) 
     721         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )  ) 
     722         fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   & 
     723            &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji)) 
    723724         !                                ! bottom ice conduction flux 
    724          fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    725       END DO 
    726  
    727       !-------------------------! 
    728       ! Heat conservation       ! 
    729       !-------------------------! 
    730       IF( con_i .AND. jiindex_1d > 0 ) THEN 
     725         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) ) 
     726      END DO 
     727 
     728      !----------------------------------------- 
     729      ! Heat flux used to warm/cool ice in W.m-2 
     730      !----------------------------------------- 
     731      DO ji = kideb, kiut 
     732         IF( t_su_1d(ji) < rtt ) THEN  ! case T_su < 0degC 
     733            hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   & 
     734               &            ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 
     735         ELSE                         ! case T_su = 0degC 
     736            hfx_dif_1d(ji) = hfx_dif_1d(ji) +    & 
     737               &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 
     738         ENDIF 
     739      END DO 
     740 
     741      ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 
     742      CALL lim_thd_enmelt( kideb, kiut ) 
     743 
     744      ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 
     745      DO ji = kideb, kiut 
     746         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  & 
     747            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 
     748         zhfx_err(ji)   = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
     749         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 
     750      END DO  
     751 
     752      ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 
     753      IF( .NOT. lk_cpl ) THEN   ! --- forced case: qns_ice and fc_su are diagnosed 
     754         ! 
    731755         DO ji = kideb, kiut 
    732             ! Upper snow value 
    733             fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) )  
    734             ! Bott. snow value 
    735             fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) )  
    736          END DO 
    737          DO ji = kideb, kiut         ! Upper ice layer 
    738             fc_i(ji,0) = - REAL( isnow(ji) ) * &  ! interface flux if there is snow 
    739                ( zkappa_i(ji,0)  * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 
    740                - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
    741                zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 
    742          END DO 
    743          DO layer = 1, nlay_i - 1         ! Internal ice layers 
    744             DO ji = kideb, kiut 
    745                fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - t_i_b(ji,layer) ) 
    746                ii = MOD( npb(ji) - 1, jpi ) + 1 
    747                ij = ( npb(ji) - 1 ) / jpi + 1 
    748             END DO 
    749          END DO 
    750          DO ji = kideb, kiut         ! Bottom ice layers 
    751             fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    752          END DO 
     756            qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 
     757            fc_su     (ji) = fc_su(ji)      - zhfx_err(ji) 
     758         END DO 
     759         ! 
     760      ELSE                      ! --- coupled case: ocean turbulent heat flux is diagnosed 
     761         ! 
     762         DO ji = kideb, kiut 
     763            fhtur_1d  (ji) = fhtur_1d(ji)   - zhfx_err(ji) 
     764         END DO 
     765         ! 
    753766      ENDIF 
     767 
     768      ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2) 
     769      DO ji = kideb, kiut 
     770         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     771         hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 
     772      END DO 
     773    
    754774      ! 
     775      CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow ) 
     776      CALL wrk_dealloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
     777      CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 
     778      CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i,   & 
     779         &              ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 
     780      CALL wrk_dealloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 
     781      CALL wrk_dealloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis ) 
     782      CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid ) 
     783      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 
     784 
    755785   END SUBROUTINE lim_thd_dif 
     786 
     787   SUBROUTINE lim_thd_enmelt( kideb, kiut ) 
     788      !!----------------------------------------------------------------------- 
     789      !!                   ***  ROUTINE lim_thd_enmelt ***  
     790      !!                  
     791      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature 
     792      !! 
     793      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
     794      !!------------------------------------------------------------------- 
     795      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
     796      ! 
     797      INTEGER  ::   ji, jk   ! dummy loop indices 
     798      REAL(wp) ::   ztmelts  ! local scalar  
     799      !!------------------------------------------------------------------- 
     800      ! 
     801      DO jk = 1, nlay_i             ! Sea ice energy of melting 
     802         DO ji = kideb, kiut 
     803            ztmelts      = - tmut  * s_i_1d(ji,jk) + rtt  
     804            rswitch      = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rtt) - epsi10 ) ) 
     805            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                                             & 
     806               &                   + lfus * ( 1.0 - rswitch * ( ztmelts-rtt ) / MIN( t_i_1d(ji,jk)-rtt, -epsi10 ) )   & 
     807               &                   - rcp  *                 ( ztmelts-rtt )  )  
     808         END DO 
     809      END DO 
     810      DO jk = 1, nlay_s             ! Snow energy of melting 
     811         DO ji = kideb, kiut 
     812            q_s_1d(ji,jk) = rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) 
     813         END DO 
     814      END DO 
     815      ! 
     816   END SUBROUTINE lim_thd_enmelt 
    756817 
    757818#else 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

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

    r4333 r5034  
    2929   USE lib_mpp        ! MPP library 
    3030   USE wrk_nemo       ! work arrays 
     31   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3132   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     33   USE limthd_ent 
    3234 
    3335   IMPLICIT NONE 
     
    3537 
    3638   PUBLIC lim_thd_lac     ! called by lim_thd 
    37  
    38    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    39    REAL(wp) ::   zzero  = 0._wp      ! 
    40    REAL(wp) ::   zone   = 1._wp      ! 
    4139 
    4240   !!---------------------------------------------------------------------- 
     
    7169      !!             - Computation of variation of ice volume and mass 
    7270      !!             - Computation of frldb after lateral accretion and  
    73       !!               update ht_s_b, ht_i_b and tbif_1d(:,:)       
     71      !!               update ht_s_1d, ht_i_1d and tbif_1d(:,:)       
    7472      !!------------------------------------------------------------------------ 
    75       INTEGER ::   ji,jj,jk,jl,jm   ! dummy loop indices 
    76       INTEGER ::   layer, nbpac     ! local integers  
    77       INTEGER ::   ii, ij, iter   !   -       - 
    78       REAL(wp)  ::   ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zinda, zde  ! local scalars 
     73      INTEGER ::   ji,jj,jk,jl      ! dummy loop indices 
     74      INTEGER ::   nbpac            ! local integers  
     75      INTEGER ::   ii, ij, iter     !   -       - 
     76      REAL(wp)  ::   ztmelts, zdv, zfrazb, zweight, zde                         ! local scalars 
    7977      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      - 
    8078      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    8179      LOGICAL  ::   iterate_frazil   ! iterate frazil ice collection thickness 
    8280      CHARACTER (len = 15) :: fieldid 
    83       ! 
    84       INTEGER , POINTER, DIMENSION(:) ::   zcatac      ! indexes of categories where new ice grows 
     81 
     82      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 
     83      REAL(wp) ::   zEi          ! sea ice specific enthalpy (J/kg) 
     84      REAL(wp) ::   zEw          ! seawater specific enthalpy (J/kg) 
     85      REAL(wp) ::   zfmdt        ! mass flux x time step (kg/m2, >0 towards ocean) 
     86      
     87      REAL(wp) ::   zv_newfra 
     88   
     89      INTEGER , POINTER, DIMENSION(:) ::   jcat        ! indexes of categories where new ice grows 
    8590      REAL(wp), POINTER, DIMENSION(:) ::   zswinew     ! switch for new ice or not 
    8691 
     
    9398      REAL(wp), POINTER, DIMENSION(:) ::   zdv_res     ! residual volume in case of excessive heat budget 
    9499      REAL(wp), POINTER, DIMENSION(:) ::   zda_res     ! residual area in case of excessive heat budget 
    95       REAL(wp), POINTER, DIMENSION(:) ::   zat_i_ac    ! total ice fraction     
    96       REAL(wp), POINTER, DIMENSION(:) ::   zat_i_lev   ! total ice fraction for level ice only (type 1)    
    97       REAL(wp), POINTER, DIMENSION(:) ::   zdh_frazb   ! accretion of frazil ice at the ice bottom 
    98       REAL(wp), POINTER, DIMENSION(:) ::   zvrel_ac    ! relative ice / frazil velocity (1D vector) 
    99  
    100       REAL(wp), POINTER, DIMENSION(:,:) ::   zhice_old   ! previous ice thickness 
    101       REAL(wp), POINTER, DIMENSION(:,:) ::   zdummy      ! dummy thickness of new ice  
    102       REAL(wp), POINTER, DIMENSION(:,:) ::   zdhicbot    ! thickness of new ice which is accreted vertically 
    103       REAL(wp), POINTER, DIMENSION(:,:) ::   zv_old      ! old volume of ice in category jl 
    104       REAL(wp), POINTER, DIMENSION(:,:) ::   za_old      ! old area of ice in category jl 
    105       REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_ac     ! 1-D version of a_i 
    106       REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_ac     ! 1-D version of v_i 
    107       REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_ac    ! 1-D version of oa_i 
    108       REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_ac   ! 1-D version of smv_i 
    109  
    110       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_ac   !: 1-D version of e_i 
    111  
    112       REAL(wp), POINTER, DIMENSION(:) ::   zqbgow    ! heat budget of the open water (negative) 
    113       REAL(wp), POINTER, DIMENSION(:) ::   zdhex     ! excessively thick accreted sea ice (hlead-hice) 
    114  
    115       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqm0      ! old layer-system heat content 
    116       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zthick0   ! old ice thickness 
    117  
    118       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final   ! ice volume summed over categories 
    119       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   !  snow volume summed over categories 
    120       REAL(wp), POINTER, DIMENSION(:,:) ::   et_i_init, et_i_final   !  ice energy summed over categories 
    121       REAL(wp), POINTER, DIMENSION(:,:) ::   et_s_init               !  snow energy summed over categories 
     100      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_1d    ! total ice fraction     
     101      REAL(wp), POINTER, DIMENSION(:) ::   zv_frazb    ! accretion of frazil ice at the ice bottom 
     102      REAL(wp), POINTER, DIMENSION(:) ::   zvrel_1d    ! relative ice / frazil velocity (1D vector) 
     103 
     104      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_b      ! old volume of ice in category jl 
     105      REAL(wp), POINTER, DIMENSION(:,:) ::   za_b      ! old area of ice in category jl 
     106      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i 
     107      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i 
     108      REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_1d  ! 1-D version of oa_i 
     109      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i 
     110 
     111      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d   !: 1-D version of e_i 
     112 
    122113      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity 
    123114      !!-----------------------------------------------------------------------! 
    124115 
    125       CALL wrk_alloc( jpij, zcatac )   ! integer 
     116      CALL wrk_alloc( jpij, jcat )   ! integer 
    126117      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    127       CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 
    128       CALL wrk_alloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
    129       CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac ) 
    130       CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 
    131       CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 
    132  
    133       et_i_init(:,:) = 0._wp 
    134       et_s_init(:,:) = 0._wp 
    135       vt_i_init(:,:) = 0._wp 
    136       vt_s_init(:,:) = 0._wp 
    137  
    138       !------------------------------------------------------------------------------! 
    139       ! 1) Conservation check and changes in each ice category 
    140       !------------------------------------------------------------------------------! 
    141       IF( con_i ) THEN 
    142          CALL lim_column_sum        ( jpl, v_i          , vt_i_init) 
    143          CALL lim_column_sum        ( jpl, v_s          , vt_s_init) 
    144          CALL lim_column_sum_energy ( jpl, nlay_i , e_i , et_i_init) 
    145          CALL lim_column_sum        ( jpl, e_s(:,:,1,:) , et_s_init) 
    146       ENDIF 
     118      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
     119      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
     120      CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     121      CALL wrk_alloc( jpi,jpj, zvrel ) 
    147122 
    148123      !------------------------------------------------------------------------------| 
     
    154129               DO ji = 1, jpi 
    155130                  !Energy of melting q(S,T) [J.m-3] 
    156                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * REAL( nlay_i ) 
    157                   zindb = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes 
    158                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 
     131                  rswitch          = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes 
     132                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) & 
     133                      &   / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i, wp ) 
     134                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 
    159135               END DO 
    160136            END DO 
     
    179155 
    180156      ! Default new ice thickness  
    181       hicol(:,:) = hiccrit(1) 
    182  
    183       IF( fraz_swi == 1._wp ) THEN 
     157      hicol(:,:) = hiccrit 
     158 
     159      IF( fraz_swi == 1 ) THEN 
    184160 
    185161         !-------------------- 
     
    193169         zgamafr = 0.03 
    194170 
    195          DO jj = 1, jpj 
    196             DO ji = 1, jpi 
    197  
    198                IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 
     171         DO jj = 2, jpj 
     172            DO ji = 2, jpi 
     173               IF ( qlead(ji,jj) < 0._wp ) THEN 
    199174                  !------------- 
    200175                  ! Wind stress 
     
    206181                     &          +   vtau_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) * 0.5_wp 
    207182                  ! Square root of wind stress 
    208                   ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
     183                  ztenagm       =  SQRT( SQRT( ztaux**2 + ztauy**2 ) ) 
    209184 
    210185                  !--------------------- 
    211186                  ! Frazil ice velocity 
    212187                  !--------------------- 
    213                   zvfrx         = zgamafr * zsqcd * ztaux / MAX(ztenagm,epsi10) 
    214                   zvfry         = zgamafr * zsqcd * ztauy / MAX(ztenagm,epsi10) 
     188                  rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) ) 
     189                  zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 ) 
     190                  zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 ) 
    215191 
    216192                  !------------------- 
     
    218194                  !------------------- 
    219195                  ! C-grid ice velocity 
    220                   zindb = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  ) 
    221                   zvgx  = zindb * (  u_ice(ji-1,jj  ) * tmu(ji-1,jj  )    & 
    222                      &             + u_ice(ji,jj    ) * tmu(ji  ,jj  )  ) * 0.5_wp 
    223                   zvgy  = zindb * (  v_ice(ji  ,jj-1) * tmv(ji  ,jj-1)    & 
    224                      &             + v_ice(ji,jj    ) * tmv(ji  ,jj  )  ) * 0.5_wp 
     196                  rswitch = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  ) 
     197                  zvgx    = rswitch * ( u_ice(ji-1,jj  ) * tmu(ji-1,jj  )  + u_ice(ji,jj) * tmu(ji,jj) ) * 0.5_wp 
     198                  zvgy    = rswitch * ( v_ice(ji  ,jj-1) * tmv(ji  ,jj-1)  + v_ice(ji,jj) * tmv(ji,jj) ) * 0.5_wp 
    225199 
    226200                  !----------------------------------- 
     
    264238            END DO ! loop on ji ends 
    265239         END DO ! loop on jj ends 
     240      !  
     241      CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 
     242      CALL lbc_lnk( hicol(:,:), 'T', 1. ) 
    266243 
    267244      ENDIF ! End of computation of frazil ice collection thickness 
     
    276253      ! This occurs if open water energy budget is negative 
    277254      nbpac = 0 
     255      npac(:) = 0 
     256      ! 
    278257      DO jj = 1, jpj 
    279258         DO ji = 1, jpi 
    280             IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) )  >  0._wp ) THEN 
     259            IF ( qlead(ji,jj)  <  0._wp ) THEN 
    281260               nbpac = nbpac + 1 
    282261               npac( nbpac ) = (jj - 1) * jpi + ji 
     
    290269         DO ji = mi0(jiindx), mi1(jiindx) 
    291270            DO jj = mj0(jjindx), mj1(jjindx) 
    292                IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) )  >  0._wp ) THEN 
     271               IF ( qlead(ji,jj)  <  0._wp ) THEN 
    293272                  jiindex_1d = (jj - 1) * jpi + ji 
    294273               ENDIF 
     
    307286      IF ( nbpac > 0 ) THEN 
    308287 
    309          CALL tab_2d_1d( nbpac, zat_i_ac  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) ) 
     288         CALL tab_2d_1d( nbpac, zat_i_1d  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) ) 
    310289         DO jl = 1, jpl 
    311             CALL tab_2d_1d( nbpac, za_i_ac  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    312             CALL tab_2d_1d( nbpac, zv_i_ac  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    313             CALL tab_2d_1d( nbpac, zoa_i_ac (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    314             CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     290            CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     291            CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     292            CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     293            CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    315294            DO jk = 1, nlay_i 
    316                CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
     295               CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
    317296            END DO ! jk 
    318297         END DO ! jl 
    319298 
    320          CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif  , jpi, jpj, npac(1:nbpac) ) 
    321          CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif  , jpi, jpj, npac(1:nbpac) ) 
    322          CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) ) 
    323          CALL tab_2d_1d( nbpac, sfx_thd_1d(1:nbpac)     , sfx_thd, jpi, jpj, npac(1:nbpac) ) 
    324          CALL tab_2d_1d( nbpac, rdm_ice_1d(1:nbpac)     , rdm_ice, jpi, jpj, npac(1:nbpac) ) 
    325          CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) ) 
    326          CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) ) 
     299         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) ) 
     300         CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) ) 
     301         CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw, jpi, jpj, npac(1:nbpac) ) 
     302         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw, jpi, jpj, npac(1:nbpac) ) 
     303         CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) ) 
     304         CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) ) 
     305 
     306         CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd, jpi, jpj, npac(1:nbpac) ) 
     307         CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw, jpi, jpj, npac(1:nbpac) ) 
    327308 
    328309         !------------------------------------------------------------------------------! 
     
    330311         !------------------------------------------------------------------------------! 
    331312 
     313         !----------------------------------------- 
     314         ! Keep old ice areas and volume in memory 
     315         !----------------------------------------- 
     316         zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:)  
     317         za_b(1:nbpac,:) = za_i_1d(1:nbpac,:) 
    332318         !---------------------- 
    333319         ! Thickness of new ice 
    334320         !---------------------- 
    335321         DO ji = 1, nbpac 
    336             zh_newice(ji) = hiccrit(1) 
    337          END DO 
    338          IF( fraz_swi == 1.0 )   zh_newice(:) = hicol_b(:) 
     322            zh_newice(ji) = hiccrit 
     323         END DO 
     324         IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 
    339325 
    340326         !---------------------- 
    341327         ! Salinity of new ice  
    342328         !---------------------- 
    343  
    344329         SELECT CASE ( num_sal ) 
    345330         CASE ( 1 )                    ! Sice = constant  
    346             zs_newice(:) = bulk_sal 
     331            zs_newice(1:nbpac) = bulk_sal 
    347332         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)] 
    348333            DO ji = 1, nbpac 
     
    352337            END DO 
    353338         CASE ( 3 )                    ! Sice = F(z) [multiyear ice] 
    354             zs_newice(:) =   2.3 
     339            zs_newice(1:nbpac) =   2.3 
    355340         END SELECT 
    356  
    357341 
    358342         !------------------------- 
     
    362346         DO ji = 1, nbpac 
    363347            ztmelts       = - tmut * zs_newice(ji) + rtt                  ! Melting point (K) 
    364             ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                             & 
    365                &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )   & 
     348            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                             & 
     349               &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) )   & 
    366350               &                       - rcp  *         ( ztmelts - rtt )  ) 
    367             ze_newice(ji) =   MAX( ze_newice(ji) , 0._wp )    & 
    368                &          +   MAX(  0.0 , SIGN( 1.0 , - ze_newice(ji) )  ) * rhoic * lfus 
    369351         END DO ! ji 
     352 
    370353         !---------------- 
    371354         ! Age of new ice 
     
    375358         END DO ! ji 
    376359 
    377          !-------------------------- 
    378          ! Open water energy budget  
    379          !-------------------------- 
    380          DO ji = 1, nbpac 
    381             zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji)     !<0 
    382          END DO ! ji 
    383  
    384360         !------------------- 
    385361         ! Volume of new ice 
    386362         !------------------- 
    387363         DO ji = 1, nbpac 
    388             zv_newice(ji) = - zqbgow(ji) / ze_newice(ji) 
     364 
     365            zEi           = - ze_newice(ji) / rhoic                ! specific enthalpy of forming ice [J/kg] 
     366 
     367            zEw           = rcp * ( t_bo_1d(ji) - rt0 )             ! specific enthalpy of seawater at t_bo_1d [J/kg] 
     368                                                                   ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied)  
     369                                                                    
     370            zdE           = zEi - zEw                              ! specific enthalpy difference [J/kg] 
     371                                               
     372            zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0)  
     373                                                                   ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point    
     374            zv_newice(ji) = - zfmdt / rhoic 
     375 
     376            zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux   
     377 
     378            ! Contribution to heat flux to the ocean [W.m-2], >0   
     379            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice 
     380            ! Total heat flux used in this process [W.m-2]   
     381            hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice 
     382            ! mass flux 
     383            wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoic * r1_rdtice 
     384            ! salt flux 
     385            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 
    389386 
    390387            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    391             zfrazb        = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 
    392             zdh_frazb(ji) =         zfrazb   * zv_newice(ji) 
     388            rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 
     389            zfrazb        = rswitch * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 
     390            zv_frazb(ji)  =         zfrazb   * zv_newice(ji) 
    393391            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
    394392         END DO 
    395  
    396          !------------------------------------ 
    397          ! Diags for energy conservation test 
    398          !------------------------------------ 
    399          DO ji = 1, nbpac 
    400             ii = MOD( npac(ji) - 1 , jpi ) + 1 
    401             ij =    ( npac(ji) - 1 ) / jpi + 1 
    402             ! 
    403             zde = ze_newice(ji) / unit_fac * area(ii,ij) * zv_newice(ji) 
    404             ! 
    405             vt_i_init(ii,ij) = vt_i_init(ii,ij) + zv_newice(ji)             ! volume 
    406             et_i_init(ii,ij) = et_i_init(ii,ij) + zde                       ! Energy 
    407  
    408          END DO 
    409  
    410          ! keep new ice volume in memory 
    411          CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , jpi, jpj ) 
    412393 
    413394         !----------------- 
     
    415396         !----------------- 
    416397         DO ji = 1, nbpac 
    417             ii = MOD( npac(ji) - 1 , jpi ) + 1 
    418             ij =    ( npac(ji) - 1 ) / jpi + 1 
    419398            za_newice(ji) = zv_newice(ji) / zh_newice(ji) 
    420             diag_lat_gr(ii,ij) = diag_lat_gr(ii,ij) + zv_newice(ji) * r1_rdtice ! clem 
    421          END DO !ji 
     399         END DO 
    422400 
    423401         !------------------------------------------------------------------------------! 
     
    425403         !------------------------------------------------------------------------------! 
    426404 
    427          !----------------------------------------- 
    428          ! Keep old ice areas and volume in memory 
    429          !----------------------------------------- 
    430          zv_old(:,:) = zv_i_ac(:,:)  
    431          za_old(:,:) = za_i_ac(:,:) 
    432  
    433          !------------------------------------------- 
    434          ! Compute excessive new ice area and volume 
    435          !------------------------------------------- 
     405         !------------------------ 
     406         ! 6.1) lateral ice growth 
     407         !------------------------ 
    436408         ! If lateral ice growth gives an ice concentration gt 1, then 
    437409         ! we keep the excessive volume in memory and attribute it later to bottom accretion 
    438410         DO ji = 1, nbpac 
    439             IF ( za_newice(ji) >  ( amax - zat_i_ac(ji) ) ) THEN 
    440                zda_res(ji)   = za_newice(ji) - ( amax - zat_i_ac(ji) ) 
     411            IF ( za_newice(ji) >  ( amax - zat_i_1d(ji) ) ) THEN 
     412               zda_res(ji)   = za_newice(ji) - ( amax - zat_i_1d(ji) ) 
    441413               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji)  
    442414               za_newice(ji) = za_newice(ji) - zda_res  (ji) 
     
    446418               zdv_res(ji) = 0._wp 
    447419            ENDIF 
    448          END DO ! ji 
    449  
    450          !------------------------------------------------ 
    451          ! Laterally redistribute new ice volume and area 
    452          !------------------------------------------------ 
    453          zat_i_ac(:) = 0._wp 
     420         END DO 
     421 
     422         ! find which category to fill 
     423         zat_i_1d(:) = 0._wp 
    454424         DO jl = 1, jpl 
    455425            DO ji = 1, nbpac 
    456                IF(  hi_max   (jl-1)  <   zh_newice(ji)   .AND.   & 
    457                   & zh_newice(ji)    <=  hi_max   (jl)         ) THEN 
    458                   za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 
    459                   zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) 
    460                   zat_i_ac(ji)    = zat_i_ac(ji)    + za_i_ac  (ji,jl) 
    461                   zcatac  (ji)    = jl 
     426               IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN 
     427                  za_i_1d (ji,jl) = za_i_1d (ji,jl) + za_newice(ji) 
     428                  zv_i_1d (ji,jl) = zv_i_1d (ji,jl) + zv_newice(ji) 
     429                  jcat    (ji)    = jl 
    462430               ENDIF 
    463             END DO 
    464          END DO 
    465  
    466          !---------------------------------- 
    467          ! Heat content - lateral accretion 
    468          !---------------------------------- 
    469          DO ji = 1, nbpac 
    470             jl = zcatac(ji)                                                           ! categroy in which new ice is put 
    471             zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) + epsi10 ) )             ! zindb=1 if ice =0 otherwise 
    472             zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb  ! old ice thickness 
    473             zdhex    (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) )           ! difference in thickness 
    474             zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) )   ! ice totally new in jl category 
     431               zat_i_1d(ji) = zat_i_1d(ji) + za_i_1d  (ji,jl) 
     432            END DO 
     433         END DO 
     434 
     435         ! Heat content 
     436         DO ji = 1, nbpac 
     437            jl = jcat(ji)                                                    ! categroy in which new ice is put 
     438            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) )   ! 0 if old ice 
    475439         END DO 
    476440 
    477441         DO jk = 1, nlay_i 
    478442            DO ji = 1, nbpac 
    479                jl = zcatac(ji) 
    480                zqold   = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 
    481                zalphai = MIN( zhice_old(ji,jl) * REAL( jk )     / REAL( nlay_i ), zh_newice(ji) )   & 
    482                   &    - MIN( zhice_old(ji,jl) * REAL( jk - 1 ) / REAL( nlay_i ), zh_newice(ji) ) 
    483                ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji)                                     & 
    484                   + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / REAL( nlay_i )  & 
    485                   + za_newice(ji)  * ze_newice(ji) * zalphai                                       & 
    486                   + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / REAL( nlay_i ) ) / ( ( zv_i_ac(ji,jl) ) / REAL( nlay_i ) ) 
    487             END DO 
    488          END DO 
    489  
    490          !----------------------------------------------- 
    491          ! Add excessive volume of new ice at the bottom 
    492          !----------------------------------------------- 
    493          ! If the ice concentration exceeds 1, the remaining volume of new ice 
    494          ! is equally redistributed among all ice categories in which there is 
    495          ! ice 
    496  
    497          ! Fraction of level ice 
    498          jm = 1 
    499          zat_i_lev(:) = 0._wp 
    500  
    501          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    502             DO ji = 1, nbpac 
    503                zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl)  
    504             END DO 
    505          END DO 
    506  
    507          IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 
    508          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    509             DO ji = 1, nbpac 
    510                zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) ) 
    511                zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_lev(ji) - epsi10 ) )  ! clem 
    512                zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zinda * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi10 ) 
    513             END DO 
    514          END DO 
    515          IF( ln_nicep .AND. jiindex_1d > 0 )   WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 
    516  
    517          !--------------------------------- 
    518          ! Heat content - bottom accretion 
    519          !--------------------------------- 
    520          jm = 1 
    521          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    522             DO ji = 1, nbpac 
    523                zindb =  1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) + epsi10 ) )       ! zindb=1 if ice =0 otherwise 
    524                zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 
    525                zdhicbot (ji,jl) = zdv_res(ji)    / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    & 
    526                   &             +  zindb * zdh_frazb(ji)                               ! frazil ice may coalesce 
    527                zdummy(ji,jl)    = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb      ! thickness of residual ice 
    528             END DO 
    529          END DO 
    530  
    531          ! old layers thicknesses and enthalpies 
    532          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     443               jl = jcat(ji) 
     444               rswitch = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) ) 
     445               ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                      & 
     446                  &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) )  & 
     447                  &        * rswitch / MAX( zv_i_1d(ji,jl), epsi20 ) 
     448            END DO 
     449         END DO 
     450 
     451         !------------------------------------------------ 
     452         ! 6.2) bottom ice growth + ice enthalpy remapping 
     453         !------------------------------------------------ 
     454         DO jl = 1, jpl 
     455 
     456            ! for remapping 
     457            h_i_old (1:nbpac,0:nlay_i+1) = 0._wp 
     458            qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 
    533459            DO jk = 1, nlay_i 
    534460               DO ji = 1, nbpac 
    535                   zthick0(ji,jk,jl) =  zhice_old(ji,jl) / REAL( nlay_i ) 
    536                   zqm0   (ji,jk,jl) =  ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 
     461                  h_i_old (ji,jk) = zv_i_1d(ji,jl) / REAL( nlay_i ) 
     462                  qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk) 
    537463               END DO 
    538464            END DO 
    539          END DO 
    540 !!gm ???  why the previous do loop  if ocerwriten by the following one ? 
    541          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     465 
     466            ! new volumes including lateral/bottom accretion + residual 
    542467            DO ji = 1, nbpac 
    543                zthick0(ji,nlay_i+1,jl) =  zdhicbot(ji,jl) 
    544                zqm0   (ji,nlay_i+1,jl) =  ze_newice(ji) * zdhicbot(ji,jl) 
    545             END DO ! ji 
    546          END DO ! jl 
    547  
    548          ! Redistributing energy on the new grid 
    549          ze_i_ac(:,:,:) = 0._wp 
    550          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    551             DO jk = 1, nlay_i 
    552                DO layer = 1, nlay_i + 1 
    553                   DO ji = 1, nbpac 
    554                      zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  
    555                      ! Redistributing energy on the new grid 
    556                      zweight = MAX (  MIN( zhice_old(ji,jl) * REAL( layer ), zdummy(ji,jl) * REAL( jk ) )   & 
    557                         &    - MAX( zhice_old(ji,jl) * REAL( layer - 1 ) , zdummy(ji,jl) * REAL( jk - 1 ) ) , 0._wp )   & 
    558                         &    /( MAX(REAL(nlay_i) * zthick0(ji,layer,jl),epsi10) ) * zindb 
    559                      ze_i_ac(ji,jk,jl) =  ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl)   
    560                   END DO ! ji 
    561                END DO ! layer 
    562             END DO ! jk 
    563          END DO ! jl 
    564  
    565          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    566             DO jk = 1, nlay_i 
    567                DO ji = 1, nbpac 
    568                   zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  
    569                   ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl)   & 
    570                      &              / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * REAL( nlay_i ) * zindb 
    571                END DO 
    572             END DO 
    573          END DO 
     468               rswitch        = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) 
     469               zv_newfra      = rswitch * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 ) 
     470               za_i_1d(ji,jl) = rswitch * za_i_1d(ji,jl)                
     471               zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra 
     472               ! for remapping 
     473               h_i_old (ji,nlay_i+1) = zv_newfra 
     474               qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra 
     475            ENDDO 
     476            ! --- Ice enthalpy remapping --- ! 
     477            CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) )  
     478         ENDDO 
    574479 
    575480         !------------ 
     
    578483         DO jl = 1, jpl 
    579484            DO ji = 1, nbpac 
    580                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    581                zoa_i_ac(ji,jl)  = za_old(ji,jl) * zoa_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    
     485               rswitch          = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) )  ! 0 if no ice and 1 if yes 
     486               zoa_i_1d(ji,jl)  = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * rswitch    
    582487            END DO  
    583488         END DO    
     
    586491         ! Update salinity 
    587492         !----------------- 
    588          !clem IF(  num_sal == 2  ) THEN 
    589             DO jl = 1, jpl 
    590                DO ji = 1, nbpac 
    591                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    592                   zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    593                   zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) * zindb ! clem modif 
    594                END DO 
    595             END DO    
    596          !clem ENDIF 
    597  
    598          !-------------------------------- 
    599          ! Update mass/salt fluxes (clem) 
    600          !-------------------------------- 
    601493         DO jl = 1, jpl 
    602494            DO ji = 1, nbpac 
    603                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    604                zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    605                rdm_ice_1d(ji) = rdm_ice_1d(ji) + zdv * rhoic * zindb 
    606                sfx_thd_1d(ji)   =   sfx_thd_1d(ji) - zdv * rhoic * zs_newice(ji) * r1_rdtice * zindb 
    607            END DO 
     495               zdv   = zv_i_1d(ji,jl) - zv_b(ji,jl) 
     496               zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji) 
     497            END DO 
    608498         END DO 
    609499 
    610500         !------------------------------------------------------------------------------! 
    611          ! 8) Change 2D vectors to 1D vectors  
     501         ! 7) Change 2D vectors to 1D vectors  
    612502         !------------------------------------------------------------------------------! 
    613503         DO jl = 1, jpl 
    614             CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_ac (1:nbpac,jl), jpi, jpj ) 
    615             CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 
    616             CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 
    617             !clem IF (  num_sal == 2  )   & 
    618                CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 
     504            CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 
     505            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 
     506            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj ) 
     507            CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 
    619508            DO jk = 1, nlay_i 
    620                CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 
    621             END DO 
    622          END DO 
    623          CALL tab_1d_2d( nbpac, sfx_thd, npac(1:nbpac), sfx_thd_1d(1:nbpac), jpi, jpj ) 
    624          CALL tab_1d_2d( nbpac, rdm_ice, npac(1:nbpac), rdm_ice_1d(1:nbpac), jpi, jpj ) 
     509               CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_1d(1:nbpac,jk,jl), jpi, jpj ) 
     510            END DO 
     511         END DO 
     512         CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj ) 
     513         CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 
     514 
     515         CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj ) 
     516         CALL tab_1d_2d( nbpac, hfx_opw, npac(1:nbpac), hfx_opw_1d(1:nbpac), jpi, jpj ) 
    625517         ! 
    626518      ENDIF ! nbpac > 0 
    627519 
    628520      !------------------------------------------------------------------------------! 
    629       ! 9) Change units for e_i 
     521      ! 8) Change units for e_i 
    630522      !------------------------------------------------------------------------------!     
    631523      DO jl = 1, jpl 
    632          DO jk = 1, nlay_i          ! heat content in 10^9 Joules 
    633             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / REAL( nlay_i )  / unit_fac  
     524         DO jk = 1, nlay_i 
     525            DO jj = 1, jpj 
     526               DO ji = 1, jpi 
     527                  ! heat content in Joules 
     528                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac )  
     529               END DO 
     530            END DO 
    634531         END DO 
    635532      END DO 
    636533 
    637       !------------------------------------------------------------------------------| 
    638       ! 10) Conservation check and changes in each ice category 
    639       !------------------------------------------------------------------------------| 
    640       IF( con_i ) THEN  
    641          CALL lim_column_sum (jpl,   v_i, vt_i_final) 
    642          fieldid = 'v_i, limthd_lac' 
    643          CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)  
    644          ! 
    645          CALL lim_column_sum_energy(jpl, nlay_i, e_i, et_i_final) 
    646          fieldid = 'e_i, limthd_lac' 
    647          CALL lim_cons_check (et_i_final, et_i_final, 1.0e-3, fieldid)  
    648          ! 
    649          CALL lim_column_sum (jpl,   v_s, vt_s_final) 
    650          fieldid = 'v_s, limthd_lac' 
    651          CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
    652          ! 
    653          !     CALL lim_column_sum (jpl,   e_s(:,:,1,:) , et_s_init) 
    654          !     fieldid = 'e_s, limthd_lac' 
    655          !     CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid)  
    656          IF( ln_nicep ) THEN 
    657             DO ji = mi0(jiindx), mi1(jiindx) 
    658                DO jj = mj0(jjindx), mj1(jjindx) 
    659                   WRITE(numout,*) ' vt_i_init : ', vt_i_init (ji,jj) 
    660                   WRITE(numout,*) ' vt_i_final: ', vt_i_final(ji,jj) 
    661                   WRITE(numout,*) ' et_i_init : ', et_i_init (ji,jj) 
    662                   WRITE(numout,*) ' et_i_final: ', et_i_final(ji,jj) 
    663                END DO 
    664             END DO 
    665          ENDIF 
    666          ! 
    667       ENDIF 
    668534      ! 
    669       CALL wrk_dealloc( jpij, zcatac )   ! integer 
     535      CALL wrk_dealloc( jpij, jcat )   ! integer 
    670536      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    671       CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 
    672       CALL wrk_dealloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
    673       CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac ) 
    674       CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 
    675       CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 
     537      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
     538      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
     539      CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     540      CALL wrk_dealloc( jpi,jpj, zvrel ) 
    676541      ! 
    677542   END SUBROUTINE lim_thd_lac 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r4624 r5034  
    5353      ! 
    5454      INTEGER  ::   ji, jk     ! dummy loop indices  
    55       REAL(wp) ::   zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch,  ztmelts   ! local scalars 
    56       REAL(wp) ::   zaaa, zbbb, zccc, zdiscrim   ! local scalars 
    57       REAL(wp), POINTER, DIMENSION(:) ::   ze_init, zhiold, zsiold 
     55      REAL(wp) ::   iflush, igravdr   ! local scalars 
    5856      !!--------------------------------------------------------------------- 
    5957 
    60       CALL wrk_alloc( jpij, ze_init, zhiold, zsiold ) 
    61  
     58      !--------------------------------------------------------- 
     59      !  0) Update ice salinity from snow-ice and bottom growth 
     60      !--------------------------------------------------------- 
     61      DO ji = kideb, kiut 
     62         sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 
     63      END DO 
     64  
    6265      !------------------------------------------------------------------------------| 
    6366      ! 1) Constant salinity, constant in time                                       | 
    6467      !------------------------------------------------------------------------------| 
    65 !!gm comment: if num_sal = 1 s_i_new, s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !! 
     68!!gm comment: if num_sal = 1 s_i_new, s_i_1d and sm_i_1d can be set to bulk_sal one for all in the initialisation phase !! 
    6669!!gm           ===>>>   simplification of almost all test on num_sal value 
    6770      IF(  num_sal == 1  ) THEN 
    68             s_i_b (kideb:kiut,1:nlay_i) =  bulk_sal 
    69             sm_i_b (kideb:kiut)          =  bulk_sal  
     71            s_i_1d (kideb:kiut,1:nlay_i) =  bulk_sal 
     72            sm_i_1d(kideb:kiut)          =  bulk_sal  
    7073            s_i_new(kideb:kiut)          =  bulk_sal 
    7174      ENDIF 
     
    7477      !  Module 2 : Constant salinity varying in time                                | 
    7578      !------------------------------------------------------------------------------| 
    76  
    7779      IF(  num_sal == 2  ) THEN 
    78  
    79          !--------------------------------- 
    80          ! Thickness at previous time step 
    81          !--------------------------------- 
    82          DO ji = kideb, kiut 
    83             zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji) 
    84             zsiold(ji) = sm_i_b(ji) 
    85          END DO 
    86  
    87          !--------------------- 
    88          ! Global heat content 
    89          !--------------------- 
    90          ze_init(:)  =  0._wp 
    91          DO jk = 1, nlay_i 
    92             DO ji = kideb, kiut 
    93                ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / REAL (nlay_i ) 
    94             END DO 
    95          END DO 
    9680 
    9781         DO ji = kideb, kiut 
     
    9983            ! Switches  
    10084            !---------- 
    101             iflush       =         MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt )        )    ! =1 if summer  
    102             igravdr      =         MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) )    ! =1 if t_su < t_bo 
    103             iaccrbo      =         MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) )           )    ! =1 if bottom accretion 
    104             i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) ) 
    105             isnowic      = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch   ! =1 if snow ice formation 
     85            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rtt )        )     ! =1 if summer  
     86            igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )    ! =1 if t_su < t_bo 
    10687 
    10788            !--------------------- 
    10889            ! Salinity tendencies 
    10990            !--------------------- 
    110             !                                   ! drainage by gravity drainage 
    111             dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice  
    112             !                                   ! drainage by flushing   
    113             dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 
     91            ! drainage by gravity drainage 
     92            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - sal_G , 0._wp ) / time_G * rdt_ice  
     93            ! drainage by flushing   
     94            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - sal_F , 0._wp ) / time_F * rdt_ice 
    11495 
    11596            !----------------- 
     
    11899            ! only drainage terms ( gravity drainage and flushing ) 
    119100            ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 
    120             sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
    121  
    122             ! if no ice, salinity = 0.1 
    123             i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 
    124             sm_i_b(ji)   = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch ) 
    125  
    126             !---------------------------- 
    127             ! Heat flux - brine drainage 
    128             !---------------------------- 
    129             fhbri_1d(ji) = 0._wp 
     101            sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
    130102 
    131103            !---------------------------- 
    132104            ! Salt flux - brine drainage 
    133105            !---------------------------- 
    134             sfx_bri_1d(ji) = sfx_bri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) * ( sm_i_b(ji) - zsiold(ji) ) * r1_rdtice 
     106            sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 
    135107 
    136108         END DO 
     
    138110         ! Salinity profile 
    139111         CALL lim_var_salprof1d( kideb, kiut ) 
    140  
    141  
    142          ! Only necessary for conservation check since salinity is modified 
    143          !-------------------- 
    144          ! Temperature update 
    145          !-------------------- 
    146          DO jk = 1, nlay_i 
    147             DO ji = kideb, kiut 
    148                ztmelts    =  -tmut*s_i_b(ji,jk) + rtt 
    149                !Conversion q(S,T) -> T (second order equation) 
    150                zaaa         =  cpic 
    151                zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 
    152                zccc         =  lfus * ( ztmelts - rtt ) 
    153                zdiscrim     =  SQRT(  MAX( zbbb*zbbb - 4.0*zaaa*zccc, 0._wp )  ) 
    154                t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 
    155             END DO 
    156          END DO 
    157112         ! 
    158113      ENDIF  
     
    161116      !  Module 3 : Profile of salinity, constant in time                            | 
    162117      !------------------------------------------------------------------------------| 
    163  
    164118      IF(  num_sal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
    165119 
    166       ! 
    167       CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold ) 
    168120      ! 
    169121   END SUBROUTINE lim_thd_sal 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r4333 r5034  
    3030   USE limvar          ! clem for ice thickness correction 
    3131   USE timing          ! Timing 
     32   USE limcons        ! conservation tests 
    3233 
    3334   IMPLICIT NONE 
     
    3536 
    3637   PUBLIC   lim_trp    ! called by ice_step 
    37  
    38    REAL(wp)  ::   epsi10 = 1.e-10_wp   
    39    REAL(wp)  ::   rzero  = 0._wp    
    40    REAL(wp)  ::   rone   = 1._wp 
    4138 
    4239   !! * Substitution 
     
    6360      INTEGER, INTENT(in) ::   kt   ! number of iteration 
    6461      ! 
    65       INTEGER  ::   ji, jj, jk, jl, layer   ! dummy loop indices 
     62      INTEGER  ::   ji, jj, jk, jl, jn      ! dummy loop indices 
    6663      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    67       INTEGER  ::   ierr                    ! error status 
    68       REAL(wp) ::   zindb  , zindsn , zindic, zindh, zinda      ! local scalar 
    69       REAL(wp) ::   zusvosn, zusvoic, zbigval     !   -      - 
    70       REAL(wp) ::   zcfl , zusnit                 !   -      - 
    71       REAL(wp) ::   ze   , zsal   , zage          !   -      - 
     64      REAL(wp) ::   zcfl , zusnit           !   -      - 
    7265      ! 
    7366      REAL(wp), POINTER, DIMENSION(:,:)      ::   zui_u, zvi_v, zsm, zs0at, zs0ow 
    7467      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 
    7568      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e 
    76       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    77       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset) 
    78       ! mass and salt flux (clem) 
    79       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold   ! old ice volume... 
    80       ! correct ice thickness (clem) 
    81       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaiold, zhimax   ! old ice concentration and thickness 
    82       REAL(wp) :: zdv, zda, zvi, zvs, zsmv 
     69      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zviold, zvsold   ! old ice volume... 
     70      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zaiold, zhimax   ! old ice concentration and thickness 
     71      REAL(wp), POINTER, DIMENSION(:,:)      ::   zeiold, zesold   ! old enthalpies 
     72      REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei 
     73      ! 
     74      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    8375      !!--------------------------------------------------------------------- 
    8476      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
    8577 
    86       CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
     78      CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 
    8779      CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    88       CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 
    89  
    90       CALL wrk_alloc( jpi,jpj,jpl,zviold )   ! clem 
    91       CALL wrk_alloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
    92  
    93       ! ------------------------------- 
    94       !- check conservation (C Rousset) 
    95       IF( ln_limdiahsb ) THEN 
    96          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    97          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    98          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    99          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    100       ENDIF 
    101       !- check conservation (C Rousset) 
    102       ! ------------------------------- 
     80      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, zs0e ) 
     81 
     82      CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold )   ! clem 
    10383 
    10484      IF( numit == nstart .AND. lwp ) THEN 
     
    11595      IF( ln_limdyn ) THEN          !   Advection of sea ice properties   ! 
    11696         !                          !-------------------------------------! 
     97 
     98         ! conservation test 
     99         IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     100 
    117101         ! mass and salt flux init (clem) 
    118102         zviold(:,:,:)  = v_i(:,:,:) 
     103         zeiold(:,:)  = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )  
     104         zesold(:,:)  = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )  
    119105 
    120106         !--- Thickness correction init. (clem) ------------------------------- 
     
    167153!         ENDIF 
    168154!!gm end 
    169          initad = 1 + NINT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
     155         initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 
    170156         zusnit = 1.0 / REAL( initad )  
    171157         IF( zcfl > 0.5 .AND. lwp )   & 
     
    174160 
    175161         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==! 
    176             DO jk = 1,initad 
    177                CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
     162            DO jn = 1,initad 
     163               CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    178164                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    179                CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
     165               CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   & 
    180166                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    181167               DO jl = 1, jpl 
    182                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     168                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    183169                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    184                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     170                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
    185171                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    186                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     172                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    187173                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    188                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     174                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
    189175                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    190                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     176                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    191177                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    192                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     178                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
    193179                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    194                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---      
     180                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---      
    195181                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    196                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     182                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
    197183                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    198                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     184                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    199185                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    200                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &  
     186                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &  
    201187                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    202                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     188                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    203189                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    204                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     190                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
    205191                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    206                   DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    207                      CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    208                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    209                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    210                      CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    211                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    212                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
     192                  DO jk = 1, nlay_i                                                           !--- ice heat contents --- 
     193                     CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     194                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     195                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     196                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     197                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     198                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    213199                  END DO 
    214200               END DO 
    215201            END DO 
    216202         ELSE 
    217             DO jk = 1, initad 
    218                CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
     203            DO jn = 1, initad 
     204               CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    219205                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    220                CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
     206               CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   & 
    221207                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    222208               DO jl = 1, jpl 
    223                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     209                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    224210                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    225                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     211                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
    226212                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    227                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     213                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    228214                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    229                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     215                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
    230216                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    231                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     217                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    232218                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    233                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     219                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
    234220                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    235221 
    236                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
     222                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    237223                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    238                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     224                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
    239225                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    240                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     226                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    241227                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    242                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
     228                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
    243229                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    244                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     230                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    245231                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    246                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     232                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
    247233                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    248                   DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    249                      CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    250                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    251                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    252                      CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    253                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    254                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
     234                  DO jk = 1, nlay_i                                                           !--- ice heat contents --- 
     235                     CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     236                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     237                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     238                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     239                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     240                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    255241                  END DO 
    256242               END DO 
     
    268254            zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:) 
    269255            zs0a  (:,:,jl) = zs0a  (:,:,jl) / area(:,:) 
    270             zs0c0 (:,:,jl) = zs0c0 (:,:,jl) / area(:,:) 
    271             DO jk = 1, nlay_i 
    272                zs0e(:,:,jk,jl) = zs0e(:,:,jk,jl) / area(:,:) 
    273             END DO 
     256            ! 
    274257         END DO 
    275258 
     
    289272         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    290273            DO ji = 1 , fs_jpim1   ! vector opt. 
    291                pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji  ,jj) ) ) )   & 
    292                   &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    293                pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji,jj  ) ) ) )   & 
    294                   &        * ( 1._wp - MAX( rzero, SIGN( rone,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 
     274               pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji  ,jj) ) ) )   & 
     275                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 
     276               pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj  ) ) ) )   & 
     277                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 
    295278            END DO 
    296279         END DO 
     
    305288            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    306289               DO ji = 1 , fs_jpim1   ! vector opt. 
    307                   pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji  ,jj,jl) ) ) )   & 
    308                      &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
    309                   pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji,jj  ,jl) ) ) )   & 
    310                      &        * ( 1._wp - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
     290                  pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji  ,jj,jl) ) ) )   & 
     291                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
     292                  pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj  ,jl) ) ) )   & 
     293                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
    311294               END DO 
    312295            END DO 
     
    334317            DO jj = 1, jpj 
    335318               DO ji = 1, jpi 
    336                   zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl) ) 
    337                   zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl) ) 
    338                   zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl) ) 
    339                   zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl) ) 
    340                   zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl) ) 
    341                   zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl) ) 
     319                  zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) ) 
     320                  zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) ) 
     321                  zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) ) 
     322                  zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) ) 
     323                  zs0a  (ji,jj,jl) = MAX( 0._wp, zs0a  (ji,jj,jl) ) 
     324                  zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) ) 
    342325                  zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl) 
    343326               END DO 
     
    346329 
    347330         !--------------------------------------------------------- 
    348          ! 5.2) Snow thickness, Ice thickness, Ice concentrations 
     331         ! 5.2) Update and mask variables 
    349332         !--------------------------------------------------------- 
    350          DO jj = 1, jpj 
    351             DO ji = 1, jpi 
    352                zindb        = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - epsi10) ) 
    353                zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 
    354                ato_i(ji,jj) = zs0ow(ji,jj) 
    355             END DO 
    356          END DO 
    357  
    358          DO jl = 1, jpl         ! Remove very small areas  
     333         DO jl = 1, jpl           
    359334            DO jj = 1, jpj 
    360335               DO ji = 1, jpi 
    361                   zvi = zs0ice(ji,jj,jl) 
    362                   zvs = zs0sn(ji,jj,jl) 
     336                  rswitch = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 
     337 
     338                  zvi  = zs0ice(ji,jj,jl) 
     339                  zvs  = zs0sn (ji,jj,jl) 
     340                  zes  = zs0c0 (ji,jj,jl)       
     341                  zsmv = zs0sm (ji,jj,jl) 
    363342                  ! 
    364                   zindb         = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - epsi10) ) 
    365                   ! 
    366                   v_s(ji,jj,jl)  = zindb * zs0sn (ji,jj,jl)  
    367                   v_i(ji,jj,jl)  = zindb * zs0ice(ji,jj,jl) 
    368                   ! 
    369                   zindsn         = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
    370                   zindic         = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    371                   zindb          = MAX( zindsn, zindic ) 
    372                   ! 
    373                   zs0a(ji,jj,jl) = zindb  * zs0a(ji,jj,jl) !ice concentration 
    374                   a_i (ji,jj,jl) = zs0a(ji,jj,jl) 
    375                   v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 
    376                   v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 
    377                   ! 
    378                   ! Update mass fluxes (clem) 
    379                   rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic  
    380                   rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn  
    381               END DO 
    382             END DO 
    383          END DO 
    384  
    385          !--- Thickness correction in case too high (clem) -------------------------------------------------------- 
    386          CALL lim_var_glo2eqv 
    387          DO jl = 1, jpl 
    388             DO jj = 1, jpj 
    389                DO ji = 1, jpi 
    390  
    391                   IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
    392                      zvi = v_i(ji,jj,jl) 
    393                      zvs = v_s(ji,jj,jl) 
    394                      zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
    395                      !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)    
    396                       
    397                      zindh = 1._wp 
    398                      IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. & 
    399                         & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                           
    400                         ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 
    401                         zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
    402                         a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
    403                      ELSE 
    404                         ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 
    405                         zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
    406                         a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
    407                      ENDIF 
    408  
    409                      ! small correction due to *zindh for a_i 
    410                      v_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) 
    411                      v_s(ji,jj,jl) = zindh * v_s(ji,jj,jl) 
    412  
    413                      ! Update mass fluxes 
    414                      rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 
    415                      rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 
    416  
    417                   ENDIF 
    418  
    419                   diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 
    420  
    421                END DO 
    422             END DO 
    423          END DO 
    424  
    425          ! --- 
    426          DO jj = 1, jpj 
    427             DO ji = 1, jpi 
    428                zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) ! clem@useless?? 
    429             END DO 
    430          END DO 
    431  
    432          !---------------------- 
    433          ! 5.3) Ice properties 
    434          !---------------------- 
    435  
    436          zbigval = 1.e+13 
    437  
    438          DO jl = 1, jpl 
    439             DO jj = 1, jpj 
    440                DO ji = 1, jpi 
    441                   zsmv = zs0sm(ji,jj,jl) 
    442  
    443                   ! Switches and dummy variables 
    444                   zusvosn         = 1.0/MAX( v_s(ji,jj,jl) , epsi10 ) 
    445                   zusvoic         = 1.0/MAX( v_i(ji,jj,jl) , epsi10 ) 
    446                   zindsn          = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
    447                   zindic          = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    448                   zindb           = MAX( zindsn, zindic ) 
    449  
     343                  ! Remove very small areas 
     344                  v_s(ji,jj,jl)   = rswitch * zs0sn (ji,jj,jl)  
     345                  v_i(ji,jj,jl)   = rswitch * zs0ice(ji,jj,jl) 
     346                  a_i(ji,jj,jl)   = rswitch * zs0a  (ji,jj,jl) 
     347                  e_s(ji,jj,1,jl) = rswitch * zs0c0 (ji,jj,jl)       
    450348                  ! Ice salinity and age 
    451                   !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 
    452349                  IF(  num_sal == 2  ) THEN 
    453350                     smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 
    454351                  ENDIF 
    455  
    456                   zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) ), 0._wp  ) * a_i(ji,jj,jl) 
    457                   oa_i (ji,jj,jl)  = zindic * zage  
    458  
    459                   ! Snow heat content 
    460                   ze              =  MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval ) 
    461                   e_s(ji,jj,1,jl) = zindsn * ze       
    462  
    463                   ! Update salt fluxes (clem) 
     352                  oa_i(ji,jj,jl) = MAX( rswitch * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl) 
     353 
     354                 ! Update fluxes 
     355                  wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice  
     356                  wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
    464357                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
    465                END DO !ji 
    466             END DO !jj 
    467          END DO ! jl 
     358                  hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
     359              END DO 
     360            END DO 
     361         END DO 
    468362 
    469363         DO jl = 1, jpl 
     
    471365               DO jj = 1, jpj 
    472366                  DO ji = 1, jpi 
    473                      ! Ice heat content 
    474                      zindic          =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    475                      ze              =  MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval ) 
    476                      e_i(ji,jj,jk,jl) = zindic * ze 
     367                     rswitch          = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 
     368                     zei              = zs0e(ji,jj,jk,jl)       
     369                     e_i(ji,jj,jk,jl) = rswitch * MAX( 0._wp, zs0e(ji,jj,jk,jl) ) 
     370                     ! Update fluxes 
     371                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    477372                  END DO !ji 
    478373               END DO ! jj 
     
    480375         END DO ! jl 
    481376 
    482  
    483       ! --- agglomerate variables (clem) ----------------- 
    484       vt_i (:,:) = 0._wp 
    485       vt_s (:,:) = 0._wp 
    486       at_i (:,:) = 0._wp 
    487       ! 
    488       DO jl = 1, jpl 
     377         !--- Thickness correction in case too high (clem) -------------------------------------------------------- 
     378         CALL lim_var_glo2eqv 
     379         DO jl = 1, jpl 
     380            DO jj = 1, jpj 
     381               DO ji = 1, jpi 
     382 
     383                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
     384                     zvi  = v_i  (ji,jj,jl) 
     385                     zvs  = v_s  (ji,jj,jl) 
     386                     zsmv = smv_i(ji,jj,jl) 
     387                     zes  = e_s  (ji,jj,1,jl) 
     388                     zei  = SUM( e_i(ji,jj,1:nlay_i,jl) ) 
     389                     zdv  = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
     390                     !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)    
     391                      
     392                     rswitch = 1._wp 
     393                     IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. & 
     394                        & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                           
     395                        ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 
     396                        rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 
     397                        a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 
     398                     ELSE 
     399                        ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 
     400                        rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 
     401                        a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 
     402                     ENDIF 
     403 
     404                     ! small correction due to *rswitch for a_i 
     405                     v_i  (ji,jj,jl) = rswitch * v_i  (ji,jj,jl) 
     406                     v_s  (ji,jj,jl) = rswitch * v_s  (ji,jj,jl) 
     407                     smv_i(ji,jj,jl) = rswitch * smv_i(ji,jj,jl) 
     408                     e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl) 
     409                     e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl) 
     410 
     411                     ! Update mass fluxes 
     412                     wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 
     413                     wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
     414                     sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
     415                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
     416                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
     417                  ENDIF 
     418               END DO 
     419            END DO 
     420         END DO 
     421         ! ------------------------------------------------- 
     422 
     423         ! --- diags --- 
    489424         DO jj = 1, jpj 
    490425            DO ji = 1, jpi 
    491                ! 
    492                vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
    493                vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
    494                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    495                ! 
    496                zinda = MAX( rzero , SIGN( rone , at_i(ji,jj) - epsi10 ) ) 
    497                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness 
    498             END DO 
    499          END DO 
    500       END DO 
    501       ! ------------------------------------------------- 
    502  
    503  
     426               diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 
     427               diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 
     428 
     429               diag_trp_vi(ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice 
     430               diag_trp_vs(ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice 
     431            END DO 
     432         END DO 
     433 
     434         ! --- agglomerate variables ----------------- 
     435         vt_i (:,:) = 0._wp 
     436         vt_s (:,:) = 0._wp 
     437         at_i (:,:) = 0._wp 
     438         ! 
     439         DO jl = 1, jpl 
     440            DO jj = 1, jpj 
     441               DO ji = 1, jpi 
     442                  ! 
     443                  vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
     444                  vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
     445                  at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
     446               END DO 
     447            END DO 
     448         END DO 
     449         ! ------------------------------------------------- 
     450 
     451         ! open water 
     452         DO jj = 1, jpj 
     453            DO ji = 1, jpi 
     454               ! open water = 1 if at_i=0 
     455               rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 
     456               ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * zs0ow(ji,jj) 
     457            END DO 
     458         END DO       
     459 
     460         ! conservation test 
     461         IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    504462 
    505463      ENDIF 
     
    536494         END DO 
    537495      ENDIF 
    538       ! ------------------------------- 
    539       !- check conservation (C Rousset) 
    540       IF( ln_limdiahsb ) THEN 
    541          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    542          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    543   
    544          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
    545          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
    546  
    547          zchk_vmin = glob_min(v_i) 
    548          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    549          zchk_amin = glob_min(a_i) 
    550          zchk_umax = glob_max(SQRT(u_ice**2 + v_ice**2)) 
    551  
    552          IF(lwp) THEN 
    553             IF ( ABS( zchk_v_i   ) >  1.e-5 ) THEN 
    554                WRITE(numout,*) 'violation volume [m3/day]     (limtrp) = ',(zchk_v_i * rday) 
    555                WRITE(numout,*) 'u_ice max [m/s]               (limtrp) = ',zchk_umax 
    556                WRITE(numout,*) 'number of time steps          (limtrp) =',kt 
    557             ENDIF 
    558             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday) 
    559             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limtrp) = ',(zchk_vmin * 1.e-3) 
    560             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limtrp) = ',zchk_amin 
    561          ENDIF 
    562       ENDIF 
    563       !- check conservation (C Rousset) 
    564       ! ------------------------------- 
    565496      ! 
    566       CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
     497      CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 
    567498      CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    568       CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e ) 
    569  
    570       CALL wrk_dealloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
     499      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, zs0e ) 
     500 
     501      CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax )   ! clem 
    571502      ! 
    572503      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r4333 r5034  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
     7   !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_lim3 
     
    3233   USE par_ice 
    3334   USE limitd_th 
     35   USE limitd_me 
    3436   USE limvar 
    3537   USE prtctl           ! Print control 
     
    3739   USE wrk_nemo         ! work arrays 
    3840   USE lib_fortran     ! glob_sum 
    39    ! Check budget (Rousset) 
    4041   USE in_out_manager   ! I/O manager 
    4142   USE iom              ! I/O manager 
    4243   USE lib_mpp          ! MPP library 
    4344   USE timing          ! Timing 
     45   USE limcons        ! conservation tests 
    4446 
    4547   IMPLICIT NONE 
     
    4850   PUBLIC   lim_update1   ! routine called by ice_step 
    4951 
    50       REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
    51       REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    52       REAL(wp)  ::   rone   = 1._wp       !    -       - 
    53           
    5452   !! * Substitutions 
    5553#  include "vectopt_loop_substitute.h90" 
     
    6664      !!                
    6765      !! ** Purpose :  Computes update of sea-ice global variables at  
    68       !!               the end of the time step. 
    69       !!               Address pathological cases 
    70       !!               This place is very important 
     66      !!               the end of the dynamics. 
    7167      !!                 
    72       !! ** Method  :   
    73       !!    Ice speed from ice dynamics 
    74       !!    Ice thickness, Snow thickness, Temperatures, Lead fraction 
    75       !!      from advection and ice thermodynamics  
    76       !! 
    77       !! ** Action  : -  
    7868      !!--------------------------------------------------------------------- 
    79       INTEGER ::   ji, jj, jk, jl, jm    ! dummy loop indices 
    80       INTEGER ::   jbnd1, jbnd2 
    81       INTEGER ::   i_ice_switch 
    82       INTEGER ::   ind_im, layer      ! indices for internal melt 
    83       REAL(wp) ::   zweight, zesum, z_da_i, zhimax 
    84       REAL(wp) ::   zinda, zindb, zindsn, zindic 
    85       REAL(wp) ::   zindg, zh, zdvres, zviold2 
    86       REAL(wp) ::   zbigvalue, zvsold2, z_da_ex 
    87       REAL(wp) ::   z_prescr_hi, zat_i_old, ztmelts, ze_s 
    88  
    89       REAL(wp), POINTER, DIMENSION(:) ::   zthick0, zqm0      ! thickness of the layers and heat contents for 
    90       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    91       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    92       ! mass and salt flux (clem) 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
     69      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     70      INTEGER  ::   i_ice_switch 
     71      REAL(wp) ::   zsal 
     72      ! 
     73      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    9474      !!------------------------------------------------------------------- 
    9575      IF( nn_timing == 1 )  CALL timing_start('limupdate1') 
    9676 
    97       CALL wrk_alloc( jkmax, zthick0, zqm0 ) 
    98  
    99       CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    100  
    101       !------------------------------------------------------------------------------ 
    102       ! 1. Update of Global variables                                               | 
    103       !------------------------------------------------------------------------------ 
    104  
    105       !----------------- 
    106       !  Trend terms 
    107       !----------------- 
    108       d_u_ice_dyn(:,:)     = u_ice(:,:)     - old_u_ice(:,:) 
    109       d_v_ice_dyn(:,:)     = v_ice(:,:)     - old_v_ice(:,:) 
    110       d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - old_a_i  (:,:,:) 
    111       d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - old_v_s  (:,:,:)   
    112       d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - old_v_i  (:,:,:)    
    113       d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - old_e_s  (:,:,:,:)   
    114       d_e_i_trp  (:,:,:,:) = e_i  (:,:,:,:) - old_e_i  (:,:,:,:) 
    115       d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - old_oa_i (:,:,:) 
    116       d_smv_i_trp(:,:,:)   = 0._wp 
    117       IF(  num_sal == 2  )   d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:) 
    118  
    119       ! mass and salt flux init (clem) 
    120       zviold(:,:,:) = v_i(:,:,:) 
    121       zvsold(:,:,:) = v_s(:,:,:) 
    122       zsmvold(:,:,:) = smv_i(:,:,:) 
    123  
    124       ! ------------------------------- 
    125       !- check conservation (C Rousset) 
    126       IF (ln_limdiahsb) THEN 
    127          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    128          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    129          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    130          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    131       ENDIF 
    132       !- check conservation (C Rousset) 
    133       ! ------------------------------- 
     77      IF( ln_limdyn ) THEN  
     78 
     79      ! conservation test 
     80      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     81 
     82      !----------------- 
     83      ! zap small values 
     84      !----------------- 
     85      CALL lim_itd_me_zapsmall 
    13486 
    13587      CALL lim_var_glo2eqv 
    136  
    137       !-------------------------------------- 
    138       ! 2. Review of all pathological cases 
    139       !-------------------------------------- 
    140  
    141 ! clem: useless now 
    142       !------------------------------------------- 
    143       ! 2.1) Advection of ice in an ice-free cell 
    144       !------------------------------------------- 
    145       ! should be removed since it is treated after dynamics now 
    146 !      zhimax = 5._wp 
    147 !      ! first category 
    148 !      DO jj = 1, jpj 
    149 !         DO ji = 1, jpi 
    150 !            !--- the thickness of such an ice is often out of bounds 
    151 !            !--- thus we recompute a new area while conserving ice volume 
    152 !            zat_i_old = SUM( old_a_i(ji,jj,:) ) 
    153 !            zindb     = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_trp(ji,jj,1) ) - epsi10 ) )  
    154 !            IF( ( ABS( d_v_i_trp(ji,jj,1) ) / MAX( ABS( d_a_i_trp(ji,jj,1) ), epsi10 ) * zindb .GT. zhimax ) & 
    155 !              &   .AND.( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) & 
    156 !              &   .AND.( zat_i_old .LT. 1.e-6 ) )  THEN ! new line 
    157 !               ht_i(ji,jj,1) = hi_max(1) * 0.5_wp 
    158 !               a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1) 
    159 !            ENDIF 
    160 !         END DO 
    161 !      END DO 
    162 ! 
    163 !      zhimax = 20._wp 
    164 !      ! other categories 
    165 !      DO jl = 2, jpl 
    166 !         jm = ice_types(jl) 
    167 !         DO jj = 1, jpj 
    168 !            DO ji = 1, jpi 
    169 !               zindb =  MAX( rzero, SIGN( rone, ABS( d_a_i_trp(ji,jj,jl) ) - epsi10 ) )  
    170 !               ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
    171 !               ! it makes problems when the advected volume and concentration do not seem to be  
    172 !               ! related with each other 
    173 !               ! the new thickness is sometimes very big! 
    174 !               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
    175 !               ! which of course is plausible 
    176 !               ! but fuck! it fucks everything up :) 
    177 !               IF ( ( ABS( d_v_i_trp(ji,jj,jl) ) / MAX( ABS( d_a_i_trp(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) & 
    178 !                  &  .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN 
    179 !                  ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp 
    180 !                  a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl) 
    181 !               ENDIF 
    182 !            END DO ! ji 
    183 !         END DO !jj 
    184 !      END DO !jl 
    18588      
     89      !---------------------------------------------------- 
     90      ! Rebin categories with thickness out of bounds 
     91      !---------------------------------------------------- 
     92      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl) 
     93 
    18694      at_i(:,:) = 0._wp 
    18795      DO jl = 1, jpl 
     
    19098 
    19199      !---------------------------------------------------- 
    192       ! 2.2) Rebin categories with thickness out of bounds 
    193       !---------------------------------------------------- 
    194       DO jm = 1, jpm 
    195          jbnd1 = ice_cat_bounds(jm,1) 
    196          jbnd2 = ice_cat_bounds(jm,2) 
    197          IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
     100      ! ice concentration should not exceed amax  
     101      !----------------------------------------------------- 
     102      DO jl  = 1, jpl 
     103         DO jj = 1, jpj 
     104            DO ji = 1, jpi 
     105               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     106                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 
     107                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     108               ENDIF 
     109            END DO 
     110         END DO 
    198111      END DO 
    199112 
     
    202115         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    203116      END DO 
    204  
    205       zbigvalue      = 1.0e+20 
    206  
    207       DO jl = 1, jpl 
    208          DO jj = 1, jpj  
    209             DO ji = 1, jpi 
    210  
    211                !switches 
    212                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    213                !switch = 1 if a_i > 1e-06 and 0 if not 
    214                zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 
    215                zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 
    216                ! bug fix 25 avril 2007 
    217                zindb         = zindb*zindic 
    218  
    219                !--- 2.3 Correction to ice age  
    220                !------------------------------ 
    221                !                IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 
    222                !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 
    223                !                ENDIF 
    224                IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    225                   oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 
    226                ENDIF 
    227                oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
    228  
    229                !--- 2.4 Correction to snow thickness 
    230                !------------------------------------- 
    231                !          ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0 
    232                !             v_s(ji,jj,jl)  = MAX( zindb * v_s(ji,jj,jl), 0.0)  
    233                ! snow thickness cannot be smaller than 1e-6 
    234                zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 
    235                v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 
    236  
    237                !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 
    238   
    239                !--- 2.5 Correction to ice thickness 
    240                !------------------------------------- 
    241                zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 
    242                v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 
    243  
    244                !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 
    245                !sfx_res(ji,jj)  = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    246  
    247                !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
    248                !---------------------------------------------------------------------------- 
    249                zindg          = tms(ji,jj) *  MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    250                zdvres         = zindg * rhosn * v_s(ji,jj,jl) / rau0 
    251                v_i(ji,jj,jl)  = v_i(ji,jj,jl)  + zdvres 
    252  
    253                zdvres         = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 
    254                v_s(ji,jj,jl)  = v_s(ji,jj,jl)  + zdvres 
    255  
    256                !--- 2.7 Correction to ice concentrations  
    257                !-------------------------------------------- 
    258                ! if greater than 0, ice concentration cannot be smaller than 1e-10 
    259                a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 
    260  
    261                !------------------------- 
    262                ! 2.8) Snow heat content 
    263                !------------------------- 
    264                e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0._wp, e_s(ji,jj,1,jl) ), zbigvalue ) ) 
    265  
    266             END DO ! ji 
    267          END DO ! jj 
    268       END DO ! jl 
    269  
    270       !------------------------ 
    271       ! 2.9) Ice heat content  
    272       !------------------------ 
    273  
    274       DO jl = 1, jpl 
    275          DO jk = 1, nlay_i 
     117     
     118      ! -------------------------------------- 
     119      ! Final thickness distribution rebinning 
     120      ! -------------------------------------- 
     121      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 
     122 
     123      !----------------- 
     124      ! zap small values 
     125      !----------------- 
     126      CALL lim_itd_me_zapsmall 
     127 
     128      !--------------------- 
     129      ! Ice salinity bounds 
     130      !--------------------- 
     131      IF (  num_sal == 2  ) THEN  
     132         DO jl = 1, jpl 
    276133            DO jj = 1, jpj  
    277134               DO ji = 1, jpi 
    278                   zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    279                   e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 
    280                END DO ! ji 
    281             END DO ! jj 
    282          END DO !jk 
    283       END DO !jl 
    284   
    285       at_i(:,:) = 0._wp 
    286       DO jl = 1, jpl 
    287          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    288       END DO 
    289  
    290       !--- 2.13 ice concentration should not exceed amax  
    291       !         (it should not be the case)  
    292       !----------------------------------------------------- 
    293       DO jj = 1, jpj 
    294          DO ji = 1, jpi 
    295             z_da_ex =  MAX( at_i(ji,jj) - amax , 0.0 )         
    296             zindb   =  MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) )  
    297             DO jl  = 1, jpl 
    298                z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 
    299                a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 
    300                ! 
    301                zinda   =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    302                ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 
    303                !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 
     135                  zsal            = smv_i(ji,jj,jl) 
     136                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
     137                  ! salinity stays in bounds 
     138                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     139                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
     140                  ! associated salt flux 
     141                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     142               END DO 
    304143            END DO 
    305144         END DO 
    306       END DO 
    307       at_i(:,:) = a_i(:,:,1) 
    308       DO jl = 2, jpl 
    309          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    310       END DO 
    311  
    312  
    313       ! Final thickness distribution rebinning 
    314       ! -------------------------------------- 
    315       DO jm = 1, jpm 
    316          jbnd1 = ice_cat_bounds(jm,1) 
    317          jbnd2 = ice_cat_bounds(jm,2) 
    318          IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    319          IF (ice_ncat_types(jm) .EQ. 1 ) THEN 
    320          ENDIF 
    321       END DO 
    322  
    323  
    324       !--------------------- 
    325       ! 2.11) Ice salinity 
    326       !--------------------- 
    327       ! clem correct bug on smv_i 
    328       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    329  
    330       IF (  num_sal == 2  ) THEN ! general case 
    331          DO jl = 1, jpl 
    332             !DO jk = 1, nlay_i 
    333                DO jj = 1, jpj  
    334                   DO ji = 1, jpi 
    335                      ! salinity stays in bounds 
    336                      !clem smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) ) 
    337                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
    338                      i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    339                      smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
    340                   END DO ! ji 
    341                END DO ! jj 
    342             !END DO !jk 
    343          END DO !jl 
    344145      ENDIF 
    345146 
    346       at_i(:,:) = a_i(:,:,1) 
    347       DO jl = 2, jpl 
    348          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    349       END DO 
    350  
    351  
    352       !-------------------------------- 
    353       ! Update mass/salt fluxes (clem) 
    354       !-------------------------------- 
    355       DO jl = 1, jpl 
    356          DO jj = 1, jpj  
    357             DO ji = 1, jpi 
    358                diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice  
    359                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    360                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    361                sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice  
    362             END DO 
    363          END DO 
    364       END DO 
    365    
    366       ! ------------------------------- 
    367       !- check conservation (C Rousset) 
    368       IF (ln_limdiahsb) THEN 
    369  
    370          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    371          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    372   
    373          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    374          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    375  
    376          zchk_vmin = glob_min(v_i) 
    377          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    378          zchk_amin = glob_min(a_i) 
    379         
    380          IF(lwp) THEN 
    381             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limupdate1) = ',(zchk_v_i * rday) 
    382             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate1) = ',(zchk_smv * rday) 
    383             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limupdate1) = ',(zchk_vmin * 1.e-3) 
    384             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limupdate1) = ',zchk_amax 
    385             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limupdate1) = ',zchk_amin 
    386          ENDIF 
    387       ENDIF 
    388       !- check conservation (C Rousset) 
    389       ! ------------------------------- 
     147      ! ------------------------------------------------- 
     148      ! Diagnostics 
     149      ! ------------------------------------------------- 
     150      d_u_ice_dyn(:,:)     = u_ice(:,:)     - u_ice_b(:,:) 
     151      d_v_ice_dyn(:,:)     = v_ice(:,:)     - v_ice_b(:,:) 
     152      d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - a_i_b  (:,:,:) 
     153      d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - v_s_b  (:,:,:)   
     154      d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - v_i_b  (:,:,:)    
     155      d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - e_s_b  (:,:,:,:)   
     156      d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
     157      d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - oa_i_b (:,:,:) 
     158      d_smv_i_trp(:,:,:)   = 0._wp 
     159      IF(  num_sal == 2  ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
     160 
     161      ! conservation test 
     162      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    390163 
    391164      IF(ln_ctl) THEN   ! Control print 
     
    400173         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    401174         CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1  : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :') 
    402          CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update1  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_v_ice   :') 
     175         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    403176 
    404177         DO jl = 1, jpl 
     
    413186            CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update1  : o_i         : ') 
    414187            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ') 
    415             CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update1  : old_a_i     : ') 
     188            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ') 
    416189            CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_a_i_trp   : ') 
    417190            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ') 
    418             CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update1  : old_v_i     : ') 
     191            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ') 
    419192            CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_i_trp   : ') 
    420193            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ') 
    421             CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update1  : old_v_s     : ') 
     194            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ') 
    422195            CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_s_trp   : ') 
    423196            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1        : ') 
    424             CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : old_e_i1    : ') 
     197            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1_b      : ') 
    425198            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : de_i1_trp   : ') 
    426199            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2        : ') 
    427             CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : old_e_i2    : ') 
     200            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2_b      : ') 
    428201            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : de_i2_trp   : ') 
    429202            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ') 
    430             CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update1  : old_e_snow  : ') 
     203            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ') 
    431204            CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : d_e_s_trp   : ') 
    432205            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ') 
    433             CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update1  : old_smv_i   : ') 
     206            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ') 
    434207            CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update1  : d_smv_i_trp : ') 
    435208            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ') 
    436             CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update1  : old_oa_i    : ') 
     209            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ') 
    437210            CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update1  : d_oa_i_trp  : ') 
    438211 
     
    446219         CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    447220         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    448          CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update1 : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    449221         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update1 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    450          CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update1 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 
    451222 
    452223         CALL prt_ctl_info(' ') 
     
    458229      ENDIF 
    459230    
    460  
    461       CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 
    462  
    463       CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
     231      ENDIF ! ln_limdyn 
    464232 
    465233      IF( nn_timing == 1 )  CALL timing_stop('limupdate1') 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r4333 r5034  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
     7   !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_lim3 
     
    3940   USE lib_fortran     ! glob_sum 
    4041   USE timing          ! Timing 
     42   USE limcons        ! conservation tests 
    4143 
    4244   IMPLICIT NONE 
     
    4547   PUBLIC   lim_update2   ! routine called by ice_step 
    4648 
    47       REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
    48       REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    49       REAL(wp)  ::   rone   = 1._wp       !    -       - 
    50           
    5149   !! * Substitutions 
    5250#  include "vectopt_loop_substitute.h90" 
     
    6462      !! ** Purpose :  Computes update of sea-ice global variables at  
    6563      !!               the end of the time step. 
    66       !!               Address pathological cases 
    67       !!               This place is very important 
    68       !!                 
    69       !! ** Method  :   
    70       !!    Ice speed from ice dynamics 
    71       !!    Ice thickness, Snow thickness, Temperatures, Lead fraction 
    72       !!      from advection and ice thermodynamics  
    7364      !! 
    74       !! ** Action  : -  
    7565      !!--------------------------------------------------------------------- 
    76       INTEGER ::   ji, jj, jk, jl, jm    ! dummy loop indices 
    77       INTEGER ::   jbnd1, jbnd2 
    78       INTEGER ::   i_ice_switch 
    79       INTEGER ::   ind_im, layer      ! indices for internal melt 
    80       REAL(wp) ::   zweight, zesum, zhimax, z_da_i 
    81       REAL(wp) ::   zinda, zindb, zindsn, zindic 
    82       REAL(wp) ::   zindg, zh, zdvres, zviold2 
    83       REAL(wp) ::   zbigvalue, zvsold2, z_da_ex 
    84       REAL(wp) ::   z_prescr_hi, zat_i_old, ztmelts, ze_s 
    85  
    86       INTEGER , POINTER, DIMENSION(:,:,:) ::  internal_melt 
    87       REAL(wp), POINTER, DIMENSION(:) ::   zthick0, zqm0      ! thickness of the layers and heat contents for 
    88       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    89       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    90       ! mass and salt flux (clem) 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
     66      INTEGER  ::   ji, jj, jk, jl    ! dummy loop indices 
     67      INTEGER  ::   i_ice_switch 
     68      REAL(wp) ::   zh, zsal 
     69      ! 
     70      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    9271      !!------------------------------------------------------------------- 
    9372      IF( nn_timing == 1 )  CALL timing_start('limupdate2') 
    9473 
    95       CALL wrk_alloc( jpi,jpj,jpl, internal_melt )   ! integer 
    96       CALL wrk_alloc( jkmax, zthick0, zqm0 ) 
    97  
    98       CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    99  
    100       !---------------------------------------------------------------------------------------- 
    101       ! 1. Computation of trend terms       
    102       !---------------------------------------------------------------------------------------- 
    103       !- Trend terms 
    104       d_a_i_thd(:,:,:)   = a_i(:,:,:)   - old_a_i(:,:,:)  
    105       d_v_s_thd(:,:,:)   = v_s(:,:,:)   - old_v_s(:,:,:) 
    106       d_v_i_thd(:,:,:)   = v_i(:,:,:)   - old_v_i(:,:,:)   
    107       d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)  
    108       d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 
    109       !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - old_oa_i (:,:,:) 
    110       d_smv_i_thd(:,:,:) = 0._wp 
    111       IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
    112       ! diag only (clem) 
    113       dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    114  
    115       ! mass and salt flux init (clem) 
    116       zviold(:,:,:) = v_i(:,:,:) 
    117       zvsold(:,:,:) = v_s(:,:,:) 
    118       zsmvold(:,:,:) = smv_i(:,:,:) 
    119  
    120       ! ------------------------------- 
    121       !- check conservation (C Rousset) 
    122       IF (ln_limdiahsb) THEN 
    123          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    124          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    125          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    126          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    127       ENDIF 
    128       !- check conservation (C Rousset) 
    129       ! ------------------------------- 
     74      ! conservation test 
     75      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     76 
     77      !----------------- 
     78      ! zap small values 
     79      !----------------- 
     80      CALL lim_itd_me_zapsmall 
    13081 
    13182      CALL lim_var_glo2eqv 
    13283 
    133       !-------------------------------------- 
    134       ! 2. Review of all pathological cases 
    135       !-------------------------------------- 
    136  
    137 ! clem: useless now 
    138       !------------------------------------------- 
    139       ! 2.1) Advection of ice in an ice-free cell 
    140       !------------------------------------------- 
    141       ! should be removed since it is treated after dynamics now 
    142 !      zhimax = 5._wp 
    143 !      ! first category 
    144 !      DO jj = 1, jpj 
    145 !         DO ji = 1, jpi 
    146 !            !--- the thickness of such an ice is often out of bounds 
    147 !            !--- thus we recompute a new area while conserving ice volume 
    148 !            zat_i_old = SUM( old_a_i(ji,jj,:) ) 
    149 !            zindb     = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_thd(ji,jj,1) ) - epsi10 ) )  
    150 !            IF ( ( ABS( d_v_i_thd(ji,jj,1) ) / MAX( ABS( d_a_i_thd(ji,jj,1) ),epsi10 ) * zindb .GT. zhimax ) & 
    151 !               &  .AND. ( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) & 
    152 !               &  .AND. ( zat_i_old .LT. 1.e-6 ) )  THEN ! new line 
    153 !               ht_i(ji,jj,1) = hi_max(1) * 0.5_wp 
    154 !               a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1) 
    155 !            ENDIF 
    156 !         END DO 
    157 !      END DO 
    158  
    159 !      zhimax = 20._wp 
    160 !      ! other categories 
    161 !      DO jl = 2, jpl 
    162 !         jm = ice_types(jl) 
    163 !         DO jj = 1, jpj 
    164 !            DO ji = 1, jpi 
    165 !               zindb =  MAX( rzero, SIGN( rone, ABS( d_a_i_thd(ji,jj,jl)) - epsi10 ) )  
    166 !              ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
    167 !               ! it makes problems when the advected volume and concentration do not seem to be  
    168 !               ! related with each other 
    169 !               ! the new thickness is sometimes very big! 
    170 !               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
    171 !               ! which of course is plausible 
    172 !               ! but fuck! it fucks everything up :) 
    173 !               IF ( ( ABS( d_v_i_thd(ji,jj,jl) ) / MAX( ABS( d_a_i_thd(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) & 
    174 !                  &  .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN 
    175 !                  ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp 
    176 !                  a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl) 
    177 !               ENDIF 
    178 !            END DO ! ji 
    179 !         END DO !jj 
    180 !      END DO !jl 
    181       
     84      !---------------------------------------------------- 
     85      ! Rebin categories with thickness out of bounds 
     86      !---------------------------------------------------- 
     87      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl) 
     88 
     89      !---------------------------------------------------------------------- 
     90      ! Constrain the thickness of the smallest category above hiclim 
     91      !---------------------------------------------------------------------- 
     92      DO jj = 1, jpj  
     93         DO ji = 1, jpi 
     94            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN 
     95               zh             = hiclim / ht_i(ji,jj,1) 
     96               ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh 
     97               ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh 
     98               a_i (ji,jj,1) = a_i(ji,jj,1)  / zh 
     99            ENDIF 
     100         END DO 
     101      END DO 
     102       
     103      !----------------------------------------------------- 
     104      ! ice concentration should not exceed amax  
     105      !----------------------------------------------------- 
    182106      at_i(:,:) = 0._wp 
    183107      DO jl = 1, jpl 
     
    185109      END DO 
    186110 
    187       !---------------------------------------------------- 
    188       ! 2.2) Rebin categories with thickness out of bounds 
    189       !---------------------------------------------------- 
    190       DO jm = 1, jpm 
    191          jbnd1 = ice_cat_bounds(jm,1) 
    192          jbnd2 = ice_cat_bounds(jm,2) 
    193          IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    194       END DO 
    195  
    196       !--------------------------------- 
    197       ! 2.3) Melt of an internal layer 
    198       !--------------------------------- 
    199       internal_melt(:,:,:) = 0 
    200  
    201       DO jl = 1, jpl 
    202          DO jk = 1, nlay_i 
    203             DO jj = 1, jpj  
    204                DO ji = 1, jpi 
    205                   ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    206                   IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) & 
    207                     & .AND. ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
    208                      internal_melt(ji,jj,jl) = 1 
    209                   ENDIF 
    210                END DO ! ji 
    211             END DO ! jj 
    212          END DO !jk 
    213       END DO !jl 
    214  
    215       DO jl = 1, jpl 
    216          DO jj = 1, jpj  
     111      DO jl  = 1, jpl 
     112         DO jj = 1, jpj 
    217113            DO ji = 1, jpi 
    218                IF( internal_melt(ji,jj,jl) == 1 ) THEN 
    219                   ! initial ice thickness 
    220                   !----------------------- 
     114               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     115                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 
    221116                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    222  
    223                   ! reduce ice thickness 
    224                   !----------------------- 
    225                   ind_im = 0 
    226                   zesum = 0.0 
    227                   DO jk = 1, nlay_i 
    228                      ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    229                      IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) ind_im = ind_im + 1 
    230                      zesum = zesum + e_i(ji,jj,jk,jl) 
    231                   END DO 
    232                   ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) 
    233                   v_i(ji,jj,jl)  = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 
    234  
    235                   !CLEM 
    236                   zdvres = REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) * a_i(ji,jj,jl) 
    237                   !rdm_ice(ji,jj) = rdm_ice(ji,jj) - zdvres * rhoic 
    238                   !sfx_res(ji,jj)  = sfx_res(ji,jj) + sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    239  
    240                   ! redistribute heat 
    241                   !----------------------- 
    242                   ! old thicknesses and enthalpies 
    243                   ind_im = 0 
    244                   DO jk = 1, nlay_i 
    245                      ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    246                      IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND.  &  
    247                         ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN 
    248                         ind_im = ind_im + 1 
    249                         zthick0(ind_im) = ht_i(ji,jj,jl) * REAL(ind_im / nlay_i) 
    250                         zqm0   (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 ) 
    251                      ENDIF 
    252                   END DO 
    253  
    254                   ! Redistributing energy on the new grid 
    255                   IF ( ind_im .GT. 0 ) THEN 
    256  
    257                      DO jk = 1, nlay_i 
    258                         e_i(ji,jj,jk,jl) = 0.0 
    259                         DO layer = 1, ind_im 
    260                            zweight         = MAX (  & 
    261                               MIN( ht_i(ji,jj,jl) * REAL(layer/ind_im) , ht_i(ji,jj,jl) * REAL(jk / nlay_i) ) -       & 
    262                               MAX( ht_i(ji,jj,jl) * REAL((layer-1)/ind_im) , ht_i(ji,jj,jl) * REAL((jk-1) / nlay_i) ) , 0.0 ) & 
    263                               /  ( ht_i(ji,jj,jl) / REAL(ind_im) ) 
    264  
    265                            e_i(ji,jj,jk,jl) =  e_i(ji,jj,jk,jl) + zweight*zqm0(layer) 
    266                         END DO !layer 
    267                      END DO ! jk 
    268  
    269                      zesum = 0.0 
    270                      DO jk = 1, nlay_i 
    271                         zesum = zesum + e_i(ji,jj,jk,jl) 
    272                      END DO 
    273  
    274                   ELSE ! ind_im .EQ. 0, total melt 
    275                      e_i(ji,jj,jk,jl) = 0.0 
    276                   ENDIF 
    277  
    278                ENDIF ! internal_melt 
    279  
    280             END DO ! ji 
    281          END DO !jj 
    282       END DO !jl 
    283  
    284       internal_melt(:,:,:) = 0 
    285  
    286  
    287       ! Melt of snow 
    288       !-------------- 
    289       DO jl = 1, jpl 
    290          DO jj = 1, jpj  
    291             DO ji = 1, jpi 
    292                ! snow energy of melting 
    293                zinda   =  MAX( 0._wp, SIGN( 1._wp, v_s(ji,jj,jl) - epsi10 ) ) 
    294                ze_s = zinda * e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) / MAX( v_s(ji,jj,jl), epsi10 )  ! snow energy of melting 
    295  
    296                ! If snow energy of melting smaller then Lf 
    297                ! Then all snow melts and meltwater, heat go to the ocean 
    298                IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = 1 
    299  
     117               ENDIF 
    300118            END DO 
    301119         END DO 
    302120      END DO 
    303  
    304       DO jl = 1, jpl 
    305          DO jj = 1, jpj  
    306             DO ji = 1, jpi 
    307                IF ( internal_melt(ji,jj,jl) == 1 ) THEN 
    308                   zdvres = v_s(ji,jj,jl) 
    309                   ! release heat 
    310                   fheat_res(ji,jj) = fheat_res(ji,jj) + ze_s * zdvres / rdt_ice 
    311                   ! release mass 
    312                   !rdm_snw(ji,jj) =  rdm_snw(ji,jj) - zdvres * rhosn 
    313                   ! 
    314                   v_s(ji,jj,jl)   = 0.0 
    315                   e_s(ji,jj,1,jl) = 0.0 
    316                  ENDIF 
    317             END DO 
    318          END DO 
    319       END DO 
    320  
    321       zbigvalue      = 1.0e+20 
    322       DO jl = 1, jpl 
    323          DO jj = 1, jpj  
    324             DO ji = 1, jpi 
    325  
    326                !switches 
    327                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    328                !switch = 1 if a_i > 1e-06 and 0 if not 
    329                zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 
    330                zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 
    331                ! bug fix 25 avril 2007 
    332                zindb         = zindb*zindic 
    333  
    334                !--- 2.3 Correction to ice age  
    335                !------------------------------ 
    336                !                IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 
    337                !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 
    338                !                ENDIF 
    339                IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    340                   oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 
    341                ENDIF 
    342                oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
    343  
    344                !--- 2.4 Correction to snow thickness 
    345                !------------------------------------- 
    346                zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 
    347                v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 
    348  
    349                !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 
    350   
    351                !--- 2.5 Correction to ice thickness 
    352                !------------------------------------- 
    353                zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 
    354                v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 
    355  
    356                !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 
    357                !sfx_res(ji,jj)  = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    358  
    359                !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
    360                !---------------------------------------------------------------------------- 
    361                zindg          = tms(ji,jj) *  MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    362                zdvres         = zindg * rhosn * v_s(ji,jj,jl) / rau0 
    363                v_i(ji,jj,jl)  = v_i(ji,jj,jl)  + zdvres 
    364  
    365                zdvres         = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 
    366                v_s(ji,jj,jl)  = v_s(ji,jj,jl)  + zdvres 
    367  
    368                !--- 2.7 Correction to ice concentrations  
    369                !-------------------------------------------- 
    370                a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 
    371  
    372                !------------------------- 
    373                ! 2.8) Snow heat content 
    374                !------------------------- 
    375                e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) ) 
    376  
    377             END DO ! ji 
    378          END DO ! jj 
    379       END DO ! jl 
    380  
    381       !------------------------ 
    382       ! 2.9) Ice heat content  
    383       !------------------------ 
    384  
    385       DO jl = 1, jpl 
    386          DO jk = 1, nlay_i 
    387             DO jj = 1, jpj  
    388                DO ji = 1, jpi 
    389                   zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    390                   e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 
    391                END DO ! ji 
    392             END DO ! jj 
    393          END DO !jk 
    394       END DO !jl 
    395  
    396  
    397       DO jm = 1, jpm 
    398          DO jj = 1, jpj  
    399             DO ji = 1, jpi 
    400                jl = ice_cat_bounds(jm,1) 
    401                !--- 2.12 Constrain the thickness of the smallest category above 5 cm 
    402                !---------------------------------------------------------------------- 
    403                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    404                ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi10) 
    405                zh            = MAX( rone , zindb * hiclim  / MAX( ht_i(ji,jj,jl) , epsi10 ) ) 
    406                ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh 
    407                ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh 
    408                a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh 
    409                !CLEM 
    410                v_i (ji,jj,jl) = a_i(ji,jj,jl) * ht_i(ji,jj,jl) 
    411                v_s (ji,jj,jl) = a_i(ji,jj,jl) * ht_s(ji,jj,jl) 
    412             END DO !ji 
    413          END DO !jj 
    414       END DO !jm 
    415121 
    416122      at_i(:,:) = 0.0 
     
    418124         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    419125      END DO 
    420        
    421       !--- 2.13 ice concentration should not exceed amax  
    422       !         (it should not be the case)  
    423       !----------------------------------------------------- 
    424       DO jj = 1, jpj 
    425          DO ji = 1, jpi 
    426             z_da_ex =  MAX( at_i(ji,jj) - amax , 0.0 )         
    427             zindb   =  MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) )  
    428             DO jl  = 1, jpl 
    429                z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 
    430                a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 
    431                ! 
    432                zinda   =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    433                ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 
    434                !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 
    435             END DO 
    436          END DO 
    437       END DO 
    438       at_i(:,:) = 0.0 
    439       DO jl = 1, jpl 
    440          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    441       END DO 
    442  
     126 
     127      ! -------------------------------------- 
    443128      ! Final thickness distribution rebinning 
    444129      ! -------------------------------------- 
    445       DO jm = 1, jpm 
    446          jbnd1 = ice_cat_bounds(jm,1) 
    447          jbnd2 = ice_cat_bounds(jm,2) 
    448          IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    449          IF (ice_ncat_types(jm) .EQ. 1 ) THEN 
    450          ENDIF 
    451       END DO 
     130      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 
     131 
     132      !----------------- 
     133      ! zap small values 
     134      !----------------- 
     135      CALL lim_itd_me_zapsmall 
    452136 
    453137      !--------------------- 
    454138      ! 2.11) Ice salinity 
    455139      !--------------------- 
    456       ! clem correct bug on smv_i 
    457       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    458  
    459       IF (  num_sal == 2  ) THEN ! general case 
     140      IF (  num_sal == 2  ) THEN  
    460141         DO jl = 1, jpl 
    461             !DO jk = 1, nlay_i 
    462                DO jj = 1, jpj  
    463                   DO ji = 1, jpi 
    464                      ! salinity stays in bounds 
    465                      !clem smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) ) 
    466                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
    467                      i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    468                      smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
    469                   END DO ! ji 
    470                END DO ! jj 
    471             !END DO !jk 
     142            DO jj = 1, jpj  
     143               DO ji = 1, jpi 
     144                  zsal            = smv_i(ji,jj,jl) 
     145                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
     146                  ! salinity stays in bounds 
     147                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     148                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
     149                  ! associated salt flux 
     150                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     151               END DO ! ji 
     152            END DO ! jj 
    472153         END DO !jl 
    473154      ENDIF 
    474  
    475       ! ------------------- 
    476       at_i(:,:) = a_i(:,:,1) 
    477       DO jl = 2, jpl 
    478          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    479       END DO 
    480155 
    481156      !------------------------------------------------------------------------------ 
     
    486161      DO jj = 2, jpjm1 
    487162         DO ji = 2, jpim1 
    488             IF ( at_i(ji,jj) .EQ. 0.0 ) THEN ! what to do if there is no ice 
    489                IF ( at_i(ji+1,jj) .EQ. 0.0 ) u_ice(ji,jj)   = 0.0 ! right side 
    490                IF ( at_i(ji-1,jj) .EQ. 0.0 ) u_ice(ji-1,jj) = 0.0 ! left side 
    491                IF ( at_i(ji,jj+1) .EQ. 0.0 ) v_ice(ji,jj)   = 0.0 ! upper side 
    492                IF ( at_i(ji,jj-1) .EQ. 0.0 ) v_ice(ji,jj-1) = 0.0 ! bottom side 
     163            IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 
     164               IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji,jj)   = 0._wp ! right side 
     165               IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side 
     166               IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj)   = 0._wp ! upper side 
     167               IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side 
    493168            ENDIF 
    494169         END DO 
     
    501176      v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
    502177  
    503       !-------------------------------- 
    504       ! Update mass/salt fluxes (clem) 
    505       !-------------------------------- 
    506       DO jl = 1, jpl 
    507          DO jj = 1, jpj  
    508             DO ji = 1, jpi 
    509                diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice  
    510                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    511                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    512                sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice  
    513             END DO 
    514          END DO 
    515       END DO 
    516  
    517       ! ------------------------------- 
    518       !- check conservation (C Rousset) 
    519       IF (ln_limdiahsb) THEN 
    520  
    521          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    522          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    523   
    524          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    525          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    526  
    527          zchk_vmin = glob_min(v_i) 
    528          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    529          zchk_amin = glob_min(a_i) 
    530  
    531          IF(lwp) THEN 
    532             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limupdate2) = ',(zchk_v_i * rday) 
    533             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate2) = ',(zchk_smv * rday) 
    534             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limupdate2) = ',(zchk_vmin * 1.e-3) 
    535             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limupdate2) = ',zchk_amax 
    536             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limupdate2) = ',zchk_amin 
    537          ENDIF 
    538       ENDIF 
    539       !- check conservation (C Rousset) 
    540       ! ------------------------------- 
     178      ! ------------------------------------------------- 
     179      ! Diagnostics 
     180      ! ------------------------------------------------- 
     181      d_a_i_thd(:,:,:)   = a_i(:,:,:)   - a_i_b(:,:,:)  
     182      d_v_s_thd(:,:,:)   = v_s(:,:,:)   - v_s_b(:,:,:) 
     183      d_v_i_thd(:,:,:)   = v_i(:,:,:)   - v_i_b(:,:,:)   
     184      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:)  
     185      d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
     186      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - oa_i_b (:,:,:) 
     187      d_smv_i_thd(:,:,:) = 0._wp 
     188      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
     189      ! diag only (clem) 
     190      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
     191 
     192      ! heat content variation (W.m-2) 
     193      DO jj = 1, jpj 
     194         DO ji = 1, jpi             
     195            diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) +  &  
     196               &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) )    & 
     197               &                   ) * unit_fac * r1_rdtice / area(ji,jj)    
     198         END DO 
     199      END DO 
     200 
     201      ! conservation test 
     202      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    541203 
    542204      IF(ln_ctl) THEN   ! Control print 
     
    550212         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update2  : strength    :') 
    551213         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update2  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    552          CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update2  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_v_ice   :') 
     214         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update2  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    553215 
    554216         DO jl = 1, jpl 
     
    563225            CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update2  : o_i         : ') 
    564226            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ') 
    565             CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_a_i     : ') 
     227            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ') 
    566228            CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_a_i_thd   : ') 
    567229            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ') 
    568             CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_i     : ') 
     230            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ') 
    569231            CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_i_thd   : ') 
    570232            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ') 
    571             CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_s     : ') 
     233            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ') 
    572234            CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_s_thd   : ') 
    573235            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1        : ') 
    574             CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i1    : ') 
     236            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1_b      : ') 
    575237            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : de_i1_thd   : ') 
    576238            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2        : ') 
    577             CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i2    : ') 
     239            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2_b      : ') 
    578240            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : de_i2_thd   : ') 
    579241            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ') 
    580             CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update2  : old_e_snow  : ') 
     242            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ') 
    581243            CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : d_e_s_thd   : ') 
    582244            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ') 
    583             CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update2  : old_smv_i   : ') 
     245            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ') 
    584246            CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update2  : d_smv_i_thd : ') 
    585247            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ') 
    586             CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update2  : old_oa_i    : ') 
     248            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ') 
    587249            CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update2  : d_oa_i_thd  : ') 
    588250 
     
    596258         CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    597259         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    598          CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update2 : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    599260         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update2 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    600          CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update2 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 
    601261 
    602262         CALL prt_ctl_info(' ') 
     
    608268      ENDIF 
    609269    
    610       CALL wrk_dealloc( jpi,jpj,jpl, internal_melt )   ! integer 
    611       CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 
    612  
    613       CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    614  
    615270      IF( nn_timing == 1 )  CALL timing_stop('limupdate2') 
     271 
    616272   END SUBROUTINE lim_update2 
    617273#else 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r4333 r5034  
    6666   PUBLIC   lim_var_salprof1d    ! 
    6767 
    68    REAL(wp) ::   epsi10 = 1.e-10_wp   !    -       - 
    69    REAL(wp) ::   zzero = 0.e0        !    -       - 
    70    REAL(wp) ::   zone  = 1.e0        !    -       - 
    71  
    7268   !!---------------------------------------------------------------------- 
    7369   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     
    9490      ! 
    9591      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    96       REAL(wp) ::   zinda, zindb 
    9792      !!------------------------------------------------------------------ 
    9893 
     
    113108               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    114109               ! 
    115                zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi10 ) )  
    116                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness 
     110               rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
     111               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch  ! ice thickness 
    117112            END DO 
    118113         END DO 
     
    134129            DO jj = 1, jpj 
    135130               DO ji = 1, jpi 
    136                   zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - epsi10 ) )  
    137                   zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi10 ) )  
    138131                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content 
    139                   smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda   ! ice salinity 
    140                   ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * zindb   ! ice age 
     132                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )  
     133                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch   ! ice salinity 
     134                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
     135                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * rswitch   ! ice age 
    141136               END DO 
    142137            END DO 
     
    163158      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    164159      REAL(wp) ::   zq_i, zaaa, zbbb, zccc, zdiscrim     ! local scalars 
    165       REAL(wp) ::   ztmelts, zindb, zq_s, zfac1, zfac2   !   -      - 
     160      REAL(wp) ::   ztmelts, zq_s, zfac1, zfac2   !   -      - 
    166161      !!------------------------------------------------------------------ 
    167162 
     
    172167         DO jj = 1, jpj 
    173168            DO ji = 1, jpi 
    174                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
    175                ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
    176                ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
    177                o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
     169               rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
     170               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
     171               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
     172               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
    178173            END DO 
    179174         END DO 
     
    184179            DO jj = 1, jpj 
    185180               DO ji = 1, jpi 
    186                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
    187                   sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * zindb 
     181                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
     182                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch 
    188183               END DO 
    189184            END DO 
     
    205200               DO ji = 1, jpi 
    206201                  !                                                              ! Energy of melting q(S,T) [J.m-3] 
    207                   zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
    208                   zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    209                   zq_i    = zq_i * unit_fac * zindb                              !convert units 
     202                  rswitch   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes 
     203                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
     204                  zq_i    = zq_i * unit_fac                             !convert units 
    210205                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature 
    211206                  ! 
     
    214209                  zccc       =  lfus * (ztmelts-rtt) 
    215210                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) ) 
    216                   t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 
     211                  t_i(ji,jj,jk,jl) = rtt + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 
    217212                  t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) )       ! 100-rtt < t_i < rtt 
    218213               END DO 
     
    231226               DO ji = 1, jpi 
    232227                  !Energy of melting q(S,T) [J.m-3] 
    233                   zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
    234                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    235                   zq_s  = zq_s * unit_fac * zindb                                    ! convert units 
     228                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes 
     229                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
     230                  zq_s  = zq_s * unit_fac                                    ! convert units 
    236231                  ! 
    237                   t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) 
     232                  t_s(ji,jj,jk,jl) = rtt + rswitch * ( - zfac1 * zq_s + zfac2 ) 
    238233                  t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) )     ! 100-rtt < t_i < rtt 
    239234               END DO 
     
    250245            DO jj = 1, jpj 
    251246               DO ji = 1, jpi 
    252                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    253                   tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
     247                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     248                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    254249                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    255250               END DO 
     
    297292      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index 
    298293      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal      ! local scalar 
    299       REAL(wp) ::   zind0, zind01, zindbal, zargtemp , zs_zero   !   -      - 
     294      REAL(wp) ::   zswi0, zswi01, zswibal, zargtemp , zs_zero   !   -      - 
    300295      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha   ! 3D pointer 
    301296      !!------------------------------------------------------------------ 
     
    320315            DO jj = 1, jpj 
    321316               DO ji = 1, jpi 
    322                   z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01 , ht_i(ji,jj,jl) ) 
     317                  z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) ) 
    323318               END DO 
    324319            END DO 
     
    332327            DO jj = 1, jpj 
    333328               DO ji = 1, jpi 
    334                   ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    335                   zind0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) )  
    336                   ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    337                   zind01 = ( 1._wp - zind0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) )  
    338                   ! If 2.sm_i GE sss_m then zindbal = 1 
     329                  ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise 
     330                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) )  
     331                  ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
     332                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) )  
     333                  ! If 2.sm_i GE sss_m then zswibal = 1 
    339334                  ! this is to force a constant salinity profile in the Baltic Sea 
    340                   zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
    341                   zalpha(ji,jj,jl) = zind0  + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
    342                   zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zindbal ) 
     335                  zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
     336                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
     337                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal ) 
    343338               END DO 
    344339            END DO 
     
    392387      !!------------------------------------------------------------------ 
    393388      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    394       REAL(wp) ::   zindb   !   -      - 
    395389      !!------------------------------------------------------------------ 
    396390 
     
    401395            DO jj = 1, jpj 
    402396               DO ji = 1, jpi 
    403                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    404                   tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
     397                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     398                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    405399                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    406400               END DO 
     
    423417      !!------------------------------------------------------------------ 
    424418      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    425       REAL(wp) ::   zbvi, zinda, zindb      ! local scalars 
     419      REAL(wp) ::   zbvi             ! local scalars 
    426420      !!------------------------------------------------------------------ 
    427421      ! 
     
    431425            DO jj = 1, jpj 
    432426               DO ji = 1, jpi 
    433                   zinda = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  ) 
    434                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    435                   zbvi  = - zinda * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   & 
     427                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  ) 
     428                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   & 
    436429                     &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp) 
    437                   bv_i(ji,jj) = bv_i(ji,jj) + zindb * zbvi  / MAX( vt_i(ji,jj) , epsi10 ) 
     430                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     431                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi10 ) 
    438432               END DO 
    439433            END DO 
     
    456450      INTEGER  ::   ii, ij  ! local integers 
    457451      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars 
    458       REAL(wp) ::   zalpha, zind0, zind01, zindbal, zs_zero              !   -      - 
     452      REAL(wp) ::   zalpha, zswi0, zswi01, zswibal, zs_zero              !   -      - 
    459453      ! 
    460454      REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s 
     
    466460      ! Vertically constant, constant in time 
    467461      !--------------------------------------- 
    468       IF( num_sal == 1 )   s_i_b(:,:) = bulk_sal 
     462      IF( num_sal == 1 )   s_i_1d(:,:) = bulk_sal 
    469463 
    470464      !------------------------------------------------------ 
     
    475469         ! 
    476470         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero 
    477             z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( 0.01 , ht_i_b(ji) ) 
     471            z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) ) 
    478472         END DO 
    479473 
     
    490484               ii =  MOD( npb(ji) - 1 , jpi ) + 1 
    491485               ij =     ( npb(ji) - 1 ) / jpi + 1 
    492                ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    493                zind0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_b(ji) ) )  
    494                ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    495                zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_b(ji) ) )  
    496                ! if 2.sm_i GE sss_m then zindbal = 1 
     486               ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise 
     487               zswi0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_1d(ji) ) )  
     488               ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
     489               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) )  
     490               ! if 2.sm_i GE sss_m then zswibal = 1 
    497491               ! this is to force a constant salinity profile in the Baltic Sea 
    498                zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(ii,ij) ) ) 
     492               zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 
    499493               ! 
    500                zalpha = (  zind0 + zind01 * ( sm_i_b(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zindbal ) 
     494               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zswibal ) 
    501495               ! 
    502                zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_b(ji) * dummy_fac2 
     496               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2 
    503497               ! weighting the profile 
    504                s_i_b(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_b(ji) 
     498               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 
    505499            END DO ! ji 
    506500         END DO ! jk 
     
    514508      IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    515509         ! 
    516          sm_i_b(:) = 2.30_wp 
     510         sm_i_1d(:) = 2.30_wp 
    517511         ! 
    518512!CDIR NOVERRCHK 
     
    521515            zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
    522516            DO ji = kideb, kiut 
    523                s_i_b(ji,jk) = zsal 
     517               s_i_1d(ji,jk) = zsal 
    524518            END DO 
    525519         END DO 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

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

    r3764 r5034  
    8989   DO jj = 2 , jpjm1 
    9090      DO ji = 2 , jpim1   ! NO vector opt. 
    91          zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    92          zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
     91         zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
     92         zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    9393         zindb  = zindh * zinda 
    94          ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
     94         ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
    9595         zcmo(ji,jj,1)  = ht_s (ji,jj,1) 
    9696         zcmo(ji,jj,2)  = ht_i (ji,jj,1) 
    97          zcmo(ji,jj,3)  = hicifp(ji,jj) 
     97         zcmo(ji,jj,3)  = 0. 
    9898         zcmo(ji,jj,4)  = frld  (ji,jj) 
    9999         zcmo(ji,jj,5)  = sist  (ji,jj) 
    100          zcmo(ji,jj,6)  = fbif  (ji,jj) 
     100         zcmo(ji,jj,6)  = fhtur  (ji,jj) 
    101101         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    102102            + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     
    132132         DO jj = 2 , jpjm1 
    133133            DO ji = 2 , jpim1   ! NO vector opt. 
    134                zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    135                zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
     134               zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
     135               zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    136136               zindb  = zindh * zinda 
    137                ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
     137               ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
    138138               rcmoy(ji,jj,1)  = ht_s (ji,jj,1) 
    139139               rcmoy(ji,jj,2)  = ht_i (ji,jj,1) 
    140                rcmoy(ji,jj,3)  = hicifp(ji,jj) 
     140               rcmoy(ji,jj,3)  = 0. 
    141141               rcmoy(ji,jj,4)  = frld  (ji,jj) 
    142142               rcmoy(ji,jj,5)  = sist  (ji,jj) 
    143                rcmoy(ji,jj,6)  = fbif  (ji,jj) 
     143               rcmoy(ji,jj,6)  = fhtur  (ji,jj) 
    144144               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    145145                  + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90

    r2528 r5034  
    1212 
    1313   !                                             !!! ice thermodynamics 
    14    INTEGER, PUBLIC, PARAMETER ::   jkmax    = 6   !: maximum number of ice layers 
     14   INTEGER, PUBLIC, PARAMETER ::   nlay_i   = 5   !: number of ice layers 
    1515   INTEGER, PUBLIC, PARAMETER ::   nlay_s   = 1   !: number of snow layers 
    1616 
    1717   !                                             !!! ice mechanical redistribution 
    1818   INTEGER, PUBLIC, PARAMETER ::   jpl      = 5   !: number of ice categories 
    19    INTEGER, PUBLIC, PARAMETER ::   jpm      = 1   !: number of ice types 
    2019 
    2120   !!---------------------------------------------------------------------- 
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r4205 r5034  
    2020   !                               !!! ** ice-thermo namelist (namicethd) ** 
    2121   REAL(wp), PUBLIC ::   hmelt       !: maximum melting at the bottom; active only for one category 
    22    REAL(wp), PUBLIC ::   hicmin      !: (REMOVE) 
    2322   REAL(wp), PUBLIC ::   hiclim      !: minimum ice thickness 
    24    REAL(wp), PUBLIC ::   sbeta       !: numerical scheme for diffusion in ice  (REMOVE) 
    25    REAL(wp), PUBLIC ::   parlat      !: (REMOVE) 
    26    REAL(wp), PUBLIC ::   hakspl      !: (REMOVE) 
    27    REAL(wp), PUBLIC ::   hibspl      !: (REMOVE) 
    28    REAL(wp), PUBLIC ::   exld        !: (REMOVE) 
    29    REAL(wp), PUBLIC ::   hakdif      !: (REMOVE) 
    30    REAL(wp), PUBLIC ::   thth        !: (REMOVE) 
    3123   REAL(wp), PUBLIC ::   hnzst       !: thick. of the surf. layer in temp. comp. 
    3224   REAL(wp), PUBLIC ::   parsub      !: switch for snow sublimation or not 
    33    REAL(wp), PUBLIC ::   alphs       !: coef. for snow density when snow-ice formation 
    34    REAL(wp), PUBLIC ::   fraz_swi    !: use of frazil ice collection in function of wind (1.0) or not (0.0) 
    3525   REAL(wp), PUBLIC ::   maxfrazb    !: maximum portion of frazil ice collecting at the ice bottom 
    3626   REAL(wp), PUBLIC ::   vfrazb      !: threshold drift speed for collection of bottom frazil ice 
    3727   REAL(wp), PUBLIC ::   Cfrazb      !: squeezing coefficient for collection of bottom frazil ice 
     28   REAL(wp), PUBLIC ::   hiccrit     !: ice th. for lateral accretion in the NH (SH) (m) 
    3829 
    39    REAL(wp), PUBLIC, DIMENSION(2) ::   hiccrit   !: ice th. for lateral accretion in the NH (SH) (m) 
     30   INTEGER , PUBLIC ::   fraz_swi    !: use of frazil ice collection in function of wind (1) or not (0) 
    4031 
    4132   !!----------------------------- 
     
    4334   !!----------------------------- 
    4435   !: In ice thermodynamics, to spare memory, the vectors are folded 
    45    !: from 1D to 2D vectors. The following variables, with ending _1d (or _b) 
     36   !: from 1D to 2D vectors. The following variables, with ending _1d 
    4637   !: are the variables corresponding to 2d vectors 
    4738 
     
    4940   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion) 
    5041 
    51    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qldif_1d      !: <==> the 2D  qldif 
    52    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcmif_1d      !: <==> the 2D  qcmif 
    53    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fstbif_1d     !: <==> the 2D  fstric 
    54    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fltbif_1d     !: <==> the 2D  ffltbif 
    55    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fscbq_1d      !: <==> the 2D  fscmcbq 
    56    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d    !: <==> the 2D  qsr_ice 
    57    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d     !: <==> the 2D  fr1_i0 
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d     !: <==> the 2D  fr2_i0 
    59    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qnsr_ice_1d   !: <==> the 2D  qns_ice 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qfvbq_1d      !: <==> the 2D  qfvbq 
    61    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_b        !: <==> the 2D  t_bo 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d    
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d   
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d    
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d    
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d   
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d      
     49 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bom_1d 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bog_1d 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dif_1d 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_opw_1d 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
     58 
     59   ! heat flux associated with ice-atmosphere mass exchange 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sub_1d 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_spr_1d 
     62 
     63   ! heat flux associated with ice-ocean mass exchange 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_thd_1d 
     65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_res_1d 
     66 
     67   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_1d  
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d 
     69 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d     
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d    
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d   
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d  
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d 
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_res_1d  
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_spr_1d 
     77 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d     
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d     
     81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d     
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d     
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d    
     84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d   
    6285 
    6386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip 
    6487   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld 
    65    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_b        !: <==> the 2D  frld 
    66    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fbif_1d       !: <==> the 2D  fbif 
    67    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_ice_1d    !: <==> the 2D  rdm_ice 
    68    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_snw_1d    !: <==> the 2D  rdm_snw 
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlbbq_1d      !: <==> the 2D  qlbsbq 
    70    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dmgwi_1d      !: <==> the 2D  dmgwi 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvsbq_1d      !: <==> the 2D  rdvosif 
    72    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvbbq_1d      !: <==> the 2D  rdvobif 
    73    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvlbq_1d      !: <==> the 2D  rdvolif 
    74    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvnbq_1d      !: <==> the 2D  rdvolif 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d        !: <==> the 2D  at_i 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d      !: <==> the 2D  fhtur 
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld 
    7591   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice 
    7692   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice 
     
    7894   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice 
    7995   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics 
    80    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsup          !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m 
    81    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   focea         !: Remaining energy in case of total ablation 
    8296   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
    83    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_i_b    !: Ice thickness at the beginnning of the time step [m] 
    84    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_s_b    !: Snow thickness at the beginning of the time step [m] 
    85    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d    !: <==> the 2D sfx_bri 
    86    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhbri_1d      !: Heat flux due to brine drainage 
    87    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_thd_1d    !: <==> the 2D sfx_thd 
    8897   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing 
    8998   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage 
    9099   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_se_1d   !: Ice salinity variations due to basal salt entrapment 
    91100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_si_1d   !: Ice salinity variations due to lateral accretion     
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_b       !: Ice collection thickness accumulated in fleads 
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_1d      !: Ice collection thickness accumulated in leads 
    93102 
    94    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_b      !: <==> the 2D  t_su 
    95    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_b       !: <==> the 2D  a_i 
    96    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_b      !: <==> the 2D  ht_s 
    97    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_b      !: <==> the 2D  ht_i 
    98    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su       !: Surface Conduction flux  
    99    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i     !: Bottom  Conduction flux  
    100    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot    !: Snow accretion/ablation        [m] 
    101    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf   !: Ice surface accretion/ablation [m] 
    102    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott   !: Ice bottom accretion/ablation  [m] 
    103    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice  !: Snow ice formation             [m of ice] 
    104    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_b      !: Ice bulk salinity [ppt] 
    105    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new     !: Salinity of new ice at the bottom 
    106    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_snowice   !: Salinity of new snow ice on top of the ice 
    107    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_b       !: Ice age                        [days] 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d       !: <==> the 2D  t_su 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d        !: <==> the 2D  a_i 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_1d       !: <==> the 2D  ht_s 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_1d       !: <==> the 2D  ht_i 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su         !: Surface Conduction flux  
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i       !: Bottom  Conduction flux  
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m] 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m] 
     111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m] 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice] 
     113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_1d       !: Ice bulk salinity [ppt] 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom 
    108115 
    109    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
    110    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
     116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s 
     117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_1d   !: corresponding to the 2D var  t_i 
     118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_1d   !: profiled ice salinity 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_1d   !:    Ice  enthalpy per unit volume 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_1d   !:    Snow enthalpy per unit volume 
    111121 
    112    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s 
    113    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i 
    114    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_b   !: profiled ice salinity 
    115    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_b   !:    Ice  enthalpy per unit volume 
    116    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_b   !:    Snow enthalpy per unit volume 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qh_i_old !: ice heat content (q*h, J.m-2) 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old  !: ice thickness layer (m) 
    117124 
    118    ! Clean the following ... 
    119    ! These variables are coded for conservation checks 
    120    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_in                  !: ice energy summed over categories (initial) 
    121    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_fin                 !: ice energy summed over categories (final) 
    122    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_s_in, qt_s_fin        !: snow energy summed over categories 
    123    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i, sum_fluxq          !: increment of energy, sum of fluxes 
    124    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fatm, foce               !: atmospheric, oceanic, heat flux 
    125    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cons_error, surf_error   !: conservation, surface error 
    126  
    127    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_in        !: goes to trash 
    128    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_fin       !: goes to trash 
    129    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i_layer, radab   !: goes to trash 
    130  
    131    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_in    !: initial total heat flux 
    132    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_fin   !: final total heat flux 
    133  
    134    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_s 
    135    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_i 
    136    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_s_lay 
    137    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_i_lay 
    138     
    139125   INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point 
    140126 
     
    151137      !!---------------------------------------------------------------------! 
    152138      INTEGER ::   thd_ice_alloc   ! return value 
    153       INTEGER ::   ierr(4) 
     139      INTEGER ::   ierr(3) 
    154140      !!---------------------------------------------------------------------! 
    155141 
    156142      ALLOCATE( npb      (jpij) , npac     (jpij),                          & 
    157143         !                                                                  ! 
    158          &      qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d  (jpij) ,     & 
    159          &      fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) ,     & 
    160          &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) ,     & 
    161          &      qfvbq_1d (jpij) , t_bo_b   (jpij) , iatte_1d   (jpij) ,     & 
    162          &      oatte_1d (jpij)                                       , STAT=ierr(1) ) 
     144         &      qlead_1d (jpij) , ftr_ice_1d  (jpij) ,     & 
     145         &      qsr_ice_1d (jpij) ,     & 
     146         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     & 
     147         &      t_bo_1d   (jpij) ,                                          & 
     148         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,     &  
     149         &      hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 
     150         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 
     151         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 
     152         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij),       STAT=ierr(1) ) 
    163153      ! 
    164       ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     & 
    165          &      fbif_1d    (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) ,     & 
    166          &      qlbbq_1d   (jpij) , dmgwi_1d   (jpij) , dvsbq_1d   (jpij) ,    & 
    167          &      dvbbq_1d   (jpij) , dvlbq_1d   (jpij) , dvnbq_1d   (jpij) ,     & 
     154      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d     (jpij) ,     & 
     155         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,     & 
     156         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , & 
     157         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) ,  wfx_res_1d (jpij) ,  & 
    168158         &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     & 
    169          &      tatm_ice_1d(jpij) , fsup       (jpij) , focea      (jpij) ,     &    
    170          &      i0         (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,     &   
    171          &      sfx_bri_1d (jpij) , fhbri_1d   (jpij) , sfx_thd_1d (jpij) ,     & 
     159         &      tatm_ice_1d(jpij) ,      &    
     160         &      i0         (jpij) ,     &   
     161         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,   & 
     162         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , & 
    172163         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &      
    173          &      dsm_i_si_1d(jpij) , hicol_b    (jpij)                     , STAT=ierr(2) ) 
     164         &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) ) 
    174165      ! 
    175       ALLOCATE( t_su_b    (jpij) , a_i_b    (jpij) , ht_i_b   (jpij) ,    &    
    176          &      ht_s_b    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
     166      ALLOCATE( t_su_1d    (jpij) , a_i_1d    (jpij) , ht_i_1d   (jpij) ,    &    
     167         &      ht_s_1d    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
    177168         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &     
    178          &      dh_snowice(jpij) , sm_i_b   (jpij) , s_i_new  (jpij) ,    &     
    179          &      s_snowice (jpij) , o_i_b    (jpij)                   ,    & 
    180          !                                                                ! 
    181          &      t_s_b(jpij,nlay_s),                                       & 
    182          !                                                                ! 
    183          &      t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                ,     &             
    184          &      q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                , STAT=ierr(3)) 
     169         &      dh_snowice(jpij) , sm_i_1d   (jpij) , s_i_new  (jpij) ,    & 
     170         &      t_s_1d(jpij,nlay_s),                                       & 
     171         &      t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1)                ,     &             
     172         &      q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1)                ,     & 
     173         &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 
    185174      ! 
    186       ALLOCATE( qt_i_in   (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in   (jpij,jpl) ,     & 
    187          &      qt_s_fin  (jpij,jpl) , dq_i    (jpij,jpl) , sum_fluxq (jpij,jpl) ,     & 
    188          &      fatm      (jpij,jpl) , foce    (jpij,jpl) , cons_error(jpij,jpl) ,     & 
    189          &      surf_error(jpij,jpl)                                             ,     & 
    190          !                                                                             ! 
    191          &      q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax)             ,     & 
    192          &      dq_i_layer  (jpij,jkmax) , radab        (jpij,jkmax)             ,     & 
    193          !                                                                             ! 
    194          &      ftotal_in(jpij), ftotal_fin(jpij)                                ,     & 
    195          !                                                                             ! 
    196          &      fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s)                      ,     & 
    197          &      fc_i(jpij,0:jkmax)  , de_i_lay(jpij,jkmax)                       , STAT=ierr(4) ) 
    198  
    199175      thd_ice_alloc = MAXVAL( ierr ) 
    200176 
Note: See TracChangeset for help on using the changeset viewer.