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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 6515 – NEMO

Changeset 6515


Ignore:
Timestamp:
2016-05-09T16:42:28+02:00 (8 years ago)
Author:
clem
Message:

implement several developments for LIM3: new advection scheme (ultimate-macho, not yet perfect) ; lateral ice melt ; enabling/disabling thermo and dyn with namelist options ; simplifications (including a clarified namelist)

Location:
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM
Files:
2 added
20 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice_cfg

    r4690 r6515  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    2 !! NEMO/LIM-2 : Ice configuration namelist. Overwrites SHARED/namelist_ice_lim2_ref 
     2!! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 
     3!!              1 - Generic parameters                 (namicerun) 
     4!!              2 - Diagnostics                        (namicediag) 
     5!!              3 - Ice initialization                 (namiceini) 
     6!!              4 - Ice discretization                 (namiceitd) 
     7!!              5 - Ice dynamics and transport         (namicedyn) 
     8!!              6 - Ice diffusion                      (namicehdf) 
     9!!              7 - Ice thermodynamics                 (namicethd) 
     10!!              8 - Ice salinity                       (namicesal) 
     11!!              9 - Ice mechanical redistribution      (namiceitdme) 
    312!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    4  
    5 !----------------------------------------------------------------------- 
    6 &namicerun     !   Share parameters for dynamics/advection/thermo 
    7 !----------------------------------------------------------------------- 
     13!------------------------------------------------------------------------------ 
     14&namicerun     !   Generic parameters 
     15!------------------------------------------------------------------------------ 
    816/ 
    9 !----------------------------------------------------------------------- 
    10 &namiceini     !   ice initialisation 
    11 !----------------------------------------------------------------------- 
     17!------------------------------------------------------------------------------ 
     18&namicediag    !   Diagnostics 
     19!------------------------------------------------------------------------------ 
    1220/ 
    13 !----------------------------------------------------------------------- 
    14 &namicedyn     !   ice dynamic 
    15 !----------------------------------------------------------------------- 
     21!------------------------------------------------------------------------------ 
     22&namiceini     !   Ice initialization 
     23!------------------------------------------------------------------------------ 
    1624/ 
    17 !----------------------------------------------------------------------- 
    18 &namicethd     !   ice thermodynamic 
    19 !----------------------------------------------------------------------- 
     25!------------------------------------------------------------------------------ 
     26&namiceitd     !   Ice discretization 
     27!------------------------------------------------------------------------------ 
    2028/ 
    21 !----------------------------------------------------------------------- 
    22 &namicesal     !   ice salinity 
    23 !----------------------------------------------------------------------- 
     29!------------------------------------------------------------------------------ 
     30&namicedyn     !   Ice dynamics and transport 
     31!------------------------------------------------------------------------------ 
    2432/ 
    25 !----------------------------------------------------------------------- 
    26 &namiceitdme   !   parameters for mechanical redistribution of ice  
    27 !----------------------------------------------------------------------- 
     33!------------------------------------------------------------------------------ 
     34&namicehdf     !   Ice horizontal diffusion 
     35!------------------------------------------------------------------------------ 
    2836/ 
    29 !----------------------------------------------------------------------- 
    30 &namicedia     !   ice diagnostics 
    31 !----------------------------------------------------------------------- 
     37!------------------------------------------------------------------------------ 
     38&namicethd     !   Ice thermodynamics 
     39!------------------------------------------------------------------------------ 
    3240/ 
     41!------------------------------------------------------------------------------ 
     42&namicesal     !   Ice salinity 
     43!------------------------------------------------------------------------------ 
     44/ 
     45!------------------------------------------------------------------------------ 
     46&namiceitdme   !   Ice mechanical redistribution (ridging and rafting) 
     47!------------------------------------------------------------------------------ 
     48/ 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref

    r6316 r6515  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    2 !! LIM3 namelist  
     2!! LIM3 namelist 
    33!!              1 - Generic parameters                 (namicerun) 
    4 !!              2 - Ice initialization                 (namiceini) 
    5 !!              3 - Ice discretization                 (namiceitd) 
    6 !!              4 - Ice dynamics and transport         (namicedyn) 
    7 !!              5 - Ice thermodynamics                 (namicethd) 
    8 !!              6 - Ice salinity                       (namicesal) 
    9 !!              7 - Ice mechanical redistribution      (namiceitdme) 
    10 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     4!!              2 - Diagnostics                        (namicediag) 
     5!!              3 - Ice initialization                 (namiceini) 
     6!!              4 - Ice discretization                 (namiceitd) 
     7!!              5 - Ice dynamics and transport         (namicedyn) 
     8!!              6 - Ice diffusion                      (namicehdf) 
     9!!              7 - Ice thermodynamics                 (namicethd) 
     10!!              8 - Ice salinity                       (namicesal) 
     11!!              9 - Ice mechanical redistribution      (namiceitdme) 
     12!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    1113! 
    1214!------------------------------------------------------------------------------ 
    1315&namicerun     !   Generic parameters 
    1416!------------------------------------------------------------------------------ 
    15    jpl            =    5           !  number of ice  categories 
    16    nlay_i         =    2           !  number of ice  layers 
    17    nlay_s         =    1           !  number of snow layers (only 1 is working) 
    18    cn_icerst_in  = "restart_ice"   !  suffix of ice restart name (input) 
    19    cn_icerst_indir = "."           !  directory from which to read input ice restarts 
    20    cn_icerst_out = "restart_ice"   !  suffix of ice restart name (output) 
    21    cn_icerst_outdir = "."          !  directory in which to write output ice restarts 
    22    ln_limdyn     = .true.          !  ice dynamics (T) or thermodynamics only (F) 
    23    rn_amax_n     = 0.999           !  maximum tolerated ice concentration NH 
    24    rn_amax_s     = 0.999           !  maximum tolerated ice concentration SH 
    25    ln_limdiahsb  = .false.         !  check the heat and salt budgets (T) or not (F) 
    26    ln_limdiaout  = .true.          !  output the heat and salt budgets (T) or not (F) 
    27    ln_icectl     = .false.         !  ice points output for debug (T or F) 
    28    iiceprt       = 10              !  i-index for debug 
    29    jiceprt       = 10              !  j-index for debug 
     17   jpl              =    5          !  number of ice  categories 
     18   nlay_i           =    2          !  number of ice  layers 
     19   nlay_s           =    1          !  number of snow layers (only 1 is working) 
     20   rn_amax_n        =   0.997       !  maximum tolerated ice concentration NH 
     21   rn_amax_s        =   0.997       !  maximum tolerated ice concentration SH 
     22   cn_icerst_in     = "restart_ice" !  suffix of ice restart name (input) 
     23   cn_icerst_out    = "restart_ice" !  suffix of ice restart name (output) 
     24   cn_icerst_indir  = "."           !  directory to read   input ice restarts 
     25   cn_icerst_outdir = "."           !  directory to write output ice restarts 
     26   ln_limthd        =  .true.       !  ice thermo   (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     27   ln_limdyn        =  .true.       !  ice dynamics (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     28   nn_limdyn        =   2           !     (ln_limdyn=T) switch for ice dynamics    
     29                                    !      2: total 
     30                                    !      1: advection only (no diffusion, no ridging/rafting) 
     31                                    !      0: advection only (as 1 but with prescribed velocity, bypass rheology) 
     32   rn_uice          =   0.00001     !     (nn_limdyn=0) ice u-velocity 
     33   rn_vice          =  -0.00001     !     (nn_limdyn=0) ice v-velocity 
     34/ 
     35!------------------------------------------------------------------------------ 
     36&namicediag    !   Diagnostics 
     37!------------------------------------------------------------------------------ 
     38   ln_limdiahsb   =  .true.         !  check online the heat, mass & salt budgets (T) or not (F) 
     39   ln_limdiaout   =  .false.        !  output the heat, mass & salt budgets (T) or not (F) 
     40   ln_icectl      =  .false.        !  ice points output for debug (T or F) 
     41   iiceprt        =    10           !  i-index for debug 
     42   jiceprt        =    10           !  j-index for debug 
    3043/ 
    3144!------------------------------------------------------------------------------ 
    3245&namiceini     !   Ice initialization 
    3346!------------------------------------------------------------------------------ 
    34    ln_iceini      = .true.         !  activate ice initialization (T) or not (F) 
    35    rn_thres_sst   =  2.0           !  maximum water temperature with initial ice (degC) 
    36    rn_hts_ini_n   =  0.3           !  initial real snow thickness (m), North 
    37    rn_hts_ini_s   =  0.3           !        "            "             South 
    38    rn_hti_ini_n   =  3.0           !  initial real ice thickness  (m), North 
    39    rn_hti_ini_s   =  1.0           !        "            "             South 
    40    rn_ati_ini_n   =  0.9           !  initial ice concentration   (-), North 
    41    rn_ati_ini_s   =  0.9           !        "            "             South 
    42    rn_smi_ini_n   =  6.3           !  initial ice salinity     (g/kg), North 
    43    rn_smi_ini_s   =  6.3           !        "            "             South 
    44    rn_tmi_ini_n   =  270.          !  initial ice/snw temperature (K), North 
    45    rn_tmi_ini_s   =  270.          !        "            "             South 
     47                  ! -- limistate -- ! 
     48   ln_limini      = .false.         !  activate ice initialization (T) or not (F) 
     49   ln_limini_file = .false.         !  netcdf file provided for initialization (T) or not (F) 
     50   rn_thres_sst   =  0.5            !  maximum water temperature with initial ice (degC) 
     51   rn_hts_ini_n   =  0.3            !  initial real snow thickness (m), North 
     52   rn_hts_ini_s   =  0.3            !        "            "             South 
     53   rn_hti_ini_n   =  3.0            !  initial real ice thickness  (m), North 
     54   rn_hti_ini_s   =  1.0            !        "            "             South 
     55   rn_ati_ini_n   =  0.9            !  initial ice concentration   (-), North 
     56   rn_ati_ini_s   =  0.9            !        "            "             South 
     57   rn_smi_ini_n   =  6.3            !  initial ice salinity     (g/kg), North 
     58   rn_smi_ini_s   =  6.3            !        "            "             South 
     59   rn_tmi_ini_n   =  270.           !  initial ice/snw temperature (K), North 
     60   rn_tmi_ini_s   =  270.           !        "            "             South 
    4661/ 
    4762!------------------------------------------------------------------------------ 
    4863&namiceitd     !   Ice discretization 
    4964!------------------------------------------------------------------------------ 
    50    nn_catbnd      =    2           !  computation of ice category boundaries based on 
    51                                    !      1: tanh function 
    52                                    !      2: h^(-alpha), function of rn_himean 
    53    rn_himean      =    2.0         !  expected domain-average ice thickness (m), nn_catbnd = 2 only 
     65   nn_catbnd      =    2            !  computation of ice category boundaries based on 
     66                                    !      1: tanh function 
     67                                    !      2: h^(-alpha), function of rn_himean 
     68   rn_himean      =    2.0          !     (nn_catbnd=2) expected domain-average ice thickness (m) 
    5469/ 
    5570!------------------------------------------------------------------------------ 
    5671&namicedyn     !   Ice dynamics and transport 
    5772!------------------------------------------------------------------------------ 
    58    nn_icestr      =    0           !  ice strength parameteriztaion                       
    59                                    !     0: Hibler_79     P = pstar*<h>*exp(-c_rhg*A) 
    60                                    !     1: Rothrock_75   P = Cf*coeff*integral(wr.h^2)     
    61    ln_icestr_bvf  =    .false.     !  ice strength function brine volume (T) or not (F)      
    62    rn_pe_rdg      =   17.0         !  ridging work divided by pot. energy change in ridging, if nn_icestr = 1 
    63    rn_pstar       =    2.0e+04     !  ice strength thickness parameter (N/m2), nn_icestr = 0  
    64    rn_crhg        =   20.0         !  ice strength conc. parameter (-), nn_icestr = 0        
    65    rn_cio         =    5.0e-03     !  ice-ocean drag coefficient           (-)              
    66    rn_creepl      =    1.0e-12     !  creep limit (s-1)                                    
    67    rn_ecc         =    2.0         !  eccentricity of the elliptical yield curve           
    68    nn_nevp        =  120           !  number of EVP subcycles                              
    69    rn_relast      =    0.333       !  ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
    70                                    !     advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 
    71    nn_ahi0        =    2           !  horizontal diffusivity computation 
    72                                    !     0: use rn_ahi0_ref 
    73                                    !     1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length ) 
    74                                    !     2: use rn_ahi0_ref x grid cell length      / ( 2deg mean grid cell length ) 
    75    rn_ahi0_ref    = 350.0          !  horizontal sea ice diffusivity (m2/s)  
    76                                    !     if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution 
     73                  ! -- limitd_me -- ! 
     74   nn_icestr      =    0            !  ice strength parameteriztaion                       
     75                                    !     0: Hibler_79     P = pstar*<h>*exp(-c_rhg*A) 
     76                                    !     1: Rothrock_75   P = Cf*coeff*integral(wr.h^2)     
     77   rn_pe_rdg      =   17.0          !     (nn_icestr=1) ridging work divided by pot. energy change in ridging 
     78   rn_pstar       =    2.0e+04      !     (nn_icestr=0) ice strength thickness parameter (N/m2)  
     79   rn_crhg        =   20.0          !     (nn_icestr=0) ice strength conc. parameter (-) 
     80   ln_icestr_bvf  =    .false.      !     ice strength function brine volume (T) or not (F) 
     81                                    ! 
     82            ! -- limdyn & limrhg -- ! 
     83   rn_cio         =    5.0e-03      !  ice-ocean drag coefficient (-) 
     84   rn_creepl      =    1.0e-12      !  creep limit (s-1) 
     85   rn_ecc         =    2.0          !  eccentricity of the elliptical yield curve           
     86   nn_nevp        =  120            !  number of EVP subcycles                              
     87   rn_relast      =    0.333        !  ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
     88                                    !     advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 
    7789/ 
    7890!------------------------------------------------------------------------------ 
    7991&namicehdf     !   Ice horizontal diffusion 
    8092!------------------------------------------------------------------------------ 
    81    nn_convfrq     = 5              !  convergence check frequency of the Crant-Nicholson scheme (perf. optimization) 
     93                     ! -- limhdf -- ! 
     94   nn_ahi0        =    2            !  horizontal diffusivity computation 
     95                                    !    -1: no diffusion (bypass limhdf) 
     96                                    !     0: use rn_ahi0_ref 
     97                                    !     1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length ) 
     98                                    !     2: use rn_ahi0_ref x grid cell length      / ( 2deg mean grid cell length ) 
     99   rn_ahi0_ref    = 350.0           !  horizontal sea ice diffusivity (m2/s)  
     100                                    !     if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution 
    82101/ 
    83102!------------------------------------------------------------------------------ 
    84103&namicethd     !   Ice thermodynamics 
    85104!------------------------------------------------------------------------------ 
    86    rn_hnewice  = 0.1               !  thickness for new ice formation in open water (m) 
    87    ln_frazil   = .false.           !  use frazil ice collection thickness as a function of wind (T) or not (F) 
    88    rn_maxfrazb = 1.0               !  maximum fraction of frazil ice collecting at the ice base 
    89    rn_vfrazb   = 0.417             !  thresold drift speed for frazil ice collecting at the ice bottom (m/s) 
    90    rn_Cfrazb   = 5.0               !  squeezing coefficient for frazil ice collecting at the ice bottom 
    91    rn_himin    = 0.10              !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice 
    92    rn_betas    = 0.66              !  exponent in lead-ice repratition of snow precipitation 
    93                                    !     betas = 1 -> equipartition, betas < 1 -> more on leads 
    94    rn_kappa_i  = 1.0               !  radiation attenuation coefficient in sea ice (m-1) 
    95    nn_conv_dif = 50                !  maximal number of iterations for heat diffusion computation 
    96    rn_terr_dif = 0.0001            !  maximum temperature after heat diffusion (degC) 
    97    nn_ice_thcon= 1                 !  sea ice thermal conductivity 
    98                                    !     0: k = k0 + beta.S/T (Untersteiner, 1964) 
    99                                    !     1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007) 
    100    nn_monocat  = 0                 !  virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0) 
    101                                    !     2: simple piling instead of ridging --- temporary option 
    102                                    !     3: activate G(he) only              --- temporary option 
    103                                    !     4: activate lateral melting only    --- temporary option 
    104   ln_it_qnsice = .true.            !  iterate the surface non-solar flux with surface temperature (T) or not (F) 
     105                 ! -- limthd_dif -- ! 
     106   rn_kappa_i     = 1.0             !  radiation attenuation coefficient in sea ice (m-1) 
     107   nn_conv_dif    = 50              !  maximal number of iterations for heat diffusion computation 
     108   rn_terr_dif    = 1.0e-04         !  maximum temperature after heat diffusion (degC) 
     109   nn_ice_thcon   = 1               !  sea ice thermal conductivity 
     110                                    !     0: k = k0 + beta.S/T            (Untersteiner, 1964) 
     111                                    !     1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007) 
     112   ln_it_qnsice   = .true.          !  iterate the surface non-solar flux with surface temperature (T) or not (F) 
     113   nn_monocat     = 0               !  virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0) 
     114                                    !     2: simple piling instead of ridging    --- temporary option 
     115                                    !     3: activate G(he) only                 --- temporary option 
     116                                    !     4: activate extra lateral melting only --- temporary option 
     117                  ! -- limthd_dh -- ! 
     118   ln_limdH       = .true.          !  activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     119   rn_betas       = 0.66            !  exponent in lead-ice repratition of snow precipitation 
     120                                    !     betas = 1 -> equipartition, betas < 1 -> more on leads 
     121                  ! -- limthd_da -- ! 
     122   ln_limdA       = .true.          !  activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     123   rn_beta        = 1.0             !     (ln_latmelt=T) coef. beta for lateral melting param. Recommended range=[0.8-1.2] 
     124                                    !      => decrease = more melt and melt peaks toward higher concentration (A~0.5 for beta=1 ; A~0.8 for beta=0.2) 
     125                                    !         0.3 = best fit for western Fram Strait and Antarctica 
     126                                    !         1.4 = best fit for eastern Fram Strait       
     127   rn_dmin        = 8.              !     (ln_latmelt=T) minimum floe diameter for lateral melting param. Recommended range=[6-10] 
     128                                    !      => 6  vs 8m = +40% melting at the peak (A~0.5) 
     129                                    !         10 vs 8m = -20% melting 
     130                 ! -- limthd_lac -- ! 
     131   ln_limdO       = .true.          !  activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     132   rn_hnewice     = 0.1             !  thickness for new ice formation in open water (m) 
     133   ln_frazil      = .true.          !  Frazil ice parameterization (ice collection as a function of wind) 
     134   rn_maxfrazb    = 1.0             !     (ln_frazil=T) maximum fraction of frazil ice collecting at the ice base 
     135   rn_vfrazb      = 0.417           !     (ln_frazil=T) thresold drift speed for frazil ice collecting at the ice bottom (m/s) 
     136   rn_Cfrazb      = 5.0             !     (ln_frazil=T) squeezing coefficient for frazil ice collecting at the ice bottom 
     137                  ! -- limitd_th -- ! 
     138   rn_himin       = 0.1             !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice 
    105139/ 
    106140!------------------------------------------------------------------------------ 
    107141&namicesal     !   Ice salinity 
    108142!------------------------------------------------------------------------------ 
    109    nn_icesal   =  2                !  ice salinity option 
    110                                    !     1: constant ice salinity (S=rn_icesal) 
    111                                    !     2: varying salinity parameterization S(z,t) 
    112                                    !     3: prescribed salinity profile S(z), Schwarzacher, 1959 
    113    rn_icesal   =  4.               !  ice salinity (g/kg, nn_icesal = 1 only) 
    114    rn_sal_gd   =  5.               !  restoring ice salinity, gravity drainage (g/kg) 
    115    rn_time_gd  =  1.73e+6          !  restoring time scale, gravity drainage  (s) 
    116    rn_sal_fl   =  2.               !  restoring ice salinity, flushing (g/kg) 
    117    rn_time_fl  =  8.64e+5          !  restoring time scale, flushing (s) 
    118    rn_simax    = 20.               !  maximum tolerated ice salinity (g/kg) 
    119    rn_simin    =  0.1              !  minimum tolerated ice salinity (g/kg) 
     143                 ! -- limthd_sal -- ! 
     144   ln_limdS       = .true.          !  activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     145   nn_icesal      =  2              !  ice salinity option 
     146                                    !     1: constant ice salinity (S=rn_icesal) 
     147                                    !     2: varying salinity parameterization S(z,t) 
     148                                    !     3: prescribed salinity profile S(z), Schwarzacher, 1959 
     149   rn_icesal      =  4.             !    (nn_icesal=1) ice salinity (g/kg) 
     150   rn_sal_gd      =  5.             !  restoring ice salinity, gravity drainage (g/kg) 
     151   rn_time_gd     =  1.73e+6        !  restoring time scale, gravity drainage  (s) 
     152   rn_sal_fl      =  2.             !  restoring ice salinity, flushing (g/kg) 
     153   rn_time_fl     =  8.64e+5        !  restoring time scale, flushing (s) 
     154   rn_simax       = 20.             !  maximum tolerated ice salinity (g/kg) 
     155   rn_simin       =  0.1            !  minimum tolerated ice salinity (g/kg) 
    120156/ 
    121157!------------------------------------------------------------------------------ 
    122158&namiceitdme   !   Ice mechanical redistribution (ridging and rafting) 
    123159!------------------------------------------------------------------------------ 
    124    rn_Cs       =   0.5             !  fraction of shearing energy contributing to ridging 
    125    rn_fsnowrdg =   0.5             !  snow volume fraction that survives in ridging 
    126    rn_fsnowrft =   0.5             !  snow volume fraction that survives in rafting 
    127    nn_partfun  =   1               !  type of ridging participation function 
    128                                    !     0: linear (Thorndike et al, 1975) 
    129                                    !     1: exponential (Lipscomb, 2007 
    130    rn_gstar    =   0.15            !  fractional area of thin ice being ridged (nn_partfun = 0) 
    131    rn_astar    =   0.05            !  exponential measure of ridging ice fraction (nn_partfun = 1) 
    132    rn_hstar    = 100.0             !  determines the maximum thickness of ridged ice (m) (Hibler, 1980) 
    133    ln_rafting  =   .true.          !  rafting activated (T) or not (F) 
    134    rn_hraft    =   0.75            !  threshold thickness for rafting (m) 
    135    rn_craft    =   5.0             !  squeezing coefficient used in the rafting function 
    136    rn_por_rdg  =   0.3             !  porosity of newly ridged ice (Lepparanta et al., 1995) 
     160                  ! -- limitd_me -- ! 
     161   rn_cs          =   0.5           !  fraction of shearing energy contributing to ridging 
     162   nn_partfun     =   1             !  type of ridging participation function 
     163                                    !     0: linear      (Thorndike et al, 1975) 
     164                                    !     1: exponential (Lipscomb, 2007) 
     165   rn_gstar       =   0.15          !     (nn_partfun = 0) fractional area of thin ice being ridged  
     166   rn_astar       =   0.05          !     (nn_partfun = 1) exponential measure of ridging ice fraction 
     167   ln_ridging     =   .true.        !  ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     168   rn_hstar       = 100.0           !     (ln_ridging = T) determines the maximum thickness of ridged ice (m) (Hibler, 1980) 
     169   rn_por_rdg     =   0.3           !     (ln_ridging = T) porosity of newly ridged ice (Lepparanta et al., 1995) 
     170   rn_fsnowrdg    =   0.5           !     (ln_ridging = T) snow volume fraction that survives in ridging 
     171   ln_rafting     =   .true.        !  rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     172   rn_hraft       =   0.75          !     (ln_rafting = T) threshold thickness for rafting (m) 
     173   rn_craft       =   5.0           !     (ln_rafting = T) squeezing coefficient used in the rafting function 
     174   rn_fsnowrft    =   0.5           !     (ln_rafting = T) snow volume fraction that survives in rafting 
    137175/ 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r6477 r6515  
    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_limdiahsb     !: flag for ice diag (T) or not (F) 
     176   LOGICAL , PUBLIC ::   ln_limdiaout     !: flag for ice diag (T) or not (F) 
     177   LOGICAL , PUBLIC ::   ln_icectl        !: 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                                          ! -- limitd_me -- ! 
     203   INTEGER , PUBLIC ::   nn_icestr        !: ice strength parameterization (0=Hibler79 1=Rothrock75) 
     204   REAL(wp), PUBLIC ::   rn_pe_rdg        !: ridging work divided by pot. energy change in ridging, nn_icestr = 1 
     205   REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength (N/M), Hibler JPO79 
     206   REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength 
     207   LOGICAL , PUBLIC ::   ln_icestr_bvf    !: use brine volume to diminish ice strength 
     208                                          ! -- limdyn & limrhg -- ! 
     209   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress 
     210   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9 
     211   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve 
     212   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
     213   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
     214 
     215   !                                     !!** ice-diffusion namelist (namicehdf) ** 
     216   INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 
     217   REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
     218 
     219   !                                     !!** ice-thermodynamics namelist (namicethd) ** 
     220                                          ! -- limthd_dif -- ! 
     221   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
     222   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion 
     223   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion 
     224   INTEGER , PUBLIC ::   nn_ice_thcon     !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
     225   LOGICAL , PUBLIC ::   ln_it_qnsice     !: iterate surface flux with changing surface temperature or not (F) 
     226   INTEGER , PUBLIC ::   nn_monocat       !: virtual ITD mono-category parameterizations (1) or not (0) 
     227                                          ! -- limthd_dh -- ! 
     228   LOGICAL , PUBLIC ::   ln_limdH         !: activate ice thickness change from growing/melting (T) or not (F) 
     229   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice 
     230                                          ! -- limthd_da -- ! 
     231   LOGICAL , PUBLIC ::   ln_limdA         !: activate lateral melting param. (T) or not (F) 
     232   REAL(wp), PUBLIC ::   rn_beta          !: coef. beta for lateral melting param. 
     233   REAL(wp), PUBLIC ::   rn_dmin          !: minimum floe diameter for lateral melting param. 
     234                                          ! -- limthd_lac -- ! 
     235   LOGICAL , PUBLIC ::   ln_limdO         !: activate ice growth in open-water (T) or not (F) 
     236   REAL(wp), PUBLIC ::   rn_hnewice       !: thickness for new ice formation (m) 
     237   LOGICAL , PUBLIC ::   ln_frazil        !: use of frazil ice collection as function of wind (T) or not (F) 
     238   REAL(wp), PUBLIC ::   rn_maxfrazb      !: maximum portion of frazil ice collecting at the ice bottom 
     239   REAL(wp), PUBLIC ::   rn_vfrazb        !: threshold drift speed for collection of bottom frazil ice 
     240   REAL(wp), PUBLIC ::   rn_Cfrazb        !: squeezing coefficient for collection of bottom frazil ice 
     241                                          ! -- limitd_th -- ! 
     242   REAL(wp), PUBLIC ::   rn_himin         !: minimum ice thickness 
     243 
     244   !                                     !!** ice-salinity namelist (namicesal) ** 
     245   LOGICAL , PUBLIC ::   ln_limdS         !: activate gravity drainage and flushing (T) or not (F) 
     246   INTEGER , PUBLIC ::   nn_icesal        !: salinity configuration used in the model 
     247   !                                      ! 1 - constant salinity in both space and time 
     248   !                                      ! 2 - prognostic salinity (s(z,t)) 
     249   !                                      ! 3 - salinity profile, constant in time 
     250   REAL(wp), PUBLIC ::   rn_icesal        !: bulk salinity (ppt) in case of constant salinity 
     251   REAL(wp), PUBLIC ::   rn_sal_gd        !: restoring salinity for gravity drainage [PSU] 
     252   REAL(wp), PUBLIC ::   rn_time_gd       !: restoring time constant for gravity drainage (= 20 days) [s] 
     253   REAL(wp), PUBLIC ::   rn_sal_fl        !: restoring salinity for flushing [PSU] 
     254   REAL(wp), PUBLIC ::   rn_time_fl       !: restoring time constant for gravity drainage (= 10 days) [s] 
     255   REAL(wp), PUBLIC ::   rn_simax         !: maximum ice salinity [PSU] 
     256   REAL(wp), PUBLIC ::   rn_simin         !: minimum ice salinity [PSU] 
     257 
     258   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
     259   REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging             
     260   INTEGER , PUBLIC ::   nn_partfun       !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
     261   REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging 
     262   REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function 
     263   LOGICAL , PUBLIC ::   ln_ridging       !: ridging of ice or not                         
     264   REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice 
     265   REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value) 
     266   REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging 
     267   LOGICAL , PUBLIC ::   ln_rafting       !: rafting of ice or not                         
     268   REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging  
     269   REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting 
     270   REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging 
     271 
     272   !                                     !!** some other parameters  
    159273   INTEGER , PUBLIC ::   nstart           !: iteration number of the begining of the run  
    160274   INTEGER , PUBLIC ::   nlast            !: iteration number of the end of the run  
     
    163277   REAL(wp), PUBLIC ::   rdt_ice          !: ice time step 
    164278   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  
    221279   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( rn_ecc * rn_ecc ) 
    222280   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cio 
    223281   REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i 
    224282   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  
     283   REAL(wp), PUBLIC ::   rswitch          !: switch for the presence of ice (1) or not (0) 
    230284   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number  
    231285   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number  
    232286   REAL(wp), PUBLIC, PARAMETER ::   epsi20   = 1.e-20_wp  !: small number  
    233287 
    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 
     288   !                                     !!** define arrays 
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce !: surface ocean velocity used in ice dynamics 
     290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 
     291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicol       !: ice collection thickness accreted in leads 
     292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength    !: ice strength 
    239293   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] 
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i     !: ice rheology elta factor (Flato & Hibler 95) [s-1] 
     295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i      !: Divergence of the velocity field [s-1] 
     296   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i     !: Shear of the velocity field [s-1] 
    243297   ! 
    244298   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) 
    246299   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    247300   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction 
     
    252305   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
    253306 
    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] 
     307   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: snow-ocean mass exchange   [kg.m-2.s-1] 
     308   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: snow precipitation on ice  [kg.m-2.s-1] 
     309   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: snow/ice sublimation       [kg.m-2.s-1] 
     310 
     311   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: ice-ocean mass exchange                   [kg.m-2.s-1] 
     312   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni     !: snow ice growth component of wfx_ice      [kg.m-2.s-1] 
     313   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw     !: lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
     314   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog     !: bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
     315   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn     !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
     316   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom     !: bottom melt component of wfx_ice          [kg.m-2.s-1] 
     317   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum     !: surface melt component of wfx_ice         [kg.m-2.s-1] 
     318   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_lam     !: lateral melt component of wfx_ice         [kg.m-2.s-1] 
     319   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res     !: residual component of wfx_ice             [kg.m-2.s-1] 
    266320 
    267321   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)          [s-1] 
     
    271325   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    272326   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     327   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_lam     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    273328   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    274329   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     
    302357   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness [W.m-2] 
    303358 
    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 
     359   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array 
     360   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice        !: transmitted solar radiation under ice 
     361   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   pahu3D, pahv3D !: ice hor. eddy diffusivity coef. at U- and V-points 
    307362 
    308363   !!-------------------------------------------------------------------------- 
     
    310365   !!-------------------------------------------------------------------------- 
    311366   !! 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) 
     367   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i      !: Ice thickness (m) 
     368   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration) 
     369   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area (m) 
     370   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area(m) 
     371   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_s      !: Snow thickness (m) 
     372   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su      !: Sea-Ice Surface Temperature (K) 
     373   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sm_i      !: Sea-Ice Bulk salinity (ppt) 
     374   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   smv_i     !: Sea-Ice Bulk salinity times volume per area (ppt.m) 
     375   !                                                                    !  this is an extensive variable that has to be transported 
     376   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age (days) 
     377   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ov_i      !: Sea-Ice Age times volume per area (days.m) 
     378   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area (days) 
     379   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bv_i      !: brine volume 
    324380 
    325381   !! 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 ...       
     382   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice !: components of the ice velocity (m/s) 
     383   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tio_u, tio_v !: components of the ice-ocean stress (N/m2) 
     384   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s  !: ice and snow total volume per unit area (m) 
     385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i         !: ice total fractional area (ice concentration) 
     386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i        !: =1-at_i ; total open water fractional area 
     387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   et_i , et_s  !: ice and snow total heat content 
     388   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i         !: mean ice temperature over all categories 
     389   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bvm_i        !: brine volume averaged over all categories 
     390   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i        !: mean sea ice salinity averaged over all categories [PSU] 
     391   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_su        !: mean surface temperature over all categories 
     392   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_i        !: mean ice  thickness over all categories 
     393   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_s        !: mean snow thickness over all categories 
     394   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   om_i         !: mean ice age over all categories 
     395 
     396   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures [K] 
     397   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow ...       
    339398       
    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] 
     399   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures          [K] 
     400   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice thermal contents    [J/m2] 
     401   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i      !: ice salinities          [PSU] 
    343402 
    344403   !!-------------------------------------------------------------------------- 
     
    368427   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    369428   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=80), 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=80), 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 
    388429   ! 
    389430   !!-------------------------------------------------------------------------- 
    390431   !! * Ice diagnostics 
    391432   !!-------------------------------------------------------------------------- 
    392    ! Increment of global variables 
    393433   ! thd refers to changes induced by thermodynamics 
    394434   ! 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) 
     435   ! 
    397436   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vi   !: transport of ice volume 
    398437   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vs   !: transport of snw volume 
     
    419458      INTEGER :: ice_alloc 
    420459      ! 
    421       INTEGER :: ierr(17), ii 
     460      INTEGER :: ierr(15), ii 
    422461      !!----------------------------------------------------------------- 
    423462 
     
    427466      ! stay within Fortran's max-line length limit. 
    428467      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) ,     & 
     468      ALLOCATE( u_oce    (jpi,jpj) , v_oce    (jpi,jpj) , ahiu      (jpi,jpj) , ahiv     (jpi,jpj) ,  & 
     469         &      hicol    (jpi,jpj) , strength (jpi,jpj) ,                                             & 
     470         &      stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,                       & 
    434471         &      delta_i  (jpi,jpj) , divu_i   (jpi,jpj) , shear_i   (jpi,jpj) , STAT=ierr(ii) ) 
    435472 
    436473      ii = ii + 1 
    437       ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,                        & 
     474      ALLOCATE( sist   (jpi,jpj) , t_bo   (jpi,jpj) ,                                           & 
    438475         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,                        & 
    439          &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,                        & 
     476         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , wfx_lam(jpi,jpj) ,     & 
    440477         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     & 
    441478         &      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          &      qlead  (jpi,jpj) , rn_amax_2d(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) ,    & 
     479         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) , rn_amax_2d(jpi,jpj),   & 
     480         &      fhtur  (jpi,jpj) , qlead  (jpi,jpj) ,                                           & 
     481         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  & 
     482         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,  & 
    447483         &      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) ) 
     484         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld   (jpi,jpj) ,                        & 
     485         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     & 
     486         &      hfx_opw(jpi,jpj) , hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,     & 
     487         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj)        ,  STAT=ierr(ii) ) 
    452488 
    453489      ! * Ice global state variables 
    454490      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) ) 
     491      ALLOCATE( ftr_ice(jpi,jpj,jpl) , pahu3D(jpi,jpj,jpl) , pahv3D(jpi,jpj,jpl) ,     & 
     492         &      ht_i   (jpi,jpj,jpl) , a_i   (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,     & 
     493         &      v_s    (jpi,jpj,jpl) , ht_s  (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,     & 
     494         &      sm_i   (jpi,jpj,jpl) , smv_i (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,     & 
     495         &      ov_i   (jpi,jpj,jpl) , oa_i  (jpi,jpj,jpl) , bv_i  (jpi,jpj,jpl) ,  STAT=ierr(ii) ) 
    459496      ii = ii + 1 
    460497      ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , tio_u(jpi,jpj) , tio_v(jpi,jpj) ,     & 
    461498         &      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) ) 
     499         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) ,     & 
     500         &      smt_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) , om_i(jpi,jpj) , STAT=ierr(ii) ) 
    464501      ii = ii + 1 
    465502      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
     
    488525      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     & 
    489526         &      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) ) 
     527         &      oa_i_b (jpi,jpj,jpl)                                                    , STAT=ierr(ii) ) 
     528      ii = ii + 1 
     529      ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) ) 
    491530       
    492531      ! * Ice thickness distribution variables 
     
    496535      ! * Ice diagnostics 
    497536      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) ) 
     537      ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),   &  
     538         &      diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj) , diag_heat  (jpi,jpj),   & 
     539         &      diag_smvi  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
    501540 
    502541      ice_alloc = MAXVAL( ierr(:) ) 
     
    513552   !!====================================================================== 
    514553END MODULE ice 
    515  
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r6399 r6515  
    185185         ! salt flux 
    186186         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    187             &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   & 
     187            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    & 
    188188            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
    189189 
    190190         ! 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(:,:)    & 
     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(:,:) + wfx_lam(:,:)  & 
    193193            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
    194194 
     
    210210         ! salt flux 
    211211         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    212             &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   &  
     212            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    &  
    213213            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 
    214214 
    215215         ! 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(:,:)    & 
     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(:,:) + wfx_lam(:,:)   & 
    218218            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 
    219219 
     
    260260               &                         cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 
    261261                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     262            IF (     zamax   > 1._wp   ) WRITE(numout,*) 'violation a_i>1               (',cd_routine,') = ',zamax 
    262263            ENDIF 
    263264            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r6417 r6515  
    5656      real(wp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
    5757      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  
     58      &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn, zbg_sfx_sub, zbg_sfx_lam  
    5959      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   
     60      real(wp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub, zbg_vfx_lam   
    6161      real(wp)   ::   zbg_hfx_dhc, zbg_hfx_spr 
    6262      real(wp)   ::   zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in    
     
    9595      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    9696      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     97      zbg_vfx_lam = ztmp * glob_sum( wfx_lam(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    9798      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    9899      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     
    112113      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    113114      zbg_sfx_sub = ztmp * glob_sum( sfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     115      zbg_sfx_lam = ztmp * glob_sum( sfx_lam(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    114116 
    115117      ! Heat budget 
     
    139141      z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
    140142                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 
    141                           &     wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 
     143                          &     wfx_sub(:,:) + wfx_lam(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 
    142144      ! 
    143145      frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
     
    176178      CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom                              )   ! volume flux bottom melt       - 
    177179      CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum                              )   ! volume flux surface melt      - 
     180      CALL iom_put( 'ibgvfxlam' , zbg_vfx_lam                              )   ! volume flux lateral melt      - 
    178181      CALL iom_put( 'ibgvfxres' , zbg_vfx_res                              )   ! volume flux resultant         - 
    179182      CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr                              )   ! volume flux from snow precip         - 
     
    191194      CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum                              )   ! salt flux surface melt      - 
    192195      CALL iom_put( 'ibgsfxsub' , zbg_sfx_sub                              )   ! salt flux sublimation      - 
     196      CALL iom_put( 'ibgsfxlam' , zbg_sfx_lam                              )   ! salt flux lateral melt      - 
    193197 
    194198      CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc                              )   ! Heat content variation in snow and ice [W] 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r5123 r6515  
    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 
     
    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 
     
    6360      INTEGER  ::   ji, jj, jl, ja    ! dummy loop indices 
    6461      INTEGER  ::   i_j1, i_jpj       ! Starting/ending j-indices for rheology 
    65       REAL(wp) ::   zcoef             ! local scalar 
    6662      REAL(wp), POINTER, DIMENSION(:)   ::   zswitch        ! i-averaged indicator of sea-ice 
    6763      REAL(wp), POINTER, DIMENSION(:)   ::   zmsk           ! i-averaged of tmask 
    68       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io   ! ice-ocean velocity 
    6964      ! 
    7065      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     
    7368      IF( nn_timing == 1 )  CALL timing_start('limdyn') 
    7469 
    75       CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 
    7670      CALL wrk_alloc( jpj, zswitch, zmsk ) 
    7771 
     
    7973 
    8074      IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    81  
    82       IF( ln_limdyn ) THEN 
     75      ! 
     76      ! conservation test 
     77      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     78       
     79      u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 
     80      v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 
     81       
     82      ! Rheology (ice dynamics) 
     83      ! ======== 
     84       
     85      !  Define the j-limits where ice rheology is computed 
     86      ! --------------------------------------------------- 
     87       
     88      IF( lk_mpp .OR. lk_mpp_rep ) THEN                    ! mpp: compute over the whole domain 
     89         i_j1 = 1 
     90         i_jpj = jpj 
     91         IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
     92         CALL lim_rhg( i_j1, i_jpj ) 
     93      ELSE                                 ! optimization of the computational area 
    8394         ! 
    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 
     95         DO jj = 1, jpj 
     96            zswitch(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line 
     97            zmsk   (jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line 
     98         END DO 
     99          
     100         IF( l_jeq ) THEN                     ! local domain include both hemisphere 
     101            !                                 ! Rheology is computed in each hemisphere 
     102            !                                 ! only over the ice cover latitude strip 
     103            ! Northern hemisphere 
     104            i_j1  = njeq 
    98105            i_jpj = jpj 
    99             IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
     106            DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
     107               i_j1 = i_j1 + 1 
     108            END DO 
     109            i_j1 = MAX( 1, i_j1-2 ) 
     110            IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  : NH  i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
    100111            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 
     112            ! 
     113            ! Southern hemisphere 
     114            i_j1  =  1 
     115            i_jpj = njeq 
     116            DO WHILE ( i_jpj >= 1 .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
     117               i_jpj = i_jpj - 1 
     118            END DO 
     119            i_jpj = MIN( jpj, i_jpj+1 ) 
     120            IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  : SH  i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
     121            ! 
     122            CALL lim_rhg( i_j1, i_jpj ) 
     123            ! 
     124         ELSE                                 ! local domain extends over one hemisphere only 
     125            !                                 ! Rheology is computed only over the ice cover 
     126            !                                 ! latitude strip 
     127            i_j1  = 1 
     128            DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 
     129               i_j1 = i_j1 + 1 
     130            END DO 
     131            i_j1 = MAX( 1, i_j1-2 ) 
     132             
     133            i_jpj  = jpj 
     134            DO WHILE ( i_jpj >= 1  .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 
     135               i_jpj = i_jpj - 1 
     136            END DO 
     137            i_jpj = MIN( jpj, i_jpj+1) 
     138            ! 
     139            IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  : one hemisphere:  i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
     140            ! 
     141            CALL lim_rhg( i_j1, i_jpj ) 
    152142            ! 
    153143         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 
    181144         ! 
    182145      ENDIF 
    183       CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point 
    184  
     146      ! 
    185147      IF(ln_ctl) THEN   ! Control print 
    186148         CALL prt_ctl_info(' ') 
    187149         CALL prt_ctl_info(' - Cell values : ') 
    188150         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    189          CALL prt_ctl(tab2d_1=ust2s     , clinfo1=' lim_dyn  : ust2s     :') 
    190151         CALL prt_ctl(tab2d_1=divu_i    , clinfo1=' lim_dyn  : divu_i    :') 
    191152         CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :') 
     
    222183      ENDIF 
    223184      ! 
    224       CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 
     185      ! conservation test 
     186      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     187      ! 
    225188      CALL wrk_dealloc( jpj, zswitch, zmsk ) 
    226189      ! 
     
    244207      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    245208      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 
     209         &                nn_nevp, rn_relast 
    249210      !!------------------------------------------------------------------- 
    250211 
     
    264225         WRITE(numout,*)'    ice strength parameterization (0=Hibler 1=Rothrock)  nn_icestr     = ', nn_icestr  
    265226         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  
     227         WRITE(numout,*)'    Ratio of ridging work to PotEner change in ridging   rn_pe_rdg     = ', rn_pe_rdg  
    267228         WRITE(numout,*) '   drag coefficient for oceanic stress                  rn_cio        = ', rn_cio 
    268229         WRITE(numout,*) '   first bulk-rheology parameter                        rn_pstar      = ', rn_pstar 
     
    272233         WRITE(numout,*) '   number of iterations for subcycling                  nn_nevp       = ', nn_nevp 
    273234         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 
    276235      ENDIF 
    277236      ! 
     
    279238      rhoco  = rau0  * rn_cio 
    280239      ! 
    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  
    324240   END SUBROUTINE lim_dyn_init 
    325241 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r6476 r6515  
    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_e12t(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           
    162          IF ( MOD( iter-1 , nn_convfrq ) == 0 )  THEN   !Convergence test every nn_convfrq iterations (perf. optimization )  
    163             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 
    164163               zconv(jk) = 0._wp                                   ! convergence test 
    165164               DO jj = 2, jpjm1 
     
    176175         END DO 
    177176         ! 
    178       END DO                                       ! end of sub-time step loop 
    179  
    180      ! ----------------------- 
    181       !!! final step (clem) !!! 
     177      END DO  ! end of sub-time step loop 
     178 
     179     ! --- final step --- ! 
    182180      DO jk = 1, isize 
    183          jl = (jk-1) /( ihdf_vars+nlay_i)+1 
     181         jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1 
    184182         DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    185183            DO ji = 1 , fs_jpim1   ! vector opt. 
     
    191189         DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    192190            DO ji = fs_2 , fs_jpim1   ! vector opt.  
    193                zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
     191               zdiv(ji,jj)    = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
    194192               ptab(ji,jj,jk) = ztab0(ji,jj,jk) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj,jk) ) 
    195193            END DO 
     
    199197      CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 
    200198 
    201       !!! final step (clem) !!! 
    202       ! ----------------------- 
    203  
     199      ! 
    204200      IF(ln_ctl)   THEN 
    205201         DO jk = 1 , isize 
     
    210206      ENDIF 
    211207      ! 
    212       CALL wrk_dealloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 
    213       CALL wrk_dealloc( jpi, jpj, zflu, zflv, zdiv ) 
    214  
     208      CALL wrk_dealloc( jpi,jpj,       zflu, zflv, zdiv ) 
     209      CALL wrk_dealloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 ) 
     210      ! 
    215211      DEALLOCATE( zconv ) 
    216212      DEALLOCATE( pt2d_array , zrlx_array ) 
     
    220216   END SUBROUTINE lim_hdf 
    221217 
    222  
    223218    
    224219   SUBROUTINE lim_hdf_init 
     
    233228      !!------------------------------------------------------------------- 
    234229      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    235       NAMELIST/namicehdf/ nn_convfrq  
    236       !!------------------------------------------------------------------- 
    237       ! 
    238       IF(lwp) THEN 
    239          WRITE(numout,*) 
    240          WRITE(numout,*) 'lim_hdf : Ice horizontal diffusion' 
    241          WRITE(numout,*) '~~~~~~~' 
    242       ENDIF 
     230      NAMELIST/namicehdf/ nn_ahi0, rn_ahi0_ref 
     231      INTEGER  ::   ji, jj 
     232      REAL(wp) ::   za00, zd_max 
     233      !!------------------------------------------------------------------- 
    243234      ! 
    244235      REWIND( numnam_ice_ref )              ! Namelist namicehdf in reference namelist : Ice horizontal diffusion 
     
    253244      IF(lwp) THEN                          ! control print 
    254245         WRITE(numout,*) 
    255          WRITE(numout,*)'   Namelist of ice parameters for ice horizontal diffusion computation ' 
    256          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 
    257250      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 
    258294      ! 
    259295   END SUBROUTINE lim_hdf_init 
     
    266302   !!====================================================================== 
    267303END MODULE limhdf 
    268  
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r6469 r6515  
    2929   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3030   USE wrk_nemo         ! work arrays 
     31   USE fldread          ! read input fields 
     32   USE iom 
    3133 
    3234   IMPLICIT NONE 
     
    3537   PUBLIC   lim_istate      ! routine called by lim_init.F90 
    3638 
    37    !                          !!** init namelist (namiceini) ** 
    38    REAL(wp) ::   rn_thres_sst   ! threshold water temperature for initial sea ice 
    39    REAL(wp) ::   rn_hts_ini_n   ! initial snow thickness in the north 
    40    REAL(wp) ::   rn_hts_ini_s   ! initial snow thickness in the south 
    41    REAL(wp) ::   rn_hti_ini_n   ! initial ice thickness in the north 
    42    REAL(wp) ::   rn_hti_ini_s   ! initial ice thickness in the south 
    43    REAL(wp) ::   rn_ati_ini_n   ! initial leads area in the north 
    44    REAL(wp) ::   rn_ati_ini_s   ! initial leads area in the south 
    45    REAL(wp) ::   rn_smi_ini_n   ! initial salinity  
    46    REAL(wp) ::   rn_smi_ini_s   ! initial salinity 
    47    REAL(wp) ::   rn_tmi_ini_n   ! initial temperature 
    48    REAL(wp) ::   rn_tmi_ini_s   ! initial temperature 
    49  
    50    LOGICAL  ::  ln_iceini    ! initialization or not 
     39   INTEGER , PARAMETER ::   jpfldi = 6           ! maximum number of files to read 
     40   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness (m)    at T-point 
     41   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snow thicknes (m)    at T-point 
     42   INTEGER , PARAMETER ::   jp_ati = 3           ! index of ice fraction (%) at T-point 
     43   INTEGER , PARAMETER ::   jp_tsu = 4           ! index of ice surface temp (K)    at T-point 
     44   INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temp at T-point 
     45   INTEGER , PARAMETER ::   jp_smi = 6           ! index of ice sali at T-point 
     46   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    5147   !!---------------------------------------------------------------------- 
    5248   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
     
    8985      REAL(wp)   :: ztmelts, zdh 
    9086      INTEGER    :: i_hemis, i_fill, jl0   
    91       REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 
    92       REAL(wp), POINTER, DIMENSION(:)     :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini 
    93       REAL(wp), POINTER, DIMENSION(:,:)   :: zh_i_ini, za_i_ini, zv_i_ini 
     87      REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv  
    9488      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator 
    95       INTEGER,  POINTER, DIMENSION(:,:)   :: zhemis   ! hemispheric index 
    96       !-------------------------------------------------------------------- 
    97  
    98       CALL wrk_alloc( jpi, jpj, zswitch ) 
    99       CALL wrk_alloc( jpi, jpj, zhemis ) 
    100       CALL wrk_alloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
    101       CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
     89      REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, zat_i_ini, zvt_i_ini            !data from namelist or nc file 
     90      REAL(wp), POINTER, DIMENSION(:,:)   :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
     91      REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini, zv_i_ini               !data by cattegories to fill 
     92      !-------------------------------------------------------------------- 
     93 
     94      CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     95      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 ) 
     96      CALL wrk_alloc( jpi, jpj,      zswitch ) 
    10297 
    10398      IF(lwp) WRITE(numout,*) 
     
    121116      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
    122117 
    123       IF( ln_iceini ) THEN 
    124  
    125       !-------------------------------------------------------------------- 
    126       ! 2) Basal temperature, ice mask and hemispheric index 
    127       !-------------------------------------------------------------------- 
    128  
    129       DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    130          DO ji = 1, jpi 
    131             IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
    132                zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice 
    133             ELSE                                                                                    
    134                zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice 
    135             ENDIF 
     118 
     119      IF( ln_limini ) THEN 
     120 
     121         !-------------------------------------------------------------------- 
     122         ! 2) Basal temperature, ice mask and hemispheric index 
     123         !-------------------------------------------------------------------- 
     124 
     125         DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
     126            DO ji = 1, jpi 
     127               IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
     128                  zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice 
     129               ELSE                                                                                    
     130                  zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice 
     131               ENDIF 
     132            END DO 
    136133         END DO 
    137       END DO 
    138  
    139  
    140       ! Hemispheric index 
    141       DO jj = 1, jpj 
    142          DO ji = 1, jpi 
    143             IF( fcor(ji,jj) >= 0._wp ) THEN     
    144                zhemis(ji,jj) = 1 ! Northern hemisphere 
    145             ELSE 
    146                zhemis(ji,jj) = 2 ! Southern hemisphere 
    147             ENDIF 
    148          END DO 
    149       END DO 
    150  
    151       !-------------------------------------------------------------------- 
    152       ! 3) Initialization of sea ice state variables 
    153       !-------------------------------------------------------------------- 
    154  
    155       !----------------------------- 
    156       ! 3.1) Hemisphere-dependent arrays 
    157       !----------------------------- 
    158       ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
    159       zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s  ! ice thickness 
    160       zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s  ! snow depth 
    161       zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s  ! ice concentration 
    162       zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s  ! bulk ice salinity 
    163       ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s  ! temperature (ice and snow) 
    164  
    165       zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume 
    166  
    167       !--------------------------------------------------------------------- 
    168       ! 3.2) Distribute ice concentration and thickness into the categories 
    169       !--------------------------------------------------------------------- 
    170       ! a gaussian distribution for ice concentration is used 
    171       ! then we check whether the distribution fullfills 
    172       ! volume and area conservation, positivity and ice categories bounds 
    173       DO i_hemis = 1, 2 
    174  
    175       ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0 
    176  
    177       ! note for the great nemo engineers:  
    178       ! only very few of the WRITE statements are necessary for the reference version 
    179       ! they were one day useful, but now i personally doubt of their 
    180       ! potential for bringing anything useful 
    181  
    182       DO i_fill = jpl, 1, -1 
    183          IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN 
    184             !---------------------------- 
    185             ! fill the i_fill categories 
    186             !---------------------------- 
    187             ! *** 1 category to fill 
    188             IF ( i_fill .EQ. 1 ) THEN 
    189                zh_i_ini(1,i_hemis)       = zht_i_ini(i_hemis) 
    190                za_i_ini(1,i_hemis)       = zat_i_ini(i_hemis) 
    191                zh_i_ini(2:jpl,i_hemis)   = 0._wp 
    192                za_i_ini(2:jpl,i_hemis)   = 0._wp 
    193             ELSE 
    194  
    195                ! *** >1 categores to fill 
    196                !--- Ice thicknesses in the i_fill - 1 first categories 
    197                DO jl = 1, i_fill - 1 
    198                   zh_i_ini(jl,i_hemis) = hi_mean(jl) 
    199                END DO 
    200                 
    201                !--- jl0: most likely index where cc will be maximum 
    202                DO jl = 1, jpl 
    203                   IF ( ( zht_i_ini(i_hemis) >  hi_max(jl-1) ) .AND. & 
    204                      & ( zht_i_ini(i_hemis) <= hi_max(jl)   ) ) THEN 
    205                      jl0 = jl 
     134 
     135         !-------------------------------------------------------------------- 
     136         ! 3) Initialization of sea ice state variables 
     137         !-------------------------------------------------------------------- 
     138         IF( ln_limini_file )THEN 
     139 
     140            zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1) 
     141            zht_s_ini(:,:)  = si(jp_hts)%fnow(:,:,1) 
     142            zat_i_ini(:,:)  = si(jp_ati)%fnow(:,:,1) 
     143            zts_u_ini(:,:)  = si(jp_tsu)%fnow(:,:,1) 
     144            ztm_i_ini(:,:)  = si(jp_tmi)%fnow(:,:,1) 
     145            zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1) 
     146 
     147         ELSE ! ln_limini_file = F 
     148 
     149            !----------------------------- 
     150            ! 3.1) Hemisphere-dependent arrays 
     151            !----------------------------- 
     152            ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
     153            DO jj = 1, jpj 
     154               DO ji = 1, jpi 
     155                  IF( fcor(ji,jj) >= 0._wp ) THEN 
     156                     zht_i_ini(ji,jj) = rn_hti_ini_n 
     157                     zht_s_ini(ji,jj) = rn_hts_ini_n 
     158                     zat_i_ini(ji,jj) = rn_ati_ini_n 
     159                     zts_u_ini(ji,jj) = rn_tmi_ini_n 
     160                     zsm_i_ini(ji,jj) = rn_smi_ini_n 
     161                     ztm_i_ini(ji,jj) = rn_tmi_ini_n 
     162                  ELSE 
     163                     zht_i_ini(ji,jj) = rn_hti_ini_s 
     164                     zht_s_ini(ji,jj) = rn_hts_ini_s 
     165                     zat_i_ini(ji,jj) = rn_ati_ini_s 
     166                     zts_u_ini(ji,jj) = rn_tmi_ini_s 
     167                     zsm_i_ini(ji,jj) = rn_smi_ini_s 
     168                     ztm_i_ini(ji,jj) = rn_tmi_ini_s 
    206169                  ENDIF 
    207170               END DO 
    208                jl0 = MIN(jl0, i_fill) 
    209                 
    210                !--- Concentrations 
    211                za_i_ini(jl0,i_hemis)      = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 
    212                DO jl = 1, i_fill - 1 
    213                   IF ( jl .NE. jl0 ) THEN 
    214                      zsigma               = 0.5 * zht_i_ini(i_hemis) 
    215                      zarg                 = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma 
    216                      za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 
    217                   ENDIF 
    218                END DO 
    219                 
    220                zA = 0. ! sum of the areas in the jpl categories  
    221                DO jl = 1, i_fill - 1 
    222                  zA = zA + za_i_ini(jl,i_hemis) 
    223                END DO 
    224                za_i_ini(i_fill,i_hemis)   = zat_i_ini(i_hemis) - zA ! ice conc in the last category 
    225                IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
     171            END DO 
     172 
     173         ENDIF ! ln_limini_file 
    226174          
    227                !--- Ice thickness in the last category 
    228                zV = 0. ! sum of the volumes of the N-1 categories 
    229                DO jl = 1, i_fill - 1 
    230                   zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis) 
    231                END DO 
    232                zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
    233                IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    234  
    235                !--- volumes 
    236                zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis) 
    237                IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    238  
    239             ENDIF ! i_fill 
    240  
    241             !--------------------- 
    242             ! Compatibility tests 
    243             !--------------------- 
    244             ! Test 1: area conservation 
    245             zA_cons = SUM(za_i_ini(:,i_hemis)) ; zconv = ABS(zat_i_ini(i_hemis) - zA_cons ) 
    246             IF ( zconv .LT. 1.0e-6 ) THEN 
    247                ztest_1 = 1 
    248             ELSE  
    249               ! this write is useful 
    250               IF(lwp)  WRITE(numout,*) ' * TEST1 AREA NOT CONSERVED *** zA_cons = ', zA_cons,' zat_i_ini = ',zat_i_ini(i_hemis)  
    251                ztest_1 = 0 
    252             ENDIF 
    253  
    254             ! Test 2: volume conservation 
    255             zV_cons = SUM(zv_i_ini(:,i_hemis)) 
    256             zconv = ABS(zvt_i_ini(i_hemis) - zV_cons) 
    257  
    258             IF ( zconv .LT. 1.0e-6 ) THEN 
    259                ztest_2 = 1 
    260             ELSE 
    261               ! this write is useful 
    262               IF(lwp)  WRITE(numout,*) ' * TEST2 VOLUME NOT CONSERVED *** zV_cons = ', zV_cons, & 
    263                             ' zvt_i_ini = ', zvt_i_ini(i_hemis) 
    264                ztest_2 = 0 
    265             ENDIF 
    266  
    267             ! Test 3: thickness of the last category is in-bounds ? 
    268             IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN 
    269                ztest_3 = 1 
    270             ELSE 
    271                ! this write is useful 
    272                IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 
    273                zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
    274                ztest_3 = 0 
    275             ENDIF 
    276  
    277             ! Test 4: positivity of ice concentrations 
    278             ztest_4 = 1 
    279             DO jl = 1, jpl 
    280                IF ( za_i_ini(jl,i_hemis) .LT. 0._wp ) THEN  
    281                   ! this write is useful 
    282                   IF(lwp) WRITE(numout,*) ' * TEST 4 POSITIVITY NOT OK FOR CAT ', jl, ' WITH A = ', za_i_ini(jl,i_hemis) 
    283                   ztest_4 = 0 
    284                ENDIF 
    285             END DO 
    286  
    287          ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4 
    288   
    289          ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 
    290  
    291       END DO ! i_fill 
    292  
    293       IF(lwp) THEN  
    294          WRITE(numout,*) ' ztests : ', ztests 
    295          IF ( ztests .NE. 4 ) THEN 
    296             WRITE(numout,*) 
    297             WRITE(numout,*) ' !!!! ALERT                  !!! ' 
    298             WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    299             WRITE(numout,*) 
    300             WRITE(numout,*) ' *** ztests is not equal to 4 ' 
    301             WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    302             WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(i_hemis) 
    303             WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(i_hemis) 
    304          ENDIF ! ztests .NE. 4 
    305       ENDIF 
    306        
    307       END DO ! i_hemis 
    308  
    309       !--------------------------------------------------------------------- 
    310       ! 3.3) Space-dependent arrays for ice state variables 
    311       !--------------------------------------------------------------------- 
    312  
    313       ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 
    314       DO jl = 1, jpl ! loop over categories 
     175         zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)   ! ice volume 
     176         !--------------------------------------------------------------------- 
     177         ! 3.2) Distribute ice concentration and thickness into the categories 
     178         !--------------------------------------------------------------------- 
     179         ! a gaussian distribution for ice concentration is used 
     180         ! then we check whether the distribution fullfills 
     181         ! volume and area conservation, positivity and ice categories bounds 
     182         zh_i_ini(:,:,:) = 0._wp  
     183         za_i_ini(:,:,:) = 0._wp 
     184         zv_i_ini(:,:,:) = 0._wp 
     185 
    315186         DO jj = 1, jpj 
    316187            DO ji = 1, jpi 
    317                a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
    318                ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))   ! ice thickness 
    319                ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth 
    320                sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj))     ! salinity 
    321                o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                        ! age (1 day) 
    322                t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 
    323  
    324                ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
    325                ! In case snow load is in excess that would lead to transformation from snow to ice 
    326                ! Then, transfer the snow excess into the ice (different from limthd_dh) 
    327                zdh = MAX( 0._wp, ( rhosn * ht_s(ji,jj,jl) + ( rhoic - rau0 ) * ht_i(ji,jj,jl) ) * r1_rau0 )  
    328                ! recompute ht_i, ht_s avoiding out of bounds values 
    329                ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh ) 
    330                ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn ) 
    331  
    332                ! ice volume, salt content, age content 
    333                v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume 
    334                v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume 
    335                smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 
    336                oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content 
    337             END DO 
    338          END DO 
    339       END DO 
    340  
    341       ! for constant salinity in time 
    342       IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN 
    343          CALL lim_var_salprof 
    344          smv_i = sm_i * v_i 
    345       ENDIF 
    346  
    347       ! Snow temperature and heat content 
    348       DO jk = 1, nlay_s 
     188 
     189               IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 
     190 
     191                  ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0 
     192!                  ztests  = 0  
     193 
     194                  DO i_fill = jpl, 1, -1 
     195 
     196!                     IF( ztests .NE. 4 ) THEN 
     197                     IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN 
     198                        !---------------------------- 
     199                        ! fill the i_fill categories 
     200                        !---------------------------- 
     201                        ! *** 1 category to fill 
     202                        IF ( i_fill .EQ. 1 ) THEN 
     203                           zh_i_ini(ji,jj,    1)   = zht_i_ini(ji,jj) 
     204                           za_i_ini(ji,jj,    1)   = zat_i_ini(ji,jj) 
     205                           zh_i_ini(ji,jj,2:jpl)   = 0._wp 
     206                           za_i_ini(ji,jj,2:jpl)   = 0._wp 
     207                        ELSE 
     208 
     209                           ! *** >1 categores to fill 
     210                           !--- Ice thicknesses in the i_fill - 1 first categories 
     211                           DO jl = 1, i_fill - 1 
     212                              zh_i_ini(ji,jj,jl) = hi_mean(jl) 
     213                           END DO 
     214                
     215                           !--- jl0: most likely index where cc will be maximum 
     216                           DO jl = 1, jpl 
     217                              IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. & 
     218                                 & ( zht_i_ini(ji,jj) <= hi_max(jl)   ) ) THEN 
     219                                 jl0 = jl 
     220                              ENDIF 
     221                           END DO 
     222                           jl0 = MIN(jl0, i_fill) 
     223                
     224                           !--- Concentrations 
     225                           za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 
     226                           DO jl = 1, i_fill - 1 
     227                              IF( jl .NE. jl0 )THEN 
     228                                 zsigma             = 0.5 * zht_i_ini(ji,jj) 
     229                                 zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / zsigma 
     230                                 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 
     231                              ENDIF 
     232                           END DO 
     233                
     234                           zA = 0. ! sum of the areas in the jpl categories  
     235                           DO jl = 1, i_fill - 1 
     236                              zA = zA + za_i_ini(ji,jj,jl) 
     237                           END DO 
     238                           za_i_ini(ji,jj,i_fill)   = zat_i_ini(ji,jj) - zA ! ice conc in the last category 
     239                           IF ( i_fill .LT. jpl ) za_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 
     240          
     241                           !--- Ice thickness in the last category 
     242                           zV = 0. ! sum of the volumes of the N-1 categories 
     243                           DO jl = 1, i_fill - 1 
     244                              zV = zV + za_i_ini(ji,jj,jl)*zh_i_ini(ji,jj,jl) 
     245                           END DO 
     246                           zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / za_i_ini(ji,jj,i_fill)  
     247                           IF ( i_fill .LT. jpl ) zh_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 
     248 
     249                           !--- volumes 
     250                           zv_i_ini(ji,jj,:) = za_i_ini(ji,jj,:) * zh_i_ini(ji,jj,:) 
     251                           IF ( i_fill .LT. jpl ) zv_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 
     252 
     253                        ENDIF ! i_fill 
     254 
     255                        !--------------------- 
     256                        ! Compatibility tests 
     257                        !--------------------- 
     258                        ! Test 1: area conservation 
     259                        zA_cons = SUM(za_i_ini(ji,jj,:)) ; zconv = ABS(zat_i_ini(ji,jj) - zA_cons ) 
     260                        IF ( zconv .LT. 1.0e-6 ) THEN 
     261                           ztest_1 = 1 
     262                        ELSE  
     263                          !this write is useful 
     264                          IF(lwp)  WRITE(numout,*) ' * TEST1 AREA NOT CONSERVED *** zA_cons = ', zA_cons,' zat_i_ini = ',zat_i_ini(ji,jj)  
     265                          ztest_1 = 0 
     266                        ENDIF 
     267 
     268                        ! Test 2: volume conservation 
     269                        zV_cons = SUM(zv_i_ini(ji,jj,:)) 
     270                        zconv = ABS(zvt_i_ini(ji,jj) - zV_cons) 
     271 
     272                        IF( zconv .LT. 1.0e-6 ) THEN 
     273                           ztest_2 = 1 
     274                        ELSE 
     275                           !this write is useful 
     276                           IF(lwp)  WRITE(numout,*) ' * TEST2 VOLUME NOT CONSERVED *** zV_cons = ', zV_cons, & 
     277                                                    ' zvt_i_ini = ', zvt_i_ini(ji,jj) 
     278                           ztest_2 = 0 
     279                        ENDIF 
     280 
     281                        ! Test 3: thickness of the last category is in-bounds ? 
     282                        IF ( zh_i_ini(ji,jj,i_fill) > hi_max(i_fill-1) ) THEN 
     283                           ztest_3 = 1 
     284                        ELSE 
     285                           ! this write is useful 
     286                           IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(ji,jj,i_fill) = ', & 
     287                           zh_i_ini(ji,jj,i_fill), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
     288                           IF(lwp) WRITE(numout,*) ' ji,jj,i_fill ',ji,jj,i_fill 
     289                           IF(lwp) WRITE(numout,*) 'zht_i_ini ',zht_i_ini(ji,jj) 
     290                           ztest_3 = 0 
     291                        ENDIF 
     292 
     293                        ! Test 4: positivity of ice concentrations 
     294                        ztest_4 = 1 
     295                        DO jl = 1, jpl 
     296                           IF ( za_i_ini(ji,jj,jl) .LT. 0._wp ) THEN  
     297                              ! this write is useful 
     298                              IF(lwp) WRITE(numout,*) ' * TEST 4 POSITIVITY NOT OK FOR CAT ', jl, ' WITH A = ', za_i_ini(ji,jj,jl) 
     299                              ztest_4 = 0 
     300                           ENDIF 
     301                        END DO 
     302 
     303                     ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4 
     304  
     305                     ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 
     306 
     307                  END DO ! i_fill 
     308 
     309                  IF(lwp) THEN  
     310                     WRITE(numout,*) ' ztests : ', ztests 
     311                     IF( ztests .NE. 4 )THEN 
     312                        WRITE(numout,*) 
     313                        WRITE(numout,*) ' !!!! ALERT                  !!! ' 
     314                        WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
     315                        WRITE(numout,*) 
     316                        WRITE(numout,*) ' *** ztests is not equal to 4 ' 
     317                        WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
     318                        WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 
     319                        WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 
     320                     ENDIF ! ztests .NE. 4 
     321                  ENDIF 
     322       
     323               ENDIF !  zat_i_ini(ji,jj) > 0._wp .AND. zhm_i_ini(ji,jj) > 0._wp 
     324 
     325            ENDDO    
     326         ENDDO    
     327 
     328         !--------------------------------------------------------------------- 
     329         ! 3.3) Space-dependent arrays for ice state variables 
     330         !--------------------------------------------------------------------- 
     331 
     332         ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 
    349333         DO jl = 1, jpl ! loop over categories 
    350334            DO jj = 1, jpj 
    351335               DO ji = 1, jpi 
    352                    t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 
    353                    ! Snow energy of melting 
    354                    e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
    355  
    356                    ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 
    357                    e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
     336                  a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini(ji,jj,jl)                       ! concentration 
     337                  ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(ji,jj,jl)                       ! ice thickness 
     338                  sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(ji,jj)                         ! salinity 
     339                  o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                                    ! age (1 day) 
     340                  t_su(ji,jj,jl)  = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 
     341 
     342                  IF( zht_i_ini(ji,jj) > 0._wp )THEN 
     343                    ht_s(ji,jj,jl)= ht_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) )  ! snow depth 
     344                  ELSE 
     345                    ht_s(ji,jj,jl)= 0._wp 
     346                  ENDIF 
     347 
     348                  ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
     349                  ! In case snow load is in excess that would lead to transformation from snow to ice 
     350                  ! Then, transfer the snow excess into the ice (different from limthd_dh) 
     351                  zdh = MAX( 0._wp, ( rhosn * ht_s(ji,jj,jl) + ( rhoic - rau0 ) * ht_i(ji,jj,jl) ) * r1_rau0 )  
     352                  ! recompute ht_i, ht_s avoiding out of bounds values 
     353                  ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh ) 
     354                  ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn ) 
     355 
     356                  ! ice volume, salt content, age content 
     357                  v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume 
     358                  v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume 
     359                  smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 
     360                  oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content 
    358361               END DO 
    359362            END DO 
    360363         END DO 
    361       END DO 
    362  
    363       ! Ice salinity, temperature and heat content 
    364       DO jk = 1, nlay_i 
    365          DO jl = 1, jpl ! loop over categories 
    366             DO jj = 1, jpj 
    367                DO ji = 1, jpi 
    368                    t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0  
    369                    s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin 
    370                    ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 
    371  
    372                    ! heat content per unit volume 
    373                    e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    374                       +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
    375                       -   rcp     * ( ztmelts - rt0 ) ) 
    376  
    377                    ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
    378                    e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
     364 
     365         ! for constant salinity in time 
     366         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN 
     367            CALL lim_var_salprof 
     368            smv_i = sm_i * v_i 
     369         ENDIF 
     370             
     371         ! Snow temperature and heat content 
     372         DO jk = 1, nlay_s 
     373            DO jl = 1, jpl ! loop over categories 
     374               DO jj = 1, jpj 
     375                  DO ji = 1, jpi 
     376                     t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 
     377                     ! Snow energy of melting 
     378                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
     379 
     380                     ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 
     381                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
     382                  END DO 
    379383               END DO 
    380384            END DO 
    381385         END DO 
    382       END DO 
    383  
    384       tn_ice (:,:,:) = t_su (:,:,:) 
    385  
    386       ELSE  
    387          ! if ln_iceini=false 
     386 
     387         ! Ice salinity, temperature and heat content 
     388         DO jk = 1, nlay_i 
     389            DO jl = 1, jpl ! loop over categories 
     390               DO jj = 1, jpj 
     391                  DO ji = 1, jpi 
     392                     t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0  
     393                     s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin 
     394                     ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 
     395 
     396                     ! heat content per unit volume 
     397                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     398                        +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
     399                        -   rcp     * ( ztmelts - rt0 ) ) 
     400 
     401                     ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
     402                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
     403                  END DO 
     404               END DO 
     405            END DO 
     406         END DO 
     407 
     408         tn_ice (:,:,:) = t_su (:,:,:) 
     409 
     410      ELSE ! if ln_limini=false 
    388411         a_i  (:,:,:) = 0._wp 
    389412         v_i  (:,:,:) = 0._wp 
     
    407430            END DO 
    408431         END DO 
    409        
    410       ENDIF ! ln_iceini 
     432 
     433      ENDIF ! ln_limini 
    411434       
    412435      at_i (:,:) = 0.0_wp 
     
    459482 
    460483 
    461       CALL wrk_dealloc( jpi, jpj, zswitch ) 
    462       CALL wrk_dealloc( jpi, jpj, zhemis ) 
    463       CALL wrk_dealloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
    464       CALL wrk_dealloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
     484      CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     485      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 ) 
     486      CALL wrk_dealloc( jpi, jpj,      zswitch ) 
    465487 
    466488   END SUBROUTINE lim_istate 
     
    482504      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    483505      !!----------------------------------------------------------------------------- 
    484       NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s,  & 
    485          &                                      rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s 
    486       INTEGER :: ios                 ! Local integer output status for namelist read 
     506      ! 
     507      INTEGER :: ios,ierr,inum_ice                 ! Local integer output status for namelist read 
     508      INTEGER :: ji,jj 
     509      INTEGER :: ifpr, ierror 
     510      ! 
     511      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ice files 
     512      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi 
     513      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read 
     514      ! 
     515      NAMELIST/namiceini/ ln_limini, ln_limini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  & 
     516         &                rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, & 
     517         &                rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             & 
     518         &                sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir 
    487519      !!----------------------------------------------------------------------------- 
    488520      ! 
     
    496528      IF(lwm) WRITE ( numoni, namiceini ) 
    497529 
     530      slf_i(jp_hti) = sn_hti  ;  slf_i(jp_hts) = sn_hts 
     531      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_tsu) = sn_tsu 
     532      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_smi) = sn_smi 
     533 
    498534      ! Define the initial parameters 
    499535      ! ------------------------- 
     
    503539         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    504540         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    505          WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini 
     541         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini     = ', ln_limini 
     542         WRITE(numout,*) '   ice initialization from a netcdf file      ln_limini_file  = ', ln_limini_file 
    506543         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst 
    507544         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n 
     
    517554      ENDIF 
    518555 
     556      IF( ln_limini_file ) THEN                      ! Ice initialization using input file 
     557         ! 
     558         ! set si structure 
     559         ALLOCATE( si(jpfldi), STAT=ierror ) 
     560         IF( ierror > 0 ) THEN 
     561            CALL ctl_stop( 'Ice_ini in limistate: unable to allocate si structure' )   ;   RETURN 
     562         ENDIF 
     563 
     564         DO ifpr = 1, jpfldi 
     565            ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) ) 
     566            ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) ) 
     567         END DO 
     568 
     569         ! fill si with slf_i and control print 
     570         CALL fld_fill( si, slf_i, cn_dir, 'lim_istate', 'lim istate ini', 'numnam_ice' ) 
     571 
     572         CALL fld_read( nit000, 1, si )                ! input fields provided at the current time-step 
     573 
     574      ENDIF 
     575 
    519576   END SUBROUTINE lim_istate_init 
    520577 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r6469 r6515  
    7070      !!                ***  ROUTINE lim_itd_me_alloc *** 
    7171      !!---------------------------------------------------------------------! 
    72       ALLOCATE(                                                                     & 
     72      ALLOCATE(                                                                      & 
    7373         !* 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 ) 
     74         &      asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl) , aksum (jpi,jpj)     ,   & 
     75         &      hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl)    , aridge(jpi,jpj,jpl) ,   & 
     76         &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl)    , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc ) 
    7877         ! 
    7978      IF( lim_itd_me_alloc /= 0 )   CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' ) 
     
    131130         CALL prt_ctl(tab2d_1=divu_i, clinfo1=' lim_itd_me: divu_i : ', tab2d_2=delta_i, clinfo2=' delta_i : ') 
    132131      ENDIF 
    133  
    134       IF( ln_limdyn ) THEN          !   Start ridging and rafting   ! 
    135132 
    136133      ! conservation test 
     
    211208            DO ji = 1, jpi 
    212209               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 
     210               IF    ( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN                  ! would lead to negative ato_i 
     211                  zfac          = - ato_i(ji,jj) / za 
    215212                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice  
    216213               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 
     214                  zfac          = ( asum(ji,jj) - ato_i(ji,jj) ) / za 
    218215                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice  
    219216               ENDIF 
     
    259256                  closing_net(ji,jj) = 0._wp 
    260257                  opning     (ji,jj) = 0._wp 
     258                  ato_i      (ji,jj) = MAX( 0._wp, 1._wp - SUM( a_i(ji,jj,:) ) ) 
    261259               ELSE 
    262260                  iterate_ridging    = 1 
     
    329327      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    330328 
    331       ENDIF  ! ln_limdyn=.true. 
    332       ! 
    333329      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 
    334330      ! 
     
    368364               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
    369365               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    370             END DO 
     366           END DO 
    371367         END DO 
    372368      END DO 
     
    438434      ENDIF 
    439435 
    440       IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions 
     436      ! --- Ridging and rafting participation concentrations --- ! 
     437      IF( ln_rafting .AND. ln_ridging ) THEN 
    441438         ! 
    442439         DO jl = 1, jpl 
     
    445442                  zdummy           = TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) 
    446443                  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) 
     444                  araft (ji,jj,jl) = athorn(ji,jj,jl) - aridge(ji,jj,jl) 
    448445               END DO 
    449446            END DO 
    450447         END DO 
    451  
    452       ELSE 
     448         ! 
     449      ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN 
    453450         ! 
    454451         DO jl = 1, jpl 
    455452            aridge(:,:,jl) = athorn(:,:,jl) 
     453         END DO 
     454         ! 
     455      ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN 
     456         ! 
     457         DO jl = 1, jpl 
     458            araft(:,:,jl) = athorn(:,:,jl) 
    456459         END DO 
    457460         ! 
     
    650653            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ij) * rhoic * r1_rdtice 
    651654            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ij) * rhoic * r1_rdtice   ! increase in ice volume due to seawater frozen in voids 
    652              
    653              ! virtual salt flux to keep salinity constant 
     655 
     656            ! virtual salt flux to keep salinity constant 
    654657            IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN 
    655658               srdg2(ij)      = srdg2(ij) - vsw(ij) * ( sss_m(ji,jj) - sm_i(ji,jj,jl1) )           ! ridge salinity = sm_i 
     
    657660                  &                            - sm_i(ji,jj,jl1) * vsw(ij) * rhoic * r1_rdtice     ! and get  sm_i  from the ocean  
    658661            ENDIF 
    659  
     662                
    660663            !------------------------------------------             
    661664            ! 3.7 Put the snow somewhere in the ocean 
     
    671674            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsnowrdg )         &  
    672675               &                                - esrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice        ! heat sink for ocean (<0, W.m-2) 
    673                 
     676 
    674677            !----------------------------------------------------------------- 
    675678            ! 3.8 Compute quantities used to apportion ice among categories 
     
    795798      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing 
    796799      REAL(wp)            ::   zp, z1_3    ! local scalars 
    797       REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here 
     800      REAL(wp), POINTER, DIMENSION(:,:) ::   zworka           ! temporary array used here 
     801      REAL(wp), POINTER, DIMENSION(:,:) ::   zstrp1, zstrp2   ! strength at previous time steps 
    798802      !!---------------------------------------------------------------------- 
    799803 
    800       CALL wrk_alloc( jpi, jpj, zworka ) 
     804      CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 
    801805 
    802806      !------------------------------------------------------------------------------! 
     
    848852         ksmooth = 1 
    849853 
    850          !------------------------------------------------------------------------------! 
    851          ! 4) Hibler (1979)' method 
    852          !------------------------------------------------------------------------------! 
     854      !------------------------------------------------------------------------------! 
     855      ! 4) Hibler (1979)' method 
     856      !------------------------------------------------------------------------------! 
    853857      ELSE                      ! kstrngth ne 1:  Hibler (1979) form 
    854858         ! 
     
    866870         DO jj = 1, jpj 
    867871            DO ji = 1, jpi 
    868                strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv_i(ji,jj),0.0))) 
     872               strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bvm_i(ji,jj),0.0))) 
    869873            END DO 
    870874         END DO 
     
    880884      IF ( ksmooth == 1 ) THEN 
    881885 
    882          CALL lbc_lnk( strength, 'T', 1. ) 
    883  
    884886         DO jj = 2, jpjm1 
    885887            DO ji = 2, jpim1 
    886                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
     888               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN  
    887889                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & 
    888890                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &   
     
    907909      ! Temporal smoothing 
    908910      !-------------------- 
    909       IF ( numit == nit000 + nn_fsbc - 1 ) THEN 
    910          strp1(:,:) = 0.0             
    911          strp2(:,:) = 0.0             
    912       ENDIF 
    913  
    914911      IF ( ksmooth == 2 ) THEN 
    915912 
    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  
     913         IF ( numit == nit000 + nn_fsbc - 1 ) THEN 
     914            zstrp1(:,:) = 0._wp 
     915            zstrp2(:,:) = 0._wp 
     916         ENDIF 
     917 
     918         DO jj = 2, jpjm1 
     919            DO ji = 2, jpim1 
     920               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN  
    921921                  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) 
     922                  IF ( zstrp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 
     923                  IF ( zstrp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 
     924                  zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / numts_rm 
     925                  zstrp2(ji,jj) = zstrp1(ji,jj) 
     926                  zstrp1(ji,jj) = strength(ji,jj) 
    927927                  strength(ji,jj) = zp 
    928  
    929928               ENDIF 
    930929            END DO 
    931930         END DO 
    932931 
     932         CALL lbc_lnk( strength, 'T', 1. )      ! Boundary conditions 
     933 
    933934      ENDIF ! ksmooth 
    934935 
    935       CALL lbc_lnk( strength, 'T', 1. )      ! Boundary conditions 
    936  
    937       CALL wrk_dealloc( jpi, jpj, zworka ) 
     936      CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 
    938937      ! 
    939938   END SUBROUTINE lim_itd_me_icestrength 
     
    953952      !!------------------------------------------------------------------- 
    954953      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 
     954      NAMELIST/namiceitdme/ rn_cs, nn_partfun, rn_gstar, rn_astar,             &  
     955        &                   ln_ridging, rn_hstar, rn_por_rdg, rn_fsnowrdg, ln_rafting, rn_hraft, rn_craft, rn_fsnowrft 
    958956      !!------------------------------------------------------------------- 
    959957      ! 
     
    969967      IF (lwp) THEN                          ! control print 
    970968         WRITE(numout,*) 
    971          WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution ' 
    972          WRITE(numout,*)' ~~~~~~~~~~~~~~~' 
     969         WRITE(numout,*)'lim_itd_me_init : ice parameters for mechanical ice redistribution ' 
     970         WRITE(numout,*)'~~~~~~~~~~~~~~~' 
    973971         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  
     972         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun 
    976973         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar 
    977974         WRITE(numout,*)'   Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar 
     975         WRITE(numout,*)'   Ridging of ice sheets or not                            ln_ridging  = ', ln_ridging 
    978976         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar 
     977         WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg 
     978         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg  
    979979         WRITE(numout,*)'   Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting 
    980980         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft 
    981981         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 
     982         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft  
    984983      ENDIF 
    985984      ! 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r6399 r6515  
    5353   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2] 
    5454   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean velocity   [m/s] 
    55    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0  , sice_0     ! cst SSS and ice salinity (levitating sea-ice)  
    5655 
    5756   !! * Substitutions 
     
    6968      !!             ***  ROUTINE lim_sbc_alloc *** 
    7069      !!------------------------------------------------------------------- 
    71       ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) ,                       & 
    72          &      sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc) 
     70      ALLOCATE( utau_oce(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc ) 
    7371         ! 
    7472      IF( lk_mpp             )   CALL mpp_sum( lim_sbc_alloc ) 
     
    110108      !!--------------------------------------------------------------------- 
    111109 
     110      ! --- case we bypass ice thermodynamics --- ! 
     111      IF( .NOT. ln_limthd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere 
     112         hfx_in   (:,:)   = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     113         hfx_out  (:,:)   = pfrld(:,:) *   qns_oce(:,:)                  + qemp_oce(:,:) 
     114         ftr_ice  (:,:,:) = 0._wp 
     115         emp_ice  (:,:)   = 0._wp 
     116         qemp_ice (:,:)   = 0._wp 
     117         qevap_ice(:,:,:) = 0._wp 
     118      ENDIF 
     119       
    112120      ! make calls for heat fluxes before it is modified 
    113121      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
     
    181189            ! mass flux from ice/ocean 
    182190            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    183                            + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     191                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj)  
    184192 
    185193            ! mass flux at the ocean/ice interface 
     
    193201      !------------------------------------------! 
    194202      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
    195          &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 
     203         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 
    196204 
    197205      !-------------------------------------------------------------! 
     
    283291            END DO 
    284292         END DO 
    285          CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. ) 
     293         CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 
    286294         ! 
    287295         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
     
    304312         END DO 
    305313      END DO 
    306       CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition 
     314      CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition 
    307315      ! 
    308316      IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   & 
     
    329337      !                                      ! allocate lim_sbc array 
    330338      IF( lim_sbc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 
    331       ! 
    332       soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    333       sice_0(:,:) = sice 
    334       ! 
    335       IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
    336          WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
    337             &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    338             soce_0(:,:) = 4._wp 
    339             sice_0(:,:) = 2._wp 
    340          END WHERE 
    341       ENDIF 
    342339      ! 
    343340      IF( .NOT. ln_rstart ) THEN 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r6399 r6515  
    2929   USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
    3030   USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
     31   USE limthd_da      ! LIM: thermodynamics, lateral melting 
    3132   USE limthd_sal     ! LIM: thermodynamics, ice salinity 
    3233   USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution 
     
    8990      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
    9091      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
     92      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io, zfric   ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 
    9193      ! 
    9294      !!------------------------------------------------------------------- 
     
    9496      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    9597 
     98      CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric ) 
     99 
     100      IF( kt == nit000 .AND. lwp ) THEN 
     101         WRITE(numout,*)''  
     102         WRITE(numout,*)' lim_thd ' 
     103         WRITE(numout,*)' ~~~~~~~~' 
     104      ENDIF 
     105       
    96106      ! conservation test 
    97107      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    98108 
    99109      CALL lim_var_glo2eqv 
    100       !------------------------------------------------------------------------! 
    101       ! 1) Initialization of some variables                                    ! 
    102       !------------------------------------------------------------------------! 
     110 
     111      !---------------------------------------------! 
     112      ! computation of friction velocity at T points 
     113      !---------------------------------------------! 
     114      IF( ln_limdyn ) THEN 
     115         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
     116         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
     117         DO jj = 2, jpjm1  
     118            DO ji = fs_2, fs_jpim1 
     119               zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
     120                  &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
     121                  &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 
     122            END DO 
     123         END DO 
     124      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
     125         DO jj = 2, jpjm1 
     126            DO ji = fs_2, fs_jpim1 
     127               zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & 
     128                  &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
     129                  &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
     130            END DO 
     131         END DO 
     132      ENDIF 
     133      CALL lbc_lnk( zfric, 'T',  1. ) 
     134      ! 
     135      !----------------------------------! 
     136      ! Initialization and units change 
     137      !----------------------------------! 
    103138      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice 
    104139 
    105       !-------------------- 
    106       ! 1.2) Heat content     
    107       !-------------------- 
    108140      ! Change the units of heat content; from J/m2 to J/m3 
    109141      DO jl = 1, jpl 
     
    111143            DO jj = 1, jpj 
    112144               DO ji = 1, jpi 
    113                   !0 if no ice and 1 if yes 
    114145                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  ) 
    115146                  !Energy of melting q(S,T) [J.m-3] 
     
    121152            DO jj = 1, jpj 
    122153               DO ji = 1, jpi 
    123                   !0 if no ice and 1 if yes 
    124154                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 )  ) 
    125155                  !Energy of melting q(S,T) [J.m-3] 
     
    130160      END DO 
    131161 
    132       ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    133       !-----------------------------------------------------------------------------! 
     162      !--------------------------------------------------------------------! 
     163      ! Partial computation of forcing for the thermodynamic sea ice model 
     164      !--------------------------------------------------------------------! 
    134165      DO jj = 1, jpj 
    135166         DO ji = 1, jpi 
     
    150181 
    151182            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 
    152             zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
     183            zfric_u      = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
    153184            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
    154185            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     
    168199            ENDIF 
    169200            ! 
    170             ! ----------------------------------------- 
    171             ! Net heat flux on top of ice-ocean [W.m-2] 
    172             ! ----------------------------------------- 
     201            ! Net heat flux on top of the ice-ocean [W.m-2] 
     202            ! --------------------------------------------- 
    173203            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
    174  
    175             ! ----------------------------------------------------------------------------- 
    176             ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
    177             ! ----------------------------------------------------------------------------- 
    178             !     First  step here              :  non solar + precip - qlead - qturb 
    179             !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
    180             !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     204         END DO 
     205      END DO 
     206       
     207      ! In case we bypass open-water ice formation 
     208      IF( .NOT. ln_limdO )  qlead(:,:) = 0._wp 
     209      ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 
     210      IF( .NOT. ln_limdH )  hfx_in(:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     211      IF( .NOT. ln_limdH )  fhtur (:,:) = 0._wp  ;  fhld  (:,:) = 0._wp 
     212 
     213      ! --------------------------------------------------------------------- 
     214      ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
     215      ! --------------------------------------------------------------------- 
     216      !     First  step here              :  non solar + precip - qlead - qturb 
     217      !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
     218      !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     219      DO jj = 1, jpj 
     220         DO ji = 1, jpi 
    181221            hfx_out(ji,jj) =   pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj)  &  ! Non solar heat flux received by the ocean                
    182222               &             - qlead(ji,jj) * r1_rdtice                         &  ! heat flux taken from the ocean where there is open water ice formation 
     
    186226         END DO 
    187227      END DO 
    188  
     228          
    189229      !------------------------------------------------------------------------------! 
    190       ! 3) Select icy points and fulfill arrays for the vectorial grid.             
     230      ! Thermodynamic computation (only on grid points covered by ice) 
    191231      !------------------------------------------------------------------------------! 
    192  
    193232      DO jl = 1, jpl      !loop over ice categories 
    194233 
    195          IF( kt == nit000 .AND. lwp ) THEN 
    196             WRITE(numout,*) ' lim_thd : transfer to 1D vectors. Category no : ', jl  
    197             WRITE(numout,*) ' ~~~~~~~~' 
    198          ENDIF 
    199  
     234         ! select ice covered grid points 
    200235         nbpb = 0 
    201236         DO jj = 1, jpj 
     
    219254         ENDIF 
    220255 
    221          !------------------------------------------------------------------------------! 
    222          ! 4) Thermodynamic computation 
    223          !------------------------------------------------------------------------------! 
    224  
    225          IF( lk_mpp )   CALL mpp_ini_ice( nbpb , numout ) 
     256         IF( lk_mpp )         CALL mpp_ini_ice( nbpb , numout ) 
    226257 
    227258         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing. 
    228  
    229             !-------------------------! 
    230             ! --- Move to 1D arrays --- 
    231             !-------------------------! 
    232             CALL lim_thd_1d2d( nbpb, jl, 1 ) 
    233  
    234             !--------------------------------------! 
    235             ! --- Ice/Snow Temperature profile --- ! 
    236             !--------------------------------------! 
    237             CALL lim_thd_dif( 1, nbpb ) 
    238  
    239             !---------------------------------! 
    240             ! --- Ice/Snow thickness ---      ! 
    241             !---------------------------------! 
    242             CALL lim_thd_dh( 1, nbpb )     
    243  
    244             ! --- Ice enthalpy remapping --- ! 
    245             CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  
    246                                              
    247             !---------------------------------! 
    248             ! --- Ice salinity ---            ! 
    249             !---------------------------------! 
    250             CALL lim_thd_sal( 1, nbpb )     
    251  
    252             !---------------------------------! 
    253             ! --- temperature update ---      ! 
    254             !---------------------------------! 
    255             CALL lim_thd_temp( 1, nbpb ) 
    256  
    257             !------------------------------------! 
    258             ! --- lateral melting if monocat --- ! 
    259             !------------------------------------! 
    260             IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
    261                CALL lim_thd_lam( 1, nbpb ) 
     259            !                                                                 
     260            s_i_new   (:) = 0._wp ; dh_s_tot (:) = 0._wp                     ! --- some init --- ! 
     261            dh_i_surf (:) = 0._wp ; dh_i_bott(:) = 0._wp 
     262            dh_snowice(:) = 0._wp ; dh_i_sub (:) = 0._wp 
     263 
     264                              CALL lim_thd_1d2d( nbpb, jl, 1 )               ! --- Move to 1D arrays --- ! 
     265            ! 
     266            IF( ln_limdH )    CALL lim_thd_dif( 1, nbpb )                    ! --- Ice/Snow Temperature profile --- ! 
     267            ! 
     268            IF( ln_limdH )    CALL lim_thd_dh( 1, nbpb )                     ! --- Ice/Snow thickness --- !     
     269            ! 
     270            IF( ln_limdH )    CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  ! --- Ice enthalpy remapping --- ! 
     271            ! 
     272                              CALL lim_thd_sal( 1, nbpb )                    ! --- Ice salinity --- !     
     273            ! 
     274                              CALL lim_thd_temp( 1, nbpb )                   ! --- temperature update --- ! 
     275            ! 
     276            IF( ln_limdH ) THEN 
     277               IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
     278                              CALL lim_thd_lam( 1, nbpb )                    ! --- extra lateral melting if monocat --- ! 
     279               END IF 
    262280            END IF 
    263  
    264             !-------------------------! 
    265             ! --- Move to 2D arrays --- 
    266             !-------------------------! 
    267             CALL lim_thd_1d2d( nbpb, jl, 2 ) 
    268  
    269             ! 
    270             IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
     281            ! 
     282                              CALL lim_thd_1d2d( nbpb, jl, 2 )               ! --- Move to 2D arrays --- ! 
     283            ! 
     284            IF( lk_mpp )      CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
    271285         ENDIF 
    272286         ! 
    273287      END DO !jl 
    274288 
    275       !------------------------------------------------------------------------------! 
    276       ! 5) Global variables, diagnostics 
    277       !------------------------------------------------------------------------------! 
    278  
    279       !------------------------ 
    280       ! Ice heat content               
    281       !------------------------ 
     289      IF( ln_limdA)           CALL lim_thd_da                                ! --- lateral melting --- ! 
     290 
    282291      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    283292      DO jl = 1, jpl 
     
    285294            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 
    286295         END DO 
    287       END DO 
    288  
    289       !------------------------ 
    290       ! Snow heat content               
    291       !------------------------ 
    292       ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    293       DO jl = 1, jpl 
    294296         DO jk = 1, nlay_s 
    295297            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 
     
    297299      END DO 
    298300  
    299       !---------------------------------- 
    300301      ! Change thickness to volume 
    301       !---------------------------------- 
    302302      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:) 
    303303      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
    304304      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    305305 
    306       ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 
     306      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting) 
    307307      DO jl  = 1, jpl 
    308308         DO jj = 1, jpj 
     
    316316      CALL lim_var_zapsmall 
    317317 
    318       !-------------------------------------------- 
    319       ! Diagnostic thermodynamic growth rates 
    320       !-------------------------------------------- 
     318      ! control checks 
    321319      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print 
    322  
    323       IF(ln_ctl) THEN            ! Control print 
    324          CALL prt_ctl_info(' ') 
    325          CALL prt_ctl_info(' - Cell values : ') 
    326          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    327          CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd  : cell area :') 
    328          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :') 
    329          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :') 
    330          CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_thd  : vt_s      :') 
    331          DO jl = 1, jpl 
    332             CALL prt_ctl_info(' ') 
    333             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    334             CALL prt_ctl_info('   ~~~~~~~~~~') 
    335             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_thd  : a_i      : ') 
    336             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_thd  : ht_i     : ') 
    337             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_thd  : ht_s     : ') 
    338             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_thd  : v_i      : ') 
    339             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_thd  : v_s      : ') 
    340             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_thd  : e_s      : ') 
    341             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_thd  : t_su     : ') 
    342             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_thd  : t_snow   : ') 
    343             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_thd  : sm_i     : ') 
    344             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_thd  : smv_i    : ') 
    345             DO jk = 1, nlay_i 
    346                CALL prt_ctl_info(' ') 
    347                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    348                CALL prt_ctl_info('   ~~~~~~~') 
    349                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_thd  : t_i      : ') 
    350                CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_thd  : e_i      : ') 
    351             END DO 
    352          END DO 
    353       ENDIF 
    354       ! 
    355320      ! 
    356321      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    357322 
    358       !------------------------------------------------------------------------------| 
    359       !  6) Transport of ice between thickness categories.                           | 
    360       !------------------------------------------------------------------------------| 
     323      !------------------------------------------------! 
     324      !  Transport ice between thickness categories 
     325      !------------------------------------------------! 
    361326      ! Given thermodynamic growth rates, transport ice between thickness categories. 
    362327      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     
    366331      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    367332 
    368       !------------------------------------------------------------------------------| 
    369       !  7) Add frazil ice growing in leads. 
    370       !------------------------------------------------------------------------------| 
     333      !------------------------------------------------! 
     334      !  Add frazil ice growing in leads 
     335      !------------------------------------------------! 
    371336      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    372337 
    373       CALL lim_thd_lac 
     338      IF( ln_limdO )     CALL lim_thd_lac 
    374339       
    375340      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     
    409374         END DO 
    410375      ENDIF 
     376      ! 
     377      CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric ) 
    411378      ! 
    412379      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
     
    632599      !!------------------------------------------------------------------- 
    633600      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    634       NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                       & 
    635          &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 
    636          &                nn_monocat, ln_it_qnsice 
     601      NAMELIST/namicethd/ rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,ln_it_qnsice,nn_monocat,  & 
     602         &                ln_limdH, rn_betas,                                                          & 
     603         &                ln_limdA, rn_beta, rn_dmin,                                                  & 
     604         &                ln_limdO, rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, rn_himin 
    637605      !!------------------------------------------------------------------- 
    638       ! 
    639       IF(lwp) THEN 
    640          WRITE(numout,*) 
    641          WRITE(numout,*) 'lim_thd : Ice Thermodynamics' 
    642          WRITE(numout,*) '~~~~~~~' 
    643       ENDIF 
    644606      ! 
    645607      REWIND( numnam_ice_ref )              ! Namelist namicethd in reference namelist : Ice thermodynamics 
     
    656618         IF(lwp) WRITE(numout, *) '   nn_monocat must be 0 in multi-category case ' 
    657619      ENDIF 
    658  
    659620      ! 
    660621      IF(lwp) THEN                          ! control print 
    661622         WRITE(numout,*) 
    662          WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation ' 
     623         WRITE(numout,*) 'lim_thd_init : Ice Thermodynamics' 
     624         WRITE(numout,*) '~~~~~~~~~~~~~' 
     625         WRITE(numout,*)'   -- limthd_dif --' 
     626         WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i 
     627         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nn_conv_dif  = ', nn_conv_dif 
     628         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif 
     629         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon 
     630         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice 
     631         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat 
     632         WRITE(numout,*)'   -- limthd_dh --' 
     633         WRITE(numout,*)'      activate ice thick change from top/bot (T) or not (F)   ln_limdH     = ', ln_limdH 
     634         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas 
     635         WRITE(numout,*)'   -- limthd_da --' 
     636         WRITE(numout,*)'      activate lateral melting (T) or not (F)                 ln_limdA     = ', ln_limdA 
     637         WRITE(numout,*)'      Coef. beta for lateral melting param.                   rn_beta      = ', rn_beta 
     638         WRITE(numout,*)'      Minimum floe diameter for lateral melting param.        rn_dmin      = ', rn_dmin 
     639         WRITE(numout,*)'   -- limthd_lac --' 
     640         WRITE(numout,*)'      activate ice growth in open-water (T) or not (F)        ln_limdO     = ', ln_limdO 
    663641         WRITE(numout,*)'      ice thick. for lateral accretion                        rn_hnewice   = ', rn_hnewice 
    664642         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       ln_frazil    = ', ln_frazil 
     
    666644         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  rn_vfrazb    = ', rn_vfrazb 
    667645         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          rn_Cfrazb    = ', rn_Cfrazb 
     646         WRITE(numout,*)'   -- limitd_th --' 
    668647         WRITE(numout,*)'      minimum ice thickness                                   rn_himin     = ', rn_himin  
    669          WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice ' 
    670          WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas 
    671          WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i 
    672          WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nn_conv_dif  = ', nn_conv_dif 
    673          WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif 
    674          WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon 
    675648         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
    676          WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat 
    677          WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice 
    678649      ENDIF 
    679650      ! 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r6469 r6515  
    7676      REAL(wp) ::   zdum        
    7777      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment 
    78       REAL(wp) ::   zs_snic      ! snow-ice salinity 
    7978      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity 
    8079      REAL(wp) ::   zswi12       ! switch for computation of bottom salinity 
     
    126125      CALL wrk_alloc( jpij, nlay_i, icount ) 
    127126        
    128       dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp ; dh_i_sub(:) = 0._wp 
    129       dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp    
    130  
    131127      zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp 
    132128      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp ; zevap_rema(:) = 0._wp ; 
     
    135131      zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp        
    136132      icount (:,:) = 0 
    137  
    138133 
    139134      ! Initialize enthalpy at nlay_i+1 
     
    634629         ht_s_1d(ji)    = ht_s_1d(ji) - dh_snowice(ji) 
    635630 
    636          ! Salinity of snow ice 
     631         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 
    637632         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    638          zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
    639  
    640          ! entrapment during snow ice formation 
    641          ! new salinity difference stored (to be used in limthd_sal.F90) 
    642          IF (  nn_icesal == 2  ) THEN 
    643             rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 
    644             ! salinity dif due to snow-ice formation 
    645             dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch      
    646             ! salinity dif due to bottom growth  
    647             IF (  zf_tt(ji)  < 0._wp ) THEN 
    648                dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch 
    649             ENDIF 
    650          ENDIF 
    651  
    652          ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 
    653          zfmdt          = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp )    ! <0 
     633         zfmdt          = ( rhosn - rhoic ) * dh_snowice(ji)    ! <0 
    654634         zsstK          = sst_m(ii,ij) + rt0                                 
    655635         zEw            = rcp * ( zsstK - rt0 ) 
     
    664644         ! virtual salt flux to keep salinity constant 
    665645         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN 
    666             sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt                  * r1_rdtice  & ! put back sss_m into the ocean 
    667                &                            - sm_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice    ! and get  sm_i from the ocean  
     646            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt                  * r1_rdtice  & ! put back sss_m     into the ocean 
     647               &                            - sm_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice    ! and get  rn_icesal from the ocean  
    668648         ENDIF 
    669            
     649          
    670650         ! Contribution to mass flux 
    671651         ! All snow is thrown in the ocean, and seawater is taken to replace the volume 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r6469 r6515  
    5151      INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index 
    5252      ! 
    53       INTEGER  ::   ji, jk     ! dummy loop indices  
    54       REAL(wp) ::   iflush, igravdr   ! local scalars 
     53      INTEGER  ::   ii, ij, ji, jk               ! dummy loop indices  
     54      REAL(wp) ::   iflush, igravdr              ! local scalars 
     55      REAL(wp) ::   zs_sni, zsm_i_gd, zsm_i_fl, zsm_i_si, zsm_i_bg   ! local scalars 
    5556      !!--------------------------------------------------------------------- 
    5657 
    57       !--------------------------------------------------------- 
    58       !  0) Update ice salinity from snow-ice and bottom growth 
    59       !--------------------------------------------------------- 
    60       DO ji = kideb, kiut 
    61          sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 
    62       END DO 
    63   
    6458      !--------------------------------------------------------------------| 
    6559      ! 1) salinity constant in time                                       | 
    6660      !--------------------------------------------------------------------| 
    6761      ! do nothing 
    68  
     62       
    6963      !----------------------------------------------------------------------| 
    7064      !  2) salinity varying in time                                         | 
     
    7367 
    7468         DO ji = kideb, kiut 
    75             ! 
    76             ! Switches  
    77             !---------- 
    78             iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 )        )     ! =1 if summer  
    79             igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )    ! =1 if t_su < t_bo 
    8069 
    81             !--------------------- 
    82             ! Salinity tendencies 
    83             !--------------------- 
    84             ! drainage by gravity drainage 
    85             dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice  
    86             ! drainage by flushing   
    87             dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice 
     70            ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     71            !--------------------------------------------------------- 
     72            !  Update ice salinity from snow-ice and bottom growth 
     73            !--------------------------------------------------------- 
     74            zs_sni   = sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic   ! Salinity of snow ice 
     75            rswitch  = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 
     76            zsm_i_si = ( zs_sni      - sm_i_1d(ji) ) *             dh_snowice(ji)  / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! snow-ice     
     77            zsm_i_bg = ( s_i_new(ji) - sm_i_1d(ji) ) * MAX( 0._wp, dh_i_bott(ji) ) / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! bottom growth 
    8878 
    89             !----------------- 
    90             ! Update salinity    
    91             !----------------- 
    92             ! only drainage terms ( gravity drainage and flushing ) 
    93             ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 
    94             sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
     79            ! Update salinity (nb: salt flux already included in limthd_dh) 
     80            sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_bg + zsm_i_si 
    9581 
    96             !---------------------------- 
    97             ! Salt flux - brine drainage 
    98             !---------------------------- 
    99             sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 
    100  
     82            IF( ln_limdS ) THEN 
     83               !--------------------------------------------------------- 
     84               !  Update ice salinity from brine drainage and flushing 
     85               !--------------------------------------------------------- 
     86               iflush   = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0         ) )  ! =1 if summer  
     87               igravdr  = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )  ! =1 if t_su < t_bo 
     88               zsm_i_gd = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice  ! gravity drainage  
     89               zsm_i_fl = - iflush  * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice  ! flushing 
     90                
     91               ! Update salinity    
     92               sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_fl + zsm_i_gd 
     93                
     94               ! Salt flux 
     95               sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( zsm_i_fl + zsm_i_gd ) * r1_rdtice 
     96            ENDIF 
    10197         END DO 
    10298 
     
    127123      !!------------------------------------------------------------------- 
    128124      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    129       NAMELIST/namicesal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl,   & 
    130          &                rn_simax, rn_simin  
     125      NAMELIST/namicesal/ ln_limdS, nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd,   & 
     126         &                rn_sal_fl, rn_time_fl, rn_simax, rn_simin  
    131127      !!------------------------------------------------------------------- 
    132128      ! 
     
    144140         WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity ' 
    145141         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    146          WRITE(numout,*) '   switch for salinity nn_icesal        = ', nn_icesal 
    147          WRITE(numout,*) '   bulk salinity value if nn_icesal = 1 = ', rn_icesal 
    148          WRITE(numout,*) '   restoring salinity for GD            = ', rn_sal_gd 
    149          WRITE(numout,*) '   restoring time for GD                = ', rn_time_gd 
    150          WRITE(numout,*) '   restoring salinity for flushing      = ', rn_sal_fl 
    151          WRITE(numout,*) '   restoring time for flushing          = ', rn_time_fl 
    152          WRITE(numout,*) '   Maximum tolerated ice salinity       = ', rn_simax 
    153          WRITE(numout,*) '   Minimum tolerated ice salinity       = ', rn_simin 
     142         WRITE(numout,*) '   activate gravity drainage and flushing (T) or not (F)   ln_limdS   = ', ln_limdS 
     143         WRITE(numout,*) '   switch for salinity                                     nn_icesal  = ', nn_icesal 
     144         WRITE(numout,*) '   bulk salinity value if nn_icesal = 1                    rn_icesal  = ', rn_icesal 
     145         WRITE(numout,*) '   restoring salinity for gravity drainage                 rn_sal_gd  = ', rn_sal_gd 
     146         WRITE(numout,*) '   restoring time for for gravity drainage                 rn_time_gd = ', rn_time_gd 
     147         WRITE(numout,*) '   restoring salinity for flushing                         rn_sal_fl  = ', rn_sal_fl 
     148         WRITE(numout,*) '   restoring time for flushing                             rn_time_fl = ', rn_time_fl 
     149         WRITE(numout,*) '   Maximum tolerated ice salinity                          rn_simax   = ', rn_simax 
     150         WRITE(numout,*) '   Minimum tolerated ice salinity                          rn_simin   = ', rn_simin 
    154151      ENDIF 
    155152      ! 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r6476 r6515  
    3232   USE limcons        ! conservation tests 
    3333   USE limctl         ! control prints 
     34   USE limadv_umx     ! advection scheme 
    3435 
    3536   IMPLICIT NONE 
     
    6162      !! ** action : 
    6263      !!--------------------------------------------------------------------- 
    63       INTEGER, INTENT(in) ::   kt           ! number of iteration 
    64       ! 
    65       INTEGER  ::   ji, jj, jk, jm , jl, jt      ! dummy loop indices 
     64      INTEGER, INTENT(in) ::   kt   ! number of iteration 
     65      ! 
     66      INTEGER  ::   ji, jj, jk, jm, jl, jt  ! dummy loop indices 
    6667      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    6768      REAL(wp) ::   zcfl , zusnit           !   -      - 
    68       CHARACTER(len=80) ::   cltmp 
    69       ! 
    70       REAL(wp), POINTER, DIMENSION(:,:)      ::   zsm 
     69      CHARACTER(len=80) :: cltmp 
     70      ! 
     71      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
     72      REAL(wp) ::    zdv, zda 
     73      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold, zsmvold  
     74      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax, zviold, zvsold 
     75      ! --- diffusion --- ! 
     76      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhdfptab 
     77      INTEGER , PARAMETER                    ::   ihdf_vars  = 6 ! Number of variables in which we apply horizontal diffusion 
     78                                                                 !  inside limtrp for each ice category , not counting the  
     79                                                                 !  variables corresponding to ice_layers  
     80      ! --- ultimate macho only --- ! 
     81      REAL(wp)                               ::   zdt 
     82      LOGICAL                                ::   lcon 
     83      REAL(wp), POINTER, DIMENSION(:,:)      ::   ze, zu_trp, zv_trp, z1_v, zudy, zvdx 
     84      ! --- prather only --- ! 
     85      REAL(wp), POINTER, DIMENSION(:,:)      ::   zarea 
     86      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0opw 
    7187      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0ice, z0snw, z0ai, z0es , z0smi , z0oi 
    72       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0opw 
    7388      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   z0ei 
    74       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zviold, zvsold, zsmvold  ! old ice volume... 
    75       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax                   ! old ice thickness 
    76       REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold   ! old concentration, enthalpies 
    77       REAL(wp), POINTER, DIMENSION(:,:,:)             ::   zhdfptab 
    78       REAL(wp) ::    zdv, zvi, zvs, zsmv, zes, zei 
    79       REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
    80       !!--------------------------------------------------------------------- 
    81       INTEGER                                ::  ihdf_vars  = 6  !!Number of variables in which we apply horizontal diffusion 
    82                                                                    !!  inside limtrp for each ice category , not counting the  
    83                                                                    !!  variables corresponding to ice_layers  
     89      !! 
    8490      !!--------------------------------------------------------------------- 
    8591      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
    8692 
    87       CALL wrk_alloc( jpi,jpj,            zsm, zatold, zeiold, zesold ) 
     93      CALL wrk_alloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold ) 
     94      CALL wrk_alloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold ) 
     95      CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab) 
     96  
     97      IF( kt == nit000 .AND. lwp ) THEN 
     98         WRITE(numout,*)'' 
     99         WRITE(numout,*)'limtrp' 
     100         WRITE(numout,*)'~~~~~~' 
     101         ncfl = 0                ! nb of time step with CFL > 1/2 
     102      ENDIF 
     103       
     104      !-------------------------------------! 
     105      !   Advection of sea ice properties   ! 
     106      !-------------------------------------! 
     107 
     108      ! conservation test 
     109      IF( ln_limdiahsb )   CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     110       
     111      ! store old values for diag 
     112      zviold = v_i 
     113      zvsold = v_s 
     114      zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 ) 
     115      zeiold (:,:) = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )  
     116      zesold (:,:) = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )  
     117 
     118      !--- Thickness correction init. --- ! 
     119      zatold(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     120      DO jl = 1, jpl 
     121         DO jj = 1, jpj 
     122            DO ji = 1, jpi 
     123               rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
     124               ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     125               ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     126            END DO 
     127         END DO 
     128      END DO 
     129      ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- ! 
     130      zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 
     131      DO jl = 1, jpl 
     132         DO jj = 2, jpjm1 
     133            DO ji = 2, jpim1 
     134               zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) ) 
     135            END DO 
     136         END DO 
     137         CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 
     138      END DO 
     139          
     140      ! --- If ice drift field is too fast, use an appropriate time step for advection --- !         
     141      zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )    ! CFL test for stability 
     142      zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
     143      IF(lk_mpp )   CALL mpp_max( zcfl ) 
     144       
     145      IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
     146      ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
     147      ENDIF 
     148       
     149!!      IF( zcfl > 0.5_wp .AND. lwp ) THEN 
     150!!         ncfl = ncfl + 1 
     151!!         IF( ncfl > 0 ) THEN    
     152!!            WRITE(cltmp,'(i6.1)') ncfl 
     153!!            CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 
     154!!         ENDIF 
     155!!      ENDIF 
     156 
     157#if defined key_limumx 
     158      !=============================! 
     159      !==  Ultimate-MACHO scheme  ==! 
     160      !=============================! 
     161       
     162      CALL wrk_alloc( jpi,jpj, ze, zu_trp, zv_trp, z1_v, zudy, zvdx ) 
     163       
     164      IF( kt == nit000 .AND. lwp ) THEN 
     165         WRITE(numout,*)'' 
     166         WRITE(numout,*)'lim_adv_umx : Ultimate-MACHO advection scheme' 
     167         WRITE(numout,*)'~~~~~~~~~~~' 
     168      ENDIF 
     169      ! 
     170      zdt = rdt_ice / REAL(initad) 
     171       
     172      ! transport 
     173      zudy(:,:) = u_ice(:,:) * e2u(:,:) 
     174      zvdx(:,:) = v_ice(:,:) * e1v(:,:) 
     175      ! 
     176      DO jt = 1, initad 
     177         lcon = .TRUE.  
     178!!!            lcon = .false.  
     179         CALL lim_adv_umx( lcon, kt, zdt, zudy, zvdx, zudy, zvdx, ato_i(:,:), ato_i(:,:) )                                       ! Open water area  
     180         ! 
     181         DO jl = 1, jpl 
     182            WHERE( v_i(:,:,jl) /= 0._wp )   ;   z1_v(:,:) = 1._wp / v_i(:,:,jl) 
     183            ELSEWHERE                       ;   z1_v(:,:) = 0._wp 
     184            END WHERE 
     185            ! 
     186            lcon = .TRUE.  
     187!!!               lcon = .false.  
     188            CALL lim_adv_umx( lcon, kt, zdt, zudy, zvdx, zudy, zvdx, a_i(:,:,jl), a_i(:,:,jl) )                      ! Ice area 
     189            CALL lim_adv_umx( lcon, kt, zdt, zudy, zvdx, zudy, zvdx, v_i(:,:,jl), v_i(:,:,jl), zu_trp, zv_trp )      ! Ice  volume 
     190            ! 
     191            lcon = .FALSE.  
     192            ze(:,:) = smv_i(:,:,jl) * z1_v(:,:) 
     193            CALL lim_adv_umx( lcon, kt, zdt, zudy, zvdx, zu_trp, zv_trp, ze, smv_i(:,:,jl) )                           ! Salt content 
     194            ! 
     195!!!check that               ze(:,:) = oa_i (:,:,jl) * z1_v(:,:) 
     196!!!check that               CALL lim_adv_umx( lcon, kt, zdt, zudy, zvdx, zu_trp, zv_trp, ze, oa_i (:,:,jl) )                           ! Age content 
     197            ! 
     198            zu_trp(:,:) = zu_trp(:,:) * r1_nlay_i 
     199            zv_trp(:,:) = zv_trp(:,:) * r1_nlay_i 
     200            z1_v  (:,:) = z1_v  (:,:) * REAL( nlay_i, wp ) 
     201            DO jk = 1, nlay_i 
     202               ze (:,:) = e_i(:,:,jk,jl) * z1_v(:,:) 
     203               CALL lim_adv_umx( lcon, kt, zdt, zudy, zvdx, zu_trp, zv_trp, ze, e_i(:,:,jk,jl) )                                  ! Ice  heat content 
     204            END DO 
     205            ! 
     206            WHERE( v_s(:,:,jl) /= 0._wp )   ;   z1_v(:,:) = 1._wp / v_s(:,:,jl) 
     207            ELSEWHERE                       ;   z1_v(:,:) = 0._wp 
     208            END WHERE 
     209            ! 
     210            lcon = .TRUE.  
     211!!!               lcon = .false.  
     212            CALL lim_adv_umx( lcon, kt, zdt, zudy, zvdx, zudy, zvdx, v_s(:,:,jl), v_s(:,:,jl), zu_trp, zv_trp )      ! Snow volume 
     213            ! 
     214            lcon = .FALSE.  
     215            ze (:,:) = e_s(:,:,1,jl) * z1_v(:,:) 
     216            CALL lim_adv_umx( lcon, kt, zdt, zudy, zvdx, zu_trp, zv_trp, ze, e_s(:,:,1,jl) )                                     ! Snow heat content 
     217            ! 
     218         END DO 
     219      END DO 
     220      ! 
     221      at_i(:,:) = a_i(:,:,1)      ! total ice fraction 
     222      DO jl = 2, jpl 
     223         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     224      END DO 
     225      ! 
     226      CALL wrk_dealloc( jpi,jpj, ze, zu_trp, zv_trp, z1_v, zudy, zvdx ) 
     227         
     228#else 
     229      !=============================! 
     230      !==      Prather scheme     ==! 
     231      !=============================! 
     232 
     233      CALL wrk_alloc( jpi,jpj,            zarea ) 
     234      CALL wrk_alloc( jpi,jpj,1,          z0opw ) 
    88235      CALL wrk_alloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
    89       CALL wrk_alloc( jpi,jpj,1,          z0opw ) 
    90236      CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 
    91       CALL wrk_alloc( jpi,jpj,jpl,        zhimax, zviold, zvsold, zsmvold ) 
    92       CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1,zhdfptab) 
    93  
    94       IF( numit == nstart .AND. lwp ) THEN 
    95          WRITE(numout,*) 
    96          IF( ln_limdyn ) THEN   ;   WRITE(numout,*) 'lim_trp : Ice transport ' 
    97          ELSE                   ;   WRITE(numout,*) 'lim_trp : No ice advection as ln_limdyn = ', ln_limdyn 
    98          ENDIF 
    99          WRITE(numout,*) '~~~~~~~~~~~~' 
    100          ncfl = 0                ! nb of time step with CFL > 1/2 
    101       ENDIF 
    102  
    103       zsm(:,:) = e12t(:,:) 
    104        
    105       !                             !-------------------------------------! 
    106       IF( ln_limdyn ) THEN          !   Advection of sea ice properties   ! 
    107          !                          !-------------------------------------! 
    108  
    109          ! conservation test 
    110          IF( ln_limdiahsb )   CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    111  
    112          ! mass and salt flux init 
    113          zviold(:,:,:)  = v_i(:,:,:) 
    114          zvsold(:,:,:)  = v_s(:,:,:) 
    115          zsmvold(:,:,:) = smv_i(:,:,:) 
    116          zeiold(:,:)    = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )  
    117          zesold(:,:)    = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )  
    118  
    119          !--- Thickness correction init. ------------------------------- 
    120          zatold(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    121          DO jl = 1, jpl 
    122             DO jj = 1, jpj 
    123                DO ji = 1, jpi 
    124                   rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
    125                   ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    126                   ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     237       
     238      IF( kt == nit000 .AND. lwp ) THEN 
     239         WRITE(numout,*)'' 
     240         WRITE(numout,*)'lim_adv_xy : Prather advection scheme' 
     241         WRITE(numout,*)'~~~~~~~~~~~' 
     242      ENDIF 
     243 
     244      zarea(:,:) = e12t(:,:) 
     245       
     246      !------------------------- 
     247      ! transported fields                                         
     248      !------------------------- 
     249      z0opw(:,:,1) = ato_i(:,:) * e12t(:,:)             ! Open water area  
     250      DO jl = 1, jpl 
     251         z0snw (:,:,jl)  = v_s  (:,:,jl) * e12t(:,:)    ! Snow volume 
     252         z0ice(:,:,jl)   = v_i  (:,:,jl) * e12t(:,:)    ! Ice  volume 
     253         z0ai  (:,:,jl)  = a_i  (:,:,jl) * e12t(:,:)    ! Ice area 
     254         z0smi (:,:,jl)  = smv_i(:,:,jl) * e12t(:,:)    ! Salt content 
     255         z0oi (:,:,jl)   = oa_i (:,:,jl) * e12t(:,:)    ! Age content 
     256         z0es (:,:,jl)   = e_s  (:,:,1,jl) * e12t(:,:)  ! Snow heat content 
     257         DO jk = 1, nlay_i 
     258            z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e12t(:,:) ! Ice  heat content 
     259         END DO 
     260      END DO 
     261 
     262       
     263      IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==! 
     264         DO jt = 1, initad 
     265            CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
     266               &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     267            CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   & 
     268               &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     269            DO jl = 1, jpl 
     270               CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     271                  &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
     272               CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   & 
     273                  &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
     274               CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     275                  &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
     276               CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   & 
     277                  &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
     278               CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     279                  &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
     280               CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   & 
     281                  &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
     282               CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---      
     283                  &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
     284               CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   & 
     285                  &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
     286               CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations --- 
     287                  &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
     288               CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &  
     289                  &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
     290               CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &    !--- snow heat contents --- 
     291                  &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
     292               CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   & 
     293                  &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
     294               DO jk = 1, nlay_i                                                                !--- ice heat contents --- 
     295                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     296                     &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     297                     &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     298                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     299                     &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     300                     &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    127301               END DO 
    128302            END DO 
    129303         END DO 
    130          !--------------------------------------------------------------------- 
    131          ! Record max of the surrounding ice thicknesses for correction 
    132          ! in case advection creates ice too thick. 
    133          !--------------------------------------------------------------------- 
    134          zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 
    135          DO jl = 1, jpl 
    136             DO jj = 2, jpjm1 
    137                DO ji = 2, jpim1 
    138                   zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) ) 
     304      ELSE 
     305         DO jt = 1, initad 
     306            CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
     307               &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     308            CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   & 
     309               &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     310            DO jl = 1, jpl 
     311               CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     312                  &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
     313               CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   & 
     314                  &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
     315               CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     316                  &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
     317               CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   & 
     318                  &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
     319               CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     320                  &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
     321               CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   & 
     322                  &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
     323               CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
     324                  &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
     325               CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   & 
     326                  &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
     327               CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     328                  &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
     329               CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
     330                  &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
     331               CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     332                  &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
     333               CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   & 
     334                  &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
     335               DO jk = 1, nlay_i                                                           !--- ice heat contents --- 
     336                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     337                     &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     338                     &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     339                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     340                     &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     341                     &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    139342               END DO 
    140343            END DO 
    141             CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 
    142          END DO 
    143           
    144          !=============================! 
    145          !==      Prather scheme     ==! 
    146          !=============================! 
    147  
    148          ! If ice drift field is too fast, use an appropriate time step for advection.          
    149          zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )         ! CFL test for stability 
    150          zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
    151          IF(lk_mpp )   CALL mpp_max( zcfl ) 
    152  
    153          IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
    154          ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
    155          ENDIF 
    156  
    157          IF( zcfl > 0.5_wp .AND. lwp )   ncfl = ncfl + 1 
    158 !!         IF( lwp ) THEN 
    159 !!            IF( ncfl > 0 ) THEN    
    160 !!               WRITE(cltmp,'(i6.1)') ncfl 
    161 !!               CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 
    162 !!            ELSE 
    163 !!            !  WRITE(numout,*) 'lim_trp : CFL criterion for ice advection is always smaller than 1/2 ' 
    164 !!            ENDIF 
    165 !!         ENDIF 
    166  
    167          !------------------------- 
    168          ! transported fields                                         
    169          !------------------------- 
    170          z0opw(:,:,1) = ato_i(:,:) * e12t(:,:)             ! Open water area  
    171          DO jl = 1, jpl 
    172             z0snw (:,:,jl)  = v_s  (:,:,jl) * e12t(:,:)    ! Snow volume 
    173             z0ice(:,:,jl)   = v_i  (:,:,jl) * e12t(:,:)    ! Ice  volume 
    174             z0ai  (:,:,jl)  = a_i  (:,:,jl) * e12t(:,:)    ! Ice area 
    175             z0smi (:,:,jl)  = smv_i(:,:,jl) * e12t(:,:)    ! Salt content 
    176             z0oi (:,:,jl)   = oa_i (:,:,jl) * e12t(:,:)    ! Age content 
    177             z0es (:,:,jl)   = e_s  (:,:,1,jl) * e12t(:,:)  ! Snow heat content 
    178            DO jk = 1, nlay_i 
    179                z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e12t(:,:) ! Ice  heat content 
    180             END DO 
    181          END DO 
    182  
    183  
    184          IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==! 
    185             DO jt = 1, initad 
    186                CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
    187                   &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    188                CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:),   & 
    189                   &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    190                DO jl = 1, jpl 
    191                   CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    192                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    193                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   & 
    194                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    195                   CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    196                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    197                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   & 
    198                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    199                   CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    200                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    201                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   & 
    202                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    203                   CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---      
    204                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    205                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   & 
    206                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    207                   CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations --- 
    208                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    209                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &  
    210                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    211                   CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &    !--- snow heat contents --- 
    212                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    213                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   & 
    214                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    215                   DO jk = 1, nlay_i                                                                !--- ice heat contents --- 
    216                      CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
    217                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
    218                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    219                      CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
    220                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
    221                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    222                   END DO 
    223                END DO 
    224             END DO 
    225          ELSE 
    226             DO jt = 1, initad 
    227                CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
    228                   &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    229                CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:),   & 
    230                   &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    231                DO jl = 1, jpl 
    232                   CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    233                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    234                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   & 
    235                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    236                   CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    237                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    238                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   & 
    239                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    240                   CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    241                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    242                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   & 
    243                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    244                   CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    245                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    246                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   & 
    247                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    248                   CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    249                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    250                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
    251                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    252                   CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    253                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    254                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   & 
    255                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    256                   DO jk = 1, nlay_i                                                           !--- ice heat contents --- 
    257                      CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
    258                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
    259                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    260                      CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
    261                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
    262                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    263                   END DO 
    264                END DO 
    265             END DO 
    266          ENDIF 
    267  
    268          !------------------------------------------- 
    269          ! Recover the properties from their contents 
    270          !------------------------------------------- 
    271          ato_i(:,:) = z0opw(:,:,1) * r1_e12t(:,:) 
    272          DO jl = 1, jpl 
    273             v_i  (:,:,jl)   = z0ice(:,:,jl) * r1_e12t(:,:) 
    274             v_s  (:,:,jl)   = z0snw(:,:,jl) * r1_e12t(:,:) 
    275             smv_i(:,:,jl)   = z0smi(:,:,jl) * r1_e12t(:,:) 
    276             oa_i (:,:,jl)   = z0oi (:,:,jl) * r1_e12t(:,:) 
    277             a_i  (:,:,jl)   = z0ai (:,:,jl) * r1_e12t(:,:) 
    278             e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e12t(:,:) 
    279             DO jk = 1, nlay_i 
    280                e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e12t(:,:) 
    281             END DO 
    282          END DO 
    283  
    284          at_i(:,:) = a_i(:,:,1)      ! total ice fraction 
    285          DO jl = 2, jpl 
    286             at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    287          END DO 
    288  
    289          !------------------------------------------------------------------------------! 
    290          ! Diffusion of Ice fields                   
    291          !------------------------------------------------------------------------------! 
    292          !------------------------------------ 
    293          !  Diffusion of other ice variables 
    294          !------------------------------------ 
     344         END DO 
     345      ENDIF 
     346       
     347      !------------------------------------------- 
     348      ! Recover the properties from their contents 
     349      !------------------------------------------- 
     350      ato_i(:,:) = z0opw(:,:,1) * r1_e12t(:,:) 
     351      DO jl = 1, jpl 
     352         v_i  (:,:,jl)   = z0ice(:,:,jl) * r1_e12t(:,:) 
     353         v_s  (:,:,jl)   = z0snw(:,:,jl) * r1_e12t(:,:) 
     354         smv_i(:,:,jl)   = z0smi(:,:,jl) * r1_e12t(:,:) 
     355         oa_i (:,:,jl)   = z0oi (:,:,jl) * r1_e12t(:,:) 
     356         a_i  (:,:,jl)   = z0ai (:,:,jl) * r1_e12t(:,:) 
     357         e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e12t(:,:) 
     358         DO jk = 1, nlay_i 
     359            e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e12t(:,:) 
     360         END DO 
     361      END DO 
     362       
     363      at_i(:,:) = a_i(:,:,1)      ! total ice fraction 
     364      DO jl = 2, jpl 
     365         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     366      END DO 
     367 
     368      CALL wrk_dealloc( jpi,jpj,            zarea ) 
     369      CALL wrk_dealloc( jpi,jpj,1,          z0opw ) 
     370      CALL wrk_dealloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
     371      CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 
     372       
     373#endif 
     374 
     375      !------------------------------! 
     376      ! Diffusion of Ice fields                   
     377      !------------------------------! 
     378      IF( nn_ahi0 /= -1 .AND. nn_limdyn == 2 ) THEN 
     379         ! 
     380         ! --- Prepare diffusion for variables with categories --- ! 
     381         !     mask eddy diffusivity coefficient at ocean U- and V-points 
    295382         jm=1 
    296383         DO jl = 1, jpl 
    297          !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points 
    298          !   DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    299          !      DO ji = 1 , fs_jpim1   ! vector opt. 
    300          !         pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,jl) ) ) )   & 
    301          !            &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
    302          !         pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj  ,jl) ) ) )   & 
    303          !            &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
    304          !      END DO 
    305          !   END DO 
    306384            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    307                DO ji = 1 , fs_jpim1   ! vector opt. 
     385               DO ji = 1 , fs_jpim1 
    308386                  pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,  jl ) ) ) )   & 
    309387                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,  jl ) ) ) ) * ahiu(ji,jj) 
     
    313391            END DO 
    314392 
    315             zhdfptab(:,:,jm)= a_i  (:,:,  jl); jm = jm + 1     
     393            zhdfptab(:,:,jm)= a_i  (:,:,  jl); jm = jm + 1 
    316394            zhdfptab(:,:,jm)= v_i  (:,:,  jl); jm = jm + 1 
    317             zhdfptab(:,:,jm)= v_s  (:,:,  jl); jm = jm + 1  
     395            zhdfptab(:,:,jm)= v_s  (:,:,  jl); jm = jm + 1 
    318396            zhdfptab(:,:,jm)= smv_i(:,:,  jl); jm = jm + 1 
    319397            zhdfptab(:,:,jm)= oa_i (:,:,  jl); jm = jm + 1 
    320398            zhdfptab(:,:,jm)= e_s  (:,:,1,jl); jm = jm + 1 
    321          ! Sample of adding more variables to apply lim_hdf using lim_hdf optimization--- 
    322          !   zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1   
    323          !   zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1  
    324          ! 
    325          ! and in this example the parameter ihdf_vars musb be changed to 8 (necessary for allocation) 
    326          !---------------------------------------------------------------------------------------- 
     399            ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 
     400            !   zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1   
     401            !   zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1  
    327402            DO jk = 1, nlay_i 
    328403              zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 
    329404            END DO 
    330405         END DO 
    331          ! 
    332          !-------------------------------- 
    333          !  diffusion of open water area 
    334          !-------------------------------- 
    335          !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points 
    336          !DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    337          !   DO ji = 1 , fs_jpim1   ! vector opt. 
    338          !      pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   & 
    339          !         &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    340          !      pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   & 
    341          !         &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 
    342          !   END DO 
    343          !END DO 
    344           
     406 
     407         ! --- Prepare diffusion for open water area --- ! 
     408         !     mask eddy diffusivity coefficient at ocean U- and V-points 
    345409         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    346             DO ji = 1 , fs_jpim1   ! vector opt. 
     410            DO ji = 1 , fs_jpim1 
    347411               pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   & 
    348412                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 
     
    353417         ! 
    354418         zhdfptab(:,:,jm)= ato_i  (:,:); 
    355          CALL lim_hdf( zhdfptab, ihdf_vars, jpl, nlay_i)  
    356  
     419 
     420         ! --- Apply diffusion --- ! 
     421         CALL lim_hdf( zhdfptab, ihdf_vars ) 
     422 
     423         ! --- Recover properties --- ! 
    357424         jm=1 
    358425         DO jl = 1, jpl 
    359             a_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1       
    360             v_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1  
    361             v_s  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1  
    362             smv_i(:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1  
    363             oa_i (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1  
    364             e_s  (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1  
    365          ! Sample of adding more variables to apply lim_hdf--------- 
    366          !   variable_1  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1  
    367          !   variable_2  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1 
    368          !----------------------------------------------------------- 
     426            a_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     427            v_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     428            v_s  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     429            smv_i(:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     430            oa_i (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     431            e_s  (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 
     432            ! Sample of adding more variables to apply lim_hdf 
     433            !   variable_1  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1  
     434            !   variable_2  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1 
    369435            DO jk = 1, nlay_i 
    370                e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1  
    371             END DO 
    372          END DO 
    373  
     436               e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 
     437            END DO 
     438         END DO 
    374439         ato_i  (:,:) = zhdfptab(:,:,jm) 
    375  
    376          !------------------------------------------------------------------------------! 
    377          ! limit ice properties after transport                            
    378          !------------------------------------------------------------------------------! 
    379 !!gm & cr   :  MAX should not be active if adv scheme is positive ! 
     440               
     441      ENDIF 
     442 
     443      ! --- diags --- 
     444      DO jj = 1, jpj 
     445         DO ji = 1, jpi 
     446            diag_trp_ei (ji,jj) = ( SUM( e_i  (ji,jj,1:nlay_i,:) ) -  zeiold(ji,jj) ) * r1_rdtice 
     447            diag_trp_es (ji,jj) = ( SUM( e_s  (ji,jj,1:nlay_s,:) ) -  zesold(ji,jj) ) * r1_rdtice 
     448            diag_trp_smv(ji,jj) = ( SUM( smv_i(ji,jj,:)          ) - zsmvold(ji,jj) ) * r1_rdtice 
     449            diag_trp_vi (ji,jj) =   SUM(   v_i(ji,jj,:)            -  zviold(ji,jj,:) ) * r1_rdtice 
     450            diag_trp_vs (ji,jj) =   SUM(   v_s(ji,jj,:)            -  zvsold(ji,jj,:) ) * r1_rdtice 
     451         END DO 
     452      END DO 
     453       
     454      IF( nn_limdyn == 2) THEN 
     455 
     456         ! zap small areas 
     457         CALL lim_var_zapsmall 
     458            
     459         !--- Thickness correction in case too high --- ! 
    380460         DO jl = 1, jpl 
    381461            DO jj = 1, jpj 
    382462               DO ji = 1, jpi 
    383                   v_s  (ji,jj,jl)   = MAX( 0._wp, v_s  (ji,jj,jl) ) 
    384                   v_i  (ji,jj,jl)   = MAX( 0._wp, v_i  (ji,jj,jl) ) 
    385                   smv_i(ji,jj,jl)   = MAX( 0._wp, smv_i(ji,jj,jl) ) 
    386                   oa_i (ji,jj,jl)   = MAX( 0._wp, oa_i (ji,jj,jl) ) 
    387                   a_i  (ji,jj,jl)   = MAX( 0._wp, a_i  (ji,jj,jl) ) 
    388                   e_s  (ji,jj,1,jl) = MAX( 0._wp, e_s  (ji,jj,1,jl) ) 
    389                END DO 
    390             END DO 
    391  
    392             DO jk = 1, nlay_i 
    393                DO jj = 1, jpj 
    394                   DO ji = 1, jpi 
    395                      e_i(ji,jj,jk,jl) = MAX( 0._wp, e_i(ji,jj,jk,jl) ) 
    396                   END DO 
    397                END DO 
    398             END DO 
    399          END DO 
    400 !!gm & cr  
    401  
    402          ! --- diags --- 
    403          DO jj = 1, jpj 
    404             DO ji = 1, jpi 
    405                diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 
    406                diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 
    407  
    408                diag_trp_vi (ji,jj) = SUM(   v_i(ji,jj,:) -  zviold(ji,jj,:) ) * r1_rdtice 
    409                diag_trp_vs (ji,jj) = SUM(   v_s(ji,jj,:) -  zvsold(ji,jj,:) ) * r1_rdtice 
    410                diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice 
    411             END DO 
    412          END DO 
    413  
    414          ! zap small areas 
    415          CALL lim_var_zapsmall 
    416  
    417          !--- Thickness correction in case too high -------------------------------------------------------- 
    418          DO jl = 1, jpl 
    419             DO jj = 1, jpj 
    420                DO ji = 1, jpi 
    421  
     463                   
    422464                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
    423  
     465                      
    424466                     rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
    425467                     ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    426468                     ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    427469                      
    428                      zvi  = v_i  (ji,jj,jl) 
    429                      zvs  = v_s  (ji,jj,jl) 
    430                      zsmv = smv_i(ji,jj,jl) 
    431                      zes  = e_s  (ji,jj,1,jl) 
    432                      zei  = SUM( e_i(ji,jj,1:nlay_i,jl) ) 
    433  
    434470                     zdv  = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl)   
    435  
     471                      
    436472                     IF ( ( zdv >  0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. & 
    437473                        & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN 
    438  
     474                         
    439475                        rswitch        = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) ) 
    440476                        a_i(ji,jj,jl)  = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 ) 
    441  
     477                         
    442478                        ! small correction due to *rswitch for a_i 
    443479                        v_i  (ji,jj,jl)        = rswitch * v_i  (ji,jj,jl) 
     
    446482                        e_s(ji,jj,1,jl)        = rswitch * e_s(ji,jj,1,jl) 
    447483                        e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl) 
    448  
    449                         ! Update mass fluxes 
    450                         wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 
    451                         wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
    452                         sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
    453                         hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0 
    454                         hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * r1_rdtice ! W.m-2 <0 
    455  
     484                                                 
    456485                     ENDIF 
    457  
     486                      
    458487                  ENDIF 
    459  
     488                 
    460489               END DO 
    461490            END DO 
    462491         END DO 
    463          ! ------------------------------------------------- 
    464492          
    465          !-------------------------------------- 
    466          ! Impose a_i < amax in mono-category 
    467          !-------------------------------------- 
    468          ! 
    469          IF ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) THEN ! simple conservative piling, comparable with LIM2 
    470             DO jj = 1, jpj 
    471                DO ji = 1, jpi 
    472                   a_i(ji,jj,1)  = MIN( a_i(ji,jj,1), rn_amax_2d(ji,jj) ) 
    473                END DO 
    474             END DO 
    475          ENDIF 
    476  
    477          ! --- agglomerate variables ----------------- 
    478          vt_i (:,:) = 0._wp 
    479          vt_s (:,:) = 0._wp 
    480          at_i (:,:) = 0._wp 
     493         ! Force the upper limit of ht_i to always be < hi_max (99 m). 
     494         DO jj = 1, jpj 
     495            DO ji = 1, jpi 
     496               rswitch         = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) ) 
     497               ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) ) 
     498               a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch 
     499            END DO 
     500         END DO 
     501 
     502      ENDIF 
     503          
     504      !------------------------------------------------------------ 
     505      ! Impose a_i < amax if no ridging/rafting or in mono-category 
     506      !------------------------------------------------------------ 
     507      ! 
     508      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     509      IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 
    481510         DO jl = 1, jpl 
    482511            DO jj = 1, jpj 
    483512               DO ji = 1, jpi 
    484                   vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) 
    485                   vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) 
    486                   at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
     513                  rswitch       = MAX( 0._wp, SIGN( 1._wp, at_i(ji,jj) - epsi20 ) ) 
     514                  zda           = rswitch * MIN( rn_amax_2d(ji,jj) - at_i(ji,jj), 0._wp )  & 
     515                     &                    * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi20 ) 
     516                  a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda 
    487517               END DO 
    488518            END DO 
    489519         END DO 
    490  
    491          ! --- open water = 1 if at_i=0 -------------------------------- 
    492          DO jj = 1, jpj 
    493             DO ji = 1, jpi 
    494                rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 
    495                ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj) 
    496             END DO 
    497          END DO       
    498  
    499          ! conservation test 
    500          IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    501  
    502       ENDIF 
    503  
     520      ENDIF 
     521       
     522      ! --- agglomerate variables ----------------- 
     523      vt_i(:,:) = SUM( v_i(:,:,:), dim=3 ) 
     524      vt_s(:,:) = SUM( v_s(:,:,:), dim=3 ) 
     525      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     526       
     527      ! --- open water = 1 if at_i=0 -------------------------------- 
     528      WHERE( at_i == 0._wp ) ato_i = 1._wp  
     529       
     530      ! conservation test 
     531      IF( ln_limdiahsb )   CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     532         
    504533      ! ------------------------------------------------- 
    505534      ! control prints 
     
    507536      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 
    508537      ! 
    509       CALL wrk_dealloc( jpi,jpj,            zsm, zatold, zeiold, zesold ) 
    510       CALL wrk_dealloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
    511       CALL wrk_dealloc( jpi,jpj,1,          z0opw ) 
    512       CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 
    513       CALL wrk_dealloc( jpi,jpj,jpl,        zviold, zvsold, zhimax, zsmvold ) 
    514       CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars+nlay_i)+1,zhdfptab) 
     538      CALL wrk_dealloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold ) 
     539      CALL wrk_dealloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold ) 
     540      CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab) 
    515541      ! 
    516542      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
    517  
     543      ! 
    518544   END SUBROUTINE lim_trp 
    519545 
     
    526552   END SUBROUTINE lim_trp 
    527553#endif 
     554 
    528555   !!====================================================================== 
    529556END MODULE limtrp 
    530  
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r6311 r6515  
    5959      IF( nn_timing == 1 )  CALL timing_start('limupdate1') 
    6060 
    61       IF( ln_limdyn ) THEN  
    62  
    6361      IF( kt == nit000 .AND. lwp ) THEN 
    64          WRITE(numout,*) ' lim_update1 '  
    65          WRITE(numout,*) ' ~~~~~~~~~~~ ' 
     62         WRITE(numout,*)''  
     63         WRITE(numout,*)' lim_update1 '  
     64         WRITE(numout,*)' ~~~~~~~~~~~ ' 
    6665      ENDIF 
    6766 
     
    200199      ENDIF 
    201200    
    202       ENDIF ! ln_limdyn 
    203  
    204201      IF( nn_timing == 1 )  CALL timing_stop('limupdate1') 
    205202   END SUBROUTINE lim_update1 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r6311 r6515  
    6262 
    6363      IF( kt == nit000 .AND. lwp ) THEN 
    64          WRITE(numout,*) ' lim_update2 ' 
    65          WRITE(numout,*) ' ~~~~~~~~~~~ ' 
     64         WRITE(numout,*)'' 
     65         WRITE(numout,*)' lim_update2 ' 
     66         WRITE(numout,*)' ~~~~~~~~~~~ ' 
    6667      ENDIF 
    6768 
     
    177178      ! conservation test 
    178179      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    179  
    180       ! necessary calls (at least for coupling) 
    181       CALL lim_var_glo2eqv 
    182       CALL lim_var_agg(2) 
    183180 
    184181      ! ------------------------------------------------- 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r6469 r6515  
    2727   !!                        - et_i(jpi,jpj)  !total ice thermal content  
    2828   !!                        - smt_i(jpi,jpj) !mean ice salinity 
    29    !!                        - ot_i(jpi,jpj)  !average ice age 
     29   !!                        - tm_i (jpi,jpj) !mean ice temperature 
    3030   !!====================================================================== 
    3131   !! History :   -   ! 2006-01 (M. Vancoppenolle) Original code 
     
    5454   PUBLIC   lim_var_eqv2glo       
    5555   PUBLIC   lim_var_salprof       
    56    PUBLIC   lim_var_icetm         
    5756   PUBLIC   lim_var_bv            
    5857   PUBLIC   lim_var_salprof1d     
     
    8685      !!------------------------------------------------------------------ 
    8786 
    88       !-------------------- 
    89       ! Compute variables 
    90       !-------------------- 
    91       vt_i (:,:) = 0._wp 
    92       vt_s (:,:) = 0._wp 
    93       at_i (:,:) = 0._wp 
    94       ato_i(:,:) = 1._wp 
    95       ! 
    96       DO jl = 1, jpl 
     87      ! integrated values 
     88      vt_i (:,:) = SUM( v_i, dim=3 ) 
     89      vt_s (:,:) = SUM( v_s, dim=3 ) 
     90      at_i (:,:) = SUM( a_i, dim=3 ) 
     91 
     92      ! open water fraction 
     93      DO jj = 1, jpj 
     94         DO ji = 1, jpi 
     95            ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp )    
     96         END DO 
     97      END DO 
     98 
     99      IF( kn > 1 ) THEN 
     100         et_s(:,:)  = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 )  ! snow heat content 
     101         et_i(:,:)  = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 )  ! ice  heat content 
     102 
     103         ! mean ice/snow thickness 
    97104         DO jj = 1, jpj 
    98105            DO ji = 1, jpi 
    99                ! 
    100                vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
    101                vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
    102                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    103                ! 
    104                rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
    105                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch  ! ice thickness 
    106             END DO 
    107          END DO 
    108       END DO 
    109  
    110       DO jj = 1, jpj 
    111          DO ji = 1, jpi 
    112             ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp )   ! open water fraction 
    113          END DO 
    114       END DO 
    115  
    116       IF( kn > 1 ) THEN 
    117          et_s (:,:) = 0._wp 
    118          ot_i (:,:) = 0._wp 
     106               rswitch      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
     107               htm_i(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 
     108               htm_s(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 
     109            ENDDO 
     110         ENDDO 
     111 
     112         ! mean temperature (K), salinity and age 
    119113         smt_i(:,:) = 0._wp 
    120          et_i (:,:) = 0._wp 
    121          ! 
     114         tm_i(:,:)  = 0._wp 
     115         tm_su(:,:) = 0._wp 
     116         om_i (:,:) = 0._wp 
    122117         DO jl = 1, jpl 
     118             
    123119            DO jj = 1, jpj 
    124120               DO ji = 1, jpi 
    125                   et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                           ! snow heat content 
    126                   rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) )  
    127                   smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch   ! ice salinity 
    128                   rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) )  
    129                   ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi20 ) * rswitch   ! ice age 
    130                END DO 
    131             END DO 
    132          END DO 
    133          ! 
    134          DO jl = 1, jpl 
     121                  rswitch      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
     122                  tm_su(ji,jj) = tm_su(ji,jj) + rswitch * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) 
     123                  om_i (ji,jj) = om_i (ji,jj) + rswitch *   oa_i(ji,jj,jl)                         / MAX( at_i(ji,jj) , epsi10 ) 
     124               END DO 
     125            END DO 
     126             
    135127            DO jk = 1, nlay_i 
    136                et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl)       ! ice heat content 
    137             END DO 
    138          END DO 
     128               DO jj = 1, jpj 
     129                  DO ji = 1, jpi 
     130                     rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
     131                     tm_i(ji,jj)  = tm_i(ji,jj)  + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  & 
     132                        &            / MAX( vt_i(ji,jj) , epsi10 ) 
     133                     smt_i(ji,jj) = smt_i(ji,jj) + r1_nlay_i * rswitch * s_i(ji,jj,jk,jl) * v_i(ji,jj,jl)  & 
     134                        &            / MAX( vt_i(ji,jj) , epsi10 ) 
     135                  END DO 
     136               END DO 
     137            END DO 
     138         END DO 
     139         tm_i  = tm_i  + rt0 
     140         tm_su = tm_su + rt0 
    139141         ! 
    140142      ENDIF 
     
    243245      END DO 
    244246 
    245       !------------------- 
    246       ! Mean temperature 
    247       !------------------- 
    248       vt_i (:,:) = 0._wp 
    249       DO jl = 1, jpl 
    250          vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
    251       END DO 
    252  
    253       tm_i(:,:) = 0._wp 
    254       DO jl = 1, jpl 
    255          DO jk = 1, nlay_i 
    256             DO jj = 1, jpj 
    257                DO ji = 1, jpi 
    258                   rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
    259                   tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  & 
    260                      &            / MAX( vt_i(ji,jj) , epsi10 ) 
    261                END DO 
    262             END DO 
    263          END DO 
    264       END DO 
    265       tm_i = tm_i + rt0 
     247      ! integrated values 
     248      vt_i (:,:) = SUM( v_i, dim=3 ) 
     249      vt_s (:,:) = SUM( v_s, dim=3 ) 
     250      at_i (:,:) = SUM( a_i, dim=3 ) 
     251 
    266252      ! 
    267253   END SUBROUTINE lim_var_glo2eqv 
     
    318304         sm_i(:,:,:)   = rn_icesal 
    319305      ENDIF 
    320  
     306          
    321307      !----------------------------------- 
    322308      ! Salinity profile, varying in time 
     
    398384 
    399385 
    400    SUBROUTINE lim_var_icetm 
    401       !!------------------------------------------------------------------ 
    402       !!                ***  ROUTINE lim_var_icetm *** 
    403       !! 
    404       !! ** Purpose :   computes mean sea ice temperature 
     386   SUBROUTINE lim_var_bv 
     387      !!------------------------------------------------------------------ 
     388      !!                ***  ROUTINE lim_var_bv *** 
     389      !! 
     390      !! ** Purpose :   computes mean brine volume (%) in sea ice 
     391      !! 
     392      !! ** Method  : e = - 0.054 * S (ppt) / T (C) 
     393      !! 
     394      !! References : Vancoppenolle et al., JGR, 2007 
    405395      !!------------------------------------------------------------------ 
    406396      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    407397      !!------------------------------------------------------------------ 
    408  
    409       ! Mean sea ice temperature 
    410       vt_i (:,:) = 0._wp 
    411       DO jl = 1, jpl 
    412          vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
    413       END DO 
    414  
    415       tm_i(:,:) = 0._wp 
     398      ! 
     399      bvm_i(:,:)   = 0._wp 
     400      bv_i (:,:,:) = 0._wp 
    416401      DO jl = 1, jpl 
    417402         DO jk = 1, nlay_i 
    418403            DO jj = 1, jpj 
    419404               DO ji = 1, jpi 
    420                   rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
    421                   tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  & 
    422                      &            / MAX( vt_i(ji,jj) , epsi10 ) 
    423                END DO 
    424             END DO 
    425          END DO 
    426       END DO 
    427       tm_i = tm_i + rt0 
    428  
    429    END SUBROUTINE lim_var_icetm 
    430  
    431  
    432    SUBROUTINE lim_var_bv 
    433       !!------------------------------------------------------------------ 
    434       !!                ***  ROUTINE lim_var_bv *** 
    435       !! 
    436       !! ** Purpose :   computes mean brine volume (%) in sea ice 
    437       !! 
    438       !! ** Method  : e = - 0.054 * S (ppt) / T (C) 
    439       !! 
    440       !! References : Vancoppenolle et al., JGR, 2007 
    441       !!------------------------------------------------------------------ 
    442       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    443       REAL(wp) ::   zbvi             ! local scalars 
    444       !!------------------------------------------------------------------ 
    445       ! 
    446       vt_i (:,:) = 0._wp 
    447       DO jl = 1, jpl 
    448          vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 
    449       END DO 
    450  
    451       bv_i(:,:) = 0._wp 
    452       DO jl = 1, jpl 
    453          DO jk = 1, nlay_i 
    454             DO jj = 1, jpj 
    455                DO ji = 1, jpi 
    456                   rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) )  ) 
    457                   zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 )   & 
    458                      &                   * v_i(ji,jj,jl) * r1_nlay_i 
    459                   rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) )  ) 
    460                   bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi20 ) 
    461                END DO 
     405                  rswitch        = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) )  ) 
     406                  bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rswitch * tmut * s_i(ji,jj,jk,jl) * r1_nlay_i  & 
     407                     &                            / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) 
     408               END DO 
     409            END DO 
     410         END DO 
     411          
     412         DO jj = 1, jpj 
     413            DO ji = 1, jpi 
     414               rswitch      = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
     415               bvm_i(ji,jj) = bvm_i(ji,jj) + rswitch * bv_i(ji,jj,jl) * v_i(ji,jj,jl) / MAX( vt_i(ji,jj), epsi10 ) 
    462416            END DO 
    463417         END DO 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r6417 r6515  
    6060      REAL(wp) ::  z1_365 
    6161      REAL(wp) ::  ztmp 
    62       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei, zt_i, zt_s 
     62      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zswi2 
    6363      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace 
    6464      !!------------------------------------------------------------------- 
     
    6666      IF( nn_timing == 1 )  CALL timing_start('limwri') 
    6767 
    68       CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
     68      CALL wrk_alloc( jpi, jpj, jpl, zswi2 ) 
    6969      CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi ) 
    7070 
     
    7474      z1_365 = 1._wp / 365._wp 
    7575 
    76       CALL lim_var_icetm      ! mean sea ice temperature 
    77  
    78       CALL lim_var_bv         ! brine volume 
    79  
    80       DO jj = 1, jpj          ! presence indicator of ice 
     76      ! brine volume 
     77      CALL lim_var_bv  
     78 
     79      ! tresholds for outputs 
     80      DO jj = 1, jpj 
    8181         DO ji = 1, jpi 
    8282            zswi(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 
    8383         END DO 
    8484      END DO 
    85       ! 
    86       ! 
    87       !                                              
    88       IF ( iom_use( "icethic_cea" ) ) THEN                       ! mean ice thickness 
    89          DO jj = 1, jpj  
     85      DO jl = 1, jpl 
     86         DO jj = 1, jpj 
    9087            DO ji = 1, jpi 
    91                z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 
     88               zswi2(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    9289            END DO 
    9390         END DO 
    94          CALL iom_put( "icethic_cea"  , z2d              ) 
    95       ENDIF 
    96  
    97       IF ( iom_use( "snowthic_cea" ) ) THEN                      ! snow thickness = mean snow thickness over the cell  
    98          DO jj = 1, jpj                                             
    99             DO ji = 1, jpi 
    100                z2d(ji,jj)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 
    101             END DO 
    102          END DO 
    103          CALL iom_put( "snowthic_cea" , z2d              )        
    104       ENDIF 
     91      END DO 
    10592      ! 
     93      ! velocity 
    10694      IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN  
    10795         DO jj = 2 , jpjm1 
     
    120108            END DO 
    121109         END DO 
    122          CALL iom_put( "icevel"       , z2d              )       ! ice velocity module 
     110         CALL iom_put( "icevel"       , z2d * zswi       )       ! ice velocity module 
    123111      ENDIF 
    124112      ! 
    125       IF ( iom_use( "miceage" ) ) THEN  
    126          z2d(:,:) = 0.e0 
    127          DO jl = 1, jpl 
    128             DO jj = 1, jpj 
    129                DO ji = 1, jpi 
    130                   rswitch    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
    131                   z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 ) 
    132                END DO 
    133             END DO 
    134          END DO 
    135          CALL iom_put( "miceage"     , z2d * z1_365      )        ! mean ice age 
    136       ENDIF 
    137  
    138       IF ( iom_use( "micet" ) ) THEN  
    139          DO jj = 1, jpj 
    140             DO ji = 1, jpi 
    141                z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj) 
    142             END DO 
    143          END DO 
    144          CALL iom_put( "micet"       , z2d               )        ! mean ice temperature 
    145       ENDIF 
     113      IF ( iom_use( "miceage" ) )       CALL iom_put( "miceage"     , om_i * zswi * z1_365   )  ! mean ice age 
     114      IF ( iom_use( "icethic_cea" ) )   CALL iom_put( "icethic_cea" , htm_i * zswi           )  ! ice thickness mean 
     115      IF ( iom_use( "snowthic_cea" ) )  CALL iom_put( "snowthic_cea", htm_s * zswi           )  ! snow thickness mean 
     116      IF ( iom_use( "micet" ) )         CALL iom_put( "micet"       , ( tm_i  - rt0 ) * zswi )  ! ice mean    temperature 
     117      IF ( iom_use( "icest" ) )         CALL iom_put( "icest"       , ( tm_su - rt0 ) * zswi )  ! ice surface temperature 
     118      IF ( iom_use( "icecolf" ) )       CALL iom_put( "icecolf"     , hicol                  )  ! frazil ice collection thickness 
    146119      ! 
    147       IF ( iom_use( "icest" ) ) THEN  
    148          z2d(:,:) = 0.e0 
    149          DO jl = 1, jpl 
    150             DO jj = 1, jpj 
    151                DO ji = 1, jpi 
    152                   z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 ) 
    153                END DO 
    154             END DO 
    155          END DO 
    156          CALL iom_put( "icest"       , z2d              )        ! ice surface temperature 
    157       ENDIF 
    158  
    159       IF ( iom_use( "icecolf" ) )   CALL iom_put( "icecolf", hicol )  ! frazil ice collection thickness 
    160  
    161120      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature 
    162121      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity 
    163       CALL iom_put( "iceconc"     , at_i                )        ! ice concentration 
    164       CALL iom_put( "icevolu"     , vt_i                )        ! ice volume = mean ice thickness over the cell 
    165       CALL iom_put( "icehc"       , et_i                )        ! ice total heat content 
    166       CALL iom_put( "isnowhc"     , et_s                )        ! snow total heat content 
    167       CALL iom_put( "ibrinv"      , bv_i * 100._wp      )        ! brine volume 
    168       CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point 
    169       CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point 
     122      CALL iom_put( "iceconc"     , at_i  * zswi        )        ! ice concentration 
     123      CALL iom_put( "icevolu"     , vt_i  * zswi        )        ! ice volume = mean ice thickness over the cell 
     124      CALL iom_put( "icehc"       , et_i  * zswi        )        ! ice total heat content 
     125      CALL iom_put( "isnowhc"     , et_s  * zswi        )        ! snow total heat content 
     126      CALL iom_put( "ibrinv"      , bvm_i * zswi * 100. )        ! brine volume 
     127      CALL iom_put( "utau_ice"    , utau_ice  * zswi    )        ! wind stress over ice along i-axis at I-point 
     128      CALL iom_put( "vtau_ice"    , vtau_ice  * zswi    )        ! wind stress over ice along j-axis at I-point 
    170129      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation  
    171       CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity 
    172  
    173       CALL iom_put( "icestr"      , strength * 0.001    )        ! ice strength 
    174       CALL iom_put( "idive"       , divu_i * 1.0e8      )        ! divergence 
    175       CALL iom_put( "ishear"      , shear_i * 1.0e8     )        ! shear 
    176       CALL iom_put( "snowvol"     , vt_s                )        ! snow volume 
     130      CALL iom_put( "micesalt"    , smt_i   * zswi      )        ! mean ice salinity 
     131 
     132      CALL iom_put( "icestr"      , strength * 0.001 * zswi )    ! ice strength 
     133      CALL iom_put( "idive"       , divu_i * 1.0e8   * zswi )    ! divergence 
     134      CALL iom_put( "ishear"      , shear_i * 1.0e8  * zswi )    ! shear 
     135      CALL iom_put( "snowvol"     , vt_s   * zswi       )        ! snow volume 
    177136       
    178137      CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport 
     
    183142 
    184143      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from bottom growth 
    185       CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from bottom melt 
    186       CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from surface melt 
     144      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from bottom melting 
     145      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from surface melting 
     146      CALL iom_put( "sfxlam"      , sfx_lam * rday      )        ! salt flux from lateral melting 
    187147      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from snow ice formation 
    188148      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from open water formation 
    189149      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting 
    190       CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from residual 
     150      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant) 
    191151      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines 
    192152      CALL iom_put( "sfxsub"      , sfx_sub * rday      )        ! salt flux from sublimation 
     
    201161      CALL iom_put( "vfxsum"     , wfx_sum * ztmp       )        ! surface melt  
    202162      CALL iom_put( "vfxbom"     , wfx_bom * ztmp       )        ! bottom melt  
     163      CALL iom_put( "vfxlam"     , wfx_lam * ztmp       )        ! lateral melt  
    203164      CALL iom_put( "vfxice"     , wfx_ice * ztmp       )        ! total ice growth/melt  
    204165      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp       )        ! total snw growth/melt  
     
    231192 
    232193      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations   
    233          DO jj = 1, jpj  
    234             DO ji = 1, jpi 
    235                z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) ! mean ice thickness 
    236             END DO 
    237          END DO 
    238          WHERE( z2d(:,:) < 0.2 .AND. z2d(:,:) > 0. ) ; z2da = wfx_bog 
    239          ELSEWHERE                                   ; z2da = 0._wp 
     194         WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog 
     195         ELSEWHERE                                       ; z2d = 0._wp 
    240196         END WHERE 
    241          CALL iom_put( "vfxthin", ( wfx_opw + z2da ) * ztmp ) 
     197         CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp ) 
    242198      ENDIF 
    243199       
     
    245201      ! Output values for each category 
    246202      !-------------------------------- 
    247       CALL iom_put( "iceconc_cat"      , a_i         )        ! area for categories 
    248       CALL iom_put( "icethic_cat"      , ht_i        )        ! thickness for categories 
    249       CALL iom_put( "snowthic_cat"     , ht_s        )        ! snow depth for categories 
    250       CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories 
     203      CALL iom_put( "iceconc_cat"      , a_i   * zswi2   )        ! area for categories 
     204      CALL iom_put( "icethic_cat"      , ht_i  * zswi2   )        ! thickness for categories 
     205      CALL iom_put( "snowthic_cat"     , ht_s  * zswi2   )        ! snow depth for categories 
     206      CALL iom_put( "salinity_cat"     , sm_i  * zswi2   )        ! salinity for categories 
    251207 
    252208      ! ice temperature 
    253       IF ( iom_use( "icetemp_cat" ) ) THEN  
    254          zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i 
    255          CALL iom_put( "icetemp_cat"   , zt_i - rt0  ) 
    256       ENDIF 
     209      IF ( iom_use( "icetemp_cat" ) )  CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 ) 
    257210       
    258211      ! snow temperature 
    259       IF ( iom_use( "snwtemp_cat" ) ) THEN  
    260          zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s 
    261          CALL iom_put( "snwtemp_cat"   , zt_s - rt0  ) 
    262       ENDIF 
    263  
    264       ! Compute ice age 
    265       IF ( iom_use( "iceage_cat" ) ) THEN  
    266          DO jl = 1, jpl  
    267             DO jj = 1, jpj 
    268                DO ji = 1, jpi 
    269                   rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
    270                   rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) ) 
    271                   zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch 
    272                END DO 
    273             END DO 
    274          END DO 
    275          CALL iom_put( "iceage_cat"   , zoi * z1_365 )        ! ice age for categories 
    276       ENDIF 
    277  
    278       ! Compute brine volume 
    279       IF ( iom_use( "brinevol_cat" ) ) THEN  
    280          zei(:,:,:) = 0._wp 
    281          DO jl = 1, jpl  
    282             DO jk = 1, nlay_i 
    283                DO jj = 1, jpj 
    284                   DO ji = 1, jpi 
    285                      rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    286                      zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 *  & 
    287                         ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 
    288                         rswitch * r1_nlay_i 
    289                   END DO 
    290                END DO 
    291             END DO 
    292          END DO 
    293          CALL iom_put( "brinevol_cat"     , zei      )        ! brine volume for categories 
    294       ENDIF 
     212      IF ( iom_use( "snwtemp_cat" ) )  CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 ) 
     213 
     214      ! ice age 
     215      IF ( iom_use( "iceage_cat" ) )   CALL iom_put( "iceage_cat" , o_i * zswi2 * z1_365 ) 
     216 
     217      ! brine volume 
     218      IF ( iom_use( "brinevol_cat" ) ) CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 ) 
    295219 
    296220      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
     
    298222      !     not yet implemented 
    299223       
    300       CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
     224      CALL wrk_dealloc( jpi, jpj, jpl, zswi2 ) 
    301225      CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db ) 
    302226 
     
    370294      CALL histend( kid, snc4set )   ! end of the file definition 
    371295 
    372       CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )     
     296      CALL histwrite( kid, "iicethic", kt, htm_i         , jpi*jpj, (/1/) )     
    373297      CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) ) 
    374298      CALL histwrite( kid, "iicetemp", kt, tm_i - rt0    , jpi*jpj, (/1/) ) 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r6399 r6515  
    1414 
    1515   PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90 
    16  
    17    !!--------------------------- 
    18    !! * Share Module variables 
    19    !!--------------------------- 
    20    !                               !!! ** ice-thermo namelist (namicethd) ** 
    21    REAL(wp), PUBLIC ::   rn_himin    !: minimum ice thickness 
    22    REAL(wp), PUBLIC ::   rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 
    23    REAL(wp), PUBLIC ::   rn_vfrazb   !: threshold drift speed for collection of bottom frazil ice 
    24    REAL(wp), PUBLIC ::   rn_Cfrazb   !: squeezing coefficient for collection of bottom frazil ice 
    25    REAL(wp), PUBLIC ::   rn_hnewice  !: thickness for new ice formation (m) 
    26  
    27    LOGICAL , PUBLIC ::   ln_frazil   !: use of frazil ice collection as function of wind (T) or not (F) 
    2816 
    2917   !!----------------------------- 
     
    9785   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics 
    9886   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
    99    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing 
    100    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage 
    101    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_se_1d   !: Ice salinity variations due to basal salt entrapment 
    102    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_si_1d   !: Ice salinity variations due to lateral accretion     
    10387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_1d      !: Ice collection thickness accumulated in leads 
    10488 
     
    140124      !!---------------------------------------------------------------------! 
    141125      INTEGER ::   thd_ice_alloc   ! return value 
    142       INTEGER ::   ierr(3) 
     126      INTEGER ::   ierr(4), ii 
    143127      !!---------------------------------------------------------------------! 
     128      ierr(:) = 0 
    144129 
     130      ii = 1 
    145131      ALLOCATE( npb      (jpij) , nplm      (jpij) , npac       (jpij) ,   & 
    146132         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   & 
     
    152138         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      & 
    153139         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   & 
    154          &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(1) ) 
     140         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(ii) ) 
    155141      ! 
     142      ii = ii + 1 
    156143      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d    (jpij) ,                     & 
    157144         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,                     & 
     
    162149         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  & 
    163150         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij),  & 
    164          &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,                     &      
    165          &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) ) 
     151         &      hicol_1d   (jpij) , STAT=ierr(ii) ) 
    166152      ! 
    167       ALLOCATE( t_su_1d   (jpij) , a_i_1d   (jpij) , ht_i_1d  (jpij) ,    &    
    168          &      ht_s_1d   (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
    169          &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_sub (jpij) ,    &     
    170          &      dh_i_bott (jpij) ,dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    & 
    171          &      t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) ,  &             
    172          &      q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) ,                        & 
    173          &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 
     153      ii = ii + 1 
     154      ALLOCATE( t_su_1d   (jpij) , a_i_1d    (jpij) , ht_i_1d  (jpij) ,                      & 
     155         &      ht_s_1d   (jpij) , fc_su     (jpij) , fc_bo_i  (jpij) ,                      &     
     156         &      dh_s_tot  (jpij) , dh_i_surf (jpij) , dh_i_sub (jpij) ,                      &     
     157         &      dh_i_bott (jpij) , dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    & 
     158         &      STAT=ierr(ii) ) 
    174159      ! 
    175       thd_ice_alloc = MAXVAL( ierr ) 
    176  
     160      ii = ii + 1 
     161      ALLOCATE( t_s_1d  (jpij,nlay_s)     , t_i_1d (jpij,nlay_i)     , s_i_1d(jpij,nlay_i) ,  &             
     162         &      q_i_1d  (jpij,nlay_i+1)   , q_s_1d (jpij,nlay_s)     ,                        & 
     163         &      qh_i_old(jpij,0:nlay_i+1) , h_i_old(jpij,0:nlay_i+1) , STAT=ierr(ii) ) 
     164      ! 
     165      thd_ice_alloc = MAXVAL( ierr(:) ) 
    177166      IF( thd_ice_alloc /= 0 )   CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' ) 
    178167      ! 
  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r6399 r6515  
    140140         !----------------------------------------------------------------- 
    141141         SELECT CASE( kblk ) 
    142          CASE( jp_clio    )   ;   CALL blk_ice_clio_tau                         ! CLIO bulk formulation             
    143          CASE( jp_core    )   ;   CALL blk_ice_core_tau                         ! CORE bulk formulation 
    144          CASE( jp_purecpl )   ;   CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation 
     142            CASE( jp_clio    )   ;    CALL blk_ice_clio_tau                         ! CLIO bulk formulation             
     143            CASE( jp_core    )   ;    CALL blk_ice_core_tau                         ! CORE bulk formulation 
     144            CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation 
    145145         END SELECT 
    146146          
    147          IF( ln_mixcpl) THEN   ! Case of a mixed Bulk/Coupled formulation 
     147         IF( ln_mixcpl) THEN                                                       ! Case of a mixed Bulk/Coupled formulation 
    148148            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice) 
    149             CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     149                                      CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    150150            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
    151151            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     
    158158         numit = numit + nn_fsbc                  ! Ice model time step 
    159159         !                                                    
    160          CALL sbc_lim_bef                         ! Store previous ice values 
    161          CALL sbc_lim_diag0                       ! set diag of mass, heat and salt fluxes to 0 
    162          CALL lim_rst_opn( kt )                   ! Open Ice restart file 
    163          ! 
    164          IF( .NOT. lk_c1d ) THEN 
     160                                      CALL sbc_lim_bef         ! Store previous ice values 
     161                                      CALL sbc_lim_diag0       ! set diag of mass, heat and salt fluxes to 0 
     162                                      CALL lim_rst_opn( kt )   ! Open Ice restart file 
     163         ! 
     164         ! --- zap this if no ice dynamics --- ! 
     165         IF( .NOT. lk_c1d .AND. ln_limdyn ) THEN 
    165166            ! 
    166             CALL lim_dyn( kt )                    ! Ice dynamics    ( rheology/dynamics )    
    167             ! 
    168             CALL lim_trp( kt )                    ! Ice transport   ( Advection/diffusion ) 
    169             ! 
    170             IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 
    171             ! 
    172 #if defined key_bdy 
    173             CALL bdy_ice_lim( kt )                ! bdy ice thermo  
    174             IF( ln_icectl )       CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
    175 #endif 
    176             ! 
    177             CALL lim_update1( kt )                ! Corrections 
     167            IF( nn_limdyn /= 0 ) THEN                          ! -- Ice dynamics 
     168                                      CALL lim_dyn( kt )       !     rheology   
     169            ELSE 
     170               u_ice(:,:) = rn_uice * umask(:,:,1)             !     or prescribed velocity 
     171               v_ice(:,:) = rn_vice * vmask(:,:,1) 
     172            ENDIF 
     173                                      CALL lim_trp( kt )       ! -- Ice transport (Advection/diffusion) 
     174            IF( nn_limdyn == 2 .AND. nn_monocat /= 2 )  &      ! -- Mechanical redistribution (ridging/rafting) 
     175               &                      CALL lim_itd_me          
     176            IF( nn_limdyn == 2 )      CALL lim_update1( kt )   ! -- Corrections 
    178177            ! 
    179178         ENDIF 
    180           
     179         ! --- 
     180#if defined key_bdy 
     181         IF( ln_limthd )              CALL bdy_ice_lim( kt )   ! bdy ice thermo  
     182         IF( ln_icectl )              CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
     183#endif 
     184 
    181185         ! previous lead fraction and ice volume for flux calculations 
    182          CALL sbc_lim_bef                         
    183          CALL lim_var_glo2eqv                     ! ht_i and ht_s for ice albedo calculation 
    184          CALL lim_var_agg(1)                      ! at_i for coupling (via pfrld)  
     186                                      CALL sbc_lim_bef                         
     187                                      CALL lim_var_glo2eqv     ! ht_i and ht_s for ice albedo calculation 
     188                                      CALL lim_var_agg(1)      ! at_i for coupling (via pfrld)  
     189         ! 
    185190         pfrld(:,:)   = 1._wp - at_i(:,:) 
    186191         phicif(:,:)  = vt_i(:,:) 
     
    197202         !---------------------------------------------------------------------------------------- 
    198203         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 
    199          CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    200  
     204          
     205                                      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    201206         SELECT CASE( kblk ) 
    202          CASE( jp_clio )                                       ! CLIO bulk formulation 
    203             ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
    204             ! (alb_ice) is computed within the bulk routine 
    205                                  CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 
    206             IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    207             IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    208          CASE( jp_core )                                       ! CORE bulk formulation 
    209             ! albedo depends on cloud fraction because of non-linear spectral effects 
    210             alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    211                                  CALL blk_ice_core_flx( t_su, alb_ice ) 
    212             IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    213             IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    214          CASE ( jp_purecpl ) 
    215             ! albedo depends on cloud fraction because of non-linear spectral effects 
    216             alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    217                                  CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    218             IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     207 
     208            CASE( jp_clio )                                       ! CLIO bulk formulation 
     209               ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     210               ! (alb_ice) is computed within the bulk routine 
     211                                      CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 
     212               IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
     213               IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     214                
     215            CASE( jp_core )                                       ! CORE bulk formulation 
     216               ! albedo depends on cloud fraction because of non-linear spectral effects 
     217               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     218                                      CALL blk_ice_core_flx( t_su, alb_ice ) 
     219               IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
     220               IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     221                
     222            CASE ( jp_purecpl )                                    ! Coupled formulation 
     223               ! albedo depends on cloud fraction because of non-linear spectral effects 
     224               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     225                                      CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
     226               IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     227 
    219228         END SELECT 
     229 
    220230         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 
    221231 
     
    223233         ! --- ice thermodynamics --- ! 
    224234         !----------------------------! 
    225          CALL lim_thd( kt )                         ! Ice thermodynamics       
    226          ! 
    227          CALL lim_update2( kt )                     ! Corrections 
    228          ! 
    229          CALL lim_sbc_flx( kt )                     ! Update surface ocean mass, heat and salt fluxes 
    230          ! 
    231          IF(ln_limdiaout) CALL lim_diahsb           ! Diagnostics and outputs  
    232          ! 
    233          CALL lim_wri( 1 )                          ! Ice outputs  
     235         ! --- zap this if no ice thermo --- ! 
     236         IF( ln_limthd )              CALL lim_thd( kt )        ! -- Ice thermodynamics       
     237         IF( ln_limthd )              CALL lim_update2( kt )    ! -- Corrections 
     238         ! --- 
     239                                      CALL lim_var_glo2eqv      ! necessary calls (at least for coupling) 
     240                                      CALL lim_var_agg( 2 )     ! necessary calls (at least for coupling) 
     241                                      ! 
     242                                      CALL lim_sbc_flx( kt )    ! -- Update surface ocean mass, heat and salt fluxes 
     243                                      ! 
     244         IF(ln_limdiaout)             CALL lim_diahsb           ! -- Diagnostics and outputs  
     245         ! 
     246                                      CALL lim_wri( 1 )         ! -- Ice outputs  
    234247         ! 
    235248         IF( kt == nit000 .AND. ln_rstart )   & 
    236             &             CALL iom_close( numrir )  ! close input ice restart file 
    237          ! 
    238          IF( lrst_ice )   CALL lim_rst_write( kt )  ! Ice restart file  
    239          ! 
    240          IF( ln_icectl )  CALL lim_ctl( kt )        ! alerts in case of model crash 
     249            &                         CALL iom_close( numrir )  ! close input ice restart file 
     250         ! 
     251         IF( lrst_ice )               CALL lim_rst_write( kt )  ! -- Ice restart file  
     252         ! 
     253         IF( ln_icectl )              CALL lim_ctl( kt )        ! alerts in case of model crash 
    241254         ! 
    242255      ENDIF   ! End sea-ice time step only 
     
    246259      !-------------------------! 
    247260      ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere 
    248       IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
     261      !    using before instantaneous surf. currents 
     262      IF( ln_limdyn )                 CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) 
    249263!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    250264      ! 
     
    264278      !!---------------------------------------------------------------------- 
    265279      IF(lwp) WRITE(numout,*) 
    266       IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition'  
     280      IF(lwp) WRITE(numout,*) 'sbc_lim_init : update ocean surface boudary condition'  
    267281      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping' 
    268282      ! 
     
    279293      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing 
    280294      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics 
    281       ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics 
     295      IF( ln_limdyn )   ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics 
    282296      ! 
    283297      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     
    300314      CALL lim_msh                     ! ice mesh initialization 
    301315      ! 
    302       CALL lim_itd_me_init             ! ice thickness distribution initialization for mecanical deformation 
     316      IF( ln_limdyn )   CALL lim_itd_me_init             ! ice thickness distribution initialization for mecanical deformation 
    303317      !                                ! Initial sea-ice state 
    304318      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst 
     
    347361      !!------------------------------------------------------------------- 
    348362      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    349       NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  & 
    350          &                ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt   
     363      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, rn_amax_n, rn_amax_s, cn_icerst_in, cn_icerst_indir,   & 
     364         &                cn_icerst_out, cn_icerst_outdir, ln_limthd, ln_limdyn, nn_limdyn, rn_uice, rn_vice   
     365      NAMELIST/namicediag/ ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt   
    351366      !!------------------------------------------------------------------- 
    352367      !                     
     
    360375      IF(lwm) WRITE ( numoni, namicerun ) 
    361376      ! 
     377      REWIND( numnam_ice_ref )              ! Namelist namicediag in reference namelist : Parameters for ice 
     378      READ  ( numnam_ice_ref, namicediag, IOSTAT = ios, ERR = 903) 
     379903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in reference namelist', lwp ) 
     380 
     381      REWIND( numnam_ice_cfg )              ! Namelist namicediag in configuration namelist : Parameters for ice 
     382      READ  ( numnam_ice_cfg, namicediag, IOSTAT = ios, ERR = 904 ) 
     383904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in configuration namelist', lwp ) 
     384      IF(lwm) WRITE ( numoni, namicediag ) 
    362385      ! 
    363386      IF(lwp) THEN                        ! control print 
    364387         WRITE(numout,*) 
    365          WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice' 
     388         WRITE(numout,*) 'ice_run : ice share~d parameters for dynamics/advection/thermo of sea-ice' 
    366389         WRITE(numout,*) ' ~~~~~~' 
    367390         WRITE(numout,*) '   number of ice  categories                               = ', jpl 
    368391         WRITE(numout,*) '   number of ice  layers                                   = ', nlay_i 
    369392         WRITE(numout,*) '   number of snow layers                                   = ', nlay_s 
    370          WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn 
    371393         WRITE(numout,*) '   maximum ice concentration for NH                        = ', rn_amax_n  
    372394         WRITE(numout,*) '   maximum ice concentration for SH                        = ', rn_amax_s 
    373          WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb 
    374          WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout 
     395         WRITE(numout,*) '   Ice thermodynamics (T) or not (F)            ln_limthd  = ', ln_limthd 
     396         WRITE(numout,*) '   Ice dynamics       (T) or not (F)            ln_limdyn  = ', ln_limdyn 
     397         WRITE(numout,*) '     (ln_limdyn=T) Ice dynamics switch          nn_limdyn  = ', nn_limdyn 
     398         WRITE(numout,*) '       2: total' 
     399         WRITE(numout,*) '       1: advection only (no diffusion, no ridging/rafting)' 
     400         WRITE(numout,*) '       0: advection only (as 1 + prescribed velocity, bypass rheology)' 
     401         WRITE(numout,*) '     (ln_limdyn=T) prescribed u-vel (case nn_limdyn=0)     = ', rn_uice 
     402         WRITE(numout,*) '     (ln_limdyn=T) prescribed v-vel (case nn_limdyn=0)     = ', rn_vice 
     403         WRITE(numout,*) 
     404         WRITE(numout,*) '...and ice diagnostics' 
     405         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~' 
     406         WRITE(numout,*) '   Diagnose heat/mass/salt budget or not     ln_limdiahsb  = ', ln_limdiahsb 
     407         WRITE(numout,*) '   Output   heat/mass/salt budget or not     ln_limdiaout  = ', ln_limdiaout 
    375408         WRITE(numout,*) '   control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 
    376409         WRITE(numout,*) '   i-index for control prints (ln_icectl=true)             = ', iiceprt 
     
    410443      ! 
    411444      REWIND( numnam_ice_ref )              ! Namelist namiceitd in reference namelist : Parameters for ice 
    412       READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903) 
    413 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 
     445      READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 905) 
     446905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 
    414447 
    415448      REWIND( numnam_ice_cfg )              ! Namelist namiceitd in configuration namelist : Parameters for ice 
    416       READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 ) 
    417 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 
     449      READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 906 ) 
     450906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 
    418451      IF(lwm) WRITE ( numoni, namiceitd ) 
    419       ! 
    420452      ! 
    421453      IF(lwp) THEN                        ! control print 
    422454         WRITE(numout,*) 
    423          WRITE(numout,*) 'ice_itd : ice cat distribution' 
    424          WRITE(numout,*) ' ~~~~~~' 
     455         WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 
     456         WRITE(numout,*) '~~~~~~~~~~~~' 
    425457         WRITE(numout,*) '   shape of ice categories distribution                          nn_catbnd = ', nn_catbnd 
    426458         WRITE(numout,*) '   mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean 
     
    430462      !- Thickness categories boundaries  
    431463      !---------------------------------- 
    432       IF(lwp) WRITE(numout,*) 
    433       IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 
    434       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    435  
    436464      hi_max(:) = 0._wp 
    437465 
     
    581609      !!---------------------------------------------------------------------- 
    582610      sfx    (:,:) = 0._wp   ; 
    583       sfx_bri(:,:) = 0._wp   ;  
     611      sfx_bri(:,:) = 0._wp   ;   sfx_lam(:,:) = 0._wp 
    584612      sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
    585613      sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
     
    592620      wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
    593621      wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
    594       wfx_spr(:,:) = 0._wp   ;    
     622      wfx_spr(:,:) = 0._wp   ;   wfx_lam(:,:) = 0._wp   
    595623       
    596624      hfx_thd(:,:) = 0._wp   ;    
Note: See TracChangeset for help on using the changeset viewer.