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

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

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

Legend:

Unmodified
Added
Removed

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

    r4161 r5682  
    55   !!====================================================================== 
    66   !! History :  3.0  ! 2003-08  (M. Vancoppenolle)  LIM-3 original code 
    7    !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
     7   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation 
    88   !!---------------------------------------------------------------------- 
    9    USE par_ice        ! LIM-3 parameter 
    109   USE in_out_manager ! I/O manager 
    1110   USE lib_mpp        ! MPP library 
    … …  
    2120   INTEGER, PUBLIC ::   njeq , njeqm1        !: j-index of the equator if it is inside the domain 
    2221 
    23    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcor       !: coriolis coefficient 
    24    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   covrai     !: sine of geographic latitude 
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   area       !: surface of grid cell  
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tms, tmi   !: temperature mask, mask for stress 
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmu, tmv   !: mask at u and v velocity points 
    28    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmf        !: mask at f-point 
    29  
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   fcor   !: coriolis coefficient 
    3023   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   wght   !: weight of the 4 neighbours to compute averages 
    3124 
    … …  
    4437      !!------------------------------------------------------------------- 
    4538      ! 
    46       ALLOCATE( fcor(jpi,jpj)                   ,      & 
    47          &      covrai(jpi,jpj) , area(jpi,jpj) ,      & 
    48          &      tms   (jpi,jpj) , tmi (jpi,jpj) ,      & 
    49          &      tmu   (jpi,jpj) , tmv (jpi,jpj) ,      & 
    50          &      tmf   (jpi,jpj) ,                      & 
    51          &      wght(jpi,jpj,2,2)               , STAT = dom_ice_alloc ) 
     39      ALLOCATE( fcor(jpi,jpj), wght(jpi,jpj,2,2), STAT = dom_ice_alloc ) 
    5240      ! 
    5341      IF( dom_ice_alloc /= 0 )   CALL ctl_warn( 'dom_ice_alloc: failed to allocate arrays.' ) 

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

    r4990 r5682  
    1111   !!   'key_lim3'                                      LIM-3 sea-ice model 
    1212   !!---------------------------------------------------------------------- 
    13    USE par_ice        ! LIM sea-ice parameters 
    1413   USE in_out_manager ! I/O manager 
    1514   USE lib_mpp        ! MPP library 
    … …  
    1817   PRIVATE 
    1918 
    20    PUBLIC    ice_alloc  !  Called in iceini.F90 
     19   PUBLIC    ice_alloc  !  Called in sbc_lim_init 
    2120 
    2221   !!====================================================================== 
    … …  
    110109   !! smv_i       |      -      |    Sea ice salt content         | ppt.m | 
    111110   !! oa_i        !      -      !    Sea ice areal age content    | day   | 
    112    !! e_i         !      -      !    Ice enthalpy                 | 10^9 J|  
     111   !! e_i         !      -      !    Ice enthalpy                 | J/m2  |  
    113112   !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  |  
    114    !! e_s         !      -      !    Snow enthalpy                | 10^9 J|  
     113   !! e_s         !      -      !    Snow enthalpy                | J/m2  |  
    115114   !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  |  
    116115   !!                                                                     | 
    … …  
    148147   !! tm_i        |      -      |    Mean sea ice temperature     | K     | 
    149148   !! ot_i        !      -      !    Sea ice areal age content    | day   | 
    150    !! et_i        !      -      !    Total ice enthalpy           | 10^9 J|  
    151    !! et_s        !      -      !    Total snow enthalpy          | 10^9 J|  
     149   !! et_i        !      -      !    Total ice enthalpy           | J/m2  |  
     150   !! et_s        !      -      !    Total snow enthalpy          | J/m2  |  
    152151   !! bv_i        !      -      !    Mean relative brine volume   | ???   |  
    153152   !!===================================================================== 
    … …  
    165164   REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice 
    166165 
    167    !                                     !!** ice-dynamic namelist (namicedyn) ** 
    168    INTEGER , PUBLIC ::   nevp             !: number of iterations for subcycling 
    169    REAL(wp), PUBLIC ::   epsd             !: tolerance parameter for dynamic 
    170    REAL(wp), PUBLIC ::   om               !: relaxation constant 
    171    REAL(wp), PUBLIC ::   cw               !: drag coefficient for oceanic stress 
    172    REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79 
    173    REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength 
    174    REAL(wp), PUBLIC ::   creepl           !: creep limit : has to be under 1.0e-9 
    175    REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve 
    176    REAL(wp), PUBLIC ::   ahi0             !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    177    REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s) 
    178    REAL(wp), PUBLIC ::   relast           !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
    179    REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses  
    180    REAL(wp), PUBLIC ::   hminrhg          !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity 
     166   !                                     !!** ice-thickness distribution namelist (namiceitd) ** 
     167   INTEGER , PUBLIC ::   nn_catbnd        !: categories distribution following: tanh function (1), or h^(-alpha) function (2) 
     168   REAL(wp), PUBLIC ::   rn_himean        !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only) 
     169 
     170   !                                     !!** ice-dynamics namelist (namicedyn) ** 
     171   LOGICAL , PUBLIC ::   ln_icestr_bvf    !: use brine volume to diminish ice strength 
     172   INTEGER , PUBLIC ::   nn_icestr        !: ice strength parameterization (0=Hibler79 1=Rothrock75) 
     173   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
     174   INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 
     175   REAL(wp), PUBLIC ::   rn_pe_rdg        !: ridging work divided by pot. energy change in ridging, nn_icestr = 1 
     176   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress 
     177   REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength (N/M), Hibler JPO79 
     178   REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength 
     179   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9 
     180   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve 
     181   REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
     182   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
    181183 
    182184   !                                     !!** ice-salinity namelist (namicesal) ** 
    183    REAL(wp), PUBLIC ::   s_i_max          !: maximum ice salinity [PSU] 
    184    REAL(wp), PUBLIC ::   s_i_min          !: minimum ice salinity [PSU] 
    185    REAL(wp), PUBLIC ::   s_i_0            !: 1st sal. value for the computation of sal .prof. [PSU] 
    186    REAL(wp), PUBLIC ::   s_i_1            !: 2nd sal. value for the computation of sal .prof. [PSU] 
    187    REAL(wp), PUBLIC ::   sal_G            !: restoring salinity for gravity drainage [PSU] 
    188    REAL(wp), PUBLIC ::   sal_F            !: restoring salinity for flushing [PSU] 
    189    REAL(wp), PUBLIC ::   time_G           !: restoring time constant for gravity drainage (= 20 days) [s] 
    190    REAL(wp), PUBLIC ::   time_F           !: restoring time constant for gravity drainage (= 10 days) [s] 
    191    REAL(wp), PUBLIC ::   bulk_sal         !: bulk salinity (ppt) in case of constant salinity 
     185   REAL(wp), PUBLIC ::   rn_simax         !: maximum ice salinity [PSU] 
     186   REAL(wp), PUBLIC ::   rn_simin         !: minimum ice salinity [PSU] 
     187   REAL(wp), PUBLIC ::   rn_sal_gd        !: restoring salinity for gravity drainage [PSU] 
     188   REAL(wp), PUBLIC ::   rn_sal_fl        !: restoring salinity for flushing [PSU] 
     189   REAL(wp), PUBLIC ::   rn_time_gd       !: restoring time constant for gravity drainage (= 20 days) [s] 
     190   REAL(wp), PUBLIC ::   rn_time_fl       !: restoring time constant for gravity drainage (= 10 days) [s] 
     191   REAL(wp), PUBLIC ::   rn_icesal        !: bulk salinity (ppt) in case of constant salinity 
    192192 
    193193   !                                     !!** ice-salinity namelist (namicesal) ** 
    194    INTEGER , PUBLIC ::   num_sal             !: salinity configuration used in the model 
     194   INTEGER , PUBLIC ::   nn_icesal           !: salinity configuration used in the model 
    195195   !                                         ! 1 - constant salinity in both space and time 
    196196   !                                         ! 2 - prognostic salinity (s(z,t)) 
    197197   !                                         ! 3 - salinity profile, constant in time 
    198    INTEGER , PUBLIC ::   thcon_i_swi         !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
     198   INTEGER , PUBLIC ::   nn_ice_thcon        !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
     199   INTEGER , PUBLIC ::   nn_monocat          !: virtual ITD mono-category parameterizations (1) or not (0) 
     200   LOGICAL , PUBLIC ::   ln_it_qnsice        !: iterate surface flux with changing surface temperature or not (F) 
    199201 
    200202   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    201    REAL(wp), PUBLIC ::   Cs               !: fraction of shearing energy contributing to ridging             
    202    REAL(wp), PUBLIC ::   Cf               !: ratio of ridging work to PE loss 
    203    REAL(wp), PUBLIC ::   fsnowrdg         !: fractional snow loss to the ocean during ridging 
    204    REAL(wp), PUBLIC ::   fsnowrft         !: fractional snow loss to the ocean during ridging 
    205    REAL(wp), PUBLIC ::   Gstar            !: fractional area of young ice contributing to ridging 
    206    REAL(wp), PUBLIC ::   astar            !: equivalent of G* for an exponential participation function 
    207    REAL(wp), PUBLIC ::   Hstar            !: thickness that determines the maximal thickness of ridged ice 
    208    REAL(wp), PUBLIC ::   hparmeter        !: threshold thickness (m) for rafting / ridging  
    209    REAL(wp), PUBLIC ::   Craft            !: coefficient for smoothness of the hyperbolic tangent in rafting 
    210    REAL(wp), PUBLIC ::   ridge_por        !: initial porosity of ridges (0.3 regular value) 
    211    REAL(wp), PUBLIC ::   betas            !: coef. for partitioning of snowfall between leads and sea ice 
    212    REAL(wp), PUBLIC ::   kappa_i          !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
    213    REAL(wp), PUBLIC ::   nconv_i_thd      !: maximal number of iterations for heat diffusion 
    214    REAL(wp), PUBLIC ::   maxer_i_thd      !: maximal tolerated error (C) for heat diffusion 
     203   REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging             
     204   REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging 
     205   REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging 
     206   REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging 
     207   REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function 
     208   REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice 
     209   REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging  
     210   REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting 
     211   REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value) 
     212   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice 
     213   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
     214   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion 
     215   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion 
    215216 
    216217   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    217    INTEGER , PUBLIC ::   ridge_scheme_swi !: scheme used for ice ridging 
    218    INTEGER , PUBLIC ::   raft_swi         !: rafting of ice or not                         
    219    INTEGER , PUBLIC ::   partfun_swi      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
    220    INTEGER , PUBLIC ::   brinstren_swi    !: use brine volume to diminish ice strength 
    221  
    222    REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( ecc * ecc ) 
    223    REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cw 
    224  
     218   LOGICAL , PUBLIC ::   ln_rafting      !: rafting of ice or not                         
     219   INTEGER , PUBLIC ::   nn_partfun      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
     220 
     221   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( rn_ecc * rn_ecc ) 
     222   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cio 
     223   REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i 
     224   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s  
     225   ! 
    225226   !                                     !!** switch for presence of ice or not  
    226227   REAL(wp), PUBLIC ::   rswitch 
    227  
     228   ! 
    228229   !                                     !!** define some parameters  
    229    REAL(wp), PUBLIC, PARAMETER ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
    230230   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number  
    231231   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number  
    … …  
    266266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2] 
    267267 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total) [s-1] 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1] 
     270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics) [s-1] 
     271 
    268272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    269273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    … …  
    282286   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt  
    283287   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion  
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux 
    284289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping  
    285290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations  
    … …  
    296301 
    297302   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice 
    298  
    299    ! temporary arrays for dummy version of the code 
    300    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, q_s 
    301303 
    302304   !!-------------------------------------------------------------------------- 
    … …  
    333335       
    334336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K] 
    335    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents [Giga J] 
     337   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents    [J/m2] 
    336338   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i        !: ice salinities          [PSU] 
    337339 
    … …  
    356358   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
    357359   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
    358        
    359  
    360    !!-------------------------------------------------------------------------- 
    361    !! * Increment of global variables 
    362    !!-------------------------------------------------------------------------- 
     360             
     361   !!-------------------------------------------------------------------------- 
     362   !! * Ice thickness distribution variables 
     363   !!-------------------------------------------------------------------------- 
     364   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
     365   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
     366 
     367   !!-------------------------------------------------------------------------- 
     368   !! * Ice Run 
     369   !!-------------------------------------------------------------------------- 
     370   !                                                  !!: ** Namelist namicerun read in sbc_lim_init ** 
     371   INTEGER          , PUBLIC ::   jpl             !: number of ice  categories  
     372   INTEGER          , PUBLIC ::   nlay_i          !: number of ice  layers  
     373   INTEGER          , PUBLIC ::   nlay_s          !: number of snow layers  
     374   CHARACTER(len=32), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
     375   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory 
     376   CHARACTER(len=32), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
     377   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory 
     378   LOGICAL          , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
     379   LOGICAL          , PUBLIC ::   ln_icectl       !: flag for sea-ice points output (T) or not (F) 
     380   REAL(wp)         , PUBLIC ::   rn_amax         !: maximum ice concentration 
     381   INTEGER          , PUBLIC ::   iiceprt         !: debug i-point 
     382   INTEGER          , PUBLIC ::   jiceprt         !: debug j-point 
     383   ! 
     384   !!-------------------------------------------------------------------------- 
     385   !! * Ice diagnostics 
     386   !!-------------------------------------------------------------------------- 
     387   ! Increment of global variables 
    363388   ! thd refers to changes induced by thermodynamics 
    364389   ! trp   ''         ''     ''       advection (transport of ice) 
    365    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_a_i_thd  , d_a_i_trp                 !: icefractions                   
    366    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_s_thd  , d_v_s_trp                 !: snow volume 
    367    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_i_thd  , d_v_i_trp                 !: ice  volume 
    368    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_smv_i_thd, d_smv_i_trp               !:      
    369    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_fl  , d_sm_i_gd                 !: 
    370    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_se  , d_sm_i_si  , d_sm_i_la    !: 
    371    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp                !: 
    372  
    373    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !: 
    374    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_i_thd  , d_e_i_trp     !: 
    375    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   d_u_ice_dyn, d_v_ice_dyn   !: ice velocity  
    376        
    377    !!-------------------------------------------------------------------------- 
    378    !! * Ice thickness distribution variables 
    379    !!-------------------------------------------------------------------------- 
    380    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    381    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
    382  
    383    !!-------------------------------------------------------------------------- 
    384    !! * Ice Run 
    385    !!-------------------------------------------------------------------------- 
    386    !                                                  !!: ** Namelist namicerun read in iceini ** 
    387    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
    388    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
    389    LOGICAL               , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
    390    LOGICAL               , PUBLIC ::   ln_nicep        !: flag for sea-ice points output (T) or not (F) 
    391    REAL(wp)              , PUBLIC ::   cai             !: atmospheric drag over sea ice 
    392    REAL(wp)              , PUBLIC ::   cao             !: atmospheric drag over ocean 
    393    REAL(wp)              , PUBLIC ::   amax            !: maximum ice concentration 
     390   LOGICAL , PUBLIC                                        ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
     391   LOGICAL , PUBLIC                                        ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
     392   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vi   !: transport of ice volume 
     393   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vs   !: transport of snw volume 
     394   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_ei   !: transport of ice enthalpy (W/m2) 
     395   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_es   !: transport of snw enthalpy (W/m2) 
     396   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_smv  !: transport of salt content 
    394397   ! 
    395    !!-------------------------------------------------------------------------- 
    396    !! * Ice diagnostics 
    397    !!-------------------------------------------------------------------------- 
    398    !! Check if everything down here is necessary 
    399    LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
    400    LOGICAL , PUBLIC                                      ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
    401    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd     !: thermodynamic growth rates  
    402    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   !: transport of ice volume 
    403    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   !: transport of snw volume 
    404    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_ei   !: transport of ice enthalpy (W/m2) 
    405    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_es   !: transport of snw enthalpy (W/m2) 
     398   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat     !: snw/ice heat content variation   [W/m2]  
     399   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_smvi     !: ice salt content variation   []  
     400   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vice     !: ice volume variation   [m/s]  
     401   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vsnw     !: snw volume variation   [m/s]  
    406402   ! 
    407    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2]  
    408    ! 
    409    INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    410  
    411403   !!---------------------------------------------------------------------- 
    412404   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
    … …  
    422414      INTEGER :: ice_alloc 
    423415      ! 
    424       INTEGER :: ierr(19), ii 
     416      INTEGER :: ierr(17), ii 
    425417      !!----------------------------------------------------------------- 
    426418 
    … …  
    439431 
    440432      ii = ii + 1 
    441       ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,      & 
    442          &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,      & 
    443          &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,    & 
     433      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,                        & 
     434         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,                        & 
     435         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,                        & 
    444436         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     & 
    445          &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,  qlead  (jpi,jpj) ,     & 
    446          &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl) ,      & 
    447          &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,      & 
    448          &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,   & 
    449          &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 
    450          &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,  & 
    451          &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & 
     437         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     & 
     438         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) ,                        & 
     439         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead  (jpi,jpj) ,                     & 
     440         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,                        & 
     441         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    & 
     442         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     &  
     443         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) ,                                   & 
     444         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,                           & 
     445         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,    & 
    452446         &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) ) 
    453447 
    … …  
    464458         &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) ) 
    465459      ii = ii + 1 
    466       ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) ,                            & 
    467          &      e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
    468       ii = ii + 1 
    469       ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) ) 
     460      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
     461      ii = ii + 1 
     462      ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 
    470463 
    471464      ! * Moments for advection 
    … …  
    483476         &      STAT=ierr(ii) ) 
    484477      ii = ii + 1 
    485       ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) ,     & 
    486          &      syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl)                           , STAT=ierr(ii) ) 
     478      ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) ,     & 
     479         &      syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl)                            , STAT=ierr(ii) ) 
    487480 
    488481      ! * Old values of global variables 
    489482      ii = ii + 1 
    490483      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     & 
    491          &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) ,     & 
    492          &      oa_i_b (jpi,jpj,jpl)                                                        ,     & 
    493          &      u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)                                   , STAT=ierr(ii) ) 
    494  
    495       ! * Increment of global variables 
    496       ii = ii + 1 
    497       ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd  (jpi,jpj,jpl) , d_v_s_trp  (jpi,jpj,jpl) ,   & 
    498          &      d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) ,   &      
    499          &      d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se  (jpi,jpj,jpl) , d_sm_i_si  (jpi,jpj,jpl) ,   & 
    500          &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) ,   & 
    501          &     STAT=ierr(ii) ) 
    502       ii = ii + 1 
    503       ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) ,     & 
    504          &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 
     484         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,     & 
     485         &      oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)          , STAT=ierr(ii) ) 
    505486       
    506487      ! * Ice thickness distribution variables 
    … …  
    510491      ! * Ice diagnostics 
    511492      ii = ii + 1 
    512       ALLOCATE( dv_dt_thd(jpi,jpj,jpl),    & 
    513          &      diag_trp_vi(jpi,jpj), diag_trp_vs  (jpi,jpj), diag_trp_ei(jpi,jpj),   &  
    514          &      diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj), STAT=ierr(ii) ) 
     493      ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj),   &  
     494         &      diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat  (jpi,jpj),   & 
     495         &      diag_smvi  (jpi,jpj), diag_vice   (jpi,jpj), diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
    515496 
    516497      ice_alloc = MAXVAL( ierr(:) ) 

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

    r4990 r5682  
    6363      !!  
    6464      INTEGER  ::   ji, jj                               ! dummy loop indices 
    65       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! local scalars 
     65      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars 
    6666      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      - 
    6767      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      - 
    … …  
    8585            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    8686               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    87             zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     87            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    8888 
    8989            ps0 (ji,jj) = zslpmax   
    90             psx (ji,jj) = zs1new      * zin0 
    91             psxx(ji,jj) = zs2new      * zin0 
    92             psy (ji,jj) = psy (ji,jj) * zin0 
    93             psyy(ji,jj) = psyy(ji,jj) * zin0 
    94             psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0 
     90            psx (ji,jj) = zs1new      * rswitch 
     91            psxx(ji,jj) = zs2new      * rswitch 
     92            psy (ji,jj) = psy (ji,jj) * rswitch 
     93            psyy(ji,jj) = psyy(ji,jj) * rswitch 
     94            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 
    9595         END DO 
    9696      END DO 
    9797 
    9898      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
    99       psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
     99      psm (:,:)  = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
    100100 
    101101      !  Calculate fluxes and moments between boxes i<-->i+1               
    … …  
    207207 
    208208      !-- Lateral boundary conditions 
    209       CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. ) 
    210       CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes 
    211       CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. ) 
    212       CALL lbc_lnk( psxy, 'T',  1. ) 
     209      CALL lbc_lnk_multi( psm , 'T',  1., ps0 , 'T',  1.   & 
     210         &              , psx , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     211         &              , psxx, 'T',  1., psyy, 'T',  1.   & 
     212         &              , psxy, 'T',  1. ) 
    213213 
    214214      IF(ln_ctl) THEN 
    … …  
    248248      !! 
    249249      INTEGER  ::   ji, jj                               ! dummy loop indices 
    250       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars 
     250      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars 
    251251      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    252252      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
    … …  
    270270            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    271271               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    272             zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     272            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    273273            ! 
    274274            ps0 (ji,jj) = zslpmax   
    275             psx (ji,jj) = psx (ji,jj) * zin0 
    276             psxx(ji,jj) = psxx(ji,jj) * zin0 
    277             psy (ji,jj) = zs1new * zin0 
    278             psyy(ji,jj) = zs2new * zin0 
    279             psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0 
     275            psx (ji,jj) = psx (ji,jj) * rswitch 
     276            psxx(ji,jj) = psxx(ji,jj) * rswitch 
     277            psy (ji,jj) = zs1new * rswitch 
     278            psyy(ji,jj) = zs2new * rswitch 
     279            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 
    280280         END DO 
    281281      END DO 
    282282 
    283283      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    284       psm(:,:)  = MAX(  pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
     284      psm(:,:)  = MAX(  pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
    285285 
    286286      !  Calculate fluxes and moments between boxes j<-->j+1               
    … …  
    393393 
    394394      !-- Lateral boundary conditions 
    395       CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. ) 
    396       CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes 
    397       CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. ) 
    398       CALL lbc_lnk( psxy, 'T',  1. ) 
     395      CALL lbc_lnk_multi( psm , 'T',  1.,  ps0 , 'T',  1.   & 
     396         &              , psx , 'T', -1.,  psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     397         &              , psxx, 'T',  1.,  psyy, 'T',  1.   & 
     398         &              , psxy, 'T',  1. ) 
    399399 
    400400      IF(ln_ctl) THEN 

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

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

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

    • Property svn:keywords set to Id
    r4990 r5682  
    1414   !!---------------------------------------------------------------------- 
    1515   USE ice             ! LIM-3: sea-ice variable 
    16    USE par_ice         ! LIM-3: ice parameters 
    1716   USE dom_ice         ! LIM-3: sea-ice domain 
    1817   USE dom_oce         ! ocean domain 
    … …  
    3231 
    3332   PUBLIC   lim_diahsb        ! routine called by ice_step.F90 
    34    !!PUBLIC   lim_diahsb_init   ! routine called by ice_init.F90 
    35    !!PUBLIC   lim_diahsb_rst   ! routine called by ice_init.F90 
    3633 
    3734   real(wp) ::   frc_sal, frc_vol   ! global forcing trends 
    … …  
    4340   !!---------------------------------------------------------------------- 
    4441   !! NEMO/OPA 3.4 , NEMO Consortium (2012) 
    45    !! $Id: limdiahsb.F90 3294 2012-10-18 16:44:18Z rblod $ 
     42   !! $Id$ 
    4643   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4744   !!---------------------------------------------------------------------- 
    … …  
    7471 
    7572      ! 1/area 
    76       z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
    77  
    78       rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 
     73      z1_area = 1._wp / MAX( glob_sum( e12t(:,:) * tmask(:,:,1) ), epsi06 ) 
     74 
     75      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e12t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 
    7976      ! ----------------------- ! 
    8077      ! 1 -  Content variations ! 
    8178      ! ----------------------- ! 
    82       zbg_ivo = glob_sum( vt_i(:,:) * area(:,:) * tms(:,:) ) ! volume ice  
    83       zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow 
    84       zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area 
    85       zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )       ! mean salt content 
    86       zbg_tem = glob_sum( ( tm_i(:,:) - rtt ) * vt_i(:,:) * area(:,:) * tms(:,:) )  ! mean temp content 
    87  
    88       !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 
    89       !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
     79      zbg_ivo = glob_sum( vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume ice  
     80      zbg_svo = glob_sum( vt_s(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume snow 
     81      zbg_are = glob_sum( at_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! area 
     82      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) )       ! mean salt content 
     83      zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e12t(:,:) * tmask(:,:,1) )  ! mean temp content 
     84 
     85      !zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 
     86      !zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
    9087 
    9188      ! Volume 
    9289      ztmp = rswitch * z1_area * r1_rau0 * rday 
    93       zbg_vfx     = ztmp * glob_sum(     emp(:,:) * area(:,:) * tms(:,:) ) 
    94       zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) 
    95       zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) 
    96       zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) 
    97       zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) 
    98       zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) 
    99       zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) 
    100       zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) 
    101       zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) 
    102       zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) 
    103       zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) 
     90      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     91      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     92      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     93      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     94      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     95      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     96      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     97      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     98      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     99      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     100      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    104101 
    105102      ! Salt 
    106       zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) 
    107       zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) 
    108       zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) 
    109       zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) 
    110  
    111       zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) 
    112       zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) 
    113       zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) 
    114       zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) 
    115       zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) 
     103      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     104      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     105      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     106      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     107 
     108      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     109      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     110      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     111      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     112      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    116113 
    117114      ! Heat budget 
    118       zbg_ihc      = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content  [1.e-20 J] 
    119       zbg_shc      = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J] 
    120       zbg_hfx_dhc  = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    121       zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    122  
    123       zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    124       zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    125       zbg_hfx_res  = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    126       zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    127       zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    128       zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    129       zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    130       zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    131       zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    132       zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    133       zbg_hfx_out  = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
    134       zbg_hfx_in   = glob_sum(  hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     115      zbg_ihc      = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content  [1.e20 J] 
     116      zbg_shc      = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 
     117      zbg_hfx_dhc  = glob_sum( diag_heat(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     118      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     119 
     120      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     121      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     122      zbg_hfx_res  = glob_sum( hfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     123      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     124      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     125      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     126      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     127      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     128      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     129      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     130      zbg_hfx_out  = glob_sum( hfx_out(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
     131      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 
    135132     
    136133      ! --------------------------------------------- ! 
    137134      ! 2 - Trends due to forcing and ice growth/melt ! 
    138135      ! --------------------------------------------- ! 
    139       z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 
    140       z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes 
     136      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 
     137      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) ! salt fluxes 
    141138      z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
    142                           &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 
     139                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 
     140                          &     wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 
    143141      ! 
    144142      frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
    … …  
    247245         WRITE(numout,*) '~~~~~~~~~~~~' 
    248246      ENDIF 
    249  
    250       ! ---------------------------------- ! 
    251       ! 2 - initial conservation variables ! 
    252       ! ---------------------------------- ! 
    253       !frc_vol = 0._wp                                          ! volume       trend due to forcing 
    254       !frc_sal = 0._wp                                          ! salt content   -    -   -    -          
    255       !bg_grme = 0._wp                                          ! ice growth + melt volume trend 
    256247      ! 
    257248      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files 

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

    r4990 r5682  
    66   !! history :  1.0  ! 2002-08  (C. Ethe, G. Madec)  original VP code  
    77   !!            3.0  ! 2007-03  (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle)  LIM3: EVP-Cgrid 
    8    !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
     8   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_lim3 
    … …  
    2020   USE sbc_ice          ! Surface boundary condition: ice   fields 
    2121   USE ice              ! LIM-3 variables 
    22    USE par_ice          ! LIM-3 parameters 
    2322   USE dom_ice          ! LIM-3 domain 
    2423   USE limrhg           ! LIM-3 rheology 
    … …  
    3130   USE timing          ! Timing 
    3231   USE limcons        ! conservation tests 
     32   USE limvar 
    3333 
    3434   IMPLICIT NONE 
    … …  
    7676      CALL wrk_alloc( jpj, zswitch, zmsk ) 
    7777 
     78      CALL lim_var_agg(1)             ! aggregate ice categories 
     79 
    7880      IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    7981 
    … …  
    8385         IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    8486 
    85          u_ice_b(:,:) = u_ice(:,:) * tmu(:,:) 
    86          v_ice_b(:,:) = v_ice(:,:) * tmv(:,:) 
     87         u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 
     88         v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 
    8789 
    8890         ! Rheology (ice dynamics) 
    … …  
    101103            DO jj = 1, jpj 
    102104               zswitch(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line 
    103                zmsk(jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line 
     105               zmsk   (jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line 
    104106            END DO 
    105107 
    … …  
    157159         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    158160         ! frictional velocity at T-point 
    159          zcoef = 0.5_wp * cw 
     161         zcoef = 0.5_wp * rn_cio 
    160162         DO jj = 2, jpjm1  
    161163            DO ji = fs_2, fs_jpim1   ! vector opt. 
    162164               ust2s(ji,jj) = zcoef * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    163                   &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj) 
     165                  &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tmask(ji,jj,1) 
    164166            END DO 
    165167         END DO 
    … …  
    170172      ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
    171173         ! 
    172          zcoef = SQRT( 0.5_wp ) / rau0 
     174         zcoef = SQRT( 0.5_wp ) * r1_rau0 
    173175         DO jj = 2, jpjm1 
    174176            DO ji = fs_2, fs_jpim1   ! vector opt. 
    175177               ust2s(ji,jj) = zcoef * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    176                   &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1)   ) * tms(ji,jj) 
     178                  &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tmask(ji,jj,1) 
    177179            END DO 
    178180         END DO 
    … …  
    189191         CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :') 
    190192         CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :') 
    191          CALL prt_ctl(tab2d_1=area      , clinfo1=' lim_dyn  : cell area :') 
     193         CALL prt_ctl(tab2d_1=e12t      , clinfo1=' lim_dyn  : cell area :') 
    192194         CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :') 
    193195         CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :') 
    … …  
    241243      !!------------------------------------------------------------------- 
    242244      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    243       NAMELIST/namicedyn/ epsd, om, cw, pstar,   & 
    244          &                c_rhg, creepl, ecc, ahi0,     & 
    245          &                nevp, relast, alphaevp, hminrhg 
     245      NAMELIST/namicedyn/ nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio,  rn_creepl, rn_ecc, & 
     246         &                nn_nevp, rn_relast, nn_ahi0, rn_ahi0_ref 
     247      INTEGER  ::   ji, jj 
     248      REAL(wp) ::   za00, zd_max 
    246249      !!------------------------------------------------------------------- 
    247250 
    … …  
    259262         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics ' 
    260263         WRITE(numout,*) '~~~~~~~~~~~~' 
    261          WRITE(numout,*) '   tolerance parameter                              epsd   = ', epsd 
    262          WRITE(numout,*) '   relaxation constant                              om     = ', om 
    263          WRITE(numout,*) '   drag coefficient for oceanic stress              cw     = ', cw 
    264          WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar 
    265          WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg 
    266          WRITE(numout,*) '   creep limit                                      creepl = ', creepl 
    267          WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc 
    268          WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
    269          WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp 
    270          WRITE(numout,*) '   ratio of elastic timescale over ice time step    relast = ', relast 
    271          WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp 
    272          WRITE(numout,*) '   min ice thickness for rheology calculations     hminrhg = ', hminrhg 
     264         WRITE(numout,*)'    ice strength parameterization (0=Hibler 1=Rothrock)  nn_icestr     = ', nn_icestr  
     265         WRITE(numout,*)'    Including brine volume in ice strength comp.         ln_icestr_bvf = ', ln_icestr_bvf 
     266         WRITE(numout,*)'   Ratio of ridging work to PotEner change in ridging    rn_pe_rdg     = ', rn_pe_rdg  
     267         WRITE(numout,*) '   drag coefficient for oceanic stress                  rn_cio        = ', rn_cio 
     268         WRITE(numout,*) '   first bulk-rheology parameter                        rn_pstar      = ', rn_pstar 
     269         WRITE(numout,*) '   second bulk-rhelogy parameter                        rn_crhg       = ', rn_crhg 
     270         WRITE(numout,*) '   creep limit                                          rn_creepl     = ', rn_creepl 
     271         WRITE(numout,*) '   eccentricity of the elliptical yield curve           rn_ecc        = ', rn_ecc 
     272         WRITE(numout,*) '   number of iterations for subcycling                  nn_nevp       = ', nn_nevp 
     273         WRITE(numout,*) '   ratio of elastic timescale over ice time step        rn_relast     = ', rn_relast 
     274         WRITE(numout,*) '   horizontal diffusivity calculation                   nn_ahi0       = ', nn_ahi0 
     275         WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)           rn_ahi0_ref   = ', rn_ahi0_ref 
    273276      ENDIF 
    274277      ! 
    275       usecc2 = 1._wp / ( ecc * ecc ) 
    276       rhoco  = rau0  * cw 
    277  
    278       ! elastic damping 
    279       telast = relast * rdt_ice 
    280  
    281       !  Diffusion coefficients. 
    282       ahiu(:,:) = ahi0 * umask(:,:,1) 
    283       ahiv(:,:) = ahi0 * vmask(:,:,1) 
    284       ! 
     278      usecc2 = 1._wp / ( rn_ecc * rn_ecc ) 
     279      rhoco  = rau0  * rn_cio 
     280      ! 
     281      !  Diffusion coefficients 
     282      SELECT CASE( nn_ahi0 ) 
     283 
     284      CASE( 0 ) 
     285         ahiu(:,:) = rn_ahi0_ref 
     286         ahiv(:,:) = rn_ahi0_ref 
     287 
     288         IF(lwp) WRITE(numout,*) '' 
     289         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim constant = rn_ahi0_ref' 
     290 
     291      CASE( 1 )  
     292 
     293         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
     294         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain 
     295          
     296         ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60° latitude in orca2 
     297                                                        !                    (60° = min latitude for ice cover)   
     298         ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 
     299 
     300         IF(lwp) WRITE(numout,*) '' 
     301         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')' 
     302         IF(lwp) WRITE(numout,*) '   value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp  
     303          
     304      CASE( 2 )  
     305 
     306         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
     307         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain 
     308          
     309         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60° latitude in orca2 
     310                                                 !                    (60° = min latitude for ice cover)   
     311         DO jj = 1, jpj 
     312            DO ji = 1, jpi 
     313               ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 
     314               ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 
     315            END DO 
     316         END DO 
     317         ! 
     318         IF(lwp) WRITE(numout,*) '' 
     319         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1' 
     320         IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 
     321          
     322      END SELECT 
     323 
    285324   END SUBROUTINE lim_dyn_init 
    286325 

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

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

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

    r4990 r5682  
    2222   USE eosbn2           ! equation of state 
    2323   USE ice              ! sea-ice variables 
    24    USE par_ice          ! ice parameters 
    2524   USE par_oce          ! ocean parameters 
    2625   USE dom_ice          ! sea-ice domain 
    … …  
    3635 
    3736   !                          !!** init namelist (namiceini) ** 
    38    REAL(wp) ::   thres_sst   ! threshold water temperature for initial sea ice 
    39    REAL(wp) ::   hts_ini_n   ! initial snow thickness in the north 
    40    REAL(wp) ::   hts_ini_s   ! initial snow thickness in the south 
    41    REAL(wp) ::   hti_ini_n   ! initial ice thickness in the north 
    42    REAL(wp) ::   hti_ini_s   ! initial ice thickness in the south 
    43    REAL(wp) ::   ati_ini_n   ! initial leads area in the north 
    44    REAL(wp) ::   ati_ini_s   ! initial leads area in the south 
    45    REAL(wp) ::   smi_ini_n   ! initial salinity  
    46    REAL(wp) ::   smi_ini_s   ! initial salinity 
    47    REAL(wp) ::   tmi_ini_n   ! initial temperature 
    48    REAL(wp) ::   tmi_ini_s   ! initial temperature 
    49  
    50    LOGICAL  ::  ln_limini    ! initialization or not 
     37   REAL(wp) ::   rn_thres_sst   ! threshold water temperature for initial sea ice 
     38   REAL(wp) ::   rn_hts_ini_n   ! initial snow thickness in the north 
     39   REAL(wp) ::   rn_hts_ini_s   ! initial snow thickness in the south 
     40   REAL(wp) ::   rn_hti_ini_n   ! initial ice thickness in the north 
     41   REAL(wp) ::   rn_hti_ini_s   ! initial ice thickness in the south 
     42   REAL(wp) ::   rn_ati_ini_n   ! initial leads area in the north 
     43   REAL(wp) ::   rn_ati_ini_s   ! initial leads area in the south 
     44   REAL(wp) ::   rn_smi_ini_n   ! initial salinity  
     45   REAL(wp) ::   rn_smi_ini_s   ! initial salinity 
     46   REAL(wp) ::   rn_tmi_ini_n   ! initial temperature 
     47   REAL(wp) ::   rn_tmi_ini_s   ! initial temperature 
     48 
     49   LOGICAL  ::  ln_iceini    ! initialization or not 
    5150   !!---------------------------------------------------------------------- 
    5251   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
    … …  
    8786      !! * Local variables 
    8887      INTEGER    :: ji, jj, jk, jl             ! dummy loop indices 
    89       REAL(wp)   :: epsi20, ztmelts, zdh 
     88      REAL(wp)   :: ztmelts, zdh 
    9089      INTEGER    :: i_hemis, i_fill, jl0   
    9190      REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 
    … …  
    101100      CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    102101 
    103       epsi20   = 1.e-20_wp 
    104  
    105102      IF(lwp) WRITE(numout,*) 
    106103      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
    … …  
    115112      ! surface temperature 
    116113      DO jl = 1, jpl ! loop over categories 
    117          t_su  (:,:,jl) = rtt * tms(:,:) 
    118          tn_ice(:,:,jl) = rtt * tms(:,:) 
     114         t_su  (:,:,jl) = rt0 * tmask(:,:,1) 
     115         tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 
    119116      END DO 
    120117 
    121118      ! basal temperature (considered at freezing point) 
    122       t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:)  
    123  
    124       IF( ln_limini ) THEN 
     119      CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 
     120      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
     121 
     122      IF( ln_iceini ) THEN 
    125123 
    126124      !-------------------------------------------------------------------- 
    … …  
    130128      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    131129         DO ji = 1, jpi 
    132             IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN  
    133                zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice 
     130            IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
     131               zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice 
    134132            ELSE                                                                                    
    135                zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice 
     133               zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice 
    136134            ENDIF 
    137135         END DO 
    … …  
    158156      !----------------------------- 
    159157      ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
    160       zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s  ! ice thickness 
    161       zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s  ! snow depth 
    162       zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s  ! ice concentration 
    163       zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s  ! bulk ice salinity 
    164       ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s  ! temperature (ice and snow) 
     158      zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s  ! ice thickness 
     159      zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s  ! snow depth 
     160      zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s  ! ice concentration 
     161      zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s  ! bulk ice salinity 
     162      ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s  ! temperature (ice and snow) 
    165163 
    166164      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume 
    … …  
    197195               !--- Ice thicknesses in the i_fill - 1 first categories 
    198196               DO jl = 1, i_fill - 1 
    199                   zh_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
     197                  zh_i_ini(jl,i_hemis) = hi_mean(jl) 
    200198               END DO 
    201199                
    202200               !--- jl0: most likely index where cc will be maximum 
    203201               DO jl = 1, jpl 
    204                   IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
    205                      ( zht_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
     202                  IF ( ( zht_i_ini(i_hemis) > hi_max(jl-1) ) .AND. & 
     203                     & ( zht_i_ini(i_hemis) <= hi_max(jl)   ) ) THEN 
    206204                     jl0 = jl 
    207205                  ENDIF 
    … …  
    267265 
    268266            ! Test 3: thickness of the last category is in-bounds ? 
    269             IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
     267            IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN 
    270268               ztest_3 = 1 
    271269            ELSE 
    … …  
    317315            DO ji = 1, jpi 
    318316               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
    319                ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
     317               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))   ! ice thickness 
    320318               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth 
    321                sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity 
    322                o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 
    323                t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp 
     319               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj))     ! salinity 
     320               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                        ! age (1 day) 
     321               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 
    324322 
    325323               ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
    … …  
    329327               ! recompute ht_i, ht_s avoiding out of bounds values 
    330328               ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh ) 
    331                ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic / rhosn ) 
     329               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn ) 
    332330 
    333331               ! ice volume, salt content, age content 
    … …  
    336334               smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 
    337335               oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content 
    338             END DO ! ji 
    339          END DO ! jj 
    340       END DO ! jl 
     336            END DO 
     337         END DO 
     338      END DO 
    341339 
    342340      ! Snow temperature and heat content 
    … …  
    345343            DO jj = 1, jpj 
    346344               DO ji = 1, jpi 
    347                    t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 
     345                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 
    348346                   ! Snow energy of melting 
    349                    e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    350                    ! Change dimensions 
    351                    e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    352                    ! Multiply by volume, so that heat content in Joules 
    353                    e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
    354                END DO ! ji 
    355             END DO ! jj 
    356          END DO ! jl 
    357       END DO ! jk 
     347                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
     348 
     349                   ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 
     350                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
     351               END DO 
     352            END DO 
     353         END DO 
     354      END DO 
    358355 
    359356      ! Ice salinity, temperature and heat content 
    … …  
    362359            DO jj = 1, jpj 
    363360               DO ji = 1, jpi 
    364                    t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt  
    365                    s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min 
    366                    ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
     361                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0  
     362                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin 
     363                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 
    367364 
    368365                   ! heat content per unit volume 
    369366                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    370                       +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
    371                       -   rcp     * ( ztmelts - rtt ) ) 
    372  
    373                    ! Correct dimensions to avoid big values 
    374                    e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    375  
    376                    ! Mutliply by ice volume, and divide by number of layers to get heat content in J 
    377                    e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 
    378                END DO ! ji 
    379             END DO ! jj 
    380          END DO ! jl 
    381       END DO ! jk 
     367                      +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
     368                      -   rcp     * ( ztmelts - rt0 ) ) 
     369 
     370                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
     371                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
     372               END DO 
     373            END DO 
     374         END DO 
     375      END DO 
    382376 
    383377      tn_ice (:,:,:) = t_su (:,:,:) 
    384378 
    385379      ELSE  
    386          ! if ln_limini=false 
     380         ! if ln_iceini=false 
    387381         a_i  (:,:,:) = 0._wp 
    388382         v_i  (:,:,:) = 0._wp 
    … …  
    400394         DO jl = 1, jpl 
    401395            DO jk = 1, nlay_i 
    402                t_i(:,:,jk,jl) = rtt * tms(:,:) 
     396               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    403397            END DO 
    404398            DO jk = 1, nlay_s 
    405                t_s(:,:,jk,jl) = rtt * tms(:,:) 
     399               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    406400            END DO 
    407401         END DO 
    408402       
    409       ENDIF ! ln_limini 
     403      ENDIF ! ln_iceini 
    410404       
    411405      at_i (:,:) = 0.0_wp 
    … …  
    481475      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    482476      !!----------------------------------------------------------------------------- 
    483       NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s,  & 
    484          &                                      ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s 
     477      NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s,  & 
     478         &                                      rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s 
    485479      INTEGER :: ios                 ! Local integer output status for namelist read 
    486480      !!----------------------------------------------------------------------------- 
    … …  
    502496         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    503497         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    504          WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini   = ', ln_limini 
    505          WRITE(numout,*) '   threshold water temp. for initial sea-ice    thres_sst  = ', thres_sst 
    506          WRITE(numout,*) '   initial snow thickness in the north          hts_ini_n  = ', hts_ini_n 
    507          WRITE(numout,*) '   initial snow thickness in the south          hts_ini_s  = ', hts_ini_s  
    508          WRITE(numout,*) '   initial ice thickness  in the north          hti_ini_n  = ', hti_ini_n 
    509          WRITE(numout,*) '   initial ice thickness  in the south          hti_ini_s  = ', hti_ini_s 
    510          WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_n  = ', ati_ini_n 
    511          WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_s  = ', ati_ini_s 
    512          WRITE(numout,*) '   initial  ice salinity  in the north          smi_ini_n  = ', smi_ini_n 
    513          WRITE(numout,*) '   initial  ice salinity  in the south          smi_ini_s  = ', smi_ini_s 
    514          WRITE(numout,*) '   initial  ice/snw temp  in the north          tmi_ini_n  = ', tmi_ini_n 
    515          WRITE(numout,*) '   initial  ice/snw temp  in the south          tmi_ini_s  = ', tmi_ini_s 
     498         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini 
     499         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst 
     500         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n 
     501         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s  
     502         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n 
     503         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s 
     504         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n 
     505         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s 
     506         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n 
     507         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s 
     508         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n 
     509         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s 
    516510      ENDIF 
    517511 

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

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

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

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

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

    r4161 r5682  
    2323   PRIVATE 
    2424 
    25    PUBLIC   lim_msh   ! routine called by ice_ini.F90 
     25   PUBLIC   lim_msh   ! routine called by sbcice_lim.F90 
    2626 
    2727   !!---------------------------------------------------------------------- 
    … …  
    4141      !!              - Definition of some constants linked with the grid 
    4242      !!              - Definition of the metric coef. for the sea/ice 
    43       !!              - Initialization of the ice masks (tmsk, umsk) 
    4443      !!  
    4544      !! Reference  : Deleersnijder et al. Ocean Modelling 100, 7-10  
    … …  
    103102!!gm end 
    104103 
    105       !                           !==  ice masks  ==! 
    106       tms(:,:) = tmask(:,:,1)             ! ice T-point  : use surface tmask 
    107       tmu(:,:) = umask(:,:,1)             ! ice U-point  : use surface umask  (C-grid EVP) 
    108       tmv(:,:) = vmask(:,:,1)             ! ice V-point  : use surface vmask  (C-grid EVP) 
    109       DO jj = 1, jpjm1                    ! ice F-point  : recompute fmask (due to nn_shlat) 
    110          DO ji = 1 , jpim1   ! NO vector opt. 
    111             tmf(ji,jj) =  tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * tms(ji+1,jj+1) 
    112          END DO 
    113       END DO 
    114       CALL lbc_lnk( tmf(:,:), 'F', 1. )           ! lateral boundary conditions 
    115  
    116       !                           !==  unmasked and masked area of T-grid cell 
    117       area(:,:) = e1t(:,:) * e2t(:,:) 
    118104      ! 
    119105   END SUBROUTINE lim_msh 

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

    r4990 r5682  
    102102      !!                 and charge ellipse. 
    103103      !!                 The user should make sure that the parameters 
    104       !!                 nevp, telast and creepl maintain stress state 
     104      !!                 nn_nevp, elastic time scale and rn_creepl maintain stress state 
    105105      !!                 on the charge ellipse for plastic flow 
    106106      !!                 e.g. in the Canadian Archipelago 
    … …  
    108108      !! References : Hunke and Dukowicz, JPO97 
    109109      !!              Bouillon et al., Ocean Modelling 2009 
    110       !!              Vancoppenolle et al., Ocean Modelling 2008 
    111110      !!------------------------------------------------------------------- 
    112111      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation 
    … …  
    117116      CHARACTER (len=50) ::   charout 
    118117      REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         ! 
    119       REAL(wp) ::   za, zstms, zmask   ! local scalars 
    120       REAL(wp) ::   zc1, zc2, zc3             ! ice mass 
    121  
    122       REAL(wp) ::   dtevp              ! time step for subcycling 
    123       REAL(wp) ::   dtotel, ecc2, ecci ! square of yield ellipse eccenticity 
    124       REAL(wp) ::   z0, zr, zcca, zccb ! temporary scalars 
    125       REAL(wp) ::   zu_ice2, zv_ice1   ! 
    126       REAL(wp) ::   zddc, zdtc         ! delta on corners and on centre 
    127       REAL(wp) ::   zdst               ! shear at the center of the grid point 
    128       REAL(wp) ::   zdsshx, zdsshy     ! term for the gradient of ocean surface 
    129       REAL(wp) ::   sigma1, sigma2     ! internal ice stress 
     118      REAL(wp) ::   za, zstms          ! local scalars 
     119      REAL(wp) ::   zc1, zc2, zc3      ! ice mass 
     120 
     121      REAL(wp) ::   dtevp , z1_dtevp              ! time step for subcycling 
     122      REAL(wp) ::   dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity 
     123      REAL(wp) ::   z0, zr, zcca, zccb            ! temporary scalars 
     124      REAL(wp) ::   zu_ice2, zv_ice1              ! 
     125      REAL(wp) ::   zddc, zdtc                    ! delta on corners and on centre 
     126      REAL(wp) ::   zdst                          ! shear at the center of the grid point 
     127      REAL(wp) ::   zdsshx, zdsshy                ! term for the gradient of ocean surface 
     128      REAL(wp) ::   sigma1, sigma2                ! internal ice stress 
    130129 
    131130      REAL(wp) ::   zresm         ! Maximal error on ice velocity 
    132       REAL(wp) ::   zdummy        ! dummy argument 
    133131      REAL(wp) ::   zintb, zintn  ! dummy argument 
    134132 
    … …  
    139137      REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points 
    140138      REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays 
    141       REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                            
    142       REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2, v_oce2   ! ocean u/v component on V points 
     139      REAL(wp), POINTER, DIMENSION(:,:) ::   v_oce1           ! ocean u/v component on U points                            
     140      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2           ! ocean u/v component on V points 
    143141      REAL(wp), POINTER, DIMENSION(:,:) ::   u_ice2, v_ice1   ! ice u/v component on V/U point 
    144142      REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses 
     143      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask            ! mask ocean grid points 
    145144       
    146145      REAL(wp), POINTER, DIMENSION(:,:) ::   zdt              ! tension at centre of grid cells 
    … …  
    152151                                                              !   ocean surface (ssh_m) if ice is not embedded 
    153152                                                              !   ice top surface if ice is embedded    
     153 
     154      REAL(wp), PARAMETER               ::   zepsi = 1.0e-20_wp ! tolerance parameter 
     155      REAL(wp), PARAMETER               ::   zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity 
    154156      !!------------------------------------------------------------------- 
    155157 
    156158      CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 
    157       CALL wrk_alloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                ) 
     159      CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               ) 
    158160      CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
    159161      CALL wrk_alloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
    … …  
    161163#if  defined key_lim2 && ! defined key_lim2_vp 
    162164# if defined key_agrif 
    163      USE ice_2, vt_s => hsnm 
    164      USE ice_2, vt_i => hicm 
     165      USE ice_2, vt_s => hsnm 
     166      USE ice_2, vt_i => hicm 
    165167# else 
    166      vt_s => hsnm 
    167      vt_i => hicm 
     168      vt_s => hsnm 
     169      vt_i => hicm 
    168170# endif 
    169      at_i(:,:) = 1. - frld(:,:) 
     171      at_i(:,:) = 1. - frld(:,:) 
    170172#endif 
    171173#if defined key_agrif && defined key_lim2  
    172     CALL agrif_rhg_lim2_load      ! First interpolation of coarse values 
     174      CALL agrif_rhg_lim2_load      ! First interpolation of coarse values 
    173175#endif 
    174176      ! 
    … …  
    186188 
    187189#if defined key_lim3 
    188       CALL lim_itd_me_icestrength( ridge_scheme_swi )      ! LIM-3: Ice strength on T-points 
    189 #endif 
    190  
    191 !CDIR NOVERRCHK 
     190      CALL lim_itd_me_icestrength( nn_icestr )      ! LIM-3: Ice strength on T-points 
     191#endif 
     192 
    192193      DO jj = k_j1 , k_jpj       ! Ice mass and temp variables 
    193 !CDIR NOVERRCHK 
    194194         DO ji = 1 , jpi 
    195195#if defined key_lim3 
    196             zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj) 
     196            zpresh(ji,jj) = tmask(ji,jj,1) *  strength(ji,jj) 
    197197#endif 
    198198#if defined key_lim2 
    199             zpresh(ji,jj) = tms(ji,jj) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) ) 
    200 #endif 
    201             ! tmi = 1 where there is ice or on land 
    202             tmi(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - epsd ) ) ) * tms(ji,jj) 
     199            zpresh(ji,jj) = tmask(ji,jj,1) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) ) 
     200#endif 
     201            ! zmask = 1 where there is ice or on land 
     202            zmask(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1) 
    203203         END DO 
    204204      END DO 
    … …  
    206206      ! Ice strength on grid cell corners (zpreshc) 
    207207      ! needed for calculation of shear stress  
    208 !CDIR NOVERRCHK 
    209208      DO jj = k_j1+1, k_jpj-1 
    210 !CDIR NOVERRCHK 
    211209         DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1) 
    212             zstms          =  tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
    213                &              tms(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
    214                &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + & 
    215                &              tms(ji,jj)     * wght(ji+1,jj+1,1,1) 
    216             zpreshc(ji,jj) = (  zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
    217                &                zpresh(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
    218                &                zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &  
    219                &                zpresh(ji,jj)     * wght(ji+1,jj+1,1,1)   & 
    220                &             ) / MAX( zstms, epsd ) 
     210            zstms          =  tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) +   & 
     211               &              tmask(ji+1,jj,1)   * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1)   * wght(ji+1,jj+1,1,1) 
     212            zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) +   & 
     213               &               zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + zpresh(ji,jj)   * wght(ji+1,jj+1,1,1)     & 
     214               &             ) / MAX( zstms, zepsi ) 
    221215         END DO 
    222216      END DO 
    223  
    224217      CALL lbc_lnk( zpreshc(:,:), 'F', 1. ) 
    225218      ! 
    … …  
    236229      !  zcorl2: Coriolis parameter on V-points                             
    237230      !  (ztagnx,ztagny): wind stress on U/V points                        
    238       !  u_oce1: ocean u component on u points                            
    239231      !  v_oce1: ocean v component on u points                           
    240232      !  u_oce2: ocean u component on v points                          
    241       !  v_oce2: ocean v component on v points                         
    242233 
    243234      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
    244           !                                             
    245           ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
    246           !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 
     235         !                                             
     236         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
     237         !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 
    247238         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp      
    248           ! 
    249           ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
    250           !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
     239         ! 
     240         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
     241         !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
    251242         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    252           ! 
     243         ! 
    253244         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0 
    254           ! 
     245         ! 
    255246      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
    256247         zpice(:,:) = ssh_m(:,:) 
    … …  
    260251         DO ji = fs_2, fs_jpim1 
    261252 
    262             zc1 = tms(ji  ,jj  ) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) ) 
    263             zc2 = tms(ji+1,jj  ) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) ) 
    264             zc3 = tms(ji  ,jj+1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) ) 
    265  
    266             zt11 = tms(ji  ,jj) * e1t(ji  ,jj) 
    267             zt12 = tms(ji+1,jj) * e1t(ji+1,jj) 
    268             zt21 = tms(ji,jj  ) * e2t(ji,jj  ) 
    269             zt22 = tms(ji,jj+1) * e2t(ji,jj+1) 
     253            zc1 = tmask(ji  ,jj  ,1) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) ) 
     254            zc2 = tmask(ji+1,jj  ,1) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) ) 
     255            zc3 = tmask(ji  ,jj+1,1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) ) 
     256 
     257            zt11 = tmask(ji  ,jj,1) * e1t(ji  ,jj) 
     258            zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj) 
     259            zt21 = tmask(ji,jj  ,1) * e2t(ji,jj  ) 
     260            zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1) 
    270261 
    271262            ! Leads area. 
    272             zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd ) 
    273             zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd ) 
     263            zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi ) 
     264            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi ) 
    274265 
    275266            ! Mass, coriolis coeff. and currents 
    276             zmass1(ji,jj) = ( zt12*zc1 + zt11*zc2 ) / (zt11+zt12+epsd) 
    277             zmass2(ji,jj) = ( zt22*zc1 + zt21*zc3 ) / (zt21+zt22+epsd) 
    278             zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) )   & 
    279                &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd ) 
    280             zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1)*fcor(ji,jj) + e2t(ji,jj)*fcor(ji,jj+1) )   & 
    281                &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 
     267            zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi ) 
     268            zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi ) 
     269            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) )   & 
     270               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi ) 
     271            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) )   & 
     272               &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi ) 
    282273            ! 
    283             u_oce1(ji,jj)  = u_oce(ji,jj) 
    284             v_oce2(ji,jj)  = v_oce(ji,jj) 
    285  
    286274            ! Ocean has no slip boundary condition 
    287             v_oce1(ji,jj)  = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)    & 
    288                &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) & 
    289                &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)   
    290  
    291             u_oce2(ji,jj)  = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)     & 
    292                &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) & 
    293                &                / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
     275            v_oce1(ji,jj)  = 0.5 * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji,jj)      & 
     276               &                   + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 
     277               &                   / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)   
     278 
     279            u_oce2(ji,jj)  = 0.5 * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj)      & 
     280               &                   + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 
     281               &                   / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
    294282 
    295283            ! Wind stress at U,V-point 
    … …  
    303291            ! include it later 
    304292 
    305             zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 
    306             zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj) 
     293            zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 
     294            zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 
    307295 
    308296            za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx 
    … …  
    318306      ! 
    319307      ! Time step for subcycling 
    320       dtevp  = rdt_ice / nevp 
     308      dtevp  = rdt_ice / nn_nevp 
     309#if defined key_lim3 
     310      dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice ) 
     311#else 
    321312      dtotel = dtevp / ( 2._wp * telast ) 
    322  
     313#endif 
     314      z1_dtotel = 1._wp / ( 1._wp + dtotel ) 
     315      z1_dtevp  = 1._wp / dtevp 
    323316      !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter) 
    324       ecc2 = ecc * ecc 
     317      ecc2 = rn_ecc * rn_ecc 
    325318      ecci = 1. / ecc2 
    326319 
    … …  
    331324 
    332325      !                                               !----------------------! 
    333       DO jter = 1 , nevp                              !    loop over jter    ! 
     326      DO jter = 1 , nn_nevp                           !    loop over jter    ! 
    334327         !                                            !----------------------!         
    335328         DO jj = k_j1, k_jpj-1 
    … …  
    339332 
    340333         DO jj = k_j1+1, k_jpj-1 
    341             DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi 
     334            DO ji = fs_2, fs_jpim1   !RB bug no vect opt due to zmask 
    342335 
    343336               !   
    … …  
    360353               ! 
    361354               ! 
    362                divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    363                   &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
    364                   &             +e1v(ji,jj)*v_ice(ji,jj)                      & 
    365                   &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
    366                   &             )                                             & 
    367                   &            / area(ji,jj) 
    368  
    369                zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
    370                   &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                & 
    371                   &           )*e2t(ji,jj)*e2t(ji,jj)                      & 
    372                   &          -( v_ice(ji,jj)/e1v(ji,jj)                    & 
    373                   &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                & 
    374                   &           )*e1t(ji,jj)*e1t(ji,jj)                      & 
    375                   &         )                                              & 
    376                   &        / area(ji,jj) 
     355               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     356                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     357                  &            ) * r1_e12t(ji,jj) 
     358 
     359               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
     360                  &         - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     361                  &         ) * r1_e12t(ji,jj) 
    377362 
    378363               ! 
    379                zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1)                & 
    380                   &            -u_ice(ji,jj)/e1u(ji,jj)                    & 
    381                   &           )*e1f(ji,jj)*e1f(ji,jj)                      & 
    382                   &          +( v_ice(ji+1,jj)/e2v(ji+1,jj)                & 
    383                   &            -v_ice(ji,jj)/e2v(ji,jj)                    & 
    384                   &           )*e2f(ji,jj)*e2f(ji,jj)                      & 
    385                   &         )                                              & 
    386                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 
    387                   &        * tmi(ji,jj) * tmi(ji,jj+1)                     & 
    388                   &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
    389  
    390  
    391                v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    392                   &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    393                   &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)  
    394  
    395                u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
    396                   &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
    397                   &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    398  
    399             END DO 
    400          END DO 
    401          CALL lbc_lnk( v_ice1, 'U', -1. )   ;   CALL lbc_lnk( u_ice2, 'V', -1. )      ! lateral boundary cond. 
    402  
    403 !CDIR NOVERRCHK 
     364               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
     365                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
     366                  &         ) * r1_e12f(ji,jj) * ( 2._wp - fmask(ji,jj,1) )   & 
     367                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 
     368 
     369 
     370               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     & 
     371                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   & 
     372                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)  
     373 
     374               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     & 
     375                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   & 
     376                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
     377            END DO 
     378         END DO 
     379 
     380         CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. )      ! lateral boundary cond. 
     381          
    404382         DO jj = k_j1+1, k_jpj-1 
    405 !CDIR NOVERRCHK 
    406383            DO ji = fs_2, fs_jpim1 
    407384 
    408385               !- Calculate Delta at centre of grid cells 
    409                zdst      = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          & 
    410                   &          - e2u(ji-1, jj) * v_ice1(ji-1,jj)          & 
    411                   &          + e1v(ji, jj  ) * u_ice2(ji,jj  )          & 
    412                   &          - e1v(ji, jj-1) * u_ice2(ji,jj-1)          & 
    413                   &          )                                          & 
    414                   &         / area(ji,jj) 
    415  
    416                delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )   
    417                delta_i(ji,jj) = delta + creepl 
    418                !-Calculate stress tensor components zs1 and zs2  
    419                !-at centre of grid cells (see section 3.5 of CICE user's guide). 
    420                zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( divu_i(ji,jj) / delta_i(ji,jj) - delta / delta_i(ji,jj) )  & 
    421                   &         * zpresh(ji,jj) ) ) / ( 1._wp + dtotel ) 
    422                zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) ) )  & 
    423                   &         / ( 1._wp + dtotel ) 
    424  
    425             END DO 
    426          END DO 
    427  
    428          CALL lbc_lnk( zs1(:,:), 'T', 1. ) 
    429          CALL lbc_lnk( zs2(:,:), 'T', 1. ) 
    430  
    431 !CDIR NOVERRCHK 
    432          DO jj = k_j1+1, k_jpj-1 
    433 !CDIR NOVERRCHK 
    434             DO ji = fs_2, fs_jpim1 
     386               zdst          = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )   & 
     387                  &            + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1)   & 
     388                  &            ) * r1_e12t(ji,jj) 
     389 
     390               delta          = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )   
     391               delta_i(ji,jj) = delta + rn_creepl 
     392 
    435393               !- Calculate Delta on corners 
    436                zddc  =      ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
    437                   &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
    438                   &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
    439                   &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
    440                   &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
    441                   &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
    442                   &         )                                               & 
    443                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
    444  
    445                zdtc  =      (-( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
    446                   &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
    447                   &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
    448                   &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
    449                   &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
    450                   &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
    451                   &         )                                               & 
    452                   &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
    453  
    454                zddc = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl 
    455  
    456                !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide). 
    457                zs12(ji,jj) = ( zs12(ji,jj) + dtotel *  & 
    458                   &          ( ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) ) )  & 
    459                   &          / ( 1.0 + dtotel )  
    460  
    461             END DO ! ji 
    462          END DO ! jj 
    463  
    464          CALL lbc_lnk( zs12(:,:), 'F', 1. ) 
    465  
     394               zddc  = (  ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  & 
     395                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
     396                  &    ) * r1_e12f(ji,jj) 
     397 
     398               zdtc  = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  & 
     399                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
     400                  &    ) * r1_e12f(ji,jj) 
     401 
     402               zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl 
     403 
     404               !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide). 
     405               zs1(ji,jj)  = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj)   * zpresh(ji,jj)   & 
     406                  &          ) * z1_dtotel 
     407               zs2(ji,jj)  = ( zs2 (ji,jj) + dtotel *         ecci * zdt(ji,jj) / delta_i(ji,jj)   * zpresh(ji,jj)   & 
     408                  &          ) * z1_dtotel 
     409               !-Calculate stress tensor component zs12 at corners 
     410               zs12(ji,jj) = ( zs12(ji,jj) + dtotel *         ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj)  & 
     411                  &          ) * z1_dtotel  
     412 
     413            END DO 
     414         END DO 
     415 
     416         CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 
     417  
    466418         ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 
    467419         DO jj = k_j1+1, k_jpj-1 
    468420            DO ji = fs_2, fs_jpim1 
    469421               !- contribution of zs1, zs2 and zs12 to zf1 
    470                zf1(ji,jj) = 0.5*( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj) & 
    471                   &              +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj) & 
    472                   &              +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj) & 
    473                   &             ) / ( e1u(ji,jj)*e2u(ji,jj) ) 
     422               zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 
     423                  &             + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj)          & 
     424                  &             + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) & 
     425                  &                ) * r1_e12u(ji,jj) 
    474426               ! contribution of zs1, zs2 and zs12 to zf2 
    475                zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) & 
    476                   &              -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) & 
    477                   &              + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 -    & 
    478                   zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) & 
    479                   &             ) / ( e1v(ji,jj)*e2v(ji,jj) ) 
     427               zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)  & 
     428                  &             - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj)          & 
     429                  &             + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj)  & 
     430                  &               )  * r1_e12v(ji,jj) 
    480431            END DO 
    481432         END DO 
    … …  
    487438         IF (MOD(jter,2).eq.0) THEN  
    488439 
    489 !CDIR NOVERRCHK 
    490440            DO jj = k_j1+1, k_jpj-1 
    491 !CDIR NOVERRCHK 
    492441               DO ji = fs_2, fs_jpim1 
    493                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    494                   z0           = zmass1(ji,jj)/dtevp 
     442                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 
     443                  z0           = zmass1(ji,jj) * z1_dtevp 
    495444 
    496445                  ! SB modif because ocean has no slip boundary condition 
    497                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)         & 
    498                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
    499                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    500                   za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
    501                      (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj)) 
    502                   zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    503                      za*(u_oce1(ji,jj)) 
    504                   zcca         = z0+za 
     446                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji  ,jj)     & 
     447                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   & 
     448                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
     449                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  & 
     450                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 
     451                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 
     452                  zcca         = z0 + za 
    505453                  zccb         = zcorl1(ji,jj) 
    506                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    507  
     454                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
    508455               END DO 
    509456            END DO 
    … …  
    511458            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    512459#if defined key_agrif && defined key_lim2 
    513             CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     460            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
    514461#endif 
    515462#if defined key_bdy 
    … …  
    517464#endif          
    518465 
    519 !CDIR NOVERRCHK 
    520466            DO jj = k_j1+1, k_jpj-1 
    521 !CDIR NOVERRCHK 
    522467               DO ji = fs_2, fs_jpim1 
    523468 
    524                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    525                   z0           = zmass2(ji,jj)/dtevp 
     469                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 
     470                  z0           = zmass2(ji,jj) * z1_dtevp 
    526471                  ! SB modif because ocean has no slip boundary condition 
    527                   zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)     & 
    528                      &                 + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
    529                      &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    530                   za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &  
    531                      (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    532                   zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    533                      za2ct(ji,jj) + za*(v_oce2(ji,jj)) 
    534                   zcca         = z0+za 
     472                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       & 
     473                     &                 + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   & 
     474                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
     475                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  &  
     476                     &                         ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) ) 
     477                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 
     478                  zcca         = z0 + za 
    535479                  zccb         = zcorl2(ji,jj) 
    536                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    537  
     480                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    538481               END DO 
    539482            END DO 
    … …  
    541484            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    542485#if defined key_agrif && defined key_lim2 
    543             CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
     486            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    544487#endif 
    545488#if defined key_bdy 
    … …  
    548491 
    549492         ELSE  
    550 !CDIR NOVERRCHK 
    551493            DO jj = k_j1+1, k_jpj-1 
    552 !CDIR NOVERRCHK 
    553494               DO ji = fs_2, fs_jpim1 
    554                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    555                   z0           = zmass2(ji,jj)/dtevp 
     495                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 
     496                  z0           = zmass2(ji,jj) * z1_dtevp 
    556497                  ! SB modif because ocean has no slip boundary condition 
    557                   zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)      & 
    558                      &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
    559                      &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)    
    560  
    561                   za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 
    562                      (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    563                   zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    564                      za2ct(ji,jj) + za*(v_oce2(ji,jj)) 
    565                   zcca         = z0+za 
     498                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       & 
     499                     &                  +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   & 
     500                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)    
     501 
     502                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  & 
     503                     &                         ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) ) 
     504                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 
     505                  zcca         = z0 + za 
    566506                  zccb         = zcorl2(ji,jj) 
    567                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    568  
     507                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    569508               END DO 
    570509            END DO 
    … …  
    572511            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    573512#if defined key_agrif && defined key_lim2 
    574             CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
     513            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    575514#endif 
    576515#if defined key_bdy 
    … …  
    578517#endif          
    579518 
    580 !CDIR NOVERRCHK 
    581519            DO jj = k_j1+1, k_jpj-1 
    582 !CDIR NOVERRCHK 
    583520               DO ji = fs_2, fs_jpim1 
    584                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    585                   z0           = zmass1(ji,jj)/dtevp 
    586                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      & 
    587                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
    588                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    589  
    590                   za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
    591                      (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj)) 
    592                   zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    593                      za*(u_oce1(ji,jj)) 
    594                   zcca         = z0+za 
     521                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 
     522                  z0           = zmass1(ji,jj) * z1_dtevp 
     523                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji,jj)       & 
     524                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   & 
     525                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
     526 
     527                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  & 
     528                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 
     529                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 
     530                  zcca         = z0 + za 
    595531                  zccb         = zcorl1(ji,jj) 
    596                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    597                END DO ! ji 
    598             END DO ! jj 
     532                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
     533               END DO 
     534            END DO 
    599535 
    600536            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    601537#if defined key_agrif && defined key_lim2 
    602             CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     538            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
    603539#endif 
    604540#if defined key_bdy 
    … …  
    611547            !---  Convergence test. 
    612548            DO jj = k_j1+1 , k_jpj-1 
    613                zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) ,           & 
    614                   ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    615             END DO 
    616             zresm = MAXVAL( zresr( 1:jpi , k_j1+1:k_jpj-1 ) ) 
     549               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
     550            END DO 
     551            zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) ) 
    617552            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain 
    618553         ENDIF 
    … …  
    625560      ! 4) Prevent ice velocities when the ice is thin 
    626561      !------------------------------------------------------------------------------! 
    627       ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 
    628       ! ocean velocity,  
    629       ! This prevents high velocity when ice is thin 
    630 !CDIR NOVERRCHK 
     562      ! If the ice volume is below zvmin then ice velocity should equal the 
     563      ! ocean velocity. This prevents high velocity when ice is thin 
    631564      DO jj = k_j1+1, k_jpj-1 
    632 !CDIR NOVERRCHK 
    633565         DO ji = fs_2, fs_jpim1 
    634             zdummy = vt_i(ji,jj) 
    635             IF ( zdummy .LE. hminrhg ) THEN 
     566            IF ( vt_i(ji,jj) <= zvmin ) THEN 
    636567               u_ice(ji,jj) = u_oce(ji,jj) 
    637568               v_ice(ji,jj) = v_oce(ji,jj) 
    638             ENDIF ! zdummy 
     569            ENDIF 
    639570         END DO 
    640571      END DO 
    641572 
    642       CALL lbc_lnk( u_ice(:,:), 'U', -1. )  
    643       CALL lbc_lnk( v_ice(:,:), 'V', -1. )  
     573      CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. ) 
     574 
    644575#if defined key_agrif && defined key_lim2 
    645       CALL agrif_rhg_lim2( nevp , nevp, 'U' ) 
    646       CALL agrif_rhg_lim2( nevp , nevp, 'V' ) 
     576      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' ) 
     577      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' ) 
    647578#endif 
    648579#if defined key_bdy 
    … …  
    653584      DO jj = k_j1+1, k_jpj-1  
    654585         DO ji = fs_2, fs_jpim1 
    655             zdummy = vt_i(ji,jj) 
    656             IF ( zdummy .LE. hminrhg ) THEN 
    657                v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    658                   &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    659                   &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    660  
    661                u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
    662                   &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
    663                   &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    664             ENDIF ! zdummy 
     586            IF ( vt_i(ji,jj) <= zvmin ) THEN 
     587               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji,  jj-1) ) * e1t(ji+1,jj)     & 
     588                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   & 
     589                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
     590 
     591               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     & 
     592                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )  &nbs