Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (5 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge —reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

Location:
trunk/NEMOGCM/NEMO/LIM_SRC_3
Files:
3 deleted
23 edited
3 copied

Legend:

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

    r6490 r7646  
    146146   !! smt_i       |      -      |    Mean sea ice salinity        | ppt   | 
    147147   !! tm_i        |      -      |    Mean sea ice temperature     | K     | 
    148    !! ot_i        !      -      !    Sea ice areal age content    | day   | 
    149148   !! et_i        !      -      !    Total ice enthalpy           | J/m2  |  
    150149   !! et_s        !      -      !    Total snow enthalpy          | J/m2  |  
    151    !! bv_i        !      -      !    Mean relative brine volume   | ???   |  
     150   !! bv_i        !      -      !    relative brine volume        | ???   |  
    152151   !!===================================================================== 
    153152 
     
    157156   !! * Share Module variables 
    158157   !!-------------------------------------------------------------------------- 
     158   !                                     !!** ice-generic parameters namelist (namicerun) ** 
     159   INTEGER           , PUBLIC ::   jpl             !: number of ice  categories  
     160   INTEGER           , PUBLIC ::   nlay_i          !: number of ice  layers  
     161   INTEGER           , PUBLIC ::   nlay_s          !: number of snow layers  
     162   REAL(wp)          , PUBLIC ::   rn_amax_n       !: maximum ice concentration Northern hemisphere 
     163   REAL(wp)          , PUBLIC ::   rn_amax_s       !: maximum ice concentration Southern hemisphere 
     164   CHARACTER(len=32) , PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
     165   CHARACTER(len=32) , PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
     166   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory 
     167   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory 
     168   LOGICAL           , PUBLIC ::   ln_limthd       !: flag for ice thermo (T) or not (F) 
     169   LOGICAL           , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
     170   INTEGER           , PUBLIC ::   nn_limdyn       !: flag for ice dynamics 
     171   REAL(wp)          , PUBLIC ::   rn_uice         !: prescribed u-vel (case nn_limdyn=0) 
     172   REAL(wp)          , PUBLIC ::   rn_vice         !: prescribed v-vel (case nn_limdyn=0) 
     173    
     174   !                                     !!** ice-diagnostics namelist (namicediag) ** 
     175   LOGICAL , PUBLIC ::   ln_limdiachk     !: flag for ice diag (T) or not (F) 
     176   LOGICAL , PUBLIC ::   ln_limdiahsb     !: flag for ice diag (T) or not (F) 
     177   LOGICAL , PUBLIC ::   ln_limctl        !: flag for sea-ice points output (T) or not (F) 
     178   INTEGER , PUBLIC ::   iiceprt          !: debug i-point 
     179   INTEGER , PUBLIC ::   jiceprt          !: debug j-point 
     180 
     181   !                                     !!** ice-init namelist (namiceini) ** 
     182                                          ! -- limistate -- ! 
     183   LOGICAL , PUBLIC ::   ln_limini        ! initialization or not 
     184   LOGICAL , PUBLIC ::   ln_limini_file   ! Ice initialization state from 2D netcdf file 
     185   REAL(wp), PUBLIC ::   rn_thres_sst     ! threshold water temperature for initial sea ice 
     186   REAL(wp), PUBLIC ::   rn_hts_ini_n     ! initial snow thickness in the north 
     187   REAL(wp), PUBLIC ::   rn_hts_ini_s     ! initial snow thickness in the south 
     188   REAL(wp), PUBLIC ::   rn_hti_ini_n     ! initial ice thickness in the north 
     189   REAL(wp), PUBLIC ::   rn_hti_ini_s     ! initial ice thickness in the south 
     190   REAL(wp), PUBLIC ::   rn_ati_ini_n     ! initial leads area in the north 
     191   REAL(wp), PUBLIC ::   rn_ati_ini_s     ! initial leads area in the south 
     192   REAL(wp), PUBLIC ::   rn_smi_ini_n     ! initial salinity  
     193   REAL(wp), PUBLIC ::   rn_smi_ini_s     ! initial salinity 
     194   REAL(wp), PUBLIC ::   rn_tmi_ini_n     ! initial temperature 
     195   REAL(wp), PUBLIC ::   rn_tmi_ini_s     ! initial temperature 
     196    
     197   !                                     !!** ice-thickness distribution namelist (namiceitd) ** 
     198   INTEGER , PUBLIC ::   nn_catbnd        !: categories distribution following: tanh function (1), or h^(-alpha) function (2) 
     199   REAL(wp), PUBLIC ::   rn_himean        !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only) 
     200 
     201   !                                     !!** ice-dynamics namelist (namicedyn) ** 
     202                                          ! -- limtrp & limadv -- ! 
     203   INTEGER , PUBLIC ::   nn_limadv        !: choose the advection scheme (-1=Prather ; 0=Ultimate-Macho) 
     204   INTEGER , PUBLIC ::   nn_limadv_ord    !: choose the order of the advection scheme (if Ultimate-Macho)    
     205                                          ! -- limitd_me -- ! 
     206   INTEGER , PUBLIC ::   nn_icestr        !: ice strength parameterization (0=Hibler79 1=Rothrock75) 
     207   REAL(wp), PUBLIC ::   rn_pe_rdg        !: ridging work divided by pot. energy change in ridging, nn_icestr = 1 
     208   REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength, Hibler JPO79 
     209   REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength 
     210   LOGICAL , PUBLIC ::   ln_icestr_bvf    !: use brine volume to diminish ice strength 
     211                                          ! -- limdyn & limrhg -- ! 
     212   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress 
     213   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9 
     214   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve 
     215   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
     216   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
     217   LOGICAL , PUBLIC ::   ln_landfast      !: landfast ice parameterization (T or F)  
     218   REAL(wp), PUBLIC ::   rn_gamma         !: fraction of ocean depth that ice must reach to initiate landfast ice 
     219   REAL(wp), PUBLIC ::   rn_icebfr        !: maximum bottom stress per unit area of contact (landfast ice)  
     220   REAL(wp), PUBLIC ::   rn_lfrelax       !: relaxation time scale (s-1) to reach static friction (landfast ice)  
     221 
     222   !                                     !!** ice-diffusion namelist (namicehdf) ** 
     223   INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 
     224   REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
     225 
     226   !                                     !!** ice-thermodynamics namelist (namicethd) ** 
     227                                          ! -- limthd_dif -- ! 
     228   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
     229   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion 
     230   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion 
     231   INTEGER , PUBLIC ::   nn_ice_thcon     !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
     232   LOGICAL , PUBLIC ::   ln_it_qnsice     !: iterate surface flux with changing surface temperature or not (F) 
     233   INTEGER , PUBLIC ::   nn_monocat       !: virtual ITD mono-category parameterizations (1) or not (0) 
     234                                          ! -- limthd_dh -- ! 
     235   LOGICAL , PUBLIC ::   ln_limdH         !: activate ice thickness change from growing/melting (T) or not (F) 
     236   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice 
     237                                          ! -- limthd_da -- ! 
     238   LOGICAL , PUBLIC ::   ln_limdA         !: activate lateral melting param. (T) or not (F) 
     239   REAL(wp), PUBLIC ::   rn_beta          !: coef. beta for lateral melting param. 
     240   REAL(wp), PUBLIC ::   rn_dmin          !: minimum floe diameter for lateral melting param. 
     241                                          ! -- limthd_lac -- ! 
     242   LOGICAL , PUBLIC ::   ln_limdO         !: activate ice growth in open-water (T) or not (F) 
     243   REAL(wp), PUBLIC ::   rn_hnewice       !: thickness for new ice formation (m) 
     244   LOGICAL , PUBLIC ::   ln_frazil        !: use of frazil ice collection as function of wind (T) or not (F) 
     245   REAL(wp), PUBLIC ::   rn_maxfrazb      !: maximum portion of frazil ice collecting at the ice bottom 
     246   REAL(wp), PUBLIC ::   rn_vfrazb        !: threshold drift speed for collection of bottom frazil ice 
     247   REAL(wp), PUBLIC ::   rn_Cfrazb        !: squeezing coefficient for collection of bottom frazil ice 
     248                                          ! -- limitd_th -- ! 
     249   REAL(wp), PUBLIC ::   rn_himin         !: minimum ice thickness 
     250 
     251   !                                     !!** ice-salinity namelist (namicesal) ** 
     252   LOGICAL , PUBLIC ::   ln_limdS         !: activate gravity drainage and flushing (T) or not (F) 
     253   INTEGER , PUBLIC ::   nn_icesal        !: salinity configuration used in the model 
     254   !                                      ! 1 - constant salinity in both space and time 
     255   !                                      ! 2 - prognostic salinity (s(z,t)) 
     256   !                                      ! 3 - salinity profile, constant in time 
     257   REAL(wp), PUBLIC ::   rn_icesal        !: bulk salinity (ppt) in case of constant salinity 
     258   REAL(wp), PUBLIC ::   rn_sal_gd        !: restoring salinity for gravity drainage [PSU] 
     259   REAL(wp), PUBLIC ::   rn_time_gd       !: restoring time constant for gravity drainage (= 20 days) [s] 
     260   REAL(wp), PUBLIC ::   rn_sal_fl        !: restoring salinity for flushing [PSU] 
     261   REAL(wp), PUBLIC ::   rn_time_fl       !: restoring time constant for gravity drainage (= 10 days) [s] 
     262   REAL(wp), PUBLIC ::   rn_simax         !: maximum ice salinity [PSU] 
     263   REAL(wp), PUBLIC ::   rn_simin         !: minimum ice salinity [PSU] 
     264 
     265   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
     266   REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging             
     267   INTEGER , PUBLIC ::   nn_partfun       !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
     268   REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging 
     269   REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function 
     270   LOGICAL , PUBLIC ::   ln_ridging       !: ridging of ice or not                         
     271   REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice 
     272   REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value) 
     273   REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging 
     274   LOGICAL , PUBLIC ::   ln_rafting       !: rafting of ice or not                         
     275   REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging  
     276   REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting 
     277   REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging 
     278 
     279   !                                     !!** some other parameters  
    159280   INTEGER , PUBLIC ::   nstart           !: iteration number of the begining of the run  
    160281   INTEGER , PUBLIC ::   nlast            !: iteration number of the end of the run  
     
    163284   REAL(wp), PUBLIC ::   rdt_ice          !: ice time step 
    164285   REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice 
    165  
    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)  
    183  
    184    !                                     !!** ice-salinity namelist (namicesal) ** 
    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 
    192  
    193    !                                     !!** ice-salinity namelist (namicesal) ** 
    194    INTEGER , PUBLIC ::   nn_icesal           !: salinity configuration used in the model 
    195    !                                         ! 1 - constant salinity in both space and time 
    196    !                                         ! 2 - prognostic salinity (s(z,t)) 
    197    !                                         ! 3 - salinity profile, constant in time 
    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) 
    201  
    202    !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    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 
    216  
    217    !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    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 
    223286   REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i 
    224287   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s  
    225    ! 
    226    !                                     !!** switch for presence of ice or not  
    227    REAL(wp), PUBLIC ::   rswitch 
    228    ! 
    229    !                                     !!** define some parameters  
     288   REAL(wp), PUBLIC ::   rswitch          !: switch for the presence of ice (1) or not (0) 
    230289   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number  
    231290   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number  
    232291   REAL(wp), PUBLIC, PARAMETER ::   epsi20   = 1.e-20_wp  !: small number  
    233292 
    234    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce   !: surface ocean velocity used in ice dynamics 
    235    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv    !: hor. diffusivity coeff. at U- and V-points [m2/s] 
    236    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ust2s, hicol   !: friction velocity, ice collection thickness accreted in leads 
    237    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strp1, strp2   !: strength at previous time steps 
    238    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength       !: ice strength 
     293   !                                     !!** define arrays 
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce !: surface ocean velocity used in ice dynamics 
     295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 
     296   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicol       !: ice collection thickness accreted in leads 
     297   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength    !: ice strength 
    239298   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element 
    240    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i        !: ice rheology elta factor (Flato & Hibler 95) [s-1] 
    241    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i         !: Divergence of the velocity field [s-1] 
    242    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i        !: Shear of the velocity field [s-1] 
     299   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i     !: ice rheology elta factor (Flato & Hibler 95) [s-1] 
     300   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i      !: Divergence of the velocity field [s-1] 
     301   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i     !: Shear of the velocity field [s-1] 
    243302   ! 
    244    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist        !: Average Sea-Ice Surface Temperature [Kelvin] 
    245    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   icethi      !: total ice thickness (for all categories) (diag only) 
    246303   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    247304   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction 
     
    252309   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
    253310 
    254    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange   [kg.m-2.s-1] 
    255    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice  [kg.m-2.s-1] 
    256    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow/ice sublimation       [kg.m-2.s-1] 
    257  
    258    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange                   [kg.m-2.s-1] 
    259    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice      [kg.m-2.s-1] 
    260    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
    261    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
    262    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
    263    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice          [kg.m-2.s-1] 
    264    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice         [kg.m-2.s-1] 
    265    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice             [kg.m-2.s-1] 
     311   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: snow-ocean mass exchange   [kg.m-2.s-1] 
     312   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: snow precipitation on ice  [kg.m-2.s-1] 
     313   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: snow/ice sublimation       [kg.m-2.s-1] 
     314 
     315   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: ice-ocean mass exchange                   [kg.m-2.s-1] 
     316   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni     !: snow ice growth component of wfx_ice      [kg.m-2.s-1] 
     317   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw     !: lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
     318   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog     !: bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
     319   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn     !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
     320   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom     !: bottom melt component of wfx_ice          [kg.m-2.s-1] 
     321   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum     !: surface melt component of wfx_ice         [kg.m-2.s-1] 
     322   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_lam     !: lateral melt component of wfx_ice         [kg.m-2.s-1] 
     323   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res     !: residual component of wfx_ice             [kg.m-2.s-1] 
    266324 
    267325   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)          [s-1] 
     
    271329   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    272330   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     331   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_lam     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    273332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    274333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     
    302361   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness [W.m-2] 
    303362 
    304    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice    
    305    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   pahu3D , pahv3D 
    306    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d  !: maximum ice concentration 2d array 
     363   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array 
     364   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice        !: transmitted solar radiation under ice 
     365   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   pahu3D, pahv3D !: ice hor. eddy diffusivity coef. at U- and V-points 
    307366 
    308367   !!-------------------------------------------------------------------------- 
     
    310369   !!-------------------------------------------------------------------------- 
    311370   !! Variables defined for each ice category 
    312    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i    !: Ice thickness (m) 
    313    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i     !: Ice fractional areas (concentration) 
    314    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i     !: Ice volume per unit area (m) 
    315    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s     !: Snow volume per unit area(m) 
    316    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_s    !: Snow thickness (m) 
    317    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su    !: Sea-Ice Surface Temperature (K) 
    318    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sm_i    !: Sea-Ice Bulk salinity (ppt) 
    319    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   smv_i   !: Sea-Ice Bulk salinity times volume per area (ppt.m) 
    320    !                                                                  !  this is an extensive variable that has to be transported 
    321    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i     !: Sea-Ice Age (days) 
    322    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ov_i    !: Sea-Ice Age times volume per area (days.m) 
    323    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i    !: Sea-Ice Age times ice area (days) 
     371   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i      !: Ice thickness (m) 
     372   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration) 
     373   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area (m) 
     374   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area(m) 
     375   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_s      !: Snow thickness (m) 
     376   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su      !: Sea-Ice Surface Temperature (K) 
     377   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sm_i      !: Sea-Ice Bulk salinity (ppt) 
     378   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   smv_i     !: Sea-Ice Bulk salinity times volume per area (ppt.m) 
     379   !                                                                    !  this is an extensive variable that has to be transported 
     380   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age (days) 
     381   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area (days) 
     382   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bv_i      !: brine volume 
    324383 
    325384   !! Variables summed over all categories, or associated to all the ice in a single grid cell 
    326    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice   !: components of the ice velocity (m/s) 
    327    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tio_u, tio_v   !: components of the ice-ocean stress (N/m2) 
    328    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s    !: ice and snow total volume per unit area (m) 
    329    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i           !: ice total fractional area (ice concentration) 
    330    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i          !: =1-at_i ; total open water fractional area 
    331    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   et_i , et_s    !: ice and snow total heat content 
    332    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ot_i           !: mean age over all categories 
    333    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i           !: mean ice temperature over all categories 
    334    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bv_i           !: brine volume averaged over all categories 
    335    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i          !: mean sea ice salinity averaged over all categories [PSU] 
    336  
    337    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s        !: Snow temperatures [K] 
    338    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s        !: Snow ...       
     385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice !: components of the ice velocity (m/s) 
     386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s  !: ice and snow total volume per unit area (m) 
     387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i         !: ice total fractional area (ice concentration) 
     388   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i        !: =1-at_i ; total open water fractional area 
     389   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   et_i , et_s  !: ice and snow total heat content 
     390   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i         !: mean ice temperature over all categories 
     391   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bvm_i        !: brine volume averaged over all categories 
     392   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i        !: mean sea ice salinity averaged over all categories [PSU] 
     393   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_su        !: mean surface temperature over all categories 
     394   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_i        !: mean ice  thickness over all categories 
     395   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_s        !: mean snow thickness over all categories 
     396   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   om_i         !: mean ice age over all categories 
     397   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tau_icebfr   !: ice friction with bathy (landfast param activated) 
     398 
     399   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures [K] 
     400   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow ...       
    339401       
    340    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K] 
    341    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents    [J/m2] 
    342    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i        !: ice salinities          [PSU] 
     402   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures          [K] 
     403   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice thermal contents    [J/m2] 
     404   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i      !: ice salinities          [PSU] 
    343405 
    344406   !!-------------------------------------------------------------------------- 
     
    362424   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
    363425   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
     426   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                     !: ice concentration (total) 
    364427             
    365428   !!-------------------------------------------------------------------------- 
     
    368431   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    369432   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
    370  
    371    !!-------------------------------------------------------------------------- 
    372    !! * Ice Run 
    373    !!-------------------------------------------------------------------------- 
    374    !                                                  !!: ** Namelist namicerun read in sbc_lim_init ** 
    375    INTEGER           , PUBLIC ::   jpl             !: number of ice  categories  
    376    INTEGER           , PUBLIC ::   nlay_i          !: number of ice  layers  
    377    INTEGER           , PUBLIC ::   nlay_s          !: number of snow layers  
    378    CHARACTER(len=32) , PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
    379    CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory 
    380    CHARACTER(len=32) , PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
    381    CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory 
    382    LOGICAL           , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
    383    LOGICAL           , PUBLIC ::   ln_icectl       !: flag for sea-ice points output (T) or not (F) 
    384    REAL(wp)          , PUBLIC ::   rn_amax_n       !: maximum ice concentration Northern hemisphere 
    385    REAL(wp)          , PUBLIC ::   rn_amax_s       !: maximum ice concentration Southern hemisphere 
    386    INTEGER           , PUBLIC ::   iiceprt         !: debug i-point 
    387    INTEGER           , PUBLIC ::   jiceprt         !: debug j-point 
    388433   ! 
    389434   !!-------------------------------------------------------------------------- 
    390435   !! * Ice diagnostics 
    391436   !!-------------------------------------------------------------------------- 
    392    ! Increment of global variables 
    393437   ! thd refers to changes induced by thermodynamics 
    394438   ! trp   ''         ''     ''       advection (transport of ice) 
    395    LOGICAL , PUBLIC                                        ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
    396    LOGICAL , PUBLIC                                        ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
     439   ! 
    397440   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vi   !: transport of ice volume 
    398441   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vs   !: transport of snw volume 
     
    419462      INTEGER :: ice_alloc 
    420463      ! 
    421       INTEGER :: ierr(17), ii 
     464      INTEGER :: ierr(15), ii 
    422465      !!----------------------------------------------------------------- 
    423466 
     
    427470      ! stay within Fortran's max-line length limit. 
    428471      ii = 1 
    429       ALLOCATE( u_oce    (jpi,jpj) , v_oce    (jpi,jpj) ,                           & 
    430          &      ahiu     (jpi,jpj) , ahiv     (jpi,jpj) ,                           & 
    431          &      ust2s    (jpi,jpj) , hicol    (jpi,jpj) ,                           & 
    432          &      strp1    (jpi,jpj) , strp2    (jpi,jpj) , strength  (jpi,jpj) ,     & 
    433          &      stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,     & 
    434          &      delta_i  (jpi,jpj) , divu_i   (jpi,jpj) , shear_i   (jpi,jpj) , STAT=ierr(ii) ) 
    435  
    436       ii = ii + 1 
    437       ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,                        & 
    438          &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,                        & 
    439          &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,                        & 
     472      ALLOCATE( u_oce   (jpi,jpj) , v_oce    (jpi,jpj) ,                                             & 
     473         &      ahiu    (jpi,jpj) , ahiv     (jpi,jpj) , hicol    (jpi,jpj) ,                        & 
     474         &      strength(jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,  & 
     475         &      delta_i (jpi,jpj) , divu_i   (jpi,jpj) , shear_i  (jpi,jpj) , STAT=ierr(ii) ) 
     476 
     477      ii = ii + 1 
     478      ALLOCATE( t_bo   (jpi,jpj) , frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,     & 
     479         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , wfx_lam(jpi,jpj) ,     & 
    440480         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     & 
    441481         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     & 
    442          &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) ,                        & 
    443          &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), pahu3D(jpi,jpj,jpl+1), pahv3D(jpi,jpj,jpl+1),            & 
    444          &      rn_amax_2d (jpi,jpj) , qlead  (jpi,jpj) ,                                                         & 
    445          &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj),                        & 
    446          &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    & 
     482         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) , rn_amax_2d(jpi,jpj),   & 
     483         &      fhtur  (jpi,jpj) , qlead  (jpi,jpj) ,                                           & 
     484         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  & 
     485         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,  & 
    447486         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     &  
    448          &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) ,       & 
    449          &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,                           & 
    450          &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,    & 
    451          &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) ) 
     487         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld   (jpi,jpj) ,                        & 
     488         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     & 
     489         &      hfx_opw(jpi,jpj) , hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,     & 
     490         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj)        ,  STAT=ierr(ii) ) 
    452491 
    453492      ! * Ice global state variables 
    454493      ii = ii + 1 
    455       ALLOCATE( ht_i (jpi,jpj,jpl) , a_i  (jpi,jpj,jpl) , v_i  (jpi,jpj,jpl) ,     & 
    456          &      v_s  (jpi,jpj,jpl) , ht_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) ,     & 
    457          &      sm_i (jpi,jpj,jpl) , smv_i(jpi,jpj,jpl) , o_i  (jpi,jpj,jpl) ,     & 
    458          &      ov_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl)                      , STAT=ierr(ii) ) 
    459       ii = ii + 1 
    460       ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , tio_u(jpi,jpj) , tio_v(jpi,jpj) ,     & 
     494      ALLOCATE( ftr_ice(jpi,jpj,jpl) , pahu3D(jpi,jpj,jpl+1) , pahv3D(jpi,jpj,jpl+1) , & 
     495         &      ht_i   (jpi,jpj,jpl) , a_i   (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,     & 
     496         &      v_s    (jpi,jpj,jpl) , ht_s  (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,     & 
     497         &      sm_i   (jpi,jpj,jpl) , smv_i (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,     & 
     498         &      oa_i   (jpi,jpj,jpl) , bv_i  (jpi,jpj,jpl) ,  STAT=ierr(ii) ) 
     499      ii = ii + 1 
     500      ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) ,                                       & 
    461501         &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) ,     & 
    462          &      et_i (jpi,jpj) , et_s (jpi,jpj) , ot_i (jpi,jpj) , tm_i (jpi,jpj) ,     & 
    463          &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) ) 
     502         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) ,     & 
     503         &      smt_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) ,     & 
     504         &      om_i (jpi,jpj) , tau_icebfr(jpi,jpj)                              , STAT=ierr(ii) ) 
    464505      ii = ii + 1 
    465506      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
     
    488529      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     & 
    489530         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,     & 
    490          &      oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)          , STAT=ierr(ii) ) 
     531         &      oa_i_b (jpi,jpj,jpl)                                                    , STAT=ierr(ii) ) 
     532      ii = ii + 1 
     533      ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , at_i_b(jpi,jpj) , STAT=ierr(ii) ) 
    491534       
    492535      ! * Ice thickness distribution variables 
     
    496539      ! * Ice diagnostics 
    497540      ii = ii + 1 
    498       ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj),   &  
    499          &      diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat  (jpi,jpj),   & 
    500          &      diag_smvi  (jpi,jpj), diag_vice   (jpi,jpj), diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
     541      ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),   &  
     542         &      diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj) , diag_heat  (jpi,jpj),   & 
     543         &      diag_smvi  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
    501544 
    502545      ice_alloc = MAXVAL( ierr(:) ) 
    503       IF( ice_alloc /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays.') 
     546      IF( ice_alloc /= 0 )   CALL ctl_warn('ice_alloc: failed to allocate arrays.') 
    504547      ! 
    505548   END FUNCTION ice_alloc 
     
    513556   !!====================================================================== 
    514557END MODULE ice 
    515  
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r6416 r7646  
    1818   USE phycst         ! physical constants 
    1919   USE ice            ! LIM-3 variables 
    20    USE dom_ice        ! LIM-3 domain 
    2120   USE dom_oce        ! ocean domain 
    2221   USE in_out_manager ! I/O manager 
     
    165164      !!                     + test if ice concentration and volume are > 0 
    166165      !! 
    167       !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true 
     166      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiachk=true 
    168167      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
    169168      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to 
     
    185184         ! salt flux 
    186185         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    187             &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   & 
     186            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    & 
    188187            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv ) 
    189188 
    190189         ! water flux 
    191          zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    192             &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     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(:,:) + wfx_lam(:,:)  & 
    193192            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv ) 
    194193 
     
    210209         ! salt flux 
    211210         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    212             &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   &  
     211            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    &  
    213212            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 
    214213 
    215214         ! water flux 
    216          zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    217             &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     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(:,:) + wfx_lam(:,:)   & 
    218217            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 
    219218 
     
    260259               &                         cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 
    261260                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     261            IF (     zamax   > 1._wp   ) WRITE(numout,*) 'violation a_i>1               (',cd_routine,') = ',zamax 
    262262            ENDIF 
    263263            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
     
    274274      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step 
    275275      !! 
    276       !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true 
     276      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiachk=true 
    277277      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
    278278      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to 
     
    286286      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt 
    287287 
    288 #if ! defined key_bdy 
    289288      ! heat flux 
    290       zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - SUM( qevap_ice * a_i_b, dim=3 ) )  & 
    291          &              * e1e2t * tmask(:,:,1) * zconv )  
     289      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es   & 
     290      !  &              - SUM( qevap_ice * a_i_b, dim=3 )                           & !!clem: I think this line must be commented (but need check) 
     291         &              ) * e1e2t * tmask(:,:,1) * zconv )  
    292292      ! salt flux 
    293293      zsfx  = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday 
     
    304304      IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx    [psu*Mt/day]   (',cd_routine,')  = ',(zsfx) 
    305305      IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx    [GW]           (',cd_routine,')  = ',(zhfx) 
    306 #endif 
    307306 
    308307   END SUBROUTINE lim_cons_final 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90

    r5836 r7646  
    55   !!====================================================================== 
    66   !! History :  3.5  !  2015-01  (M. Vancoppenolle) Original code 
     7   !!            3.7  !  2016-10  (C. Rousset)       Add routine lim_prt3D 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_lim3 
     
    1213   !!    lim_ctl   : control prints in case of crash 
    1314   !!    lim_prt   : ice control print at a given grid point 
     15   !!    lim_prt3D : control prints of ice arrays 
    1416   !!---------------------------------------------------------------------- 
    1517   USE oce             ! ocean dynamics and tracers 
     
    1719   USE ice             ! LIM-3: ice variables 
    1820   USE thd_ice         ! LIM-3: thermodynamical variables 
    19    USE dom_ice         ! LIM-3: ice domain 
    2021   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2122   USE sbc_ice         ! Surface boundary condition: ice   fields 
     
    3536   PUBLIC   lim_ctl 
    3637   PUBLIC   lim_prt 
     38   PUBLIC   lim_prt3D 
    3739 
    3840   !! * Substitutions 
     
    445447   END SUBROUTINE lim_prt 
    446448 
     449   SUBROUTINE lim_prt3D( cd_routine ) 
     450      !!--------------------------------------------------------------------------------------------------------- 
     451      !!                                   ***  ROUTINE lim_prt3D *** 
     452      !! 
     453      !! ** Purpose : CTL prints of ice arrays in case ln_ctl is activated  
     454      !! 
     455      !!--------------------------------------------------------------------------------------------------------- 
     456      CHARACTER(len=*), INTENT(in)  :: cd_routine    ! name of the routine 
     457      INTEGER                       :: jk, jl        ! dummy loop indices 
     458       
     459      CALL prt_ctl_info(' ========== ') 
     460      CALL prt_ctl_info( cd_routine ) 
     461      CALL prt_ctl_info(' ========== ') 
     462      CALL prt_ctl_info(' - Cell values : ') 
     463      CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
     464      CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' cell area   :') 
     465      CALL prt_ctl(tab2d_1=at_i       , clinfo1=' at_i        :') 
     466      CALL prt_ctl(tab2d_1=ato_i      , clinfo1=' ato_i       :') 
     467      CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' vt_i        :') 
     468      CALL prt_ctl(tab2d_1=vt_s       , clinfo1=' vt_s        :') 
     469      CALL prt_ctl(tab2d_1=divu_i     , clinfo1=' divu_i      :') 
     470      CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :') 
     471      CALL prt_ctl(tab2d_1=stress1_i  , clinfo1=' stress1_i   :') 
     472      CALL prt_ctl(tab2d_1=stress2_i  , clinfo1=' stress2_i   :') 
     473      CALL prt_ctl(tab2d_1=stress12_i , clinfo1=' stress12_i  :') 
     474      CALL prt_ctl(tab2d_1=strength   , clinfo1=' strength    :') 
     475      CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :') 
     476      CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
     477        
     478      DO jl = 1, jpl 
     479         CALL prt_ctl_info(' ') 
     480         CALL prt_ctl_info(' - Category : ', ivar1=jl) 
     481         CALL prt_ctl_info('   ~~~~~~~~~~') 
     482         CALL prt_ctl(tab2d_1=ht_i       (:,:,jl)        , clinfo1= ' ht_i        : ') 
     483         CALL prt_ctl(tab2d_1=ht_s       (:,:,jl)        , clinfo1= ' ht_s        : ') 
     484         CALL prt_ctl(tab2d_1=t_su       (:,:,jl)        , clinfo1= ' t_su        : ') 
     485         CALL prt_ctl(tab2d_1=t_s        (:,:,1,jl)      , clinfo1= ' t_snow      : ') 
     486         CALL prt_ctl(tab2d_1=sm_i       (:,:,jl)        , clinfo1= ' sm_i        : ') 
     487         CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' o_i         : ') 
     488         CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' a_i         : ') 
     489         CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' v_i         : ') 
     490         CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' v_s         : ') 
     491         CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' e_i1        : ') 
     492         CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' e_snow      : ') 
     493         CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' smv_i       : ') 
     494         CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' oa_i        : ') 
     495          
     496         DO jk = 1, nlay_i 
     497            CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
     498            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ') 
     499         END DO 
     500      END DO 
     501       
     502      CALL prt_ctl_info(' ') 
     503      CALL prt_ctl_info(' - Heat / FW fluxes : ') 
     504      CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
     505      CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
     506      CALL prt_ctl(tab2d_1=qsr    , clinfo1= ' qsr   : ', tab2d_2=qns       , clinfo2= ' qns       : ') 
     507      CALL prt_ctl(tab2d_1=emp    , clinfo1= ' emp   : ', tab2d_2=sfx       , clinfo2= ' sfx       : ') 
     508       
     509      CALL prt_ctl_info(' ') 
     510      CALL prt_ctl_info(' - Stresses : ') 
     511      CALL prt_ctl_info('   ~~~~~~~~~~ ') 
     512      CALL prt_ctl(tab2d_1=utau       , clinfo1= ' utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ') 
     513      CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ') 
     514      CALL prt_ctl(tab2d_1=u_oce      , clinfo1= ' u_oce     : ', tab2d_2=v_oce      , clinfo2= ' v_oce     : ') 
     515       
     516   END SUBROUTINE lim_prt3D 
     517 
    447518#else 
    448519   !!-------------------------------------------------------------------------- 
     
    454525   SUBROUTINE lim_prt     ! Empty routine 
    455526   END SUBROUTINE lim_prt 
     527   SUBROUTINE lim_prt3D   ! Empty routine 
     528   END SUBROUTINE lim_prt3D 
    456529#endif 
    457530   !!====================================================================== 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r6418 r7646  
    1414   !!---------------------------------------------------------------------- 
    1515   USE ice             ! LIM-3: sea-ice variable 
    16    USE dom_ice         ! LIM-3: sea-ice domain 
    1716   USE dom_oce         ! ocean domain 
    1817   USE sbc_oce         ! surface boundary condition: ocean fields 
     
    3130 
    3231   PUBLIC   lim_diahsb        ! routine called by ice_step.F90 
    33  
    34    real(wp) ::   frc_sal, frc_vol   ! global forcing trends 
    35    real(wp) ::   bg_grme            ! global ice growth+melt trends 
    36  
     32   PUBLIC   lim_diahsb_init   ! routine called in sbcice_lim.F90 
     33 
     34   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 
     35   REAL(wp)                              ::   frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot  ! global forcing trends 
     36    
    3737   !! * Substitutions 
    3838#  include "vectopt_loop_substitute.h90" 
     
    4646CONTAINS 
    4747 
    48    SUBROUTINE lim_diahsb 
     48   SUBROUTINE lim_diahsb( kt ) 
    4949      !!--------------------------------------------------------------------------- 
    5050      !!                  ***  ROUTINE lim_diahsb  *** 
     
    5353      !!  
    5454      !!--------------------------------------------------------------------------- 
     55      INTEGER, INTENT(in) :: kt    ! number of iteration 
    5556      !! 
    56       real(wp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
    57       real(wp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni,   & 
    58       &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn, zbg_sfx_sub  
    59       real(wp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 
    60       real(wp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub   
    61       real(wp)   ::   zbg_hfx_dhc, zbg_hfx_spr 
    62       real(wp)   ::   zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in    
    63       real(wp)   ::   zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 
    64       real(wp)   ::   z_frc_vol, z_frc_sal, z_bg_grme  
    65       real(wp)   ::   z1_area                     !    -     - 
    66       REAL(wp)   ::   ztmp 
     57      real(wp)   ::   zbg_ivol, zbg_svol, zbg_area, zbg_isal, zbg_item ,zbg_stem 
     58      REAL(wp)   ::   z_frc_voltop, z_frc_volbot, z_frc_sal, z_frc_temtop, z_frc_tembot   
     59      REAL(wp)   ::   zdiff_vol, zdiff_sal, zdiff_tem   
    6760      !!--------------------------------------------------------------------------- 
    6861      IF( nn_timing == 1 )   CALL timing_start('lim_diahsb') 
    6962 
    70       IF( numit == nstart ) CALL lim_diahsb_init  
    71  
    72       ! 1/area 
    73       z1_area = 1._wp / MAX( glob_sum( e1e2t(:,:) * tmask(:,:,1) ), epsi06 ) 
    74  
    75       rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e1e2t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 
    76       ! ----------------------- ! 
    77       ! 1 -  Content variations ! 
    78       ! ----------------------- ! 
    79       zbg_ivo = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume ice  
    80       zbg_svo = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume snow 
    81       zbg_are = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! area 
    82       zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) )       ! mean salt content 
    83       zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) )  ! mean temp content 
    84  
    85       !zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 
    86       !zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
    87  
    88       ! Volume 
    89       ztmp = rswitch * z1_area * r1_rau0 * rday 
    90       zbg_vfx     = ztmp * glob_sum(     emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    91       zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    92       zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    93       zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    94       zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    95       zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    96       zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    97       zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    98       zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    99       zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    100       zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    101  
    102       ! Salt 
    103       zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    104       zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    105       zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    106       zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    107  
    108       zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    109       zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    110       zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    111       zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    112       zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    113       zbg_sfx_sub = ztmp * glob_sum( sfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    114  
    115       ! Heat budget 
    116       zbg_ihc      = glob_sum( et_i(:,:) * e1e2t(:,:) * 1.e-20 ) ! ice heat content  [1.e20 J] 
    117       zbg_shc      = glob_sum( et_s(:,:) * e1e2t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 
    118       zbg_hfx_dhc  = glob_sum( diag_heat(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    119       zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    120  
    121       zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    122       zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    123       zbg_hfx_res  = glob_sum( hfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    124       zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    125       zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    126       zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    127       zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    128       zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    129       zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    130       zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    131       zbg_hfx_out  = glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    132       zbg_hfx_in   = glob_sum(  hfx_in(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 
    133      
    134       ! --------------------------------------------- ! 
    135       ! 2 - Trends due to forcing and ice growth/melt ! 
    136       ! --------------------------------------------- ! 
    137       z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 
    138       z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! salt fluxes 
    139       z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
    140                           &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 
    141                           &     wfx_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 
    142       ! 
    143       frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
    144       frc_sal  = frc_sal  + z_frc_sal  * rdt_ice 
    145       bg_grme  = bg_grme  + z_bg_grme  * rdt_ice 
     63      ! ----------------------- ! 
     64      ! 1 -  Contents ! 
     65      ! ----------------------- ! 
     66      zbg_ivol = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                  ! ice volume (km3) 
     67      zbg_svol = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                  ! snow volume (km3) 
     68      zbg_area = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-6 )                  ! area (km2) 
     69      zbg_isal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! salt content (pss*km3) 
     70      zbg_item = glob_sum( et_i * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                      ! heat content (1.e20 J) 
     71      zbg_stem = glob_sum( et_s * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                      ! heat content (1.e20 J) 
    14672       
    147       ! difference 
    148       !frc_vol = zbg_ivo - frc_vol 
    149       !frc_sal = zbg_sal - frc_sal 
    150        
    151       ! ----------------------- ! 
    152       ! 3 - Diagnostics writing ! 
    153       ! ----------------------- ! 
    154       rswitch = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 
    155       ! 
    156       IF( iom_use('ibgvoltot') )   & 
    157       CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9        )   ! ice volume (km3 equivalent liquid)          
    158       IF( iom_use('sbgvoltot') )   & 
    159       CALL iom_put( 'sbgvoltot' , zbg_svo * rhosn * r1_rau0 * 1.e-9        )   ! snw volume (km3 equivalent liquid)        
    160       IF( iom_use('ibgarea') )   & 
    161       CALL iom_put( 'ibgarea'   , zbg_are * 1.e-6                          )   ! ice area   (km2) 
    162       IF( iom_use('ibgsaline') )   & 
    163       CALL iom_put( 'ibgsaline' , rswitch * zbg_sal / MAX( zbg_ivo, epsi06 ) )   ! ice saline (psu) 
    164       IF( iom_use('ibgtemper') )   & 
    165       CALL iom_put( 'ibgtemper' , rswitch * zbg_tem / MAX( zbg_ivo, epsi06 ) )   ! ice temper (C) 
    166       CALL iom_put( 'ibgheatco' , zbg_ihc                                  )   ! ice heat content (1.e20 J)         
    167       CALL iom_put( 'sbgheatco' , zbg_shc                                  )   ! snw heat content (1.e20 J) 
    168       IF( iom_use('ibgsaltco') )   & 
    169       CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9        )   ! ice salt content (psu*km3 equivalent liquid)         
    170  
    171       CALL iom_put( 'ibgvfx'    , zbg_vfx                                  )   ! volume flux emp (m/day liquid) 
    172       CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog                              )   ! volume flux bottom growth     -(m/day equivalent liquid) 
    173       CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw                              )   ! volume flux open water growth - 
    174       CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni                              )   ! volume flux snow ice growth   - 
    175       CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn                              )   ! volume flux dynamic growth    - 
    176       CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom                              )   ! volume flux bottom melt       - 
    177       CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum                              )   ! volume flux surface melt      - 
    178       CALL iom_put( 'ibgvfxres' , zbg_vfx_res                              )   ! volume flux resultant         - 
    179       CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr                              )   ! volume flux from snow precip         - 
    180       CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw                              )   ! volume flux from snow melt         - 
    181       CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub                              )   ! volume flux from sublimation         - 
    182            
    183       CALL iom_put( 'ibgsfx'    , zbg_sfx                                  )   ! salt flux         -(psu*m/day equivalent liquid)        
    184       CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri                              )   ! salt flux brines  -       
    185       CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn                              )   ! salt flux dynamic -     
    186       CALL iom_put( 'ibgsfxres' , zbg_sfx_res                              )   ! salt flux result  -     
    187       CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog                              )   ! salt flux bottom growth    
    188       CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw                              )   ! salt flux open water growth - 
    189       CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni                              )   ! salt flux snow ice growth   - 
    190       CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom                              )   ! salt flux bottom melt       - 
    191       CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum                              )   ! salt flux surface melt      - 
    192       CALL iom_put( 'ibgsfxsub' , zbg_sfx_sub                              )   ! salt flux sublimation      - 
    193  
    194       CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc                              )   ! Heat content variation in snow and ice [W] 
    195       CALL iom_put( 'ibghfxspr' , zbg_hfx_spr                              )   ! Heat content of snow precip [W] 
    196  
    197       CALL iom_put( 'ibghfxres' , zbg_hfx_res                              )   !  
    198       CALL iom_put( 'ibghfxsub' , zbg_hfx_sub                              )   !  
    199       CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn                              )   !  
    200       CALL iom_put( 'ibghfxthd' , zbg_hfx_thd                              )   !  
    201       CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw                              )   !  
    202       CALL iom_put( 'ibghfxsum' , zbg_hfx_sum                              )   !  
    203       CALL iom_put( 'ibghfxbom' , zbg_hfx_bom                              )   !  
    204       CALL iom_put( 'ibghfxbog' , zbg_hfx_bog                              )   !  
    205       CALL iom_put( 'ibghfxdif' , zbg_hfx_dif                              )   !  
    206       CALL iom_put( 'ibghfxopw' , zbg_hfx_opw                              )   !  
    207       CALL iom_put( 'ibghfxout' , zbg_hfx_out                              )   !  
    208       CALL iom_put( 'ibghfxin'  , zbg_hfx_in                               )   !  
    209  
    210       CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9                          )   ! vol - forcing     (km3 equivalent liquid)  
    211       CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9                          )   ! sal - forcing     (psu*km3 equivalent liquid)    
    212       IF( iom_use('ibgvolgrm') )   & 
    213       CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9                )   ! vol growth + melt (km3 equivalent liquid)          
    214  
     73      ! ---------------------------! 
     74      ! 2 - Trends due to forcing  ! 
     75      ! ---------------------------! 
     76      z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )  ! freshwater flux ice/snow-ocean  
     77      z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                     ! freshwater flux ice/snow-atm 
     78      z_frc_sal    = r1_rau0 * glob_sum( - sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                                            ! salt fluxes ice/snow-ocean 
     79      z_frc_tembot =           glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                                         ! heat on top of ocean (and below ice) 
     80      z_frc_temtop =           glob_sum( hfx_in (:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                                         ! heat on top of ice-coean 
     81      ! 
     82      frc_voltop  = frc_voltop  + z_frc_voltop  * rdt_ice ! km3 
     83      frc_volbot  = frc_volbot  + z_frc_volbot  * rdt_ice ! km3 
     84      frc_sal     = frc_sal     + z_frc_sal     * rdt_ice ! km3*pss 
     85      frc_temtop  = frc_temtop  + z_frc_temtop  * rdt_ice ! 1.e20 J 
     86      frc_tembot  = frc_tembot  + z_frc_tembot  * rdt_ice ! 1.e20 J 
     87             
     88      ! ----------------------- ! 
     89      ! 3 -  Content variations ! 
     90      ! ----------------------- ! 
     91      zdiff_vol = r1_rau0 * glob_sum( ( rhoic * vt_i(:,:) + rhosn * vt_s(:,:) - vol_loc_ini(:,:)  &  ! freshwater trend (km3)  
     92         &                            ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )  
     93      zdiff_sal = r1_rau0 * glob_sum( ( rhoic * SUM( smv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:)     &  ! salt content trend (km3*pss) 
     94         &                            ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) 
     95      zdiff_tem =           glob_sum( ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:)                  &  ! heat content trend (1.e20 J) 
     96      !  &                            + SUM( qevap_ice * a_i_b, dim=3 ) &     !! clem: I think this line should be commented (but needs a check) 
     97         &                            ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) 
     98 
     99      ! ----------------------- ! 
     100      ! 4 -  Drifts             ! 
     101      ! ----------------------- ! 
     102      zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 
     103      zdiff_sal = zdiff_sal - frc_sal 
     104      zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 
     105 
     106      ! ----------------------- ! 
     107      ! 5 - Diagnostics writing ! 
     108      ! ----------------------- ! 
     109      ! 
     110      IF( iom_use('ibgvolume') )  CALL iom_put( 'ibgvolume' , zdiff_vol        )   ! ice/snow volume  drift            (km3 equivalent ocean water)          
     111      IF( iom_use('ibgsaltco') )  CALL iom_put( 'ibgsaltco' , zdiff_sal        )   ! ice salt content drift            (psu*km3 equivalent ocean water) 
     112      IF( iom_use('ibgheatco') )  CALL iom_put( 'ibgheatco' , zdiff_tem        )   ! ice/snow heat content drift       (1.e20 J) 
     113      IF( iom_use('ibgheatfx') )  CALL iom_put( 'ibgheatfx' , zdiff_tem /      &   ! ice/snow heat flux drift          (W/m2) 
     114         &                                                    glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 
     115 
     116      IF( iom_use('ibgfrcvoltop') )  CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water)  
     117      IF( iom_use('ibgfrcvolbot') )  CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water)  
     118      IF( iom_use('ibgfrcsal') )     CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)    
     119      IF( iom_use('ibgfrctemtop') )  CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)    
     120      IF( iom_use('ibgfrctembot') )  CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)    
     121      IF( iom_use('ibgfrchfxtop') )  CALL iom_put( 'ibgfrchfxtop' , frc_temtop / & ! heat on top of ice/snw/ocean      (W/m2)  
     122         &                                                    glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 
     123      IF( iom_use('ibgfrchfxbot') )  CALL iom_put( 'ibgfrchfxbot' , frc_tembot / & ! heat on top of ocean(below ice)   (W/m2)  
     124         &                                                    glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 
     125 
     126      IF( iom_use('ibgvol_tot' ) )  CALL iom_put( 'ibgvol_tot'  , zbg_ivol     )   ! ice volume                        (km3) 
     127      IF( iom_use('sbgvol_tot' ) )  CALL iom_put( 'sbgvol_tot'  , zbg_svol     )   ! snow volume                       (km3) 
     128      IF( iom_use('ibgarea_tot') )  CALL iom_put( 'ibgarea_tot' , zbg_area     )   ! ice area                          (km2) 
     129      IF( iom_use('ibgsalt_tot') )  CALL iom_put( 'ibgsalt_tot' , zbg_isal     )   ! ice salinity content              (pss*km3) 
     130      IF( iom_use('ibgheat_tot') )  CALL iom_put( 'ibgheat_tot' , zbg_item     )   ! ice heat content                  (1.e20 J) 
     131      IF( iom_use('sbgheat_tot') )  CALL iom_put( 'sbgheat_tot' , zbg_stem     )   ! snow heat content                 (1.e20 J) 
    215132      ! 
    216133      IF( lrst_ice )   CALL lim_diahsb_rst( numit, 'WRITE' ) 
    217134      ! 
    218135      IF( nn_timing == 1 )   CALL timing_stop('lim_diahsb') 
    219 ! 
     136      ! 
    220137   END SUBROUTINE lim_diahsb 
    221138 
     
    233150      !!             - Compute coefficients for conversion 
    234151      !!--------------------------------------------------------------------------- 
    235       INTEGER            ::   jk       ! dummy loop indice 
    236152      INTEGER            ::   ierror   ! local integer 
    237153      !! 
     
    247163         WRITE(numout,*) '~~~~~~~~~~~~' 
    248164      ENDIF 
    249       ! 
     165      !       
     166      ALLOCATE( vol_loc_ini(jpi,jpj), sal_loc_ini(jpi,jpj), tem_loc_ini(jpi,jpj), STAT=ierror ) 
     167      IF( ierror > 0 )  THEN 
     168         CALL ctl_stop( 'lim_diahsb: unable to allocate vol_loc_ini' ) 
     169         RETURN 
     170      ENDIF 
     171 
    250172      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files 
    251173      ! 
     
    263185     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    264186     ! 
    265      INTEGER ::   id1, id2, id3   ! local integers 
    266187     !!---------------------------------------------------------------------- 
    267188     ! 
    268189     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    269190        IF( ln_rstart ) THEN                   !* Read the restart file 
    270            !id1 = iom_varid( numrir, 'frc_vol'  , ldstop = .TRUE. ) 
    271191           ! 
    272192           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    273            IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp 
    274            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    275            CALL iom_get( numrir, 'frc_vol', frc_vol ) 
    276            CALL iom_get( numrir, 'frc_sal', frc_sal ) 
    277            CALL iom_get( numrir, 'bg_grme', bg_grme ) 
     193           IF(lwp) WRITE(numout,*) ' lim_diahsb_rst read at it= ', kt,' date= ', ndastp 
     194           IF(lwp) WRITE(numout,*) '~~~~~~~' 
     195           CALL iom_get( numrir, 'frc_voltop' , frc_voltop  ) 
     196           CALL iom_get( numrir, 'frc_volbot' , frc_volbot  ) 
     197           CALL iom_get( numrir, 'frc_temtop' , frc_temtop  ) 
     198           CALL iom_get( numrir, 'frc_tembot' , frc_tembot  ) 
     199           CALL iom_get( numrir, 'frc_sal'    , frc_sal     ) 
     200           CALL iom_get( numrir, jpdom_autoglo, 'vol_loc_ini', vol_loc_ini ) 
     201           CALL iom_get( numrir, jpdom_autoglo, 'tem_loc_ini', tem_loc_ini ) 
     202           CALL iom_get( numrir, jpdom_autoglo, 'sal_loc_ini', sal_loc_ini ) 
    278203        ELSE 
    279204           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    280205           IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' 
    281206           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    282            frc_vol  = 0._wp                                           
    283            frc_sal  = 0._wp                                                  
    284            bg_grme  = 0._wp                                        
     207           ! set trends to 0 
     208           frc_voltop  = 0._wp                                           
     209           frc_volbot  = 0._wp                                           
     210           frc_temtop  = 0._wp                                                  
     211           frc_tembot  = 0._wp                                                  
     212           frc_sal     = 0._wp                                                  
     213           ! record initial ice volume, salt and temp 
     214           vol_loc_ini(:,:) = rhoic * vt_i(:,:) + rhosn * vt_s(:,:)  ! ice/snow volume (kg/m2) 
     215           tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:)                  ! ice/snow heat content (J) 
     216           sal_loc_ini(:,:) = rhoic * SUM( smv_i(:,:,:), dim=3 )     ! ice salt content (pss*kg/m2) 
     217            
    285218       ENDIF 
    286219 
     
    288221        !                                   ! ------------------- 
    289222        IF(lwp) WRITE(numout,*) '~~~~~~~' 
    290         IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp 
     223        IF(lwp) WRITE(numout,*) ' lim_diahsb_rst write at it= ', kt,' date= ', ndastp 
    291224        IF(lwp) WRITE(numout,*) '~~~~~~~' 
    292         CALL iom_rstput( kt, nitrst, numriw, 'frc_vol'   , frc_vol     ) 
    293         CALL iom_rstput( kt, nitrst, numriw, 'frc_sal'   , frc_sal     ) 
    294         CALL iom_rstput( kt, nitrst, numriw, 'bg_grme'   , bg_grme     ) 
     225        CALL iom_rstput( kt, nitrst, numriw, 'frc_voltop' , frc_voltop  ) 
     226        CALL iom_rstput( kt, nitrst, numriw, 'frc_volbot' , frc_volbot  ) 
     227        CALL iom_rstput( kt, nitrst, numriw, 'frc_temtop' , frc_temtop  ) 
     228        CALL iom_rstput( kt, nitrst, numriw, 'frc_tembot' , frc_tembot  ) 
     229        CALL iom_rstput( kt, nitrst, numriw, 'frc_sal'    , frc_sal     ) 
     230        CALL iom_rstput( kt, nitrst, numriw, 'vol_loc_ini', vol_loc_ini ) 
     231        CALL iom_rstput( kt, nitrst, numriw, 'tem_loc_ini', tem_loc_ini ) 
     232        CALL iom_rstput( kt, nitrst, numriw, 'sal_loc_ini', sal_loc_ini ) 
    295233        ! 
    296234     ENDIF 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r5836 r7646  
    1717   USE phycst           ! physical constants 
    1818   USE dom_oce          ! ocean space and time domain 
    19    USE sbc_oce          ! Surface boundary condition: ocean fields 
    2019   USE sbc_ice          ! Surface boundary condition: ice   fields 
    2120   USE ice              ! LIM-3 variables 
    22    USE dom_ice          ! LIM-3 domain 
    2321   USE limrhg           ! LIM-3 rheology 
    2422   USE lbclnk           ! lateral boundary conditions - MPP exchanges 
     
    2624   USE wrk_nemo         ! work arrays 
    2725   USE in_out_manager   ! I/O manager 
    28    USE prtctl           ! Print control 
    2926   USE lib_fortran      ! glob_sum 
    30    USE timing          ! Timing 
    31    USE limcons        ! conservation tests 
     27   USE timing           ! Timing 
     28   USE limcons          ! conservation tests 
     29   USE limctl           ! control prints 
    3230   USE limvar 
    3331 
     
    3533   PRIVATE 
    3634 
    37    PUBLIC   lim_dyn   ! routine called by ice_step 
     35   PUBLIC   lim_dyn        ! routine called by sbcice_lim.F90 
     36   PUBLIC   lim_dyn_init   ! routine called by sbcice_lim.F90 
    3837 
    3938   !! * Substitutions 
     
    5049      !!               ***  ROUTINE lim_dyn  *** 
    5150      !!                
    52       !! ** Purpose :   compute ice velocity and ocean-ice stress 
     51      !! ** Purpose :   compute ice velocity 
    5352      !!                 
    5453      !! ** Method  :  
     
    5655      !! ** Action  : - Initialisation 
    5756      !!              - Call of the dynamic routine for each hemisphere 
    58       !!              - computation of the stress at the ocean surface          
    59       !!              - treatment of the case if no ice dynamic 
    6057      !!------------------------------------------------------------------------------------ 
    6158      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    6259      !! 
    63       INTEGER  ::   ji, jj, jl, ja    ! dummy loop indices 
    64       INTEGER  ::   i_j1, i_jpj       ! Starting/ending j-indices for rheology 
    65       REAL(wp) ::   zcoef             ! local scalar 
    66       REAL(wp), POINTER, DIMENSION(:)   ::   zswitch        ! i-averaged indicator of sea-ice 
    67       REAL(wp), POINTER, DIMENSION(:)   ::   zmsk           ! i-averaged of tmask 
    68       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io   ! ice-ocean velocity 
    69       ! 
     60      INTEGER  :: jl, jk ! dummy loop indices 
    7061      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7162     !!--------------------------------------------------------------------- 
     
    7364      IF( nn_timing == 1 )  CALL timing_start('limdyn') 
    7465 
    75       CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 
    76       CALL wrk_alloc( jpj, zswitch, zmsk ) 
    77  
    78       CALL lim_var_agg(1)             ! aggregate ice categories 
    79  
    80       IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    81  
    82       IF( ln_limdyn ) THEN 
    83          ! 
    84          ! conservation test 
    85          IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    86  
    87          u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 
    88          v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 
    89  
    90          ! Rheology (ice dynamics) 
    91          ! ======== 
    92  
    93          !  Define the j-limits where ice rheology is computed 
    94          ! --------------------------------------------------- 
    95  
    96          IF( lk_mpp .OR. lk_mpp_rep ) THEN                    ! mpp: compute over the whole domain 
    97             i_j1 = 1 
    98             i_jpj = jpj 
    99             IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
    100             CALL lim_rhg( i_j1, i_jpj ) 
    101          ELSE                                 ! optimization of the computational area 
    102             ! 
    103             DO jj = 1, jpj 
    104                zswitch(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line 
    105                zmsk   (jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line 
    106             END DO 
    107  
    108             IF( l_jeq ) THEN                     ! local domain include both hemisphere 
    109                !                                 ! Rheology is computed in each hemisphere 
    110                !                                 ! only over the ice cover latitude strip 
    111                ! Northern hemisphere 
    112                i_j1  = njeq 
    113                i_jpj = jpj 
    114                DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
    115                   i_j1 = i_j1 + 1 
    116                END DO 
    117                i_j1 = MAX( 1, i_j1-2 ) 
    118                IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  : NH  i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
    119                CALL lim_rhg( i_j1, i_jpj ) 
    120                ! 
    121                ! Southern hemisphere 
    122                i_j1  =  1 
    123                i_jpj = njeq 
    124                DO WHILE ( i_jpj >= 1 .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
    125                   i_jpj = i_jpj - 1 
    126                END DO 
    127                i_jpj = MIN( jpj, i_jpj+1 ) 
    128                IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  : SH  i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
    129                ! 
    130                CALL lim_rhg( i_j1, i_jpj ) 
    131                ! 
    132             ELSE                                 ! local domain extends over one hemisphere only 
    133                !                                 ! Rheology is computed only over the ice cover 
    134                !                                 ! latitude strip 
    135                i_j1  = 1 
    136                DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
    137                   i_j1 = i_j1 + 1 
    138                END DO 
    139                i_j1 = MAX( 1, i_j1-2 ) 
    140  
    141                i_jpj  = jpj 
    142                DO WHILE ( i_jpj >= 1  .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
    143                   i_jpj = i_jpj - 1 
    144                END DO 
    145                i_jpj = MIN( jpj, i_jpj+1) 
    146                ! 
    147                IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  : one hemisphere:  i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
    148                ! 
    149                CALL lim_rhg( i_j1, i_jpj ) 
    150                ! 
    151             ENDIF 
    152             ! 
    153          ENDIF 
    154  
    155          ! computation of friction velocity 
    156          ! -------------------------------- 
    157          ! ice-ocean velocity at U & V-points (u_ice v_ice at U- & V-points ; ssu_m, ssv_m at U- & V-points) 
    158          zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
    159          zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    160          ! frictional velocity at T-point 
    161          zcoef = 0.5_wp * rn_cio 
    162          DO jj = 2, jpjm1  
    163             DO ji = fs_2, fs_jpim1   ! vector opt. 
    164                ust2s(ji,jj) = zcoef * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    165                   &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tmask(ji,jj,1) 
    166             END DO 
    167          END DO 
    168          ! 
    169          ! conservation test 
    170          IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    171          ! 
    172       ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
    173          ! 
    174          zcoef = SQRT( 0.5_wp ) * r1_rau0 
    175          DO jj = 2, jpjm1 
    176             DO ji = fs_2, fs_jpim1   ! vector opt. 
    177                ust2s(ji,jj) = zcoef * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    178                   &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tmask(ji,jj,1) 
    179             END DO 
    180          END DO 
    181          ! 
    182       ENDIF 
    183       CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point 
    184  
    185       IF(ln_ctl) THEN   ! Control print 
    186          CALL prt_ctl_info(' ') 
    187          CALL prt_ctl_info(' - Cell values : ') 
    188          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    189          CALL prt_ctl(tab2d_1=ust2s     , clinfo1=' lim_dyn  : ust2s     :') 
    190          CALL prt_ctl(tab2d_1=divu_i    , clinfo1=' lim_dyn  : divu_i    :') 
    191          CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :') 
    192          CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :') 
    193          CALL prt_ctl(tab2d_1=e1e2t     , clinfo1=' lim_dyn  : cell area :') 
    194          CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :') 
    195          CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :') 
    196          CALL prt_ctl(tab2d_1=vt_s      , clinfo1=' lim_dyn  : vt_s      :') 
    197          CALL prt_ctl(tab2d_1=stress1_i , clinfo1=' lim_dyn  : stress1_i :') 
    198          CALL prt_ctl(tab2d_1=stress2_i , clinfo1=' lim_dyn  : stress2_i :') 
    199          CALL prt_ctl(tab2d_1=stress12_i, clinfo1=' lim_dyn  : stress12_i:') 
     66      CALL lim_var_agg(1)                      ! aggregate ice categories 
     67      ! 
     68      ! conservation test 
     69      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     70       
     71      ! ice velocities before rheology 
     72      u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 
     73      v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 
     74       
     75      ! Landfast ice parameterization: define max bottom friction 
     76      tau_icebfr(:,:) = 0._wp 
     77      IF( ln_landfast ) THEN 
    20078         DO jl = 1, jpl 
    201             CALL prt_ctl_info(' ') 
    202             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    203             CALL prt_ctl_info('   ~~~~~~~~~~') 
    204             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_dyn  : a_i      : ') 
    205             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_dyn  : ht_i     : ') 
    206             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_dyn  : ht_s     : ') 
    207             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_dyn  : v_i      : ') 
    208             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_dyn  : v_s      : ') 
    209             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_dyn  : e_s      : ') 
    210             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_dyn  : t_su     : ') 
    211             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_dyn  : t_snow   : ') 
    212             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_dyn  : sm_i     : ') 
    213             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_dyn  : smv_i    : ') 
    214             DO ja = 1, nlay_i 
    215                CALL prt_ctl_info(' ') 
    216                CALL prt_ctl_info(' - Layer : ', ivar1=ja) 
    217                CALL prt_ctl_info('   ~~~~~~~') 
    218                CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_dyn  : t_i      : ') 
    219                CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_dyn  : e_i      : ') 
    220             END DO 
     79            WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma )  tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 
    22180         END DO 
    22281      ENDIF 
     82       
     83      ! Rheology (ice dynamics) 
     84      ! ========      
     85      CALL lim_rhg 
    22386      ! 
    224       CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 
    225       CALL wrk_dealloc( jpj, zswitch, zmsk ) 
     87      ! conservation test 
     88      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     89 
     90      ! Control prints 
     91      IF( ln_ctl )       CALL lim_prt3D( 'limdyn' ) 
    22692      ! 
    22793      IF( nn_timing == 1 )  CALL timing_stop('limdyn') 
     
    243109      !!------------------------------------------------------------------- 
    244110      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    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 
     111      NAMELIST/namicedyn/ nn_limadv, nn_limadv_ord,  & 
     112         &                nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio, rn_creepl, rn_ecc, & 
     113         &                nn_nevp, rn_relast, ln_landfast, rn_gamma, rn_icebfr, rn_lfrelax 
    249114      !!------------------------------------------------------------------- 
    250115 
     
    262127         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics ' 
    263128         WRITE(numout,*) '~~~~~~~~~~~~' 
    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 
     129         ! limtrp 
     130         WRITE(numout,*)'    choose the advection scheme (-1=Prather, 0=Ulimate-Macho)   nn_limadv     = ', nn_limadv  
     131         WRITE(numout,*)'    choose the order of the scheme (if ultimate)                nn_limadv_ord = ', nn_limadv_ord   
     132         ! limrhg 
     133         WRITE(numout,*)'    ice strength parameterization (0=Hibler 1=Rothrock)         nn_icestr     = ', nn_icestr  
     134         WRITE(numout,*)'    Including brine volume in ice strength comp.                ln_icestr_bvf = ', ln_icestr_bvf 
     135         WRITE(numout,*)'    Ratio of ridging work to PotEner change in ridging          rn_pe_rdg     = ', rn_pe_rdg  
     136         WRITE(numout,*) '   drag coefficient for oceanic stress                         rn_cio        = ', rn_cio 
     137         WRITE(numout,*) '   first bulk-rheology parameter                               rn_pstar      = ', rn_pstar 
     138         WRITE(numout,*) '   second bulk-rhelogy parameter                               rn_crhg       = ', rn_crhg 
     139         WRITE(numout,*) '   creep limit                                                 rn_creepl     = ', rn_creepl 
     140         WRITE(numout,*) '   eccentricity of the elliptical yield curve                  rn_ecc        = ', rn_ecc 
     141         WRITE(numout,*) '   number of iterations for subcycling                         nn_nevp       = ', nn_nevp 
     142         WRITE(numout,*) '   ratio of elastic timescale over ice time step               rn_relast     = ', rn_relast 
     143         WRITE(numout,*) '   Landfast: param (T or F)                                    ln_landfast   = ', ln_landfast 
     144         WRITE(numout,*) '   Landfast: fraction of ocean depth that ice must reach       rn_gamma      = ', rn_gamma 
     145         WRITE(numout,*) '   Landfast: maximum bottom stress per unit area of contact    rn_icebfr     = ', rn_icebfr 
     146         WRITE(numout,*) '   Landfast: relax time scale (s-1) to reach static friction   rn_lfrelax    = ', rn_lfrelax 
    276147      ENDIF 
    277148      ! 
    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  
    324149   END SUBROUTINE lim_dyn_init 
    325150 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r6490 r7646  
    77   !!             -   !  2001-05 (G. Madec, R. Hordoir) opa norm 
    88   !!            1.0  !  2002-08 (C. Ethe)  F90, free form 
    9    !!            3.0  !  2015-08 (O. Tintó and M. Castrillo)  added lim_hdf (multiple) 
     9   !!            3.6  !  2015-08 (O. Tintó and M. Castrillo)  added lim_hdf (multiple) 
    1010   !!---------------------------------------------------------------------- 
    1111#if defined key_lim3 
     
    2828   PRIVATE 
    2929 
    30    PUBLIC   lim_hdf ! called by lim_trp 
     30   PUBLIC   lim_hdf         ! called by lim_trp 
    3131   PUBLIC   lim_hdf_init    ! called by sbc_lim_init 
    3232 
    3333   LOGICAL  ::   linit = .TRUE.                             ! initialization flag (set to flase after the 1st call) 
    34    INTEGER  ::   nn_convfrq                                 !:  convergence check frequency of the Crant-Nicholson scheme 
    3534   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient 
    3635 
     
    4443CONTAINS 
    4544 
    46    SUBROUTINE lim_hdf( ptab , ihdf_vars , jpl , nlay_i ) 
     45   SUBROUTINE lim_hdf( ptab, ihdf_vars ) 
    4746      !!------------------------------------------------------------------- 
    4847      !!                  ***  ROUTINE lim_hdf  *** 
     
    5554      !! ** Action  :    update ptab with the diffusive contribution 
    5655      !!------------------------------------------------------------------- 
    57       INTEGER                           :: jpl, nlay_i, isize, ihdf_vars 
    58       REAL(wp),  DIMENSION(:,:,:), INTENT( inout ),TARGET ::   ptab    ! Field on which the diffusion is applied 
    59       ! 
    60       INTEGER                           ::  ji, jj, jk, jl , jm               ! dummy loop indices 
    61       INTEGER                           ::  iter, ierr           ! local integers 
    62       REAL(wp)                          ::  zrlxint     ! local scalars 
    63       REAL(wp), POINTER , DIMENSION ( : )        :: zconv     ! local scalars 
    64       REAL(wp), POINTER , DIMENSION(:,:,:) ::  zrlx,zdiv0, ztab0 
    65       REAL(wp), POINTER , DIMENSION(:,:) ::  zflu, zflv, zdiv 
    66       CHARACTER(lc)                     ::  charout                   ! local character 
    67       REAL(wp), PARAMETER               ::  zrelax = 0.5_wp           ! relaxation constant for iterative procedure 
    68       REAL(wp), PARAMETER               ::  zalfa  = 0.5_wp           ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 
    69       INTEGER , PARAMETER               ::  its    = 100              ! Maximum number of iteration 
     56      INTEGER,                    INTENT( in )            ::  ihdf_vars ! number of fields to diffuse 
     57      REAL(wp), DIMENSION(:,:,:), INTENT( inout ), TARGET ::  ptab      ! Field on which the diffusion is applied 
     58      ! 
     59      INTEGER                             ::  ji, jj, jk, jl, jm        ! dummy loop indices 
     60      INTEGER                             ::  iter, ierr, isize         ! local integers 
     61      REAL(wp)                            ::  zrlxint 
     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                 ::  num_iter_max = 100        ! Maximum number of iteration 
     66      INTEGER , PARAMETER                 ::  num_convfrq  = 5          ! convergence check frequency of the Crant-Nicholson scheme (perf. optimization) 
     67      REAL(wp), POINTER, DIMENSION(:)     ::  zconv 
     68      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zrlx, zdiv0, ztab0 
     69      REAL(wp), POINTER, DIMENSION(:,:)   ::  zflu, zflv, zdiv 
    7070      !!------------------------------------------------------------------- 
    7171      TYPE(arrayptr)   , ALLOCATABLE, DIMENSION(:) ::   pt2d_array, zrlx_array 
    72       CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) ::   type_array ! define the nature of ptab array grid-points 
    73       !                                                            ! = T , U , V , F , W and I points 
    74       REAL(wp)        , ALLOCATABLE, DIMENSION(:)  ::   psgn_array    ! =-1 the sign change across the north fold boundary 
    75  
    76      !!---------------------------------------------------------------------  
    77  
     72      CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) ::   type_array      ! define the nature of ptab array grid-points 
     73      !                                                                 ! = T , U , V , F , W and I points 
     74      REAL(wp)         , ALLOCATABLE, DIMENSION(:) ::   psgn_array      ! =-1 the sign change across the north fold boundary 
     75      !!------------------------------------------------------------------- 
     76       
    7877      !                       !==  Initialisation  ==! 
    7978      ! +1 open water diffusion 
    80       isize = jpl*(ihdf_vars+nlay_i)+1 
     79      isize = jpl * ( ihdf_vars + nlay_i ) + 1 
    8180      ALLOCATE( zconv (isize) ) 
    8281      ALLOCATE( pt2d_array(isize) , zrlx_array(isize) ) 
    8382      ALLOCATE( type_array(isize) ) 
    8483      ALLOCATE( psgn_array(isize) ) 
     84 
     85      CALL wrk_alloc( jpi,jpj,       zflu, zflv, zdiv ) 
     86      CALL wrk_alloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 ) 
    8587       
    86       CALL wrk_alloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 
    87       CALL wrk_alloc( jpi, jpj, zflu, zflv, zdiv ) 
    88  
    89       DO jk= 1 , isize 
    90          pt2d_array(jk)%pt2d=>ptab(:,:,jk) 
    91          zrlx_array(jk)%pt2d=>zrlx(:,:,jk) 
    92          type_array(jk)='T' 
    93          psgn_array(jk)=1. 
     88      DO jk= 1, isize 
     89         pt2d_array(jk)%pt2d => ptab(:,:,jk) 
     90         zrlx_array(jk)%pt2d => zrlx(:,:,jk) 
     91         type_array(jk) = 'T' 
     92         psgn_array(jk) = 1. 
    9493      END DO 
    9594 
     
    9998         IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    10099         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' ) 
    101          DO jj = 2, jpjm1 
     100         DO jj = 2, jpjm1   
    102101            DO ji = fs_2 , fs_jpim1   ! vector opt. 
    103102               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj) 
     
    106105         linit = .FALSE. 
    107106      ENDIF 
    108       !                             ! Time integration parameters 
    109       ! 
    110       zflu (jpi,: ) = 0._wp 
    111       zflv (jpi,: ) = 0._wp 
    112  
     107      ! 
     108      ! Arrays initialization 
     109      zflu(jpi,:) = 0._wp    
     110      zflv(jpi,:) = 0._wp 
    113111      DO jk=1 , isize 
    114          ztab0(:, : , jk ) = ptab(:,:,jk)      ! Arrays initialization 
     112         ztab0(:, : , jk ) = ptab(:,:,jk) 
    115113         zdiv0(:, 1 , jk ) = 0._wp 
    116114         zdiv0(:,jpj, jk ) = 0._wp 
     
    119117      END DO 
    120118 
    121       zconv = 1._wp           !==  horizontal diffusion using a Crant-Nicholson scheme  ==! 
    122       iter  = 0 
    123       ! 
    124       DO WHILE( MAXVAL(zconv(:)) > ( 2._wp * 1.e-04 ) .AND. iter <= its )   ! Sub-time step loop 
     119      !                !==  horizontal diffusion using a Crant-Nicholson scheme  ==! 
     120      zconv(:) = 1._wp 
     121      iter     = 0 
     122      ! 
     123      DO WHILE( MAXVAL( zconv(:) ) > ( 2._wp * 1.e-04 ) .AND. iter <= num_iter_max )   ! Sub-time step loop 
    125124         ! 
    126125         iter = iter + 1                                 ! incrementation of the sub-time step number 
    127126         ! 
    128127         DO jk = 1 , isize 
    129             jl = (jk-1) /( ihdf_vars+nlay_i)+1 
    130             IF (zconv(jk) > ( 2._wp * 1.e-04 )) THEN 
     128            jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1 
     129            IF ( zconv(jk) > ( 2._wp * 1.e-04 ) ) THEN 
    131130               DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    132131                  DO ji = 1 , fs_jpim1   ! vector opt. 
     
    159158         CALL lbc_lnk_multi( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 
    160159         ! 
    161          IF ( MOD( iter-1 , nn_convfrq ) == 0 )  THEN   !Convergence test every nn_convfrq iterations (perf. optimization )  
    162             DO jk=1,isize 
     160 
     161         IF ( MOD( iter-1 , num_convfrq ) == 0 )  THEN   ! Convergence test every num_convfrq iterations (perf. optimization )  
     162            DO jk = 1, isize 
    163163               zconv(jk) = 0._wp                                   ! convergence test 
    164164               DO jj = 2, jpjm1 
     
    175175         END DO 
    176176         ! 
    177       END DO                                       ! end of sub-time step loop 
    178  
    179      ! ----------------------- 
    180       !!! final step (clem) !!! 
     177      END DO  ! end of sub-time step loop 
     178 
     179     ! --- final step --- ! 
    181180      DO jk = 1, isize 
    182          jl = (jk-1) /( ihdf_vars+nlay_i)+1 
     181         jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1 
    183182         DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    184183            DO ji = 1 , fs_jpim1   ! vector opt. 
     
    198197      CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 
    199198 
    200       !!! final step (clem) !!! 
    201       ! ----------------------- 
    202  
     199      ! 
    203200      IF(ln_ctl)   THEN 
    204201         DO jk = 1 , isize 
     
    209206      ENDIF 
    210207      ! 
    211       CALL wrk_dealloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 
    212       CALL wrk_dealloc( jpi, jpj, zflu, zflv, zdiv ) 
    213  
     208      CALL wrk_dealloc( jpi,jpj,       zflu, zflv, zdiv ) 
     209      CALL wrk_dealloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 ) 
     210      ! 
    214211      DEALLOCATE( zconv ) 
    215212      DEALLOCATE( pt2d_array , zrlx_array ) 
     
    219216   END SUBROUTINE lim_hdf 
    220217 
    221  
    222218    
    223219   SUBROUTINE lim_hdf_init 
     
    232228      !!------------------------------------------------------------------- 
    233229      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    234       NAMELIST/namicehdf/ nn_convfrq  
    235       !!------------------------------------------------------------------- 
    236       ! 
    237       IF(lwp) THEN 
    238          WRITE(numout,*) 
    239          WRITE(numout,*) 'lim_hdf : Ice horizontal diffusion' 
    240          WRITE(numout,*) '~~~~~~~' 
    241       ENDIF 
     230      NAMELIST/namicehdf/ nn_ahi0, rn_ahi0_ref 
     231      INTEGER  ::   ji, jj 
     232      REAL(wp) ::   za00, zd_max 
     233      !!------------------------------------------------------------------- 
    242234      ! 
    243235      REWIND( numnam_ice_ref )              ! Namelist namicehdf in reference namelist : Ice horizontal diffusion 
     
    252244      IF(lwp) THEN                          ! control print 
    253245         WRITE(numout,*) 
    254          WRITE(numout,*)'   Namelist of ice parameters for ice horizontal diffusion computation ' 
    255          WRITE(numout,*)'      convergence check frequency of the Crant-Nicholson scheme   nn_convfrq   = ', nn_convfrq 
     246         WRITE(numout,*) 'lim_hdf_init : Ice horizontal diffusion' 
     247         WRITE(numout,*) '~~~~~~~~~~~' 
     248         WRITE(numout,*) '   horizontal diffusivity calculation                          nn_ahi0      = ', nn_ahi0 
     249         WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)                  rn_ahi0_ref  = ', rn_ahi0_ref 
    256250      ENDIF 
     251      ! 
     252      !  Diffusion coefficients 
     253      SELECT CASE( nn_ahi0 ) 
     254 
     255      CASE( 0 ) 
     256         ahiu(:,:) = rn_ahi0_ref 
     257         ahiv(:,:) = rn_ahi0_ref 
     258 
     259         IF(lwp) WRITE(numout,*) '' 
     260         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim constant = rn_ahi0_ref' 
     261 
     262      CASE( 1 )  
     263 
     264         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
     265         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain 
     266          
     267         ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 
     268                                                        !                    (60deg = min latitude for ice cover)   
     269         ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 
     270 
     271         IF(lwp) WRITE(numout,*) '' 
     272         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')' 
     273         IF(lwp) WRITE(numout,*) '   value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp  
     274          
     275      CASE( 2 )  
     276 
     277         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
     278         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain 
     279          
     280         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 
     281                                                 !                    (60deg = min latitude for ice cover)   
     282         DO jj = 1, jpj 
     283            DO ji = 1, jpi 
     284               ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 
     285               ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 
     286            END DO 
     287         END DO 
     288         ! 
     289         IF(lwp) WRITE(numout,*) '' 
     290         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1' 
     291         IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 
     292          
     293      END SELECT 
    257294      ! 
    258295   END SUBROUTINE lim_hdf_init 
     
    265302   !!====================================================================== 
    266303END MODULE limhdf 
    267  
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r6695 r7646  
    55   !!====================================================================== 
    66   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code 
    7    !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     7   !!            3.0  ! 2011-02 (G. Madec) dynamical allocation 
    88   !!             -   ! 2014    (C. Rousset) add N/S initializations 
    99   !!---------------------------------------------------------------------- 
     
    2323   USE ice              ! sea-ice variables 
    2424   USE par_oce          ! ocean parameters 
    25    USE dom_ice          ! sea-ice domain 
    2625   USE limvar           ! lim_var_salprof 
     26   ! 
    2727   USE in_out_manager   ! I/O manager 
    2828   USE lib_mpp          ! MPP library 
     
    3636 
    3737   PUBLIC   lim_istate      ! routine called by lim_init.F90 
    38  
    39    !                          !!** init namelist (namiceini) ** 
    40    REAL(wp) ::   rn_thres_sst   ! threshold water temperature for initial sea ice 
    41    REAL(wp) ::   rn_hts_ini_n   ! initial snow thickness in the north 
    42    REAL(wp) ::   rn_hts_ini_s   ! initial snow thickness in the south 
    43    REAL(wp) ::   rn_hti_ini_n   ! initial ice thickness in the north 
    44    REAL(wp) ::   rn_hti_ini_s   ! initial ice thickness in the south 
    45    REAL(wp) ::   rn_ati_ini_n   ! initial leads area in the north 
    46    REAL(wp) ::   rn_ati_ini_s   ! initial leads area in the south 
    47    REAL(wp) ::   rn_smi_ini_n   ! initial salinity  
    48    REAL(wp) ::   rn_smi_ini_s   ! initial salinity 
    49    REAL(wp) ::   rn_tmi_ini_n   ! initial temperature 
    50    REAL(wp) ::   rn_tmi_ini_s   ! initial temperature 
    5138 
    5239   INTEGER , PARAMETER ::   jpfldi = 6           ! maximum number of files to read 
     
    5744   INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temp at T-point 
    5845   INTEGER , PARAMETER ::   jp_smi = 6           ! index of ice sali at T-point 
    59    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si    ! structure of input fields (file informations, fields read) 
    60  
    61    LOGICAL  ::  ln_iceini        ! initialization or not 
    62    LOGICAL  ::  ln_iceini_file   ! Ice initialization state from 2D netcdf file 
     46   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    6347   !!---------------------------------------------------------------------- 
    6448   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
     
    7458      !! ** Purpose :   defined the sea-ice initial state 
    7559      !! 
    76       !! ** Method  :    
    77       !!                This routine will put some ice where ocean 
     60      !! ** Method  :   This routine will put some ice where ocean 
    7861      !!                is at the freezing point, then fill in ice  
    7962      !!                state variables using prescribed initial  
    8063      !!                values in the namelist             
    8164      !! 
    82       !! ** Steps   :    
    83       !!                1) Read namelist 
     65      !! ** Steps   :   1) Read namelist 
    8466      !!                2) Basal temperature; ice and hemisphere masks 
    8567      !!                3) Fill in the ice thickness distribution using gaussian 
     
    9678      !!   4.0  !  09-11  (M. Vancoppenolle)   Enhanced version for ice cats 
    9779      !!-------------------------------------------------------------------- 
    98  
    99       !! * Local variables 
    100       INTEGER    :: ji, jj, jk, jl             ! dummy loop indices 
    101       REAL(wp)   :: ztmelts, zdh 
    102       INTEGER    :: i_hemis, i_fill, jl0   
    103       REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv  
     80      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
     81      REAL(wp) :: ztmelts, zdh 
     82      INTEGER  :: i_hemis, i_fill, jl0   
     83      REAL(wp)   :: zarg, zV, zconv, zdv  
    10484      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator 
    10585      REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, zat_i_ini, zvt_i_ini            !data from namelist or nc file 
    10686      REAL(wp), POINTER, DIMENSION(:,:)   :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
    107       REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini, zv_i_ini               !data by cattegories to fill 
    108       !-------------------------------------------------------------------- 
    109  
    110       CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     87      REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini                         !data by cattegories to fill 
     88      INTEGER , POINTER, DIMENSION(:)     :: itest 
     89      !-------------------------------------------------------------------- 
     90 
     91      CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini ) 
    11192      CALL wrk_alloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    11293      CALL wrk_alloc( jpi, jpj,      zswitch ) 
     94      Call wrk_alloc( 4,             itest ) 
    11395 
    11496      IF(lwp) WRITE(numout,*) 
    115       IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
    116       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
     97      IF(lwp) WRITE(numout,*) 'lim_istate : sea-ice initialization ' 
     98      IF(lwp) WRITE(numout,*) '~~~~~~~~~~ ' 
    11799 
    118100      !-------------------------------------------------------------------- 
    119101      ! 1) Read namelist 
    120102      !-------------------------------------------------------------------- 
    121  
    122       CALL lim_istate_init     !  reading the initials parameters of the ice 
    123  
    124       ! surface temperature 
    125       DO jl = 1, jpl ! loop over categories 
     103      ! 
     104      CALL lim_istate_init 
     105 
     106      ! init surface temperature 
     107      DO jl = 1, jpl 
    126108         t_su  (:,:,jl) = rt0 * tmask(:,:,1) 
    127109         tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 
    128110      END DO 
    129111 
    130       ! basal temperature (considered at freezing point) 
     112      ! init basal temperature (considered at freezing point) 
    131113      CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 
    132114      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
    133115 
    134116 
    135       IF( ln_iceini ) THEN 
    136  
    137          !-------------------------------------------------------------------- 
    138          ! 2) Basal temperature, ice mask and hemispheric index 
    139          !-------------------------------------------------------------------- 
    140  
    141          DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    142             DO ji = 1, jpi 
    143                IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
    144                   zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice 
    145                ELSE                                                                                    
    146                   zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice 
    147                ENDIF 
    148             END DO 
    149          END DO 
    150  
    151          !-------------------------------------------------------------------- 
    152          ! 3) Initialization of sea ice state variables 
    153          !-------------------------------------------------------------------- 
    154          IF( ln_iceini_file )THEN 
    155  
     117      !-------------------------------------------------------------------- 
     118      ! 2) Initialization of sea ice state variables 
     119      !-------------------------------------------------------------------- 
     120      IF( ln_limini ) THEN 
     121         ! 
     122         IF( ln_limini_file )THEN 
     123         ! 
    156124            zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1) 
    157125            zht_s_ini(:,:)  = si(jp_hts)%fnow(:,:,1) 
     
    160128            ztm_i_ini(:,:)  = si(jp_tmi)%fnow(:,:,1) 
    161129            zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1) 
    162  
    163          ELSE ! ln_iceini_file = F 
     130            ! 
     131            WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1)  
     132            ELSEWHERE                       ; zswitch(:,:) = 0._wp 
     133            END WHERE 
     134            ! 
     135         ELSE ! ln_limini_file = F 
     136 
     137            !-------------------------------------------------------------------- 
     138            ! 3) Basal temperature, ice mask 
     139            !-------------------------------------------------------------------- 
     140            ! no ice if sst <= t-freez + ttest 
     141            WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp  
     142            ELSEWHERE                                                                  ; zswitch(:,:) = tmask(:,:,1) 
     143            END WHERE 
    164144 
    165145            !----------------------------- 
     
    169149            DO jj = 1, jpj 
    170150               DO ji = 1, jpi 
    171                   IF( fcor(ji,jj) >= 0._wp ) THEN 
    172                      zht_i_ini(ji,jj) = rn_hti_ini_n 
    173                      zht_s_ini(ji,jj) = rn_hts_ini_n 
    174                      zat_i_ini(ji,jj) = rn_ati_ini_n 
    175                      zts_u_ini(ji,jj) = rn_tmi_ini_n 
    176                      zsm_i_ini(ji,jj) = rn_smi_ini_n 
    177                      ztm_i_ini(ji,jj) = rn_tmi_ini_n 
     151                  IF( ff_t(ji,jj) >= 0._wp ) THEN 
     152                     zht_i_ini(ji,jj) = rn_hti_ini_n * zswitch(ji,jj) 
     153                     zht_s_ini(ji,jj) = rn_hts_ini_n * zswitch(ji,jj) 
     154                     zat_i_ini(ji,jj) = rn_ati_ini_n * zswitch(ji,jj) 
     155                     zts_u_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 
     156                     zsm_i_ini(ji,jj) = rn_smi_ini_n * zswitch(ji,jj) 
     157                     ztm_i_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 
    178158                  ELSE 
    179                      zht_i_ini(ji,jj) = rn_hti_ini_s 
    180                      zht_s_ini(ji,jj) = rn_hts_ini_s 
    181                      zat_i_ini(ji,jj) = rn_ati_ini_s 
    182                      zts_u_ini(ji,jj) = rn_tmi_ini_s 
    183                      zsm_i_ini(ji,jj) = rn_smi_ini_s 
    184                      ztm_i_ini(ji,jj) = rn_tmi_ini_s 
     159                     zht_i_ini(ji,jj) = rn_hti_ini_s * zswitch(ji,jj) 
     160                     zht_s_ini(ji,jj) = rn_hts_ini_s * zswitch(ji,jj) 
     161                     zat_i_ini(ji,jj) = rn_ati_ini_s * zswitch(ji,jj) 
     162                     zts_u_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 
     163                     zsm_i_ini(ji,jj) = rn_smi_ini_s * zswitch(ji,jj) 
     164                     ztm_i_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 
    185165                  ENDIF 
    186166               END DO 
    187167            END DO 
    188  
    189          ENDIF ! ln_iceini_file 
    190  
     168            ! 
     169         ENDIF ! ln_limini_file 
     170          
    191171         zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)   ! ice volume 
    192  
    193172         !--------------------------------------------------------------------- 
    194173         ! 3.2) Distribute ice concentration and thickness into the categories 
     
    199178         zh_i_ini(:,:,:) = 0._wp  
    200179         za_i_ini(:,:,:) = 0._wp 
    201          zv_i_ini(:,:,:) = 0._wp 
    202  
     180         ! 
    203181         DO jj = 1, jpj 
    204182            DO ji = 1, jpi 
    205  
     183               ! 
    206184               IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 
    207185 
    208                   ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0 
    209 !                  ztests  = 0  
    210  
    211                   DO i_fill = jpl, 1, -1 
    212  
    213 !                     IF( ztests .NE. 4 ) THEN 
    214                      IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN 
    215                         !---------------------------- 
    216                         ! fill the i_fill categories 
    217                         !---------------------------- 
    218                         ! *** 1 category to fill 
    219                         IF ( i_fill .EQ. 1 ) THEN 
    220                            zh_i_ini(ji,jj,    1)   = zht_i_ini(ji,jj) 
    221                            za_i_ini(ji,jj,    1)   = zat_i_ini(ji,jj) 
    222                            zh_i_ini(ji,jj,2:jpl)   = 0._wp 
    223                            za_i_ini(ji,jj,2:jpl)   = 0._wp 
    224                         ELSE 
    225  
    226                            ! *** >1 categores to fill 
    227                            !--- Ice thicknesses in the i_fill - 1 first categories 
    228                            DO jl = 1, i_fill - 1 
    229                               zh_i_ini(ji,jj,jl) = hi_mean(jl) 
    230                            END DO 
    231                 
    232                            !--- jl0: most likely index where cc will be maximum 
    233                            DO jl = 1, jpl 
    234                               IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. & 
    235                                  & ( zht_i_ini(ji,jj) <= hi_max(jl)   ) ) THEN 
    236                                  jl0 = jl 
    237                               ENDIF 
    238                            END DO 
    239                            jl0 = MIN(jl0, i_fill) 
    240                 
    241                            !--- Concentrations 
    242                            za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 
    243                            DO jl = 1, i_fill - 1 
    244                               IF( jl .NE. jl0 )THEN 
    245                                  zsigma             = 0.5 * zht_i_ini(ji,jj) 
    246                                  zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / zsigma 
    247                                  za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 
    248                               ENDIF 
    249                            END DO 
    250                 
    251                            zA = 0. ! sum of the areas in the jpl categories  
    252                            DO jl = 1, i_fill - 1 
    253                               zA = zA + za_i_ini(ji,jj,jl) 
    254                            END DO 
    255                            za_i_ini(ji,jj,i_fill)   = zat_i_ini(ji,jj) - zA ! ice conc in the last category 
    256                            IF ( i_fill .LT. jpl ) za_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 
    257           
    258                            !--- Ice thickness in the last category 
    259                            zV = 0. ! sum of the volumes of the N-1 categories 
    260                            DO jl = 1, i_fill - 1 
    261                               zV = zV + za_i_ini(ji,jj,jl)*zh_i_ini(ji,jj,jl) 
    262                            END DO 
    263                            zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / za_i_ini(ji,jj,i_fill)  
    264                            IF ( i_fill .LT. jpl ) zh_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 
    265  
    266                            !--- volumes 
    267                            zv_i_ini(ji,jj,:) = za_i_ini(ji,jj,:) * zh_i_ini(ji,jj,:) 
    268                            IF ( i_fill .LT. jpl ) zv_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 
    269  
    270                         ENDIF ! i_fill 
    271  
    272                         !--------------------- 
    273                         ! Compatibility tests 
    274                         !--------------------- 
    275                         ! Test 1: area conservation 
    276                         zA_cons = SUM(za_i_ini(ji,jj,:)) ; zconv = ABS(zat_i_ini(ji,jj) - zA_cons ) 
    277                         IF ( zconv .LT. 1.0e-6 ) THEN 
    278                            ztest_1 = 1 
    279                         ELSE  
    280                           ztest_1 = 0 
    281                         ENDIF 
    282  
    283                         ! Test 2: volume conservation 
    284                         zV_cons = SUM(zv_i_ini(ji,jj,:)) 
    285                         zconv = ABS(zvt_i_ini(ji,jj) - zV_cons) 
    286  
    287                         IF( zconv .LT. 1.0e-6 ) THEN 
    288                            ztest_2 = 1 
    289                         ELSE 
    290                            ztest_2 = 0 
    291                         ENDIF 
    292  
    293                         ! Test 3: thickness of the last category is in-bounds ? 
    294                         IF ( zh_i_ini(ji,jj,i_fill) > hi_max(i_fill-1) ) THEN 
    295                            ztest_3 = 1 
    296                         ELSE 
    297                            ztest_3 = 0 
    298                         ENDIF 
    299  
    300                         ! Test 4: positivity of ice concentrations 
    301                         ztest_4 = 1 
    302                         DO jl = 1, jpl 
    303                            IF ( za_i_ini(ji,jj,jl) .LT. 0._wp ) THEN  
    304                               ztest_4 = 0 
     186                  !--- jl0: most likely index where cc will be maximum 
     187                  jl0 = jpl 
     188                  DO jl = 1, jpl 
     189                     IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 
     190                        jl0 = jl 
     191                        CYCLE 
     192                     ENDIF 
     193                  END DO 
     194                  ! 
     195                  ! initialisation of tests 
     196                  itest(:)  = 0 
     197                   
     198                  i_fill = jpl + 1                                             !==================================== 
     199                  DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories 
     200                     ! iteration                                               !==================================== 
     201                     i_fill = i_fill - 1 
     202 
     203                     ! initialisation of ice variables for each try 
     204                     zh_i_ini(ji,jj,:) = 0._wp  
     205                     za_i_ini(ji,jj,:) = 0._wp 
     206                     itest(:) = 0 
     207                     ! 
     208                     ! *** case very thin ice: fill only category 1 
     209                     IF ( i_fill == 1 ) THEN 
     210                        zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj) 
     211                        za_i_ini(ji,jj,1) = zat_i_ini(ji,jj) 
     212 
     213                     ! *** case ice is thicker: fill categories >1 
     214                     ELSE 
     215 
     216                        ! Fill ice thicknesses in the (i_fill-1) cat by hmean  
     217                        DO jl = 1, i_fill-1 
     218                           zh_i_ini(ji,jj,jl) = hi_mean(jl) 
     219                        END DO 
     220                        ! 
     221                        !--- Concentrations 
     222                        za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 
     223                        DO jl = 1, i_fill - 1 
     224                           IF( jl /= jl0 )THEN 
     225                              zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) ) 
     226                              za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 
    305227                           ENDIF 
    306228                        END DO 
    307  
    308                      ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4 
    309   
    310                      ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 
    311  
    312                   END DO ! i_fill 
    313  
    314                   IF(lwp) THEN  
    315                      WRITE(numout,*) ' ztests : ', ztests 
    316                      IF( ztests .NE. 4 )THEN 
    317                         WRITE(numout,*) 
    318                         WRITE(numout,*) ' !!!! ALERT                  !!! ' 
    319                         WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    320                         WRITE(numout,*) 
    321                         WRITE(numout,*) ' *** ztests is not equal to 4 ' 
    322                         WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    323                         WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 
    324                         WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 
    325                      ENDIF ! ztests .NE. 4 
     229                        ! 
     230                        ! Concentration in the last (i_fill) category 
     231                        za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) ) 
     232 
     233                        ! Ice thickness in the last (i_fill) category 
     234                        zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) ) 
     235                        zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 )  
     236 
     237                        ! clem: correction if concentration of upper cat is greater than lower cat 
     238                        !       (it should be a gaussian around jl0 but sometimes it is not) 
     239                        IF ( jl0 /= jpl ) THEN 
     240                           DO jl = jpl, jl0+1, -1 
     241                              IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN 
     242                                 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl) 
     243                                 zh_i_ini(ji,jj,jl    ) = 0._wp 
     244                                 za_i_ini(ji,jj,jl    ) = 0._wp 
     245                                 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1)  & 
     246                                    &                     + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 ) 
     247                              END IF 
     248                           ENDDO 
     249                        ENDIF 
     250                        ! 
     251                     ENDIF ! case ice is thick or thin 
     252 
     253                     !--------------------- 
     254                     ! Compatibility tests 
     255                     !--------------------- 
     256                     ! Test 1: area conservation 
     257                     zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) ) 
     258                     IF ( zconv < epsi06 ) itest(1) = 1 
     259                      
     260                     ! Test 2: volume conservation 
     261                     zconv = ABS(       zat_i_ini(ji,jj)       * zht_i_ini(ji,jj)   & 
     262                        &        - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) ) 
     263                     IF ( zconv < epsi06 ) itest(2) = 1 
     264                      
     265                     ! Test 3: thickness of the last category is in-bounds ? 
     266                     IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 
     267                      
     268                     ! Test 4: positivity of ice concentrations 
     269                     itest(4) = 1 
     270                     DO jl = 1, i_fill 
     271                        IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0 
     272                     END DO 
     273                     !                                      !============================ 
     274                  END DO                                    ! end iteration on categories 
     275                  !                                         !============================ 
     276                  ! 
     277                  IF( lwp .AND. SUM(itest) /= 4 ) THEN  
     278                     WRITE(numout,*) 
     279                     WRITE(numout,*) ' !!!! ALERT itest is not equal to 4      !!! ' 
     280                     WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
     281                     WRITE(numout,*) 
     282                     WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:) 
     283                     WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 
     284                     WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 
    326285                  ENDIF 
    327        
    328                ENDIF !  zat_i_ini(ji,jj) > 0._wp .AND. zhm_i_ini(ji,jj) > 0._wp 
    329  
    330             ENDDO    
    331          ENDDO    
     286                
     287               ENDIF !  zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp 
     288               ! 
     289            END DO    
     290         END DO    
    332291 
    333292         !--------------------------------------------------------------------- 
     
    373332            smv_i = sm_i * v_i 
    374333         ENDIF 
    375           
     334             
    376335         ! Snow temperature and heat content 
    377336         DO jk = 1, nlay_s 
     
    413372         tn_ice (:,:,:) = t_su (:,:,:) 
    414373 
    415       ELSE ! if ln_iceini=false 
     374      ELSE ! if ln_limini=false 
    416375         a_i  (:,:,:) = 0._wp 
    417376         v_i  (:,:,:) = 0._wp 
     
    436395         END DO 
    437396 
    438       ENDIF ! ln_iceini 
     397      ENDIF ! ln_limini 
    439398       
    440399      at_i (:,:) = 0.0_wp 
     
    486445      sxyage (:,:,:)  = 0._wp 
    487446 
    488  
    489       CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     447!!!clem 
     448!!      ! Output the initial state and forcings 
     449!!      CALL dia_wri_state( 'output.init', nit000 ) 
     450!!!       
     451 
     452      CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini ) 
    490453      CALL wrk_dealloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    491454      CALL wrk_dealloc( jpi, jpj,      zswitch ) 
     455      Call wrk_dealloc( 4,             itest ) 
    492456 
    493457   END SUBROUTINE lim_istate 
     
    518482      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read 
    519483      ! 
    520       NAMELIST/namiceini/ ln_iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  & 
     484      NAMELIST/namiceini/ ln_limini, ln_limini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  & 
    521485         &                rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, & 
    522486         &                rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             & 
     
    544508         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    545509         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    546          WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini 
    547          WRITE(numout,*) '   ice initialization from a netcdf file      ln_iceini_file  = ', ln_iceini_file 
     510         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini     = ', ln_limini 
     511         WRITE(numout,*) '   ice initialization from a netcdf file      ln_limini_file  = ', ln_limini_file 
    548512         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst 
    549513         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n 
     
    559523      ENDIF 
    560524 
    561       IF( ln_iceini_file ) THEN                      ! Ice initialization using input file 
     525      IF( ln_limini_file ) THEN                      ! Ice initialization using input file 
    562526         ! 
    563527         ! set si structure 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r6470 r7646  
    1818   USE thd_ice          ! LIM thermodynamics 
    1919   USE ice              ! LIM variables 
    20    USE dom_ice          ! LIM domain 
    2120   USE limvar           ! LIM 
    2221   USE lbclnk           ! lateral boundary condition - MPP exchanges 
    2322   USE lib_mpp          ! MPP library 
    2423   USE wrk_nemo         ! work arrays 
    25    USE prtctl           ! Print control 
    2624 
    2725   USE in_out_manager   ! I/O manager 
    2826   USE iom              ! I/O manager 
    2927   USE lib_fortran      ! glob_sum 
    30    USE limdiahsb 
    3128   USE timing           ! Timing 
    3229   USE limcons          ! conservation tests 
     30   USE limctl           ! control prints 
    3331 
    3432   IMPLICIT NONE 
     
    7068      !!                ***  ROUTINE lim_itd_me_alloc *** 
    7169      !!---------------------------------------------------------------------! 
    72       ALLOCATE(                                                                     & 
     70      ALLOCATE(                                                                      & 
    7371         !* Variables shared among ridging subroutines 
    74          &      asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl)                    ,     & 
    75          &      aksum(jpi,jpj)                                                ,     & 
    76          &      hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl) , aridge(jpi,jpj,jpl) ,     & 
    77          &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc ) 
     72         &      asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl) , aksum (jpi,jpj)     ,   & 
     73         &      hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl)    , aridge(jpi,jpj,jpl) ,   & 
     74         &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl)    , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc ) 
    7875         ! 
    7976      IF( lim_itd_me_alloc /= 0 )   CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' ) 
     
    127124      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross ) 
    128125 
    129       IF(ln_ctl) THEN 
    130          CALL prt_ctl(tab2d_1=ato_i , clinfo1=' lim_itd_me: ato_i  : ', tab2d_2=at_i   , clinfo2=' at_i    : ') 
    131          CALL prt_ctl(tab2d_1=divu_i, clinfo1=' lim_itd_me: divu_i : ', tab2d_2=delta_i, clinfo2=' delta_i : ') 
    132       ENDIF 
    133  
    134       IF( ln_limdyn ) THEN          !   Start ridging and rafting   ! 
    135  
    136126      ! conservation test 
    137       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     127      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    138128 
    139129      !-----------------------------------------------------------------------------! 
     
    211201            DO ji = 1, jpi 
    212202               za   = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice 
    213                IF( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN  ! would lead to negative ato_i 
    214                   zfac = - ato_i(ji,jj) / za 
     203               IF    ( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN                  ! would lead to negative ato_i 
     204                  zfac          = - ato_i(ji,jj) / za 
    215205                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice  
    216206               ELSEIF( za > 0._wp .AND. za > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN  ! would lead to ato_i > asum 
    217                   zfac = ( asum(ji,jj) - ato_i(ji,jj) ) / za 
     207                  zfac          = ( asum(ji,jj) - ato_i(ji,jj) ) / za 
    218208                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice  
    219209               ENDIF 
     
    259249                  closing_net(ji,jj) = 0._wp 
    260250                  opning     (ji,jj) = 0._wp 
     251                  ato_i      (ji,jj) = MAX( 0._wp, 1._wp - SUM( a_i(ji,jj,:) ) ) 
    261252               ELSE 
    262253                  iterate_ridging    = 1 
     
    292283      ! control prints 
    293284      !-----------------------------------------------------------------------------! 
    294       IF(ln_ctl) THEN  
    295          CALL lim_var_glo2eqv 
    296  
    297          CALL prt_ctl_info(' ') 
    298          CALL prt_ctl_info(' - Cell values : ') 
    299          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    300          CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_itd_me  : cell area :') 
    301          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :') 
    302          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :') 
    303          CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_me  : vt_s      :') 
    304          DO jl = 1, jpl 
    305             CALL prt_ctl_info(' ') 
    306             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    307             CALL prt_ctl_info('   ~~~~~~~~~~') 
    308             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_me  : a_i      : ') 
    309             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_me  : ht_i     : ') 
    310             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_me  : ht_s     : ') 
    311             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_me  : v_i      : ') 
    312             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_me  : v_s      : ') 
    313             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_me  : e_s      : ') 
    314             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_me  : t_su     : ') 
    315             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_me  : t_snow   : ') 
    316             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_me  : sm_i     : ') 
    317             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_me  : smv_i    : ') 
    318             DO jk = 1, nlay_i 
    319                CALL prt_ctl_info(' ') 
    320                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    321                CALL prt_ctl_info('   ~~~~~~~') 
    322                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_me  : t_i      : ') 
    323                CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_me  : e_i      : ') 
    324             END DO 
    325          END DO 
    326       ENDIF 
    327  
    328285      ! conservation test 
    329       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    330  
    331       ENDIF  ! ln_limdyn=.true. 
    332       ! 
     286      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     287 
     288      ! control prints 
     289      IF( ln_ctl )       CALL lim_prt3D( 'limitd_me' ) 
     290 
    333291      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 
    334292      ! 
     
    368326               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
    369327               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    370             END DO 
     328           END DO 
    371329         END DO 
    372330      END DO 
     
    438396      ENDIF 
    439397 
    440       IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions 
     398      ! --- Ridging and rafting participation concentrations --- ! 
     399      IF( ln_rafting .AND. ln_ridging ) THEN 
    441400         ! 
    442401         DO jl = 1, jpl 
     
    445404                  zdummy           = TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) 
    446405                  aridge(ji,jj,jl) = ( 1._wp + zdummy ) * 0.5_wp * athorn(ji,jj,jl) 
    447                   araft (ji,jj,jl) = ( 1._wp - zdummy ) * 0.5_wp * athorn(ji,jj,jl) 
     406                  araft (ji,jj,jl) = athorn(ji,jj,jl) - aridge(ji,jj,jl) 
    448407               END DO 
    449408            END DO 
    450409         END DO 
    451  
    452       ELSE 
     410         ! 
     411      ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN 
    453412         ! 
    454413         DO jl = 1, jpl 
    455414            aridge(:,:,jl) = athorn(:,:,jl) 
     415         END DO 
     416         ! 
     417      ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN 
     418         ! 
     419         DO jl = 1, jpl 
     420            araft(:,:,jl) = athorn(:,:,jl) 
    456421         END DO 
    457422         ! 
     
    657622                  &                            - sm_i(ji,jj,jl1) * vsw(ij) * rhoic * r1_rdtice     ! and get  sm_i  from the ocean  
    658623            ENDIF 
    659              
     624                
    660625            !------------------------------------------             
    661626            ! 3.7 Put the snow somewhere in the ocean 
     
    795760      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing 
    796761      REAL(wp)            ::   zp, z1_3    ! local scalars 
    797       REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here 
     762      REAL(wp), POINTER, DIMENSION(:,:) ::   zworka           ! temporary array used here 
     763      REAL(wp), POINTER, DIMENSION(:,:) ::   zstrp1, zstrp2   ! strength at previous time steps 
    798764      !!---------------------------------------------------------------------- 
    799765 
    800       CALL wrk_alloc( jpi, jpj, zworka ) 
     766      CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 
    801767 
    802768      !------------------------------------------------------------------------------! 
     
    844810         END DO 
    845811    
    846          strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) 
     812         strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) * tmask(:,:,1) 
    847813                         ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 
    848814         ksmooth = 1 
    849815 
    850          !------------------------------------------------------------------------------! 
    851          ! 4) Hibler (1979)' method 
    852          !------------------------------------------------------------------------------! 
     816      !------------------------------------------------------------------------------! 
     817      ! 4) Hibler (1979)' method 
     818      !------------------------------------------------------------------------------! 
    853819      ELSE                      ! kstrngth ne 1:  Hibler (1979) form 
    854820         ! 
    855          strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  ) 
     821         strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  ) * tmask(:,:,1) 
    856822         ! 
    857823         ksmooth = 1 
     
    866832         DO jj = 1, jpj 
    867833            DO ji = 1, jpi 
    868                strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv_i(ji,jj),0.0))) 
     834               strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bvm_i(ji,jj),0.0))) 
    869835            END DO 
    870836         END DO 
     
    880846      IF ( ksmooth == 1 ) THEN 
    881847 
    882          CALL lbc_lnk( strength, 'T', 1. ) 
    883  
    884848         DO jj = 2, jpjm1 
    885849            DO ji = 2, jpim1 
    886                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
     850               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN  
    887851                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & 
    888852                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &   
     
    907871      ! Temporal smoothing 
    908872      !-------------------- 
    909       IF ( numit == nit000 + nn_fsbc - 1 ) THEN 
    910          strp1(:,:) = 0.0             
    911          strp2(:,:) = 0.0             
    912       ENDIF 
    913  
    914873      IF ( ksmooth == 2 ) THEN 
    915874 
    916          CALL lbc_lnk( strength, 'T', 1. ) 
    917  
    918          DO jj = 1, jpj - 1 
    919             DO ji = 1, jpi - 1 
    920                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
     875         IF ( numit == nit000 + nn_fsbc - 1 ) THEN 
     876            zstrp1(:,:) = 0._wp 
     877            zstrp2(:,:) = 0._wp 
     878         ENDIF 
     879 
     880         DO jj = 2, jpjm1 
     881            DO ji = 2, jpim1 
     882               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN  
    921883                  numts_rm = 1 ! number of time steps for the running mean 
    922                   IF ( strp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 
    923                   IF ( strp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 
    924                   zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm 
    925                   strp2(ji,jj) = strp1(ji,jj) 
    926                   strp1(ji,jj) = strength(ji,jj) 
     884                  IF ( zstrp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 
     885                  IF ( zstrp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 
     886                  zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / numts_rm 
     887                  zstrp2(ji,jj) = zstrp1(ji,jj) 
     888                  zstrp1(ji,jj) = strength(ji,jj) 
    927889                  strength(ji,jj) = zp 
    928  
    929890               ENDIF 
    930891            END DO 
    931892         END DO 
    932893 
     894         CALL lbc_lnk( strength, 'T', 1. )      ! Boundary conditions 
     895 
    933896      ENDIF ! ksmooth 
    934897 
    935       CALL lbc_lnk( strength, 'T', 1. )      ! Boundary conditions 
    936  
    937       CALL wrk_dealloc( jpi, jpj, zworka ) 
     898      CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 
    938899      ! 
    939900   END SUBROUTINE lim_itd_me_icestrength 
     
    953914      !!------------------------------------------------------------------- 
    954915      INTEGER :: ios                 ! Local integer output status for namelist read 
    955       NAMELIST/namiceitdme/ rn_cs, rn_fsnowrdg, rn_fsnowrft,              &  
    956         &                   rn_gstar, rn_astar, rn_hstar, ln_rafting, rn_hraft, rn_craft, rn_por_rdg, & 
    957         &                   nn_partfun 
     916      NAMELIST/namiceitdme/ rn_cs, nn_partfun, rn_gstar, rn_astar,             &  
     917        &                   ln_ridging, rn_hstar, rn_por_rdg, rn_fsnowrdg, ln_rafting, rn_hraft, rn_craft, rn_fsnowrft 
    958918      !!------------------------------------------------------------------- 
    959919      ! 
     
    969929      IF (lwp) THEN                          ! control print 
    970930         WRITE(numout,*) 
    971          WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution ' 
    972          WRITE(numout,*)' ~~~~~~~~~~~~~~~' 
     931         WRITE(numout,*)'lim_itd_me_init : ice parameters for mechanical ice redistribution ' 
     932         WRITE(numout,*)'~~~~~~~~~~~~~~~' 
    973933         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        rn_cs       = ', rn_cs  
    974          WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg  
    975          WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft  
     934         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun 
    976935         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar 
    977936         WRITE(numout,*)'   Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar 
     937         WRITE(numout,*)'   Ridging of ice sheets or not                            ln_ridging  = ', ln_ridging 
    978938         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar 
     939         WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg 
     940         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg  
    979941         WRITE(numout,*)'   Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting 
    980942         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft 
    981943         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  rn_craft    = ', rn_craft   
    982          WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg 
    983          WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun 
     944         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft  
    984945      ENDIF 
    985946      ! 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r5407 r7646  
    1818   !!   lim_itd_shiftice : 
    1919   !!---------------------------------------------------------------------- 
    20    USE dom_ice          ! LIM-3 domain 
    2120   USE par_oce          ! ocean parameters 
    2221   USE dom_oce          ! ocean domain 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r6416 r7646  
    99   !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas 
    1010   !!            3.4  !  2011-01  (A. Porter)  dynamical allocation  
    11    !!            3.5  !  2012-08  (R. Benshila)  AGRIF  
     11   !!            3.5  !  2012-08  (R. Benshila)  AGRIF 
     12   !!            3.6  !  2016-06  (C. Rousset) Rewriting + landfast ice + possibility to use mEVP (Bouillon 2013) 
    1213   !!---------------------------------------------------------------------- 
    13 #if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp ) 
     14#if defined key_lim3 
    1415   !!---------------------------------------------------------------------- 
    15    !!   'key_lim3'               OR                     LIM-3 sea-ice model 
    16    !!   'key_lim2' AND NOT 'key_lim2_vp'            EVP LIM-2 sea-ice model 
     16   !!   'key_lim3'                                      LIM-3 sea-ice model 
    1717   !!---------------------------------------------------------------------- 
    1818   !!   lim_rhg       : computes ice velocities 
     
    2424   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2525   USE sbc_ice        ! Surface boundary condition: ice fields 
    26 #if defined key_lim3 
    27    USE ice            ! LIM-3: ice variables 
    28    USE dom_ice        ! LIM-3: ice domain 
    29    USE limitd_me      ! LIM-3:  
    30 #else 
    31    USE ice_2          ! LIM-2: ice variables 
    32    USE dom_ice_2      ! LIM-2: ice domain 
    33 #endif 
     26   USE ice            ! ice variables 
     27   USE limitd_me      ! ice strength 
    3428   USE lbclnk         ! Lateral Boundary Condition / MPP link 
    3529   USE lib_mpp        ! MPP library 
     
    3832   USE prtctl         ! Print control 
    3933   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    40 #if defined key_agrif && defined key_lim2 
    41    USE agrif_lim2_interp 
     34#if defined key_agrif 
     35   USE agrif_lim3_interp 
    4236#endif 
    43 #if defined key_bdy 
    44    USE bdyice_lim 
    45 #endif 
     37   USE bdy_oce   , ONLY: ln_bdy  
     38   USE bdyice_lim  
    4639 
    4740   IMPLICIT NONE 
    4841   PRIVATE 
    4942 
    50    PUBLIC   lim_rhg        ! routine called by lim_dyn (or lim_dyn_2) 
     43   PUBLIC   lim_rhg        ! routine called by lim_dyn 
    5144 
    5245   !! * Substitutions 
     
    5952CONTAINS 
    6053 
    61    SUBROUTINE lim_rhg( k_j1, k_jpj ) 
     54   SUBROUTINE lim_rhg 
    6255      !!------------------------------------------------------------------- 
    6356      !!                 ***  SUBROUTINE lim_rhg  *** 
     
    10699      !!                 e.g. in the Canadian Archipelago 
    107100      !! 
     101      !! ** Notes   : There is the possibility to use mEVP from Bouillon 2013 
     102      !!              (by uncommenting some lines in part 3 and changing alpha and beta parameters) 
     103      !!              but this solution appears very unstable (see Kimmritz et al 2016) 
     104      !! 
    108105      !! References : Hunke and Dukowicz, JPO97 
    109106      !!              Bouillon et al., Ocean Modelling 2009 
     107      !!              Bouillon et al., Ocean Modelling 2013 
    110108      !!------------------------------------------------------------------- 
    111       INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation 
    112       INTEGER, INTENT(in) ::   k_jpj   ! northern j-index for ice computation 
    113       !! 
    114       INTEGER ::   ji, jj   ! dummy loop indices 
    115       INTEGER ::   jter     ! local integers 
     109      INTEGER ::   ji, jj       ! dummy loop indices 
     110      INTEGER ::   jter         ! local integers 
    116111      CHARACTER (len=50) ::   charout 
    117       REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         ! 
    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 
    129  
    130       REAL(wp) ::   zresm         ! Maximal error on ice velocity 
    131       REAL(wp) ::   zintb, zintn  ! dummy argument 
    132  
    133       REAL(wp), POINTER, DIMENSION(:,:) ::   zpresh           ! temporary array for ice strength 
    134       REAL(wp), POINTER, DIMENSION(:,:) ::   zpreshc          ! Ice strength on grid cell corners (zpreshc) 
    135       REAL(wp), POINTER, DIMENSION(:,:) ::   zfrld1, zfrld2   ! lead fraction on U/V points 
    136       REAL(wp), POINTER, DIMENSION(:,:) ::   zmass1, zmass2   ! ice/snow mass on U/V points 
    137       REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points 
    138       REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays 
    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 
    141       REAL(wp), POINTER, DIMENSION(:,:) ::   u_ice2, v_ice1   ! ice u/v component on V/U point 
    142       REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses 
    143       REAL(wp), POINTER, DIMENSION(:,:) ::   zmask            ! mask ocean grid points 
     112 
     113      REAL(wp) ::   zrhoco                                                   ! rau0 * rn_cio 
     114      REAL(wp) ::   zdtevp, z1_dtevp                                         ! time step for subcycling 
     115      REAL(wp) ::   ecc2, z1_ecc2                                            ! square of yield ellipse eccenticity 
     116      REAL(wp) ::   zbeta, zalph1, z1_alph1, zalph2, z1_alph2                ! alpha and beta from Bouillon 2009 and 2013 
     117      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV                            ! ice/snow mass 
     118      REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2            ! temporary scalars 
     119      REAL(wp) ::   zTauO, zTauB, zTauE, zCor, zvel                          ! temporary scalars 
     120 
     121      REAL(wp) ::   zsig1, zsig2                                             ! internal ice stress 
     122      REAL(wp) ::   zresm                                                    ! Maximal error on ice velocity 
     123      REAL(wp) ::   zintb, zintn                                             ! dummy argument 
    144124       
    145       REAL(wp), POINTER, DIMENSION(:,:) ::   zdt              ! tension at centre of grid cells 
    146       REAL(wp), POINTER, DIMENSION(:,:) ::   zds              ! Shear on northeast corner of grid cells 
    147       REAL(wp), POINTER, DIMENSION(:,:) ::   zs1   , zs2      ! Diagonal stress tensor components zs1 and zs2  
    148       REAL(wp), POINTER, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12 
    149       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr   ! Local error on velocity 
    150       REAL(wp), POINTER, DIMENSION(:,:) ::   zpice            ! array used for the calculation of ice surface slope: 
    151                                                               !   ocean surface (ssh_m) if ice is not embedded 
    152                                                               !   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 
     125      REAL(wp), POINTER, DIMENSION(:,:) ::   z1_e1t0, z1_e2t0                ! scale factors 
     126      REAL(wp), POINTER, DIMENSION(:,:) ::   zp_delt                         ! P/delta at T points 
     127      ! 
     128      REAL(wp), POINTER, DIMENSION(:,:) ::   zaU   , zaV                     ! ice fraction on U/V points 
     129      REAL(wp), POINTER, DIMENSION(:,:) ::   zmU_t, zmV_t                    ! ice/snow mass/dt on U/V points 
     130      REAL(wp), POINTER, DIMENSION(:,:) ::   zmf                             ! coriolis parameter at T points 
     131      REAL(wp), POINTER, DIMENSION(:,:) ::   zTauU_ia , ztauV_ia             ! ice-atm. stress at U-V points 
     132      REAL(wp), POINTER, DIMENSION(:,:) ::   zspgU , zspgV                   ! surface pressure gradient at U/V points 
     133      REAL(wp), POINTER, DIMENSION(:,:) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                            
     134      REAL(wp), POINTER, DIMENSION(:,:) ::   zfU   , zfV                     ! internal stresses 
     135       
     136      REAL(wp), POINTER, DIMENSION(:,:) ::   zds                             ! shear 
     137      REAL(wp), POINTER, DIMENSION(:,:) ::   zs1, zs2, zs12                  ! stress tensor components 
     138      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr           ! check convergence 
     139      REAL(wp), POINTER, DIMENSION(:,:) ::   zpice                           ! array used for the calculation of ice surface slope: 
     140                                                                             !   ocean surface (ssh_m) if ice is not embedded 
     141                                                                             !   ice top surface if ice is embedded    
     142      REAL(wp), POINTER, DIMENSION(:,:) ::   zswitchU, zswitchV              ! dummy arrays 
     143      REAL(wp), POINTER, DIMENSION(:,:) ::   zmaskU, zmaskV                  ! mask for ice presence 
     144      REAL(wp), POINTER, DIMENSION(:,:) ::   zfmask, zwf                     ! mask at F points for the ice 
     145 
     146      REAL(wp), PARAMETER               ::   zepsi  = 1.0e-20_wp             ! tolerance parameter 
     147      REAL(wp), PARAMETER               ::   zmmin  = 1._wp                  ! ice mass (kg/m2) below which ice velocity equals ocean velocity 
     148      REAL(wp), PARAMETER               ::   zshlat = 2._wp                  ! boundary condition for sea-ice velocity (2=no slip ; 0=free slip) 
    156149      !!------------------------------------------------------------------- 
    157150 
    158       CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 
    159       CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               ) 
    160       CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
    161       CALL wrk_alloc( jpi,jpj, zs1   , zs2   , zs12   , zresr , zpice                 ) 
    162  
    163 #if  defined key_lim2 && ! defined key_lim2_vp 
    164 # if defined key_agrif 
    165       USE ice_2, vt_s => hsnm 
    166       USE ice_2, vt_i => hicm 
    167 # else 
    168       vt_s => hsnm 
    169       vt_i => hicm 
    170 # endif 
    171       at_i(:,:) = 1. - frld(:,:) 
    172 #endif 
    173 #if defined key_agrif && defined key_lim2  
    174       CALL agrif_rhg_lim2_load      ! First interpolation of coarse values 
     151      CALL wrk_alloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt ) 
     152      CALL wrk_alloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia ) 
     153      CALL wrk_alloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV ) 
     154      CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 
     155      CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 
     156 
     157#if defined key_agrif  
     158      CALL agrif_interp_lim3( 'U', 0, nn_nevp )   ! First interpolation of coarse values 
     159      CALL agrif_interp_lim3( 'V', 0, nn_nevp ) 
    175160#endif 
    176161      ! 
    177162      !------------------------------------------------------------------------------! 
    178       ! 1) Ice strength (zpresh)                                ! 
    179       !------------------------------------------------------------------------------! 
     163      ! 0) mask at F points for the ice 
     164      !------------------------------------------------------------------------------! 
     165      ! ocean/land mask 
     166      DO jj = 1, jpjm1 
     167         DO ji = 1, jpim1      ! NO vector opt. 
     168            zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     169         END DO 
     170      END DO 
     171      CALL lbc_lnk( zfmask, 'F', 1._wp ) 
     172 
     173      ! Lateral boundary conditions on velocity (modify zfmask) 
     174      zwf(:,:) = zfmask(:,:) 
     175      DO jj = 2, jpjm1 
     176         DO ji = fs_2, fs_jpim1   ! vector opt. 
     177            IF( zfmask(ji,jj) == 0._wp ) THEN 
     178               zfmask(ji,jj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) ) 
     179            ENDIF 
     180         END DO 
     181      END DO 
     182      DO jj = 2, jpjm1 
     183         IF( zfmask(1,jj) == 0._wp ) THEN 
     184            zfmask(1  ,jj) = zshlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     185         ENDIF 
     186         IF( zfmask(jpi,jj) == 0._wp ) THEN 
     187            zfmask(jpi,jj) = zshlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     188         ENDIF 
     189      END DO 
     190      DO ji = 2, jpim1 
     191         IF( zfmask(ji,1) == 0._wp ) THEN 
     192            zfmask(ji,1  ) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     193         ENDIF 
     194         IF( zfmask(ji,jpj) == 0._wp ) THEN 
     195            zfmask(ji,jpj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     196         ENDIF 
     197      END DO 
     198      CALL lbc_lnk( zfmask, 'F', 1._wp ) 
     199 
     200      !------------------------------------------------------------------------------! 
     201      ! 1) define some variables and initialize arrays 
     202      !------------------------------------------------------------------------------! 
     203      zrhoco = rau0 * rn_cio  
     204 
     205      ! ecc2: square of yield ellipse eccenticrity 
     206      ecc2    = rn_ecc * rn_ecc 
     207      z1_ecc2 = 1._wp / ecc2 
     208 
     209      ! Time step for subcycling 
     210      zdtevp   = rdt_ice / REAL( nn_nevp ) 
     211      z1_dtevp = 1._wp / zdtevp 
     212 
     213      ! alpha parameters (Bouillon 2009) 
     214      zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp 
     215      zalph2 = zalph1 * z1_ecc2 
     216 
     217      ! alpha and beta parameters (Bouillon 2013) 
     218      !!zalph1 = 40. 
     219      !!zalph2 = 40. 
     220      !!zbeta  = 3000. 
     221      !!zbeta = REAL( nn_nevp )   ! close to classical EVP of Hunke (2001) 
     222 
     223      z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 
     224      z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
     225 
     226      ! Initialise stress tensor  
     227      zs1 (:,:) = stress1_i (:,:)  
     228      zs2 (:,:) = stress2_i (:,:) 
     229      zs12(:,:) = stress12_i(:,:) 
     230 
     231      ! Ice strength 
     232      CALL lim_itd_me_icestrength( nn_icestr ) 
     233 
     234      ! scale factors 
     235      DO jj = 2, jpjm1 
     236         DO ji = fs_2, fs_jpim1 
     237            z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj  ) + e1t(ji,jj  ) ) 
     238            z1_e2t0(ji,jj) = 1._wp / ( e2t(ji  ,jj+1) + e2t(ji,jj  ) ) 
     239         END DO 
     240      END DO 
     241             
    180242      ! 
    181       ! Put every vector to 0 
    182       delta_i(:,:) = 0._wp   ; 
    183       zpresh (:,:) = 0._wp   ;   
    184       zpreshc(:,:) = 0._wp 
    185       u_ice2 (:,:) = 0._wp   ;   v_ice1(:,:) = 0._wp 
    186       divu_i (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp 
    187       shear_i(:,:) = 0._wp 
    188  
    189 #if defined key_lim3 
    190       CALL lim_itd_me_icestrength( nn_icestr )      ! LIM-3: Ice strength on T-points 
    191 #endif 
    192  
    193       DO jj = k_j1 , k_jpj       ! Ice mass and temp variables 
    194          DO ji = 1 , jpi 
    195 #if defined key_lim3 
    196             zpresh(ji,jj) = tmask(ji,jj,1) *  strength(ji,jj) 
    197 #endif 
    198 #if defined key_lim2 
    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) 
    203          END DO 
    204       END DO 
    205  
    206       ! Ice strength on grid cell corners (zpreshc) 
    207       ! needed for calculation of shear stress  
    208       DO jj = k_j1+1, k_jpj-1 
    209          DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1) 
    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 ) 
    215          END DO 
    216       END DO 
    217       CALL lbc_lnk( zpreshc(:,:), 'F', 1. ) 
    218       ! 
    219243      !------------------------------------------------------------------------------! 
    220244      ! 2) Wind / ocean stress, mass terms, coriolis terms 
    221245      !------------------------------------------------------------------------------! 
    222       ! 
    223       !  Wind stress, coriolis and mass terms on the sides of the squares         
    224       !  zfrld1: lead fraction on U-points                                       
    225       !  zfrld2: lead fraction on V-points                                      
    226       !  zmass1: ice/snow mass on U-points                                     
    227       !  zmass2: ice/snow mass on V-points                                    
    228       !  zcorl1: Coriolis parameter on U-points                              
    229       !  zcorl2: Coriolis parameter on V-points                             
    230       !  (ztagnx,ztagny): wind stress on U/V points                        
    231       !  v_oce1: ocean v component on u points                           
    232       !  u_oce2: ocean u component on v points                          
    233246 
    234247      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
     
    242255         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    243256         ! 
    244          zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:) ) * r1_rau0 
     257         zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 
    245258         ! 
    246259      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
     
    248261      ENDIF 
    249262 
    250       DO jj = k_j1+1, k_jpj-1 
     263      DO jj = 2, jpjm1 
    251264         DO ji = fs_2, fs_jpim1 
    252265 
    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) 
    261  
    262             ! Leads area. 
    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 ) 
    265  
    266             ! Mass, coriolis coeff. and currents 
    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 ) 
    273             ! 
    274             ! Ocean has no slip boundary condition 
    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) 
    282  
    283             ! Wind stress at U,V-point 
    284             ztagnx = ( 1. - zfrld1(ji,jj) ) * utau_ice(ji,jj) 
    285             ztagny = ( 1. - zfrld2(ji,jj) ) * vtau_ice(ji,jj) 
    286  
    287             ! Computation of the velocity field taking into account the ice internal interaction. 
    288             ! Terms that are independent of the velocity field. 
    289  
    290             ! SB On utilise maintenant le gradient de la pente de l'ocean 
    291             ! include it later 
    292  
    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) 
    295  
    296             za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx 
    297             za2ct(ji,jj) = ztagny - zmass2(ji,jj) * grav * zdsshy 
     266            ! ice fraction at U-V points 
     267            zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
     268            zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
     269 
     270            ! Ice/snow mass at U-V points 
     271            zm1 = ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) ) 
     272            zm2 = ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) ) 
     273            zm3 = ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) ) 
     274            zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
     275            zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
     276 
     277            ! Ocean currents at U-V points 
     278            v_oceU(ji,jj)   = 0.5_wp * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji+1,jj)    & 
     279               &                       + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 
     280             
     281            u_oceV(ji,jj)   = 0.5_wp * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj+1)    & 
     282               &                       + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 
     283 
     284            ! Coriolis at T points (m*f) 
     285            zmf(ji,jj)      = zm1 * ff_t(ji,jj) 
     286 
     287            ! m/dt 
     288            zmU_t(ji,jj)    = zmassU * z1_dtevp 
     289            zmV_t(ji,jj)    = zmassV * z1_dtevp 
     290 
     291            ! Drag ice-atm. 
     292            zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 
     293            zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 
     294 
     295            ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 
     296            zspgU(ji,jj)    = - zmassU * grav * ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 
     297            zspgV(ji,jj)    = - zmassV * grav * ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 
     298 
     299            ! masks 
     300            zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice 
     301            zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice 
     302 
     303            ! switches 
     304            zswitchU(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassU - zmmin ) ) ! 0 if ice mass < zmmin 
     305            zswitchV(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassV - zmmin ) ) ! 0 if ice mass < zmmin 
    298306 
    299307         END DO 
    300308      END DO 
    301  
     309      CALL lbc_lnk( zmf, 'T', 1. ) 
    302310      ! 
    303311      !------------------------------------------------------------------------------! 
     
    305313      !------------------------------------------------------------------------------! 
    306314      ! 
    307       ! Time step for subcycling 
    308       dtevp  = rdt_ice / nn_nevp 
    309 #if defined key_lim3 
    310       dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice ) 
    311 #else 
    312       dtotel = dtevp / ( 2._wp * telast ) 
    313 #endif 
    314       z1_dtotel = 1._wp / ( 1._wp + dtotel ) 
    315       z1_dtevp  = 1._wp / dtevp 
    316       !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter) 
    317       ecc2 = rn_ecc * rn_ecc 
    318       ecci = 1. / ecc2 
    319  
    320       !-Initialise stress tensor  
    321       zs1 (:,:) = stress1_i (:,:)  
    322       zs2 (:,:) = stress2_i (:,:) 
    323       zs12(:,:) = stress12_i(:,:) 
    324  
    325315      !                                               !----------------------! 
    326316      DO jter = 1 , nn_nevp                           !    loop over jter    ! 
    327317         !                                            !----------------------!         
    328          DO jj = k_j1, k_jpj-1 
    329             zu_ice(:,jj) = u_ice(:,jj)    ! velocity at previous time step 
    330             zv_ice(:,jj) = v_ice(:,jj) 
    331          END DO 
    332  
    333          DO jj = k_j1+1, k_jpj-1 
    334             DO ji = fs_2, fs_jpim1   !RB bug no vect opt due to zmask 
    335  
    336                !   
    337                !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002) 
    338                !- divu_i(:,:), zdt(:,:): divergence and tension at centre of grid cells 
    339                !- zds(:,:): shear on northeast corner of grid cells 
    340                ! 
    341                !- IMPORTANT REMINDER: Dear Gurvan, note that, the way these terms are coded,  
    342                !                      there are many repeated calculations.  
    343                !                      Speed could be improved by regrouping terms. For 
    344                !                      the moment, however, the stress is on clarity of coding to avoid 
    345                !                      bugs (Martin, for Miguel). 
    346                ! 
    347                !- ALSO: arrays zdt, zds and delta could  
    348                !  be removed in the future to minimise memory demand. 
    349                ! 
    350                !- MORE NOTES: Note that we are calculating deformation rates and stresses on the corners of 
    351                !              grid cells, exactly as in the B grid case. For simplicity, the indexation on 
    352                !              the corners is the same as in the B grid. 
    353                ! 
    354                ! 
    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_e1e2t(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_e1e2t(ji,jj) 
    362  
    363                ! 
     318         IF(ln_ctl) THEN   ! Convergence test 
     319            DO jj = 1, jpjm1 
     320               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 
     321               zv_ice(:,jj) = v_ice(:,jj) 
     322            END DO 
     323         ENDIF 
     324 
     325         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
     326         DO jj = 1, jpjm1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 
     327            DO ji = 1, jpim1 
     328 
     329               ! shear at F points 
    364330               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)   & 
    365331                  &         + ( 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_e1e2f(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. 
     332                  &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     333 
     334            END DO 
     335         END DO 
     336         CALL lbc_lnk( zds, 'F', 1. ) 
     337 
     338         DO jj = 2, jpjm1 
     339            DO ji = 2, jpim1 ! no vector loop 
     340 
     341               ! shear**2 at T points (doc eq. A16) 
     342               zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  & 
     343                  &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  & 
     344                  &   ) * 0.25_wp * r1_e1e2t(ji,jj) 
     345               
     346               ! divergence at T points 
     347               zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     348                  &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     349                  &    ) * r1_e1e2t(ji,jj) 
     350               zdiv2 = zdiv * zdiv 
     351                
     352               ! tension at T points 
     353               zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
     354                  &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     355                  &   ) * r1_e1e2t(ji,jj) 
     356               zdt2 = zdt * zdt 
     357                
     358               ! delta at T points 
     359               zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
     360 
     361               ! P/delta at T points 
     362               zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 
     363                
     364               ! stress at T points 
     365               zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv - zdelta ) ) * z1_alph1 
     366               zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 ) ) * z1_alph2 
     367              
     368            END DO 
     369         END DO 
     370         CALL lbc_lnk( zp_delt, 'T', 1. ) 
     371 
     372         DO jj = 1, jpjm1 
     373            DO ji = 1, jpim1 
     374 
     375               ! P/delta at F points 
     376               zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 
     377                
     378               ! stress at F points 
     379               zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 ) * 0.5_wp ) * z1_alph2 
     380 
     381            END DO 
     382         END DO 
     383         CALL lbc_lnk_multi( zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 
     384  
     385 
     386         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
     387         DO jj = 2, jpjm1 
     388            DO ji = fs_2, fs_jpim1                
     389 
     390               ! U points 
     391               zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             & 
     392                  &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    & 
     393                  &                    ) * r1_e2u(ji,jj)                                                                      & 
     394                  &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  & 
     395                  &                    ) * 2._wp * r1_e1u(ji,jj)                                                              & 
     396                  &                  ) * r1_e1e2u(ji,jj) 
     397 
     398               ! V points 
     399               zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             & 
     400                  &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    & 
     401                  &                    ) * r1_e1v(ji,jj)                                                                      & 
     402                  &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  & 
     403                  &                    ) * 2._wp * r1_e2v(ji,jj)                                                              & 
     404                  &                  ) * r1_e1e2v(ji,jj) 
     405 
     406               ! u_ice at V point 
     407               u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     & 
     408                  &                     + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 
     409                
     410               ! v_ice at U point 
     411               v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     & 
     412                  &                     + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 
     413 
     414            END DO 
     415         END DO 
     416         ! 
     417         ! --- Computation of ice velocity --- ! 
     418         !  Bouillon et al. 2013 (eq 47-48) => unstable unless alpha, beta are chosen wisely and large nn_nevp 
     419         !  Bouillon et al. 2009 (eq 34-35) => stable 
     420         IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations 
     421             
     422            DO jj = 2, jpjm1 
     423               DO ji = fs_2, fs_jpim1 
     424 
     425                  ! tau_io/(v_oce - v_ice) 
     426                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
     427                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 
     428 
     429                  ! tau_bottom/v_ice 
     430                  zvel  = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) ) 
     431                  zTauB = - tau_icebfr(ji,jj) / zvel 
     432 
     433                  ! Coriolis at V-points (energy conserving formulation) 
     434                  zCor  = - 0.25_wp * r1_e2v(ji,jj) *  & 
     435                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
     436                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
     437 
     438                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
     439                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 
     440 
     441                  ! landfast switch => 0 = static friction ; 1 = sliding friction 
     442                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     443                   
     444                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 
     445                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                   &  ! previous velocity 
     446                     &                                     + zTauE + zTauO * v_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     447                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast 
     448                     &             + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0 
     449                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin 
     450                     &           ) * zmaskV(ji,jj) 
     451                  ! Bouillon 2013 
     452                  !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) )                  & 
     453                  !!   &           + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj)  & 
     454                  !!   &           ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj) 
     455 
     456               END DO 
     457            END DO 
     458            CALL lbc_lnk( v_ice, 'V', -1. ) 
     459             
     460#if defined key_agrif 
     461!!            CALL agrif_interp_lim3( 'V', jter, nn_nevp ) 
     462            CALL agrif_interp_lim3( 'V' ) 
     463#endif 
     464            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' ) 
     465 
     466            DO jj = 2, jpjm1 
     467               DO ji = fs_2, fs_jpim1 
     468                                
     469                  ! tau_io/(u_oce - u_ice) 
     470                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
     471                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 
     472 
     473                  ! tau_bottom/u_ice 
     474                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) ) 
     475                  zTauB = - tau_icebfr(ji,jj) / zvel 
     476 
     477                  ! Coriolis at U-points (energy conserving formulation) 
     478                  zCor  =   0.25_wp * r1_e1u(ji,jj) *  & 
     479                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
     480                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
     481                   
     482                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
     483                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 
     484 
     485                  ! landfast switch => 0 = static friction ; 1 = sliding friction 
     486                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     487 
     488                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 
     489                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                   &  ! previous velocity 
     490                     &                                     + zTauE + zTauO * u_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     491                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast 
     492                     &             + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0 
     493                     &             ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin  
     494                     &           ) * zmaskU(ji,jj) 
     495                  ! Bouillon 2013 
     496                  !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) )                  & 
     497                  !!   &           + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj)  & 
     498                  !!   &           ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj) 
     499               END DO 
     500            END DO 
     501            CALL lbc_lnk( u_ice, 'U', -1. ) 
     502             
     503#if defined key_agrif 
     504!!            CALL agrif_interp_lim3( 'U', jter, nn_nevp ) 
     505            CALL agrif_interp_lim3( 'U' ) 
     506#endif 
     507            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' ) 
     508 
     509         ELSE ! odd iterations 
     510 
     511            DO jj = 2, jpjm1 
     512               DO ji = fs_2, fs_jpim1 
     513 
     514                  ! tau_io/(u_oce - u_ice) 
     515                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
     516                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 
     517 
     518                  ! tau_bottom/u_ice 
     519                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) ) 
     520                  zTauB = - tau_icebfr(ji,jj) / zvel 
     521 
     522                  ! Coriolis at U-points (energy conserving formulation) 
     523                  zCor  =   0.25_wp * r1_e1u(ji,jj) *  & 
     524                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
     525                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
     526 
     527                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
     528                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 
     529 
     530                  ! landfast switch => 0 = static friction ; 1 = sliding friction 
     531                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     532 
     533                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 
     534                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                   &  ! previous velocity 
     535                     &                                     + zTauE + zTauO * u_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     536                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast 
     537                     &             + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0 
     538                     &             ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin 
     539                     &           ) * zmaskU(ji,jj) 
     540                  ! Bouillon 2013 
     541                  !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) )                  & 
     542                  !!   &           + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj)  & 
     543                  !!   &           ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj) 
     544               END DO 
     545            END DO 
     546            CALL lbc_lnk( u_ice, 'U', -1. ) 
     547             
     548#if defined key_agrif 
     549!!            CALL agrif_interp_lim3( 'U', jter, nn_nevp ) 
     550            CALL agrif_interp_lim3( 'U' ) 
     551#endif 
     552            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' ) 
     553 
     554            DO jj = 2, jpjm1 
     555               DO ji = fs_2, fs_jpim1 
    381556          
    382          DO jj = k_j1+1, k_jpj-1 
    383             DO ji = fs_2, fs_jpim1 
    384  
    385                !- Calculate Delta at centre of grid cells 
    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_e1e2t(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  
    393                !- Calculate Delta on corners 
    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_e1e2f(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_e1e2f(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   
    418          ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 
    419          DO jj = k_j1+1, k_jpj-1 
    420             DO ji = fs_2, fs_jpim1 
    421                !- contribution of zs1, zs2 and zs12 to zf1 
    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_e1e2u(ji,jj) 
    426                ! contribution of zs1, zs2 and zs12 to zf2 
    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_e1e2v(ji,jj) 
    431             END DO 
    432          END DO 
    433          ! 
    434          ! Computation of ice velocity 
    435          ! 
    436          ! Both the Coriolis term and the ice-ocean drag are solved semi-implicitly. 
    437          ! 
    438          IF (MOD(jter,2).eq.0) THEN  
    439  
    440             DO jj = k_j1+1, k_jpj-1 
    441                DO ji = fs_2, fs_jpim1 
    442                   rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 
    443                   z0           = zmass1(ji,jj) * z1_dtevp 
    444  
    445                   ! SB modif because ocean has no slip boundary condition 
    446                   zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji  ,jj)     & 
    447                      &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   & 
    448                      &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
    449                   za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  & 
    450                      &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 
    451                   zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 
    452                   zcca         = z0 + za 
    453                   zccb         = zcorl1(ji,jj) 
    454                   u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
     557                  ! tau_io/(v_oce - v_ice) 
     558                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
     559                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 
     560 
     561                  ! tau_bottom/v_ice 
     562                  zvel  = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) ) 
     563                  ztauB = - tau_icebfr(ji,jj) / zvel 
     564                   
     565                  ! Coriolis at V-points (energy conserving formulation) 
     566                  zCor  = - 0.25_wp * r1_e2v(ji,jj) *  & 
     567                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
     568                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
     569 
     570                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
     571                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 
     572 
     573                  ! landfast switch => 0 = static friction (tau_icebfr > zTauE); 1 = sliding friction 
     574                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     575                   
     576                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 
     577                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                   &  ! previous velocity 
     578                     &                                     + zTauE + zTauO * v_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     579                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast 
     580                     &             + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0 
     581                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin 
     582                     &           ) * zmaskV(ji,jj) 
     583                  ! Bouillon 2013 
     584                  !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) )                  & 
     585                  !!   &           + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj)  & 
     586                  !!   &           ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj) 
    455587               END DO 
    456588            END DO 
    457  
    458             CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    459 #if defined key_agrif && defined key_lim2 
    460             CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
     589            CALL lbc_lnk( v_ice, 'V', -1. ) 
     590             
     591#if defined key_agrif 
     592!!            CALL agrif_interp_lim3( 'V', jter, nn_nevp ) 
     593            CALL agrif_interp_lim3( 'V' ) 
    461594#endif 
    462 #if defined key_bdy 
    463          CALL bdy_ice_lim_dyn( 'U' ) 
    464 #endif          
    465  
    466             DO jj = k_j1+1, k_jpj-1 
    467                DO ji = fs_2, fs_jpim1 
    468  
    469                   rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 
    470                   z0           = zmass2(ji,jj) * z1_dtevp 
    471                   ! SB modif because ocean has no slip boundary condition 
    472                   zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       & 
    473                      &                 + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   & 
    474                      &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
    475                   za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  &  
    476                      &                         ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) ) 
    477                   zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 
    478                   zcca         = z0 + za 
    479                   zccb         = zcorl2(ji,jj) 
    480                   v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    481                END DO 
    482             END DO 
    483  
    484             CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    485 #if defined key_agrif && defined key_lim2 
    486             CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    487 #endif 
    488 #if defined key_bdy 
    489          CALL bdy_ice_lim_dyn( 'V' ) 
    490 #endif          
    491  
    492          ELSE  
    493             DO jj = k_j1+1, k_jpj-1 
    494                DO ji = fs_2, fs_jpim1 
    495                   rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 
    496                   z0           = zmass2(ji,jj) * z1_dtevp 
    497                   ! SB modif because ocean has no slip boundary condition 
    498                   zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       & 
    499                      &                  +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   & 
    500                      &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)    
    501  
    502                   za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  & 
    503                      &                         ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) ) 
    504                   zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 
    505                   zcca         = z0 + za 
    506                   zccb         = zcorl2(ji,jj) 
    507                   v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 
    508                END DO 
    509             END DO 
    510  
    511             CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    512 #if defined key_agrif && defined key_lim2 
    513             CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 
    514 #endif 
    515 #if defined key_bdy 
    516          CALL bdy_ice_lim_dyn( 'V' ) 
    517 #endif          
    518  
    519             DO jj = k_j1+1, k_jpj-1 
    520                DO ji = fs_2, fs_jpim1 
    521                   rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 
    522                   z0           = zmass1(ji,jj) * z1_dtevp 
    523                   zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji,jj)       & 
    524                      &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   & 
    525                      &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
    526  
    527                   za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  & 
    528                      &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 
    529                   zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 
    530                   zcca         = z0 + za 
    531                   zccb         = zcorl1(ji,jj) 
    532                   u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch  
    533                END DO 
    534             END DO 
    535  
    536             CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    537 #if defined key_agrif && defined key_lim2 
    538             CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 
    539 #endif 
    540 #if defined key_bdy 
    541          CALL bdy_ice_lim_dyn( 'U' ) 
    542 #endif          
     595            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' ) 
    543596 
    544597         ENDIF 
    545598          
    546          IF(ln_ctl) THEN 
    547             !---  Convergence test. 
    548             DO jj = k_j1+1 , k_jpj-1 
     599         IF(ln_ctl) THEN   ! Convergence test 
     600            DO jj = 2 , jpjm1 
    549601               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    550602            END DO 
    551             zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) ) 
     603            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 
    552604            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain 
    553605         ENDIF 
    554  
     606         ! 
    555607         !                                                ! ==================== ! 
    556608      END DO                                              !  end loop over jter  ! 
     
    558610      ! 
    559611      !------------------------------------------------------------------------------! 
    560       ! 4) Prevent ice velocities when the ice is thin 
    561       !------------------------------------------------------------------------------! 
    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 
    564       DO jj = k_j1+1, k_jpj-1 
    565          DO ji = fs_2, fs_jpim1 
    566             IF ( vt_i(ji,jj) <= zvmin ) THEN 
    567                u_ice(ji,jj) = u_oce(ji,jj) 
    568                v_ice(ji,jj) = v_oce(ji,jj) 
    569             ENDIF 
     612      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution)  
     613      !------------------------------------------------------------------------------! 
     614      DO jj = 1, jpjm1 
     615         DO ji = 1, jpim1 
     616 
     617            ! shear at F points 
     618            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)   & 
     619               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
     620               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     621 
     622         END DO 
     623      END DO            
     624      CALL lbc_lnk( zds, 'F', 1. ) 
     625       
     626      DO jj = 2, jpjm1 
     627         DO ji = 2, jpim1 ! no vector loop 
     628             
     629            ! tension**2 at T points 
     630            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
     631               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     632               &   ) * r1_e1e2t(ji,jj) 
     633            zdt2 = zdt * zdt 
     634             
     635            ! shear**2 at T points (doc eq. A16) 
     636            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  & 
     637               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  & 
     638               &   ) * 0.25_wp * r1_e1e2t(ji,jj) 
     639             
     640            ! shear at T points 
     641            shear_i(ji,jj) = SQRT( zdt2 + zds2 ) 
     642 
     643            ! divergence at T points 
     644            divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     645               &            + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     646               &            ) * r1_e1e2t(ji,jj) 
     647             
     648            ! delta at T points 
     649            zdelta         = SQRT( divu_i(ji,jj) * divu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
     650            rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 
     651            delta_i(ji,jj) = zdelta + rn_creepl * rswitch 
     652 
    570653         END DO 
    571654      END DO 
    572  
    573       CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. ) 
    574  
    575 #if defined key_agrif && defined key_lim2 
    576       CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' ) 
    577       CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' ) 
    578 #endif 
    579 #if defined key_bdy 
    580       CALL bdy_ice_lim_dyn( 'U' ) 
    581       CALL bdy_ice_lim_dyn( 'V' ) 
    582 #endif          
    583  
    584       DO jj = k_j1+1, k_jpj-1  
    585          DO ji = fs_2, fs_jpim1 
    586             IF ( vt_i(ji,jj) <= zvmin ) THEN 
    587                v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji,  jj-1) ) * e1t(ji+1,jj)     & 
    588                   &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   & 
    589                   &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
    590  
    591                u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     & 
    592                   &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   & 
    593                   &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 
    594             ENDIF  
    595          END DO 
    596       END DO 
    597  
    598       CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. ) 
    599  
    600       ! Recompute delta, shear and div, inputs for mechanical redistribution  
    601       DO jj = k_j1+1, k_jpj-1 
    602          DO ji = fs_2, jpim1   !RB bug no vect opt due to zmask 
    603             !- divu_i(:,:), zdt(:,:): divergence and tension at centre  
    604             !- zds(:,:): shear on northeast corner of grid cells 
    605             IF ( vt_i(ji,jj) <= zvmin ) THEN 
    606  
    607                divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj  ) * u_ice(ji-1,jj  )   & 
    608                   &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji  ,jj-1) * v_ice(ji  ,jj-1)   & 
    609                   &            ) * r1_e1e2t(ji,jj) 
    610  
    611                zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)  & 
    612                   &          -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)  & 
    613                   &         ) * r1_e1e2t(ji,jj) 
    614                ! 
    615                ! SB modif because ocean has no slip boundary condition  
    616                zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  & 
    617                   &          +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  & 
    618                   &         ) * r1_e1e2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) )                                     & 
    619                   &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 
    620  
    621                zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )    & 
    622                   &   + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1) ) * r1_e1e2t(ji,jj) 
    623  
    624                delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )   
    625                delta_i(ji,jj) = delta + rn_creepl 
    626              
    627             ENDIF 
    628          END DO 
    629       END DO 
    630       ! 
    631       !------------------------------------------------------------------------------! 
    632       ! 5) Store stress tensor and its invariants 
    633       !------------------------------------------------------------------------------! 
    634       ! * Invariants of the stress tensor are required for limitd_me 
    635       !   (accelerates convergence and improves stability) 
    636       DO jj = k_j1+1, k_jpj-1 
    637          DO ji = fs_2, fs_jpim1 
    638             zdst           = (  e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)  &    
    639                &              + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1e2t(ji,jj)  
    640             shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 
    641          END DO 
    642       END DO 
    643  
    644       ! Lateral boundary condition 
    645       CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1.,  shear_i(:,:), 'T', 1. ) 
    646  
    647       ! * Store the stress tensor for the next time step 
     655      CALL lbc_lnk_multi( shear_i, 'T', 1., divu_i, 'T', 1., delta_i, 'T', 1. ) 
     656       
     657      ! --- Store the stress tensor for the next time step --- ! 
    648658      stress1_i (:,:) = zs1 (:,:) 
    649659      stress2_i (:,:) = zs2 (:,:) 
    650660      stress12_i(:,:) = zs12(:,:) 
    651  
    652661      ! 
    653       !------------------------------------------------------------------------------! 
    654       ! 6) Control prints of residual and charge ellipse 
     662 
     663      !------------------------------------------------------------------------------! 
     664      ! 5) Control prints of residual and charge ellipse 
    655665      !------------------------------------------------------------------------------! 
    656666      ! 
     
    672682            WRITE(charout,FMT="('lim_rhg  :', I4, I6, I1, I1, A10)") 1000, numit, 0, 0, ' ch. ell. ' 
    673683            CALL prt_ctl_info(charout) 
    674             DO jj = k_j1+1, k_jpj-1 
     684            DO jj = 2, jpjm1 
    675685               DO ji = 2, jpim1 
    676                   IF (zpresh(ji,jj) > 1.0) THEN 
    677                      sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )  
    678                      sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 
     686                  IF (strength(ji,jj) > 1.0) THEN 
     687                     zsig1 = ( zs1(ji,jj) + SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) )  
     688                     zsig2 = ( zs1(ji,jj) - SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) ) 
    679689                     WRITE(charout,FMT="('lim_rhg  :', I4, I4, D23.16, D23.16, D23.16, D23.16, A10)") 
    680690                     CALL prt_ctl_info(charout) 
     
    686696         ENDIF 
    687697      ENDIF 
    688       ! 
    689       CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 
    690       CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               ) 
    691       CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  ) 
    692       CALL wrk_dealloc( jpi,jpj, zs1   , zs2   , zs12   , zresr , zpice                 ) 
     698      !      
     699       
     700      CALL wrk_dealloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt ) 
     701      CALL wrk_dealloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia ) 
     702      CALL wrk_dealloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV ) 
     703      CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 
     704      CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 
    693705 
    694706   END SUBROUTINE lim_rhg 
     
    699711   !!---------------------------------------------------------------------- 
    700712CONTAINS 
    701    SUBROUTINE lim_rhg( k1 , k2 )         ! Dummy routine 
    702       WRITE(*,*) 'lim_rhg: You should not have seen this print! error?', k1, k2 
     713   SUBROUTINE lim_rhg         ! Dummy routine 
     714      WRITE(*,*) 'lim_rhg: You should not have seen this print! error?' 
    703715   END SUBROUTINE lim_rhg 
    704716#endif 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r6140 r7646  
    5353      INTEGER, INTENT(in) ::   kt       ! number of iteration 
    5454      ! 
    55       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    56       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     55      CHARACTER(len=20)   ::   clkt     ! ocean time-step define as a character 
     56      CHARACTER(len=50)   ::   clname   ! ice output restart file name 
    5757      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file  
    5858      !!---------------------------------------------------------------------- 
     
    9191      ENDIF 
    9292      ! 
    93       IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print 
     93      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print 
    9494   END SUBROUTINE lim_rst_opn 
    9595 
     
    105105      INTEGER ::   ji, jj, jk ,jl   ! dummy loop indices 
    106106      INTEGER ::   iter 
    107       CHARACTER(len=15) ::   znam 
    108       CHARACTER(len=1)  ::   zchar, zchar1 
     107      CHARACTER(len=25) ::   znam 
     108      CHARACTER(len=2)  ::   zchar, zchar1 
    109109      REAL(wp), POINTER, DIMENSION(:,:) :: z2d 
    110110      !!---------------------------------------------------------------------- 
     
    128128      ! Prognostic variables  
    129129      DO jl = 1, jpl  
    130          WRITE(zchar,'(I1)') jl 
     130         WRITE(zchar,'(I2.2)') jl 
    131131         znam = 'v_i'//'_htc'//zchar 
    132132         z2d(:,:) = v_i(:,:,jl) 
     
    150150 
    151151      DO jl = 1, jpl  
    152          WRITE(zchar,'(I1)') jl 
     152         WRITE(zchar,'(I2.2)') jl 
    153153         znam = 'tempt_sl1'//'_htc'//zchar 
    154154         z2d(:,:) = e_s(:,:,1,jl) 
     
    157157 
    158158      DO jl = 1, jpl  
    159          WRITE(zchar,'(I1)') jl 
     159         WRITE(zchar,'(I2.2)') jl 
    160160         DO jk = 1, nlay_i  
    161             WRITE(zchar1,'(I1)') jk 
     161            WRITE(zchar1,'(I2.2)') jk 
    162162            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
    163163            z2d(:,:) = e_i(:,:,jk,jl) 
     
    174174      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) 
    175175 
    176       DO jl = 1, jpl  
    177          WRITE(zchar,'(I1)') jl 
    178          znam = 'sxice'//'_htc'//zchar 
    179          z2d(:,:) = sxice(:,:,jl) 
    180          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    181          znam = 'syice'//'_htc'//zchar 
    182          z2d(:,:) = syice(:,:,jl) 
    183          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    184          znam = 'sxxice'//'_htc'//zchar 
    185          z2d(:,:) = sxxice(:,:,jl) 
    186          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    187          znam = 'syyice'//'_htc'//zchar 
    188          z2d(:,:) = syyice(:,:,jl) 
    189          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    190          znam = 'sxyice'//'_htc'//zchar 
    191          z2d(:,:) = sxyice(:,:,jl) 
    192          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    193          znam = 'sxsn'//'_htc'//zchar 
    194          z2d(:,:) = sxsn(:,:,jl) 
    195          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    196          znam = 'sysn'//'_htc'//zchar 
    197          z2d(:,:) = sysn(:,:,jl) 
    198          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    199          znam = 'sxxsn'//'_htc'//zchar 
    200          z2d(:,:) = sxxsn(:,:,jl) 
    201          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    202          znam = 'syysn'//'_htc'//zchar 
    203          z2d(:,:) = syysn(:,:,jl) 
    204          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    205          znam = 'sxysn'//'_htc'//zchar 
    206          z2d(:,:) = sxysn(:,:,jl) 
    207          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    208          znam = 'sxa'//'_htc'//zchar 
    209          z2d(:,:) = sxa(:,:,jl) 
    210          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    211          znam = 'sya'//'_htc'//zchar 
    212          z2d(:,:) = sya(:,:,jl) 
    213          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    214          znam = 'sxxa'//'_htc'//zchar 
    215          z2d(:,:) = sxxa(:,:,jl) 
    216          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    217          znam = 'syya'//'_htc'//zchar 
    218          z2d(:,:) = syya(:,:,jl) 
    219          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    220          znam = 'sxya'//'_htc'//zchar 
    221          z2d(:,:) = sxya(:,:,jl) 
    222          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    223          znam = 'sxc0'//'_htc'//zchar 
    224          z2d(:,:) = sxc0(:,:,jl) 
    225          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    226          znam = 'syc0'//'_htc'//zchar 
    227          z2d(:,:) = syc0(:,:,jl) 
    228          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    229          znam = 'sxxc0'//'_htc'//zchar 
    230          z2d(:,:) = sxxc0(:,:,jl) 
    231          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    232          znam = 'syyc0'//'_htc'//zchar 
    233          z2d(:,:) = syyc0(:,:,jl) 
    234          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    235          znam = 'sxyc0'//'_htc'//zchar 
    236          z2d(:,:) = sxyc0(:,:,jl) 
    237          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    238          znam = 'sxsal'//'_htc'//zchar 
    239          z2d(:,:) = sxsal(:,:,jl) 
    240          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    241          znam = 'sysal'//'_htc'//zchar 
    242          z2d(:,:) = sysal(:,:,jl) 
    243          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    244          znam = 'sxxsal'//'_htc'//zchar 
    245          z2d(:,:) = sxxsal(:,:,jl) 
    246          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    247          znam = 'syysal'//'_htc'//zchar 
    248          z2d(:,:) = syysal(:,:,jl) 
    249          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    250          znam = 'sxysal'//'_htc'//zchar 
    251          z2d(:,:) = sxysal(:,:,jl) 
    252          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    253          znam = 'sxage'//'_htc'//zchar 
    254          z2d(:,:) = sxage(:,:,jl) 
    255          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    256          znam = 'syage'//'_htc'//zchar 
    257          z2d(:,:) = syage(:,:,jl) 
    258          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    259          znam = 'sxxage'//'_htc'//zchar 
    260          z2d(:,:) = sxxage(:,:,jl) 
    261          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    262          znam = 'syyage'//'_htc'//zchar 
    263          z2d(:,:) = syyage(:,:,jl) 
    264          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    265          znam = 'sxyage'//'_htc'//zchar 
    266          z2d(:,:) = sxyage(:,:,jl) 
    267          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    268       END DO 
    269  
    270       CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  ) 
    271       CALL iom_rstput( iter, nitrst, numriw, 'syopw ' ,  syopw  ) 
    272       CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' ,  sxxopw ) 
    273       CALL iom_rstput( iter, nitrst, numriw, 'syyopw' ,  syyopw ) 
    274       CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw ) 
    275  
    276       DO jl = 1, jpl  
    277          WRITE(zchar,'(I1)') jl 
    278          DO jk = 1, nlay_i  
    279             WRITE(zchar1,'(I1)') jk 
    280             znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
    281             z2d(:,:) = sxe(:,:,jk,jl) 
    282             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    283             znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
    284             z2d(:,:) = sye(:,:,jk,jl) 
    285             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    286             znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
    287             z2d(:,:) = sxxe(:,:,jk,jl) 
    288             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    289             znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
    290             z2d(:,:) = syye(:,:,jk,jl) 
    291             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    292             znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
    293             z2d(:,:) = sxye(:,:,jk,jl) 
    294             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    295          END DO 
    296       END DO 
    297  
     176      ! In case Prather scheme is used for advection, write second order moments 
     177      ! ------------------------------------------------------------------------ 
     178      IF( nn_limadv == -1 ) THEN 
     179          
     180         DO jl = 1, jpl  
     181            WRITE(zchar,'(I2.2)') jl 
     182            znam = 'sxice'//'_htc'//zchar 
     183            z2d(:,:) = sxice(:,:,jl) 
     184            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     185            znam = 'syice'//'_htc'//zchar 
     186            z2d(:,:) = syice(:,:,jl) 
     187            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     188            znam = 'sxxice'//'_htc'//zchar 
     189            z2d(:,:) = sxxice(:,:,jl) 
     190            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     191            znam = 'syyice'//'_htc'//zchar 
     192            z2d(:,:) = syyice(:,:,jl) 
     193            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     194            znam = 'sxyice'//'_htc'//zchar 
     195            z2d(:,:) = sxyice(:,:,jl) 
     196            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     197            znam = 'sxsn'//'_htc'//zchar 
     198            z2d(:,:) = sxsn(:,:,jl) 
     199            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     200            znam = 'sysn'//'_htc'//zchar 
     201            z2d(:,:) = sysn(:,:,jl) 
     202            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     203            znam = 'sxxsn'//'_htc'//zchar 
     204            z2d(:,:) = sxxsn(:,:,jl) 
     205            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     206            znam = 'syysn'//'_htc'//zchar 
     207            z2d(:,:) = syysn(:,:,jl) 
     208            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     209            znam = 'sxysn'//'_htc'//zchar 
     210            z2d(:,:) = sxysn(:,:,jl) 
     211            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     212            znam = 'sxa'//'_htc'//zchar 
     213            z2d(:,:) = sxa(:,:,jl) 
     214            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     215            znam = 'sya'//'_htc'//zchar 
     216            z2d(:,:) = sya(:,:,jl) 
     217            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     218            znam = 'sxxa'//'_htc'//zchar 
     219            z2d(:,:) = sxxa(:,:,jl) 
     220            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     221            znam = 'syya'//'_htc'//zchar 
     222            z2d(:,:) = syya(:,:,jl) 
     223            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     224            znam = 'sxya'//'_htc'//zchar 
     225            z2d(:,:) = sxya(:,:,jl) 
     226            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     227            znam = 'sxc0'//'_htc'//zchar 
     228            z2d(:,:) = sxc0(:,:,jl) 
     229            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     230            znam = 'syc0'//'_htc'//zchar 
     231            z2d(:,:) = syc0(:,:,jl) 
     232            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     233            znam = 'sxxc0'//'_htc'//zchar 
     234            z2d(:,:) = sxxc0(:,:,jl) 
     235            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     236            znam = 'syyc0'//'_htc'//zchar 
     237            z2d(:,:) = syyc0(:,:,jl) 
     238            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     239            znam = 'sxyc0'//'_htc'//zchar 
     240            z2d(:,:) = sxyc0(:,:,jl) 
     241            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     242            znam = 'sxsal'//'_htc'//zchar 
     243            z2d(:,:) = sxsal(:,:,jl) 
     244            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     245            znam = 'sysal'//'_htc'//zchar 
     246            z2d(:,:) = sysal(:,:,jl) 
     247            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     248            znam = 'sxxsal'//'_htc'//zchar 
     249            z2d(:,:) = sxxsal(:,:,jl) 
     250            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     251            znam = 'syysal'//'_htc'//zchar 
     252            z2d(:,:) = syysal(:,:,jl) 
     253            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     254            znam = 'sxysal'//'_htc'//zchar 
     255            z2d(:,:) = sxysal(:,:,jl) 
     256            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     257            znam = 'sxage'//'_htc'//zchar 
     258            z2d(:,:) = sxage(:,:,jl) 
     259            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     260            znam = 'syage'//'_htc'//zchar 
     261            z2d(:,:) = syage(:,:,jl) 
     262            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     263            znam = 'sxxage'//'_htc'//zchar 
     264            z2d(:,:) = sxxage(:,:,jl) 
     265            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     266            znam = 'syyage'//'_htc'//zchar 
     267            z2d(:,:) = syyage(:,:,jl) 
     268            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     269            znam = 'sxyage'//'_htc'//zchar 
     270            z2d(:,:) = sxyage(:,:,jl) 
     271            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     272         END DO 
     273 
     274         CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  ) 
     275         CALL iom_rstput( iter, nitrst, numriw, 'syopw ' ,  syopw  ) 
     276         CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' ,  sxxopw ) 
     277         CALL iom_rstput( iter, nitrst, numriw, 'syyopw' ,  syyopw ) 
     278         CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw ) 
     279          
     280         DO jl = 1, jpl  
     281            WRITE(zchar,'(I2.2)') jl 
     282            DO jk = 1, nlay_i  
     283               WRITE(zchar1,'(I2.2)') jk 
     284               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
     285               z2d(:,:) = sxe(:,:,jk,jl) 
     286               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     287               znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
     288               z2d(:,:) = sye(:,:,jk,jl) 
     289               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     290               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
     291               z2d(:,:) = sxxe(:,:,jk,jl) 
     292               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     293               znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
     294               z2d(:,:) = syye(:,:,jk,jl) 
     295               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     296               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
     297               z2d(:,:) = sxye(:,:,jk,jl) 
     298               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     299            END DO 
     300         END DO 
     301 
     302      ENDIF 
     303       
     304      ! close restart file 
     305      ! ------------------ 
    298306      IF( iter == nitrst ) THEN 
    299          CALL iom_close( numriw )                         ! close the restart file 
     307         CALL iom_close( numriw ) 
    300308         lrst_ice = .FALSE. 
    301309      ENDIF 
     
    315323      REAL(wp) ::   zfice, ziter 
    316324      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d 
    317       CHARACTER(len=15) ::   znam 
    318       CHARACTER(len=1)  ::   zchar, zchar1 
     325      CHARACTER(len=25) ::   znam 
     326      CHARACTER(len=2)  ::   zchar, zchar1 
    319327      INTEGER           ::   jlibalt = jprstlib 
    320328      LOGICAL           ::   llok 
     
    347355         &                   '   control of time parameter  nrstdt' ) 
    348356 
     357      ! Prognostic variables  
    349358      DO jl = 1, jpl  
    350          WRITE(zchar,'(I1)') jl 
     359         WRITE(zchar,'(I2.2)') jl 
    351360         znam = 'v_i'//'_htc'//zchar 
    352361         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     
    370379 
    371380      DO jl = 1, jpl  
    372          WRITE(zchar,'(I1)') jl 
     381         WRITE(zchar,'(I2.2)') jl 
    373382         znam = 'tempt_sl1'//'_htc'//zchar 
    374383         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     
    377386 
    378387      DO jl = 1, jpl  
    379          WRITE(zchar,'(I1)') jl 
     388         WRITE(zchar,'(I2.2)') jl 
    380389         DO jk = 1, nlay_i  
    381             WRITE(zchar1,'(I1)') jk 
     390            WRITE(zchar1,'(I2.2)') jk 
    382391            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
    383392            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     
    394403      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) 
    395404 
    396       DO jl = 1, jpl  
    397          WRITE(zchar,'(I1)') jl 
    398          znam = 'sxice'//'_htc'//zchar 
    399          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    400          sxice(:,:,jl) = z2d(:,:) 
    401          znam = 'syice'//'_htc'//zchar 
    402          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    403          syice(:,:,jl) = z2d(:,:) 
    404          znam = 'sxxice'//'_htc'//zchar 
    405          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    406          sxxice(:,:,jl) = z2d(:,:) 
    407          znam = 'syyice'//'_htc'//zchar 
    408          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    409          syyice(:,:,jl) = z2d(:,:) 
    410          znam = 'sxyice'//'_htc'//zchar 
    411          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    412          sxyice(:,:,jl) = z2d(:,:) 
    413          znam = 'sxsn'//'_htc'//zchar 
    414          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    415          sxsn(:,:,jl) = z2d(:,:) 
    416          znam = 'sysn'//'_htc'//zchar 
    417          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    418          sysn(:,:,jl) = z2d(:,:) 
    419          znam = 'sxxsn'//'_htc'//zchar 
    420          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    421          sxxsn(:,:,jl) = z2d(:,:) 
    422          znam = 'syysn'//'_htc'//zchar 
    423          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    424          syysn(:,:,jl) = z2d(:,:) 
    425          znam = 'sxysn'//'_htc'//zchar 
    426          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    427          sxysn(:,:,jl) = z2d(:,:) 
    428          znam = 'sxa'//'_htc'//zchar 
    429          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    430          sxa(:,:,jl) = z2d(:,:) 
    431          znam = 'sya'//'_htc'//zchar 
    432          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    433          sya(:,:,jl) = z2d(:,:) 
    434          znam = 'sxxa'//'_htc'//zchar 
    435          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    436          sxxa(:,:,jl) = z2d(:,:) 
    437          znam = 'syya'//'_htc'//zchar 
    438          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    439          syya(:,:,jl) = z2d(:,:) 
    440          znam = 'sxya'//'_htc'//zchar 
    441          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    442          sxya(:,:,jl) = z2d(:,:) 
    443          znam = 'sxc0'//'_htc'//zchar 
    444          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    445          sxc0(:,:,jl) = z2d(:,:) 
    446          znam = 'syc0'//'_htc'//zchar 
    447          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    448          syc0(:,:,jl) = z2d(:,:) 
    449          znam = 'sxxc0'//'_htc'//zchar 
    450          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    451          sxxc0(:,:,jl) = z2d(:,:) 
    452          znam = 'syyc0'//'_htc'//zchar 
    453          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    454          syyc0(:,:,jl) = z2d(:,:) 
    455          znam = 'sxyc0'//'_htc'//zchar 
    456          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    457          sxyc0(:,:,jl) = z2d(:,:) 
    458          znam = 'sxsal'//'_htc'//zchar 
    459          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    460          sxsal(:,:,jl) = z2d(:,:) 
    461          znam = 'sysal'//'_htc'//zchar 
    462          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    463          sysal(:,:,jl) = z2d(:,:) 
    464          znam = 'sxxsal'//'_htc'//zchar 
    465          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    466          sxxsal(:,:,jl) = z2d(:,:) 
    467          znam = 'syysal'//'_htc'//zchar 
    468          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    469          syysal(:,:,jl) = z2d(:,:) 
    470          znam = 'sxysal'//'_htc'//zchar 
    471          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    472          sxysal(:,:,jl) = z2d(:,:) 
    473          znam = 'sxage'//'_htc'//zchar 
    474          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    475          sxage(:,:,jl) = z2d(:,:) 
    476          znam = 'syage'//'_htc'//zchar 
    477          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    478          syage(:,:,jl) = z2d(:,:) 
    479          znam = 'sxxage'//'_htc'//zchar 
    480          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    481          sxxage(:,:,jl) = z2d(:,:) 
    482          znam = 'syyage'//'_htc'//zchar 
    483          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    484          syyage(:,:,jl) = z2d(:,:) 
    485          znam = 'sxyage'//'_htc'//zchar 
    486          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    487          sxyage(:,:,jl)= z2d(:,:) 
    488       END DO 
    489  
    490       CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  ) 
    491       CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  ) 
    492       CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw ) 
    493       CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw ) 
    494       CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw ) 
    495  
    496       DO jl = 1, jpl  
    497          WRITE(zchar,'(I1)') jl 
    498          DO jk = 1, nlay_i  
    499             WRITE(zchar1,'(I1)') jk 
    500             znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
    501             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    502             sxe(:,:,jk,jl) = z2d(:,:) 
    503             znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
    504             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    505             sye(:,:,jk,jl) = z2d(:,:) 
    506             znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
    507             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    508             sxxe(:,:,jk,jl) = z2d(:,:) 
    509             znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
    510             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    511             syye(:,:,jk,jl) = z2d(:,:) 
    512             znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
    513             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    514             sxye(:,:,jk,jl) = z2d(:,:) 
    515          END DO 
    516       END DO 
    517       ! 
     405      ! In case Prather scheme is used for advection, read second order moments 
     406      ! ------------------------------------------------------------------------ 
     407      IF( nn_limadv == -1 ) THEN 
     408 
     409         DO jl = 1, jpl  
     410            WRITE(zchar,'(I2.2)') jl 
     411            znam = 'sxice'//'_htc'//zchar 
     412            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     413            sxice(:,:,jl) = z2d(:,:) 
     414            znam = 'syice'//'_htc'//zchar 
     415            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     416            syice(:,:,jl) = z2d(:,:) 
     417            znam = 'sxxice'//'_htc'//zchar 
     418            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     419            sxxice(:,:,jl) = z2d(:,:) 
     420            znam = 'syyice'//'_htc'//zchar 
     421            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     422            syyice(:,:,jl) = z2d(:,:) 
     423            znam = 'sxyice'//'_htc'//zchar 
     424            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     425            sxyice(:,:,jl) = z2d(:,:) 
     426            znam = 'sxsn'//'_htc'//zchar 
     427            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     428            sxsn(:,:,jl) = z2d(:,:) 
     429            znam = 'sysn'//'_htc'//zchar 
     430            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     431            sysn(:,:,jl) = z2d(:,:) 
     432            znam = 'sxxsn'//'_htc'//zchar 
     433            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     434            sxxsn(:,:,jl) = z2d(:,:) 
     435            znam = 'syysn'//'_htc'//zchar 
     436            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     437            syysn(:,:,jl) = z2d(:,:) 
     438            znam = 'sxysn'//'_htc'//zchar 
     439            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     440            sxysn(:,:,jl) = z2d(:,:) 
     441            znam = 'sxa'//'_htc'//zchar 
     442            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     443            sxa(:,:,jl) = z2d(:,:) 
     444            znam = 'sya'//'_htc'//zchar 
     445            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     446            sya(:,:,jl) = z2d(:,:) 
     447            znam = 'sxxa'//'_htc'//zchar 
     448            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     449            sxxa(:,:,jl) = z2d(:,:) 
     450            znam = 'syya'//'_htc'//zchar 
     451            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     452            syya(:,:,jl) = z2d(:,:) 
     453            znam = 'sxya'//'_htc'//zchar 
     454            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     455            sxya(:,:,jl) = z2d(:,:) 
     456            znam = 'sxc0'//'_htc'//zchar 
     457            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     458            sxc0(:,:,jl) = z2d(:,:) 
     459            znam = 'syc0'//'_htc'//zchar 
     460            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     461            syc0(:,:,jl) = z2d(:,:) 
     462            znam = 'sxxc0'//'_htc'//zchar 
     463            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     464            sxxc0(:,:,jl) = z2d(:,:) 
     465            znam = 'syyc0'//'_htc'//zchar 
     466            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     467            syyc0(:,:,jl) = z2d(:,:) 
     468            znam = 'sxyc0'//'_htc'//zchar 
     469            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     470            sxyc0(:,:,jl) = z2d(:,:) 
     471            znam = 'sxsal'//'_htc'//zchar 
     472            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     473            sxsal(:,:,jl) = z2d(:,:) 
     474            znam = 'sysal'//'_htc'//zchar 
     475            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     476            sysal(:,:,jl) = z2d(:,:) 
     477            znam = 'sxxsal'//'_htc'//zchar 
     478            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     479            sxxsal(:,:,jl) = z2d(:,:) 
     480            znam = 'syysal'//'_htc'//zchar 
     481            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     482            syysal(:,:,jl) = z2d(:,:) 
     483            znam = 'sxysal'//'_htc'//zchar 
     484            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     485            sxysal(:,:,jl) = z2d(:,:) 
     486            znam = 'sxage'//'_htc'//zchar 
     487            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     488            sxage(:,:,jl) = z2d(:,:) 
     489            znam = 'syage'//'_htc'//zchar 
     490            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     491            syage(:,:,jl) = z2d(:,:) 
     492            znam = 'sxxage'//'_htc'//zchar 
     493            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     494            sxxage(:,:,jl) = z2d(:,:) 
     495            znam = 'syyage'//'_htc'//zchar 
     496            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     497            syyage(:,:,jl) = z2d(:,:) 
     498            znam = 'sxyage'//'_htc'//zchar 
     499            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     500            sxyage(:,:,jl)= z2d(:,:) 
     501         END DO 
     502 
     503         CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  ) 
     504         CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  ) 
     505         CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw ) 
     506         CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw ) 
     507         CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw ) 
     508 
     509         DO jl = 1, jpl  
     510            WRITE(zchar,'(I2.2)') jl 
     511            DO jk = 1, nlay_i  
     512               WRITE(zchar1,'(I2.2)') jk 
     513               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
     514               CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     515               sxe(:,:,jk,jl) = z2d(:,:) 
     516               znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
     517               CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     518               sye(:,:,jk,jl) = z2d(:,:) 
     519               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
     520               CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     521               sxxe(:,:,jk,jl) = z2d(:,:) 
     522               znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
     523               CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     524               syye(:,:,jk,jl) = z2d(:,:) 
     525               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
     526               CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
     527               sxye(:,:,jk,jl) = z2d(:,:) 
     528            END DO 
     529         END DO 
     530         ! 
     531      END IF 
     532       
    518533      ! clem: I do not understand why the following IF is needed 
    519534      !       I suspect something inconsistent in the main code with option nn_icesal=1 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r6416 r7646  
    3434   USE traqsr         ! add penetration of solar flux in the calculation of heat budget 
    3535   USE domvvl         ! Variable volume 
    36    USE limctl         !  
    37    USE limcons        !  
     36   USE limctl         ! 
     37   USE limcons        ! 
     38   USE bdy_oce  , ONLY: ln_bdy 
    3839   ! 
    3940   USE in_out_manager ! I/O manager 
     
    4243   USE lib_mpp        ! MPP library 
    4344   USE wrk_nemo       ! work arrays 
    44    USE prtctl         ! Print control 
    4545   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4646 
     
    4848   PRIVATE 
    4949 
    50    PUBLIC   lim_sbc_init   ! called by sbcice_lim 
     50   PUBLIC   lim_sbc_init   ! called by sbc_lim_init 
    5151   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim 
    5252   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
     
    9494      !!              - fr_i    : ice fraction 
    9595      !!              - tn_ice  : sea-ice surface temperature 
    96       !!              - alb_ice : sea-ice albedo (only useful in coupled mode) 
     96      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode) 
    9797      !! 
    9898      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    109109      REAL(wp), POINTER, DIMENSION(:,:)   ::   zalb                 ! 2D workspace 
    110110      !!--------------------------------------------------------------------- 
    111       ! 
    112       ! make calls for heat fluxes before it is modified 
    113       ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    114       IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
    115       IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface 
    116       IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface 
    117       IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 
    118       IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice 
    119       IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )   
    120       IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   & 
    121          &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 
    122       IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )   
    123       IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )   
    124       IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce(:,:) )   ! emp over ocean (taking into account the snow blown away from the ice) 
    125       IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice(:,:) )   ! emp over ice   (taking into account the snow blown away from the ice) 
    126  
     111 
     112      ! --- case we bypass ice thermodynamics --- ! 
     113      IF( .NOT. ln_limthd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere 
     114         hfx_in   (:,:)   = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     115         hfx_out  (:,:)   = pfrld(:,:) *   qns_oce(:,:)                  + qemp_oce(:,:) 
     116         ftr_ice  (:,:,:) = 0._wp 
     117         emp_ice  (:,:)   = 0._wp 
     118         qemp_ice (:,:)   = 0._wp 
     119         qevap_ice(:,:,:) = 0._wp 
     120      ENDIF 
     121       
    127122      ! albedo output 
    128123      CALL wrk_alloc( jpi,jpj, zalb )     
    129124 
    130125      zalb(:,:) = 0._wp 
    131       WHERE     ( SUM( a_i_b, dim=3 ) <= epsi06 )  ;  zalb(:,:) = 0.066_wp 
    132       ELSEWHERE                                    ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 
     126      WHERE     ( at_i_b <= epsi06 )  ;  zalb(:,:) = 0.066_wp 
     127      ELSEWHERE                       ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
    133128      END WHERE 
    134129      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output 
    135130 
    136       zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ) )       
     131      zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b )       
    137132      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output 
    138133 
     
    180175            ! mass flux from ice/ocean 
    181176            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    182                            + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     177                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj)  
    183178 
    184179            ! mass flux at the ocean/ice interface 
    185180            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model 
    186             emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)             
     181            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    187182         END DO 
    188183      END DO 
     
    192187      !------------------------------------------! 
    193188      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
    194          &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 
     189         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 
    195190 
    196191      !-------------------------------------------------------------! 
     
    221216 
    222217      ! conservation test 
    223       IF( ln_limdiahsb )   CALL lim_cons_final( 'limsbc' ) 
     218      IF( ln_limdiachk .AND. .NOT. ln_bdy)  CALL lim_cons_final( 'limsbc' ) 
    224219 
    225220      ! control prints 
    226       IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
    227       ! 
    228       IF(ln_ctl) THEN 
    229          CALL prt_ctl( tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns , clinfo2=' qns     : ' ) 
    230          CALL prt_ctl( tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=sfx , clinfo2=' sfx     : ' ) 
    231          CALL prt_ctl( tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ' ) 
    232          CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    233       ENDIF 
    234       ! 
     221      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
     222      IF( ln_ctl )      CALL lim_prt3D( 'limsbc' ) 
     223 
    235224   END SUBROUTINE lim_sbc_flx 
    236225 
     
    266255      INTEGER  ::   ji, jj   ! dummy loop indices 
    267256      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar 
    268       REAL(wp) ::   zat_v, zvtau_ice, zv_t          !   -      - 
     257      REAL(wp) ::   zat_v, zvtau_ice, zv_t, zrhoco  !   -      - 
    269258      !!--------------------------------------------------------------------- 
     259      zrhoco = rau0 * rn_cio 
    270260      ! 
    271261      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
     
    278268               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  ) 
    279269               !                                               ! update the ocean stress modulus 
    280                taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * rhoco * zmodt 
    281                tmod_io(ji,jj) = rhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
     270               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 
     271               tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
    282272            END DO 
    283273         END DO 
    284          CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. ) 
     274         CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 
    285275         ! 
    286276         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
     
    303293         END DO 
    304294      END DO 
    305       CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition 
    306       ! 
    307       IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   & 
    308          &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask ) 
     295      CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition 
     296      ! 
    309297      !   
    310298   END SUBROUTINE lim_sbc_tau 
     
    333321      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    334322      sice_0(:,:) = sice 
    335       ! 
    336       IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
    337          WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
    338             &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    339             soce_0(:,:) = 4._wp 
    340             sice_0(:,:) = 2._wp 
    341          END WHERE 
    342       ENDIF 
     323      !                                      ! decrease ocean & ice reference salinities in the Baltic Sea area 
     324      WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     325         &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     326         soce_0(:,:) = 4._wp 
     327         sice_0(:,:) = 2._wp 
     328      END WHERE 
    343329      ! 
    344330      IF( .NOT. ln_rstart ) THEN 
     
    348334            snwice_mass_b(:,:) = snwice_mass(:,:) 
    349335         ELSE 
    350             snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
    351             snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
     336            snwice_mass  (:,:) = 0._wp          ! no mass exchanges 
     337            snwice_mass_b(:,:) = 0._wp          ! no mass exchanges 
    352338         ENDIF 
    353339         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area 
     
    355341            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    356342 
    357 !!gm I really don't like this staff here...  Find a way to put that elsewhere or differently 
     343!!gm I really don't like this stuff here...  Find a way to put that elsewhere or differently 
    358344!!gm 
    359345            IF( .NOT.ln_linssh ) THEN 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r6416 r7646  
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain variables 
    24    USE ice            ! LIM: sea-ice variables 
     24   USE ice            ! sea-ice variables 
    2525   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2626   USE sbc_ice        ! Surface boundary condition: ice fields 
    27    USE dom_ice        ! LIM: sea-ice domain 
    28    USE thd_ice        ! LIM: thermodynamic sea-ice variables 
    29    USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
    30    USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
    31    USE limthd_sal     ! LIM: thermodynamics, ice salinity 
    32    USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution 
    33    USE limthd_lac     ! LIM: lateral accretion 
    34    USE limitd_th      ! LIM: remapping thickness distribution 
    35    USE limtab         ! LIM: 1D <==> 2D transformation 
    36    USE limvar         ! LIM: sea-ice variables 
    37    USE limcons        ! LIM: conservation tests 
    38    USE limctl         ! LIM: control print 
     27   USE thd_ice        ! thermodynamic sea-ice variables 
     28   USE limthd_dif     ! vertical diffusion 
     29   USE limthd_dh      ! ice-snow growth and melt 
     30   USE limthd_da      ! lateral melting 
     31   USE limthd_sal     ! ice salinity 
     32   USE limthd_ent     ! ice enthalpy redistribution 
     33   USE limthd_lac     ! lateral accretion 
     34   USE limitd_th      ! remapping thickness distribution 
     35   USE limtab         ! 1D <==> 2D transformation 
     36   USE limvar         ! 
     37   USE limcons        ! conservation tests 
     38   USE limctl         ! control print 
    3939   ! 
    4040   USE in_out_manager ! I/O manager 
    41    USE prtctl         ! Print control 
    4241   USE lbclnk         ! lateral boundary condition - MPP links 
    4342   USE lib_mpp        ! MPP library 
     
    8887      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
    8988      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
     89      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io, zfric   ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 
     90      ! 
    9091      !!------------------------------------------------------------------- 
    9192 
    9293      IF( nn_timing == 1 )   CALL timing_start('limthd') 
    9394 
     95      CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric ) 
     96 
     97      IF( kt == nit000 .AND. lwp ) THEN 
     98         WRITE(numout,*)''  
     99         WRITE(numout,*)' lim_thd ' 
     100         WRITE(numout,*)' ~~~~~~~~' 
     101      ENDIF 
     102       
    94103      ! conservation test 
    95       IF( ln_limdiahsb )   CALL lim_cons_hsm( 0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
     104      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    96105 
    97106      CALL lim_var_glo2eqv 
    98       !------------------------------------------------------------------------! 
    99       ! 1) Initialization of some variables                                    ! 
    100       !------------------------------------------------------------------------! 
     107 
     108      !---------------------------------------------! 
     109      ! computation of friction velocity at T points 
     110      !---------------------------------------------! 
     111      IF( ln_limdyn ) THEN 
     112         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
     113         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
     114         DO jj = 2, jpjm1  
     115            DO ji = fs_2, fs_jpim1 
     116               zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
     117                  &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
     118                  &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 
     119            END DO 
     120         END DO 
     121      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
     122         DO jj = 2, jpjm1 
     123            DO ji = fs_2, fs_jpim1 
     124               zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & 
     125                  &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
     126                  &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
     127            END DO 
     128         END DO 
     129      ENDIF 
     130      CALL lbc_lnk( zfric, 'T',  1. ) 
     131      ! 
     132      !----------------------------------! 
     133      ! Initialization and units change 
     134      !----------------------------------! 
    101135      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice 
    102136 
    103       !-------------------- 
    104       ! 1.2) Heat content     
    105       !-------------------- 
    106137      ! Change the units of heat content; from J/m2 to J/m3 
    107138      DO jl = 1, jpl 
     
    109140            DO jj = 1, jpj 
    110141               DO ji = 1, jpi 
    111                   !0 if no ice and 1 if yes 
    112142                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  ) 
    113143                  !Energy of melting q(S,T) [J.m-3] 
     
    119149            DO jj = 1, jpj 
    120150               DO ji = 1, jpi 
    121                   !0 if no ice and 1 if yes 
    122151                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 )  ) 
    123152                  !Energy of melting q(S,T) [J.m-3] 
     
    128157      END DO 
    129158 
    130       ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    131       !-----------------------------------------------------------------------------! 
     159      !--------------------------------------------------------------------! 
     160      ! Partial computation of forcing for the thermodynamic sea ice model 
     161      !--------------------------------------------------------------------! 
    132162      DO jj = 1, jpj 
    133163         DO ji = 1, jpi 
     
    148178 
    149179            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 
    150             zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
     180            zfric_u      = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
    151181            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
    152182            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     
    166196            ENDIF 
    167197            ! 
    168             ! ----------------------------------------- 
    169             ! Net heat flux on top of ice-ocean [W.m-2] 
    170             ! ----------------------------------------- 
     198            ! Net heat flux on top of the ice-ocean [W.m-2] 
     199            ! --------------------------------------------- 
    171200            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
    172  
    173             ! ----------------------------------------------------------------------------- 
    174             ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
    175             ! -----------------------------------------------------------------------------