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 7309 – NEMO

Changeset 7309


Ignore:
Timestamp:
2016-11-22T18:43:11+01:00 (7 years ago)
Author:
clem
Message:

first implementations

Location:
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM
Files:
5 added
3 deleted
55 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml

    r5517 r7309  
    6161   <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 
    6262     <field field_ref="empmr"        name="wfo"      /> 
     63      <field field_ref="emp_oce"      name="emp_oce"  long_name="Evap minus Precip over ocean"              /> 
     64      <field field_ref="emp_ice"      name="emp_ice"  long_name="Evap minus Precip over ice"                /> 
    6365     <field field_ref="qsr_oce"      name="qsr_oce"  /> 
    6466     <field field_ref="qns_oce"      name="qns_oce"  /> 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice_cfg

    r4690 r7309  
    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_CNRS_AGRIF_2016/NEMOGCM/CONFIG/SHARED/field_def.xml

    r6472 r7309  
    239239         <field id="hflx_rain_cea" long_name="heat flux due to rainfall"                                standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"        unit="W/m2"     /> 
    240240         <field id="hflx_evap_cea" long_name="heat flux due to evaporation"                             standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water"   unit="W/m2"     /> 
    241          <field id="hflx_snow_cea" long_name="heat flux due to snow falling over ice-free ocean"        standard_name="heat_flux_into_sea_water_due_to_snow_thermodynamics"                           unit="W/m2"     /> 
     241         <field id="hflx_snow_cea" long_name="heat flux due to snow falling"                            standard_name="heat_flux_onto_ocean_and_ice_due_to_snow_thermodynamics"                       unit="W/m2"     /> 
     242         <field id="hflx_snow_ai_cea" long_name="heat flux due to snow falling over ice"                standard_name="heat_flux_onto_ice_due_to_snow_thermodynamics"                                 unit="W/m2"     /> 
     243         <field id="hflx_snow_ao_cea" long_name="heat flux due to snow falling over ice-free ocean"     standard_name="heat_flux_onto_sea_water_due_to_snow_thermodynamics"                           unit="W/m2"     /> 
    242244         <field id="hflx_ice_cea"  long_name="heat flux due to ice thermodynamics"                      standard_name="heat_flux_into_sea_water_due_to_sea_ice_thermodynamics"                        unit="W/m2"     /> 
    243245         <field id="hflx_rnf_cea"  long_name="heat flux due to runoffs"                                 standard_name="temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water"          unit="W/m2"     /> 
    … …  
    317319         <field id="icevolu"      long_name="ice volume"                                                   unit="m"        /> 
    318320         <field id="snowvol"      long_name="snow volume"                                                  unit="m"        /> 
     321         <field id="tau_icebfr"   long_name="ice friction on ocean bottom for landfast ice"                unit="N/m2"     /> 
    319322 
    320323         <field id="icetrp"       long_name="ice volume transport"                                         unit="m/day"          /> 
    … …  
    330333         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="1e-3*kg/m2/day" /> 
    331334         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="1e-3*kg/m2/day" /> 
     335         <field id="sfxlam"       long_name="salt flux from lateral melt"                                  unit="1e-3*kg/m2/day" /> 
    332336         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/day" /> 
    333337         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/day" /> 
    … …  
    340344         <field id="vfxsni"       long_name="daily snowice ice prod."                                      unit="m/day"   /> 
    341345         <field id="vfxsum"       long_name="surface melt"                                                 unit="m/day"   /> 
     346         <field id="vfxlam"       long_name="lateral melt"                                                 unit="m/day"   /> 
    342347         <field id="vfxbom"       long_name="bottom melt"                                                  unit="m/day"   /> 
    343348         <field id="vfxres"       long_name="daily resultant ice prod./melting from limupdate"             unit="m/day"   /> 
    … …  
    345350         <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="m/day"   /> 
    346351         <field id="vfxsub"       long_name="snw sublimation"                                              unit="m/day"   /> 
     352         <field id="vfxsub_err"   long_name="excess of snw sublimation sent to ocean"                      unit="m/day"   /> 
    347353         <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="m/day"   /> 
    348          <field id="vfxthin"      long_name="daily thermo ice prod. for thin ice(<20cm) + open water"      unit="m/day"   /> 
     354         <field id="vfxthin"      long_name="daily thermo ice prod. for thin ice(20cm) + open water"       unit="m/day"   /> 
    349355 
    350356         <field id="afxtot"       long_name="area tendency (total)"                                        unit="day-1"   /> 
    … …  
    521527 
    522528          <!-- available with ln_diahsb --> 
    523        <field id="bgtemper"     long_name="drift in global mean temperature wrt timestep 1"                 standard_name="change_over_time_in_sea_water_potential_temperature"   unit="degC"     /> 
     529       <field id="bgtemper"     long_name="drift in global mean temperature wrt timestep 1"                 standard_name="change_over_time_in_sea_water_potential_temperature"   unit="degC"     /> 
    524530       <field id="bgsaline"     long_name="drift in global mean salinity wrt timestep 1"                    standard_name="change_over_time_in_sea_water_practical_salinity"      unit="1e-3"     /> 
    525        <field id="bgheatco"     long_name="drift in global mean heat content wrt timestep 1"                                                                                      unit="10^9J"    /> 
    526        <field id="bgsaltco"     long_name="drift in global mean salt content wrt timestep 1"                                                                                      unit="1e-3*m3"  /> 
     531       <field id="bgheatco"     long_name="drift in global mean heat content wrt timestep 1"                                                                                      unit="1.e20J"   /> 
     532       <field id="bgheatfx"     long_name="drift in global mean heat flux    wrt timestep 1"                                                                                      unit="W/m2"     /> 
     533           <field id="bgsaltco"     long_name="drift in global mean salt content wrt timestep 1"                                                                                      unit="1e-3*km3" /> 
    527534       <field id="bgvolssh"     long_name="drift in global mean ssh volume wrt timestep 1"                                                                                        unit="km3"      /> 
    528535         <field id="bgvole3t"     long_name="drift in global mean volume variation (e3t) wrt timestep 1"                                                                            unit="km3"      /> 
    529        <field id="bgvoltot"     long_name="drift in global mean volume wrt timestep 1"                                                                                            unit="km3"      /> 
    530          <!-- NOTE: No matching iom_put call --> 
    531        <field id="bgsshtot"     long_name="drift in global mean ssh wrt timestep 1"                         standard_name="global_average_sea_level_change"                       unit="m"        /> 
    532        <field id="bgfrcvol"     long_name="drift in global mean volume from forcing wrt timestep 1"                                                                               unit="km3"      /> 
    533        <field id="bgfrctem"     long_name="drift in global mean heat content from forcing wrt timestep 1"                                                                         unit="10^9J"    /> 
    534        <field id="bgfrcsal"     long_name="drift in global mean salt content from forcing wrt timestep 1"                                                                         unit="1e-3*km3" /> 
    535        <field id="bgmistem"     long_name="global mean temperature error due to free surface"                                                                                     unit="degC"     /> 
    536        <field id="bgmissal"     long_name="global mean salinity error due to free surface"                                                                                        unit="1e-3"     /> 
    537       </field_group> 
     536       <field id="bgfrcvol"     long_name="global mean volume from forcing"                                                                                                       unit="km3"      /> 
     537       <field id="bgfrctem"     long_name="global mean heat content from forcing"                                                                                                 unit="1.e20J"   /> 
     538         <field id="bgfrchfx"     long_name="global mean heat flux from forcing"                                                                                                    unit="W/m2"     /> 
     539       <field id="bgfrcsal"     long_name="global mean salt content from forcing"                                                                                                 unit="1e-3*km3" /> 
     540       <field id="bgmistem"     long_name="global mean temperature error due to free surface (no vvl)"                                                                            unit="degC"     /> 
     541       <field id="bgmissal"     long_name="global mean salinity error due to free surface (no vvl)"                                                                               unit="1e-3"     /> 
     542     </field_group> 
    538543 
    539544      <!-- LIM3 scalar variables --> 
    … …  
    541546      <field_group id="SBC_scalar"  domain_ref="1point" > 
    542547         <!-- available with ln_limdiaout --> 
    543          <field id="ibgvoltot"    long_name="global mean ice volume"                                 unit="km3"        /> 
    544          <field id="sbgvoltot"    long_name="global mean snow volume"                                unit="km3"        /> 
    545          <field id="ibgarea"      long_name="global mean ice area"                                   unit="km2"        /> 
    546          <field id="ibgsaline"    long_name="global mean ice salinity"                               unit="1e-3"       /> 
    547          <field id="ibgtemper"    long_name="global mean ice temperature"                            unit="degC"       /> 
    548          <field id="ibgheatco"    long_name="global mean ice heat content"                           unit="10^20J"     /> 
    549          <field id="sbgheatco"    long_name="global mean snow heat content"                          unit="10^20J"     /> 
    550          <field id="ibgsaltco"    long_name="global mean ice salt content"                           unit="1e-3*km3"   /> 
    551  
    552          <field id="ibgvfx"       long_name="global mean volume flux (emp)"                          unit="m/day"      /> 
    553          <field id="ibgvfxbog"    long_name="global mean volume flux (bottom growth)"                unit="m/day"      /> 
    554          <field id="ibgvfxopw"    long_name="global mean volume flux (open water growth)"            unit="m/day"      /> 
    555          <field id="ibgvfxsni"    long_name="global mean volume flux (snow-ice growth)"              unit="m/day"      /> 
    556          <field id="ibgvfxdyn"    long_name="global mean volume flux (dynamic growth)"               unit="m/day"      /> 
    557          <field id="ibgvfxbom"    long_name="global mean volume flux (bottom melt)"                  unit="m/day"      /> 
    558          <field id="ibgvfxsum"    long_name="global mean volume flux (surface melt)"                 unit="m/day"      /> 
    559          <field id="ibgvfxres"    long_name="global mean volume flux (resultant)"                    unit="m/day"      /> 
    560          <field id="ibgvfxspr"    long_name="global mean volume flux (snow precip)"                  unit="m/day"      /> 
    561          <field id="ibgvfxsnw"    long_name="global mean volume flux (snow melt)"                    unit="m/day"      /> 
    562          <field id="ibgvfxsub"    long_name="global mean volume flux (snow sublimation)"             unit="m/day"      /> 
    563  
    564          <field id="ibgsfx"       long_name="global mean salt flux (total)"                          unit="1e-3*m/day" /> 
    565          <field id="ibgsfxbri"    long_name="global mean salt flux (brines)"                         unit="1e-3*m/day" /> 
    566          <field id="ibgsfxdyn"    long_name="global mean salt flux (dynamic)"                        unit="1e-3*m/day" /> 
    567          <field id="ibgsfxres"    long_name="global mean salt flux (resultant)"                      unit="1e-3*m/day" /> 
    568          <field id="ibgsfxbog"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" /> 
    569          <field id="ibgsfxopw"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" /> 
    570          <field id="ibgsfxsni"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" /> 
    571          <field id="ibgsfxbom"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" /> 
    572          <field id="ibgsfxsum"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" /> 
    573          <field id="ibgsfxsub"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" /> 
    574  
    575          <field id="ibghfxdhc"    long_name="Heat content variation in snow and ice"                 unit="W"          /> 
    576          <field id="ibghfxspr"    long_name="Heat content of snow precip"                            unit="W"          /> 
    577  
    578          <field id="ibghfxthd"    long_name="heat fluxes from ice-ocean exchange during thermo"      unit="W"          /> 
    579          <field id="ibghfxsum"    long_name="heat fluxes causing surface ice melt"                   unit="W"          /> 
    580          <field id="ibghfxbom"    long_name="heat fluxes causing bottom ice melt"                    unit="W"          /> 
    581          <field id="ibghfxbog"    long_name="heat fluxes causing bottom ice growth"                  unit="W"          /> 
    582          <field id="ibghfxdif"    long_name="heat fluxes causing ice temperature change"             unit="W"          /> 
    583          <field id="ibghfxopw"    long_name="heat fluxes causing open water ice formation"           unit="W"          /> 
    584          <field id="ibghfxdyn"    long_name="heat fluxes from ice-ocean exchange during dynamic"     unit="W"          /> 
    585          <field id="ibghfxres"    long_name="heat fluxes from ice-ocean exchange during resultant"   unit="W"          /> 
    586          <field id="ibghfxsub"    long_name="heat fluxes from sublimation"                           unit="W"          /> 
    587          <field id="ibghfxsnw"    long_name="heat fluxes from snow-ocean exchange"                   unit="W"          /> 
    588          <field id="ibghfxout"    long_name="non solar heat fluxes received by the ocean"            unit="W"          /> 
    589          <field id="ibghfxin"     long_name="total heat fluxes at the ice surface"                   unit="W"          /> 
    590  
    591          <field id="ibgfrcvol"    long_name="global mean forcing volume (emp)"                       unit="km3"        /> 
    592          <field id="ibgfrcsfx"    long_name="global mean forcing salt   (sfx)"                       unit="1e-3*km3"   /> 
    593          <field id="ibgvolgrm"    long_name="global mean ice growth+melt volume"                     unit="km3"        /> 
     548         <field id="ibgfrcvoltop"    long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)"   unit="km3"       /> 
     549         <field id="ibgfrcvolbot"    long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3"       /> 
     550         <field id="ibgfrctemtop"    long_name="global mean heat on top of ice/snw/ocean-atm "                                             unit="1e20J"     /> 
     551         <field id="ibgfrctembot"    long_name="global mean heat below ice (on top of ocean) "                                             unit="1e20J"     /> 
     552         <field id="ibgfrcsal"       long_name="global mean ice/snow forcing (salt equivalent ocean volume)"                               unit="pss*km3"   /> 
     553         <field id="ibgfrchfxtop"    long_name="global mean heat flux on top of ice/snw/ocean-atm "                                        unit="W/m2"      /> 
     554         <field id="ibgfrchfxbot"    long_name="global mean heat flux below ice (on top of ocean) "                                        unit="W/m2"      /> 
     555  
     556         <field id="ibgvolume"    long_name="drift in ice/snow volume (equivalent ocean volume)"            unit="km3"        /> 
     557         <field id="ibgsaltco"    long_name="drift in ice salt content (equivalent ocean volume)"           unit="pss*km3"    /> 
     558         <field id="ibgheatco"    long_name="drift in ice/snow heat content"                                unit="1e20J"      /> 
     559         <field id="ibgheatfx"    long_name="drift in ice/snow heat flux"                                   unit="W/m2"       /> 
     560 
     561         <field id="ibgvol_tot"    long_name="global mean ice volume"                                       unit="km3"        /> 
     562         <field id="sbgvol_tot"    long_name="global mean snow volume"                                      unit="km3"        /> 
     563         <field id="ibgarea_tot"   long_name="global mean ice area"                                         unit="km2"        /> 
     564         <field id="ibgsalt_tot"   long_name="global mean ice salt content"                                 unit="1e-3*km3"   /> 
     565         <field id="ibgheat_tot"   long_name="global mean ice heat content"                                 unit="1e20J"      /> 
     566         <field id="sbgheat_tot"   long_name="global mean snow heat content"                                unit="1e20J"      /> 
    594567      </field_group> 
    595568   

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref

    r6416 r7309  
    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_limdiachk   =  .false.        !  check online the heat, mass & salt budgets (T) or not (F) 
     39   ln_limdiahsb   =  .false.        !  output the heat, mass & salt budgets (T) or not (F) 
     40   ln_limctl      =  .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      = .true.          !  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   =  2.0            !  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!------------------------------------------------------------------------------ 
    … …  
    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                  ! -- limtrp & limadv -- ! 
     74   nn_limadv      =    0            !  choose the advection scheme (-1=Prather ; 0=Ultimate-Macho) 
     75   nn_limadv_ord  =    5            !  choose the order of the advection scheme (if nn_limadv=0) 
     76                  ! -- limitd_me -- ! 
     77   nn_icestr      =    0            !  ice strength parameteriztaion                       
     78                                    !     0: Hibler_79     P = pstar*<h>*exp(-c_rhg*A) 
     79                                    !     1: Rothrock_75   P = Cf*coeff*integral(wr.h^2)     
     80   rn_pe_rdg      =   17.0          !     (nn_icestr=1) ridging work divided by pot. energy change in ridging 
     81   rn_pstar       =    2.0e+04      !     (nn_icestr=0) ice strength thickness parameter (N/m2)  
     82   rn_crhg        =   20.0          !     (nn_icestr=0) ice strength conc. parameter (-) 
     83   ln_icestr_bvf  =    .false.      !     ice strength function brine volume (T) or not (F) 
     84                                    ! 
     85            ! -- limdyn & limrhg -- ! 
     86   rn_cio         =    5.0e-03      !  ice-ocean drag coefficient (-) 
     87   rn_creepl      =    1.0e-12      !  creep limit (s-1) 
     88   rn_ecc         =    2.0          !  eccentricity of the elliptical yield curve           
     89   nn_nevp        =  120            !  number of EVP subcycles                              
     90   rn_relast      =    0.333        !  ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
     91                                    !     advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 
     92   ln_landfast    =  .false.        !  landfast ice parameterization (T or F)                            
     93   rn_gamma       =    0.15         !     (ln_landfast=T)  fraction of ocean depth that ice must reach to initiate landfast 
     94                                    !                      recommended range: [0.1 ; 0.25] 
     95   rn_icebfr      =    10.          !     (ln_landfast=T)  maximum bottom stress per unit area of contact (N/m2)                  
     96                                    !                      a very large value ensures ice velocity=0 even with a small contact area 
     97                                    !                      recommended range: ?? (should be greater than atm-ice stress => >0.1 N/m2) 
     98   rn_lfrelax     =    1.e-5        !     (ln_landfast=T)  relaxation time scale to reach static friction (s-1)                  
    7799/ 
    78100!------------------------------------------------------------------------------ 
    79101&namicehdf     !   Ice horizontal diffusion 
    80102!------------------------------------------------------------------------------ 
    81    nn_convfrq     = 5              !  convergence check frequency of the Crant-Nicholson scheme (perf. optimization) 
     103                     ! -- limhdf -- ! 
     104   nn_ahi0        =    -1           !  horizontal diffusivity computation 
     105                                    !    -1: no diffusion (bypass limhdf) 
     106                                    !     0: use rn_ahi0_ref 
     107                                    !     1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length ) 
     108                                    !     2: use rn_ahi0_ref x grid cell length      / ( 2deg mean grid cell length ) 
     109   rn_ahi0_ref    = 350.0           !  horizontal sea ice diffusivity (m2/s)  
     110                                    !     if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution 
    82111/ 
    83112!------------------------------------------------------------------------------ 
    84113&namicethd     !   Ice thermodynamics 
    85114!------------------------------------------------------------------------------ 
    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) 
     115                 ! -- limthd_dif -- ! 
     116   rn_kappa_i     = 1.0             !  radiation attenuation coefficient in sea ice (m-1) 
     117   nn_conv_dif    = 50              !  maximal number of iterations for heat diffusion computation 
     118   rn_terr_dif    = 1.0e-04         !  maximum temperature after heat diffusion (degC) 
     119   nn_ice_thcon   = 1               !  sea ice thermal conductivity 
     120                                    !     0: k = k0 + beta.S/T            (Untersteiner, 1964) 
     121                                    !     1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007) 
     122   ln_it_qnsice   = .true.          !  iterate the surface non-solar flux with surface temperature (T) or not (F) 
     123   nn_monocat     = 0               !  virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0) 
     124                                    !     2: simple piling instead of ridging    --- temporary option 
     125                                    !     3: activate G(he) only                 --- temporary option 
     126                                    !     4: activate extra lateral melting only --- temporary option 
     127                  ! -- limthd_dh -- ! 
     128   ln_limdH       = .true.          !  activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     129   rn_betas       = 0.66            !  exponent in lead-ice repratition of snow precipitation 
     130                                    !     betas = 1 -> equipartition, betas < 1 -> more on leads 
     131                  ! -- limthd_da -- ! 
     132   ln_limdA       = .true.          !  activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     133   rn_beta        = 1.0             !     (ln_latmelt=T) coef. beta for lateral melting param. Recommended range=[0.8-1.2] 
     134                                    !      => decrease = more melt and melt peaks toward higher concentration (A~0.5 for beta=1 ; A~0.8 for beta=0.2) 
     135                                    !         0.3 = best fit for western Fram Strait and Antarctica 
     136                                    !         1.4 = best fit for eastern Fram Strait       
     137   rn_dmin        = 8.              !     (ln_latmelt=T) minimum floe diameter for lateral melting param. Recommended range=[6-10] 
     138                                    !      => 6  vs 8m = +40% melting at the peak (A~0.5) 
     139                                    !         10 vs 8m = -20% melting 
     140                 ! -- limthd_lac -- ! 
     141   ln_limdO       = .true.          !  activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     142   rn_hnewice     = 0.1             !  thickness for new ice formation in open water (m) 
     143   ln_frazil      = .false.         !  Frazil ice parameterization (ice collection as a function of wind) 
     144   rn_maxfrazb    = 1.0             !     (ln_frazil=T) maximum fraction of frazil ice collecting at the ice base 
     145   rn_vfrazb      = 0.417           !     (ln_frazil=T) thresold drift speed for frazil ice collecting at the ice bottom (m/s) 
     146   rn_Cfrazb      = 5.0             !     (ln_frazil=T) squeezing coefficient for frazil ice collecting at the ice bottom 
     147                  ! -- limitd_th -- ! 
     148   rn_himin       = 0.1             !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice 
    105149/ 
    106150!------------------------------------------------------------------------------ 
    107151&namicesal     !   Ice salinity 
    108152!------------------------------------------------------------------------------ 
    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) 
     153                 ! -- limthd_sal -- ! 
     154   ln_limdS       = .true.          !  activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     155   nn_icesal      =  2              !  ice salinity option 
     156                                    !     1: constant ice salinity (S=rn_icesal) 
     157                                    !     2: varying salinity parameterization S(z,t) 
     158                                    !     3: prescribed salinity profile S(z), Schwarzacher, 1959 
     159   rn_icesal      =  4.             !    (nn_icesal=1) ice salinity (g/kg) 
     160   rn_sal_gd      =  5.             !  restoring ice salinity, gravity drainage (g/kg) 
     161   rn_time_gd     =  1.73e+6        !  restoring time scale, gravity drainage  (s) 
     162   rn_sal_fl      =  2.             !  restoring ice salinity, flushing (g/kg) 
     163   rn_time_fl     =  8.64e+5        !  restoring time scale, flushing (s) 
     164   rn_simax       = 20.             !  maximum tolerated ice salinity (g/kg) 
     165   rn_simin       =  0.1            !  minimum tolerated ice salinity (g/kg) 
    120166/ 
    121167!------------------------------------------------------------------------------ 
    122168&namiceitdme   !   Ice mechanical redistribution (ridging and rafting) 
    123169!------------------------------------------------------------------------------ 
    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) 
     170                  ! -- limitd_me -- ! 
     171   rn_cs          =   0.5           !  fraction of shearing energy contributing to ridging 
     172   nn_partfun     =   1             !  type of ridging participation function 
     173                                    !     0: linear      (Thorndike et al, 1975) 
     174                                    !     1: exponential (Lipscomb, 2007) 
     175   rn_gstar       =   0.15          !     (nn_partfun = 0) fractional area of thin ice being ridged  
     176   rn_astar       =   0.05          !     (nn_partfun = 1) exponential measure of ridging ice fraction 
     177   ln_ridging     =   .true.        !  ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     178   rn_hstar       = 100.0           !     (ln_ridging = T) determines the maximum thickness of ridged ice (m) (Hibler, 1980) 
     179   rn_por_rdg     =   0.3           !     (ln_ridging = T) porosity of newly ridged ice (Lepparanta et al., 1995) 
     180   rn_fsnowrdg    =   0.5           !     (ln_ridging = T) snow volume fraction that survives in ridging 
     181   ln_rafting     =   .true.        !  rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
     182   rn_hraft       =   0.75          !     (ln_rafting = T) threshold thickness for rafting (m) 
     183   rn_craft       =   5.0           !     (ln_rafting = T) squeezing coefficient used in the rafting function 
     184   rn_fsnowrft    =   0.5           !     (ln_rafting = T) snow volume fraction that survives in rafting 
    137185/ 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/CONFIG/SHARED/namelist_ref

    r6497 r7309  
    1111!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_ldfeiv, namtra_dmp) 
    1212!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) 
    13 !!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx) 
     13!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx, namzdf_tmx_new) 
    1414!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto) 
    1515!!             10 - miscellaneous    (nammpp, namctl) 
    … …  
    295295&namsbc_ana    !   analytical surface boundary condition 
    296296!----------------------------------------------------------------------- 
     297   ! --- oce variables --- ! 
    297298   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps 
    298299   rn_utau0    =   0.5     !  uniform value for the i-stress 
    … …  
    301302   rn_qsr0     =   0.e0    !  uniform value for the solar radiation 
    302303   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P) 
     304   ! --- ice variables --- ! 
     305   rn_iutau0   =   0.e0    !  uniform value for the i-stress over ice 
     306   rn_ivtau0   =   0.e0    !  uniform value for the j-stress over ice 
     307   rn_iqns0    =   0.e0    !  uniform value for the total heat flux over ice 
     308   rn_iqsr0    =   0.e0    !  uniform value for the solar radiation over ice 
     309   rn_sprec0   =   0.e0    !  uniform value for snow precip 
     310   rn_ievap0   =   0.e0    !  uniform value for sublimation 
    303311/ 
    304312!----------------------------------------------------------------------- 
    … …  
    353361   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
    354362                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 
     363   ln_Cd_L12   = .false.   !  Modify the drag ice-atm and oce-atm depending on ice concentration 
     364                           !  This parameterization is from Lupkes et al. (JGR 2012) 
    355365/ 
    356366!----------------------------------------------------------------------- 
    … …  
    401411!              !  file name  ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    402412!              !             !  (if <0  months)  !   name    !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
     413   l_sasread   = .TRUE.   ! Read fields in a file if .TRUE. , or initialize to 0. in sbcssm.F90 if .FALSE. 
    403414   sn_usp      = 'sas_grid_U',     120           , 'vozocrtx',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 
    404415   sn_vsp      = 'sas_grid_V',     120           , 'vomecrty',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90

    r6140 r7309  
    8383      CALL ice_run_2                   ! read in namelist some run parameters 
    8484      !           
    85       rdt_ice = nn_fsbc * rdt           ! sea-ice time step 
     85      rdt_ice = nn_fsbc * rdt          ! sea-ice time step 
    8686      numit   = nit000 - 1 
    8787      ! 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90

    r3625 r7309  
    8080      njeqm1 = njeq - 1  
    8181 
    82       fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   !  coriolis factor at T-point 
     82      fcor(:,:) = 2. * omega * SIN( gphif(:,:) * rad )   !  coriolis factor at T-point 
    8383  
    8484!i    DO jj = 1, jpj 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

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

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r6416 r7309  
    1818   USE phycst         ! physical constants 
    1919   USE ice            ! LIM-3 variables 
    20    USE dom_ice        ! LIM-3 domain 
    2120   USE dom_oce        ! ocean domain 
    2221   USE in_out_manager ! I/O manager 
    … …  
    165164      !!                     + test if ice concentration and volume are > 0 
    166165      !! 
    167       !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true 
     166      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiachk=true 
    168167      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
    169168      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to 
    … …  
    185184         ! salt flux 
    186185         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    187             &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   & 
     186            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    & 
    188187            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv ) 
    189188 
    190189         ! water flux 
    191          zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    192             &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     190         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +               & 
     191            &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:)  & 
    193192            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv ) 
    194193 
    … …  
    210209         ! salt flux 
    211210         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    212             &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   &  
     211            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    &  
    213212            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 
    214213 
    215214         ! water flux 
    216          zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
    217             &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     215         zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +                & 
     216            &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:)   & 
    218217            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 
    219218 
    … …  
    260259               &                         cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 
    261260                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     261            IF (     zamax   > 1._wp   ) WRITE(numout,*) 'violation a_i>1               (',cd_routine,') = ',zamax 
    262262            ENDIF 
    263263            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
    … …  
    274274      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step 
    275275      !! 
    276       !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true 
     276      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiachk=true 
    277277      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
    278278      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to 
    … …  
    288288#if ! defined key_bdy 
    289289      ! heat flux 
    290       zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - SUM( qevap_ice * a_i_b, dim=3 ) )  & 
    291          &              * e1e2t * tmask(:,:,1) * zconv )  
     290      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es   & 
     291      !  &              - SUM( qevap_ice * a_i_b, dim=3 )                           & !!clem: I think this line must be commented (but need check) 
     292         &              ) * e1e2t * tmask(:,:,1) * zconv )  
    292293      ! salt flux 
    293294      zsfx  = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90

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

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

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

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

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

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

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

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r6695 r7309  
    2323   USE ice              ! sea-ice variables 
    2424   USE par_oce          ! ocean parameters 
    25    USE dom_ice          ! sea-ice domain 
    2625   USE limvar           ! lim_var_salprof 
    2726   USE in_out_manager   ! I/O manager 
    … …  
    3736   PUBLIC   lim_istate      ! routine called by lim_init.F90 
    3837 
    39    !                          !!** init namelist (namiceini) ** 
    40    REAL(wp) ::   rn_thres_sst   ! threshold water temperature for initial sea ice 
    41    REAL(wp) ::   rn_hts_ini_n   ! initial snow thickness in the north 
    42    REAL(wp) ::   rn_hts_ini_s   ! initial snow thickness in the south 
    43    REAL(wp) ::   rn_hti_ini_n   ! initial ice thickness in the north 
    44    REAL(wp) ::   rn_hti_ini_s   ! initial ice thickness in the south 
    45    REAL(wp) ::   rn_ati_ini_n   ! initial leads area in the north 
    46    REAL(wp) ::   rn_ati_ini_s   ! initial leads area in the south 
    47    REAL(wp) ::   rn_smi_ini_n   ! initial salinity  
    48    REAL(wp) ::   rn_smi_ini_s   ! initial salinity 
    49    REAL(wp) ::   rn_tmi_ini_n   ! initial temperature 
    50    REAL(wp) ::   rn_tmi_ini_s   ! initial temperature 
    51  
    5238   INTEGER , PARAMETER ::   jpfldi = 6           ! maximum number of files to read 
    5339   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness (m)    at T-point 
    … …  
    5743   INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temp at T-point 
    5844   INTEGER , PARAMETER ::   jp_smi = 6           ! index of ice sali at T-point 
    59    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si    ! structure of input fields (file informations, fields read) 
    60  
    61    LOGICAL  ::  ln_iceini        ! initialization or not 
    62    LOGICAL  ::  ln_iceini_file   ! Ice initialization state from 2D netcdf file 
     45   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    6346   !!---------------------------------------------------------------------- 
    6447   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
    … …  
    10184      REAL(wp)   :: ztmelts, zdh 
    10285      INTEGER    :: i_hemis, i_fill, jl0   
    103       REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv  
     86      REAL(wp)   :: zarg, zV, zconv, zdv  
    10487      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator 
    10588      REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, zat_i_ini, zvt_i_ini            !data from namelist or nc file 
    10689      REAL(wp), POINTER, DIMENSION(:,:)   :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
    107       REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini, zv_i_ini               !data by cattegories to fill 
    108       !-------------------------------------------------------------------- 
    109  
    110       CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     90      REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini                         !data by cattegories to fill 
     91      INTEGER , POINTER, DIMENSION(:)     :: itest 
     92      !-------------------------------------------------------------------- 
     93 
     94      CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini ) 
    11195      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 ) 
    11296      CALL wrk_alloc( jpi, jpj,      zswitch ) 
     97      Call wrk_alloc( 4,             itest ) 
    11398 
    11499      IF(lwp) WRITE(numout,*) 
    … …  
    119104      ! 1) Read namelist 
    120105      !-------------------------------------------------------------------- 
    121  
    122       CALL lim_istate_init     !  reading the initials parameters of the ice 
    123  
    124       ! surface temperature 
    125       DO jl = 1, jpl ! loop over categories 
     106      CALL lim_istate_init 
     107 
     108      ! init surface temperature 
     109      DO jl = 1, jpl 
    126110         t_su  (:,:,jl) = rt0 * tmask(:,:,1) 
    127111         tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 
    128112      END DO 
    129113 
    130       ! basal temperature (considered at freezing point) 
     114      ! init basal temperature (considered at freezing point) 
    131115      CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 
    132116      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
    133117 
    134118 
    135       IF( ln_iceini ) THEN 
    136  
    137          !-------------------------------------------------------------------- 
    138          ! 2) Basal temperature, ice mask and hemispheric index 
    139          !-------------------------------------------------------------------- 
    140  
    141          DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    142             DO ji = 1, jpi 
    143                IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN  
    144                   zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice 
    145                ELSE                                                                                    
    146                   zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice 
    147                ENDIF 
    148             END DO 
    149          END DO 
    150  
    151          !-------------------------------------------------------------------- 
    152          ! 3) Initialization of sea ice state variables 
    153          !-------------------------------------------------------------------- 
    154          IF( ln_iceini_file )THEN 
     119      !-------------------------------------------------------------------- 
     120      ! 2) Initialization of sea ice state variables 
     121      !-------------------------------------------------------------------- 
     122      IF( ln_limini ) THEN 
     123 
     124         IF( ln_limini_file )THEN 
    155125 
    156126            zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1) 
    … …  
    161131            zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1) 
    162132 
    163          ELSE ! ln_iceini_file = F 
     133            WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1)  
     134            ELSEWHERE                       ; zswitch(:,:) = 0._wp 
     135            END WHERE 
     136 
     137         ELSE ! ln_limini_file = F 
     138 
     139            !-------------------------------------------------------------------- 
     140            ! 3) Basal temperature, ice mask 
     141            !-------------------------------------------------------------------- 
     142            ! no ice if sst <= t-freez + ttest 
     143            WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp  
     144            ELSEWHERE                                                                  ; zswitch(:,:) = tmask(:,:,1) 
     145            END WHERE 
    164146 
    165147            !----------------------------- 
    … …  
    169151            DO jj = 1, jpj 
    170152               DO ji = 1, jpi 
    171                   IF( fcor(ji,jj) >= 0._wp ) THEN 
    172                      zht_i_ini(ji,jj) = rn_hti_ini_n 
    173                      zht_s_ini(ji,jj) = rn_hts_ini_n 
    174                      zat_i_ini(ji,jj) = rn_ati_ini_n 
    175                      zts_u_ini(ji,jj) = rn_tmi_ini_n 
    176                      zsm_i_ini(ji,jj) = rn_smi_ini_n 
    177                      ztm_i_ini(ji,jj) = rn_tmi_ini_n 
     153                  IF( ff(ji,jj) >= 0._wp ) THEN 
     154                     zht_i_ini(ji,jj) = rn_hti_ini_n * zswitch(ji,jj) 
     155                     zht_s_ini(ji,jj) = rn_hts_ini_n * zswitch(ji,jj) 
     156                     zat_i_ini(ji,jj) = rn_ati_ini_n * zswitch(ji,jj) 
     157                     zts_u_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 
     158                     zsm_i_ini(ji,jj) = rn_smi_ini_n * zswitch(ji,jj) 
     159                     ztm_i_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 
    178160                  ELSE 
    179                      zht_i_ini(ji,jj) = rn_hti_ini_s 
    180                      zht_s_ini(ji,jj) = rn_hts_ini_s 
    181                      zat_i_ini(ji,jj) = rn_ati_ini_s 
    182                      zts_u_ini(ji,jj) = rn_tmi_ini_s 
    183                      zsm_i_ini(ji,jj) = rn_smi_ini_s 
    184                      ztm_i_ini(ji,jj) = rn_tmi_ini_s 
     161                     zht_i_ini(ji,jj) = rn_hti_ini_s * zswitch(ji,jj) 
     162                     zht_s_ini(ji,jj) = rn_hts_ini_s * zswitch(ji,jj) 
     163                     zat_i_ini(ji,jj) = rn_ati_ini_s * zswitch(ji,jj) 
     164                     zts_u_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 
     165                     zsm_i_ini(ji,jj) = rn_smi_ini_s * zswitch(ji,jj) 
     166                     ztm_i_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 
    185167                  ENDIF 
    186168               END DO 
    187169            END DO 
    188170 
    189          ENDIF ! ln_iceini_file 
    190  
     171         ENDIF ! ln_limini_file 
     172          
    191173         zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)   ! ice volume 
    192  
    193174         !--------------------------------------------------------------------- 
    194175         ! 3.2) Distribute ice concentration and thickness into the categories 
    … …  
    199180         zh_i_ini(:,:,:) = 0._wp  
    200181         za_i_ini(:,:,:) = 0._wp 
    201          zv_i_ini(:,:,:) = 0._wp 
    202182 
    203183         DO jj = 1, jpj 
    … …  
    206186               IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 
    207187 
    208                   ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0 
    209 !                  ztests  = 0  
    210  
    211                   DO i_fill = jpl, 1, -1 
    212  
    213 !                     IF( ztests .NE. 4 ) THEN 
    214                      IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN 
    215                         !---------------------------- 
    216                         ! fill the i_fill categories 
    217                         !---------------------------- 
    218                         ! *** 1 category to fill 
    219                         IF ( i_fill .EQ. 1 ) THEN 
    220                            zh_i_ini(ji,jj,    1)   = zht_i_ini(ji,jj) 
    221                            za_i_ini(ji,jj,    1)   = zat_i_ini(ji,jj) 
    222                            zh_i_ini(ji,jj,2:jpl)   = 0._wp 
    223                            za_i_ini(ji,jj,2:jpl)   = 0._wp 
    224                         ELSE 
    225  
    226                            ! *** >1 categores to fill 
    227                            !--- Ice thicknesses in the i_fill - 1 first categories 
    228                            DO jl = 1, i_fill - 1 
    229                               zh_i_ini(ji,jj,jl) = hi_mean(jl) 
    230                            END DO 
     188                  !--- jl0: most likely index where cc will be maximum 
     189                  jl0 = jpl 
     190                  DO jl = 1, jpl 
     191                     IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 
     192                        jl0 = jl 
     193                        CYCLE 
     194                     ENDIF 
     195                  END DO 
     196 
     197                  ! initialisation of tests 
     198                  itest(:)  = 0 
     199                   
     200                  i_fill = jpl + 1                                             !==================================== 
     201                  DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories 
     202                     ! iteration                                               !==================================== 
     203                     i_fill = i_fill - 1 
     204 
     205                     ! initialisation of ice variables for each try 
     206                     zh_i_ini(ji,jj,:) = 0._wp  
     207                     za_i_ini(ji,jj,:) = 0._wp 
     208                     itest(:) = 0 
     209 
     210                     ! *** case very thin ice: fill only category 1 
     211                     IF ( i_fill == 1 ) THEN 
     212                        zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj) 
     213                        za_i_ini(ji,jj,1) = zat_i_ini(ji,jj) 
     214 
     215                     ! *** case ice is thicker: fill categories >1 
     216                     ELSE 
     217 
     218                        ! Fill ice thicknesses in the (i_fill-1) cat by hmean  
     219                        DO jl = 1, i_fill-1 
     220                           zh_i_ini(ji,jj,jl) = hi_mean(jl) 
     221                        END DO 
    231222                
    232                            !--- jl0: most likely index where cc will be maximum 
    233                            DO jl = 1, jpl 
    234                               IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. & 
    235                                  & ( zht_i_ini(ji,jj) <= hi_max(jl)   ) ) THEN 
    236                                  jl0 = jl 
    237                               ENDIF 
    238                            END DO 
    239                            jl0 = MIN(jl0, i_fill) 
    240                 
    241                            !--- Concentrations 
    242                            za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 
    243                            DO jl = 1, i_fill - 1 
    244                               IF( jl .NE. jl0 )THEN 
    245                                  zsigma             = 0.5 * zht_i_ini(ji,jj) 
    246                                  zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / zsigma 
    247                                  za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 
    248                               ENDIF 
    249                            END DO 
    250                 
    251                            zA = 0. ! sum of the areas in the jpl categories  
    252                            DO jl = 1, i_fill - 1 
    253                               zA = zA + za_i_ini(ji,jj,jl) 
    254                            END DO 
    255                            za_i_ini(ji,jj,i_fill)   = zat_i_ini(ji,jj) - zA ! ice conc in the last category 
    256                            IF ( i_fill .LT. jpl ) za_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 
    257           
    258                            !--- Ice thickness in the last category 
    259                            zV = 0. ! sum of the volumes of the N-1 categories 
    260                            DO jl = 1, i_fill - 1 
    261                               zV = zV + za_i_ini(ji,jj,jl)*zh_i_ini(ji,jj,jl) 
    262                            END DO 
    263                            zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / za_i_ini(ji,jj,i_fill)  
    264                            IF ( i_fill .LT. jpl ) zh_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 
    265  
    266                            !--- volumes 
    267                            zv_i_ini(ji,jj,:) = za_i_ini(ji,jj,:) * zh_i_ini(ji,jj,:) 
    268                            IF ( i_fill .LT. jpl ) zv_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 
    269  
    270                         ENDIF ! i_fill 
    271  
    272                         !--------------------- 
    273                         ! Compatibility tests 
    274                         !--------------------- 
    275                         ! Test 1: area conservation 
    276                         zA_cons = SUM(za_i_ini(ji,jj,:)) ; zconv = ABS(zat_i_ini(ji,jj) - zA_cons ) 
    277                         IF ( zconv .LT. 1.0e-6 ) THEN 
    278                            ztest_1 = 1 
    279                         ELSE  
    280                           ztest_1 = 0 
    281                         ENDIF 
    282  
    283                         ! Test 2: volume conservation 
    284                         zV_cons = SUM(zv_i_ini(ji,jj,:)) 
    285                         zconv = ABS(zvt_i_ini(ji,jj) - zV_cons) 
    286  
    287                         IF( zconv .LT. 1.0e-6 ) THEN 
    288                            ztest_2 = 1 
    289                         ELSE 
    290                            ztest_2 = 0 
    291                         ENDIF 
    292  
    293                         ! Test 3: thickness of the last category is in-bounds ? 
    294                         IF ( zh_i_ini(ji,jj,i_fill) > hi_max(i_fill-1) ) THEN 
    295                            ztest_3 = 1 
    296                         ELSE 
    297                            ztest_3 = 0 
    298                         ENDIF 
    299  
    300                         ! Test 4: positivity of ice concentrations 
    301                         ztest_4 = 1 
    302                         DO jl = 1, jpl 
    303                            IF ( za_i_ini(ji,jj,jl) .LT. 0._wp ) THEN  
    304                               ztest_4 = 0 
     223                        !--- Concentrations 
     224                        za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 
     225                        DO jl = 1, i_fill - 1 
     226                           IF( jl /= jl0 )THEN 
     227                              zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) ) 
     228                              za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 
    305229                           ENDIF 
    306230                        END DO 
    307  
    308                      ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4 
    309   
    310                      ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 
    311  
    312                   END DO ! i_fill 
    313  
    314                   IF(lwp) THEN  
    315                      WRITE(numout,*) ' ztests : ', ztests 
    316                      IF( ztests .NE. 4 )THEN 
    317                         WRITE(numout,*) 
    318                         WRITE(numout,*) ' !!!! ALERT                  !!! ' 
    319                         WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    320                         WRITE(numout,*) 
    321                         WRITE(numout,*) ' *** ztests is not equal to 4 ' 
    322                         WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    323                         WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 
    324                         WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 
    325                      ENDIF ! ztests .NE. 4 
     231                
     232                        ! Concentration in the last (i_fill) category 
     233                        za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) ) 
     234 
     235                        ! Ice thickness in the last (i_fill) category 
     236                        zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) ) 
     237                        zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 )  
     238 
     239                        ! clem: correction if concentration of upper cat is greater than lower cat 
     240                        !       (it should be a gaussian around jl0 but sometimes it is not) 
     241                        IF ( jl0 /= jpl ) THEN 
     242                           DO jl = jpl, jl0+1, -1 
     243                              IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN 
     244                                 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl) 
     245                                 zh_i_ini(ji,jj,jl    ) = 0._wp 
     246                                 za_i_ini(ji,jj,jl    ) = 0._wp 
     247                                 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1)  & 
     248                                    &                     + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 ) 
     249                              END IF 
     250                           ENDDO 
     251                        ENDIF 
     252 
     253                     ENDIF ! case ice is thick or thin 
     254 
     255                     !--------------------- 
     256                     ! Compatibility tests 
     257                     !--------------------- 
     258                     ! Test 1: area conservation 
     259                     zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) ) 
     260                     IF ( zconv < epsi06 ) itest(1) = 1 
     261                      
     262                     ! Test 2: volume conservation 
     263                     zconv = ABS(       zat_i_ini(ji,jj)       * zht_i_ini(ji,jj)   & 
     264                        &        - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) ) 
     265                     IF ( zconv < epsi06 ) itest(2) = 1 
     266                      
     267                     ! Test 3: thickness of the last category is in-bounds ? 
     268                     IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 
     269                      
     270                     ! Test 4: positivity of ice concentrations 
     271                     itest(4) = 1 
     272                     DO jl = 1, i_fill 
     273                        IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0 
     274                     END DO 
     275                     !                                      !============================ 
     276                  END DO                                    ! end iteration on categories 
     277                  !                                         !============================ 
     278 
     279                  IF( lwp .AND. SUM(itest) /= 4 ) THEN  
     280                     WRITE(numout,*) 
     281                     WRITE(numout,*) ' !!!! ALERT itest is not equal to 4      !!! ' 
     282                     WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
     283                     WRITE(numout,*) 
     284                     WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:) 
     285                     WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 
     286                     WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 
    326287                  ENDIF 
    327        
    328                ENDIF !  zat_i_ini(ji,jj) > 0._wp .AND. zhm_i_ini(ji,jj) > 0._wp 
    329  
    330             ENDDO    
    331          ENDDO    
     288                
     289               ENDIF !  zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp 
     290             
     291            ENDDO 
     292         ENDDO 
    332293 
    333294         !--------------------------------------------------------------------- 
    … …  
    373334            smv_i = sm_i * v_i 
    374335         ENDIF 
    375           
     336             
    376337         ! Snow temperature and heat content 
    377338         DO jk = 1, nlay_s 
    … …  
    413374         tn_ice (:,:,:) = t_su (:,:,:) 
    414375 
    415       ELSE ! if ln_iceini=false 
     376      ELSE ! if ln_limini=false 
    416377         a_i  (:,:,:) = 0._wp 
    417378         v_i  (:,:,:) = 0._wp 
    … …  
    436397         END DO 
    437398 
    438       ENDIF ! ln_iceini 
     399      ENDIF ! ln_limini 
    439400       
    440401      at_i (:,:) = 0.0_wp 
    … …  
    486447      sxyage (:,:,:)  = 0._wp 
    487448 
    488  
    489       CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     449!!!clem 
     450!!      ! Output the initial state and forcings 
     451!!      CALL dia_wri_state( 'output.init', nit000 ) 
     452!!!       
     453 
     454      CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini ) 
    490455      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 ) 
    491456      CALL wrk_dealloc( jpi, jpj,      zswitch ) 
     457      Call wrk_dealloc( 4,             itest ) 
    492458 
    493459   END SUBROUTINE lim_istate 
    … …  
    518484      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read 
    519485      ! 
    520       NAMELIST/namiceini/ ln_iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  & 
     486      NAMELIST/namiceini/ ln_limini, ln_limini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  & 
    521487         &                rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, & 
    522488         &                rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             & 
    … …  
    544510         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    545511         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    546          WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini 
    547          WRITE(numout,*) '   ice initialization from a netcdf file      ln_iceini_file  = ', ln_iceini_file 
     512         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini     = ', ln_limini 
     513         WRITE(numout,*) '   ice initialization from a netcdf file      ln_limini_file  = ', ln_limini_file 
    548514         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst 
    549515         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n 
    … …  
    559525      ENDIF 
    560526 
    561       IF( ln_iceini_file ) THEN                      ! Ice initialization using input file 
     527      IF( ln_limini_file ) THEN                      ! Ice initialization using input file 
    562528         ! 
    563529         ! set si structure 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

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

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r5407 r7309  
    1818   !!   lim_itd_shiftice : 
    1919   !!---------------------------------------------------------------------- 
    20    USE dom_ice          ! LIM-3 domain 
    2120   USE par_oce          ! ocean parameters 
    2221   USE dom_oce          ! ocean domain 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

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

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

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

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r6416 r7309  
    4242   USE lib_mpp        ! MPP library 
    4343   USE wrk_nemo       ! work arrays 
    44    USE prtctl         ! Print control 
    4544   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4645 
    … …  
    4847   PRIVATE 
    4948 
    50    PUBLIC   lim_sbc_init   ! called by sbcice_lim 
     49   PUBLIC   lim_sbc_init   ! called by sbc_lim_init 
    5150   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim 
    5251   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
    … …  
    9493      !!              - fr_i    : ice fraction 
    9594      !!              - tn_ice  : sea-ice surface temperature 
    96       !!              - alb_ice : sea-ice albedo (only useful in coupled mode) 
     95      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode) 
    9796      !! 
    9897      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
    … …  
    109108      REAL(wp), POINTER, DIMENSION(:,:)   ::   zalb                 ! 2D workspace 
    110109      !!--------------------------------------------------------------------- 
    111       ! 
    112       ! make calls for heat fluxes before it is modified 
    113       ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    114       IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
    115       IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface 
    116       IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface 
    117       IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 
    118       IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice 
    119       IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )   
    120       IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   & 
    121          &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 
    122       IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )   
    123       IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )   
    124       IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce(:,:) )   ! emp over ocean (taking into account the snow blown away from the ice) 
    125       IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice(:,:) )   ! emp over ice   (taking into account the snow blown away from the ice) 
    126  
     110 
     111      ! --- case we bypass ice thermodynamics --- ! 
     112      IF( .NOT. ln_limthd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere 
     113         hfx_in   (:,:)   = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     114         hfx_out  (:,:)   = pfrld(:,:) *   qns_oce(:,:)                  + qemp_oce(:,:) 
     115         ftr_ice  (:,:,:) = 0._wp 
     116         emp_ice  (:,:)   = 0._wp 
     117         qemp_ice (:,:)   = 0._wp 
     118         qevap_ice(:,:,:) = 0._wp 
     119      ENDIF 
     120       
    127121      ! albedo output 
    128122      CALL wrk_alloc( jpi,jpj, zalb )     
    129123 
    130124      zalb(:,:) = 0._wp 
    131       WHERE     ( SUM( a_i_b, dim=3 ) <= epsi06 )  ;  zalb(:,:) = 0.066_wp 
    132       ELSEWHERE                                    ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 
     125      WHERE     ( at_i_b <= epsi06 )  ;  zalb(:,:) = 0.066_wp 
     126      ELSEWHERE                       ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
    133127      END WHERE 
    134128      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output 
    135129 
    136       zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ) )       
     130      zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b )       
    137131      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output 
    138132 
    … …  
    180174            ! mass flux from ice/ocean 
    181175            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    182                            + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     176                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj)  
    183177 
    184178            ! mass flux at the ocean/ice interface 
    185179            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model 
    186             emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)             
     180            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    187181         END DO 
    188182      END DO 
    … …  
    192186      !------------------------------------------! 
    193187      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
    194          &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 
     188         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 
    195189 
    196190      !-------------------------------------------------------------! 
    … …  
    221215 
    222216      ! conservation test 
    223       IF( ln_limdiahsb )   CALL lim_cons_final( 'limsbc' ) 
     217      IF( ln_limdiachk )  CALL lim_cons_final( 'limsbc' ) 
    224218 
    225219      ! control prints 
    226       IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
    227       ! 
    228       IF(ln_ctl) THEN 
    229          CALL prt_ctl( tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns , clinfo2=' qns     : ' ) 
    230          CALL prt_ctl( tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=sfx , clinfo2=' sfx     : ' ) 
    231          CALL prt_ctl( tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ' ) 
    232          CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    233       ENDIF 
    234       ! 
     220      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
     221      IF( ln_ctl )      CALL lim_prt3D( 'limsbc' ) 
     222 
    235223   END SUBROUTINE lim_sbc_flx 
    236224 
    … …  
    266254      INTEGER  ::   ji, jj   ! dummy loop indices 
    267255      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar 
    268       REAL(wp) ::   zat_v, zvtau_ice, zv_t          !   -      - 
     256      REAL(wp) ::   zat_v, zvtau_ice, zv_t, zrhoco  !   -      - 
    269257      !!--------------------------------------------------------------------- 
     258      zrhoco = rau0 * rn_cio 
    270259      ! 
    271260      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    … …  
    278267               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  ) 
    279268               !                                               ! update the ocean stress modulus 
    280                taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * rhoco * zmodt 
    281                tmod_io(ji,jj) = rhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
     269               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 
     270               tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
    282271            END DO 
    283272         END DO 
    284          CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. ) 
     273         CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 
    285274         ! 
    286275         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
    … …  
    303292         END DO 
    304293      END DO 
    305       CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition 
    306       ! 
    307       IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   & 
    308          &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask ) 
     294      CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition 
     295      ! 
    309296      !   
    310297   END SUBROUTINE lim_sbc_tau 
    … …  
    355342            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    356343 
    357 !!gm I really don't like this staff here...  Find a way to put that elsewhere or differently 
     344!!gm I really don't like this stuff here...  Find a way to put that elsewhere or differently 
    358345!!gm 
    359346            IF( .NOT.ln_linssh ) THEN 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r6416 r7309  
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain variables 
    24    USE ice            ! LIM: sea-ice variables 
     24   USE ice            ! sea-ice variables 
    2525   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2626   USE sbc_ice        ! Surface boundary condition: ice fields 
    27    USE dom_ice        ! LIM: sea-ice domain 
    28    USE thd_ice        ! LIM: thermodynamic sea-ice variables 
    29    USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
    30    USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
    31    USE limthd_sal     ! LIM: thermodynamics, ice salinity 
    32    USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution 
    33    USE limthd_lac     ! LIM: lateral accretion 
    34    USE limitd_th      ! LIM: remapping thickness distribution 
    35    USE limtab         ! LIM: 1D <==> 2D transformation 
    36    USE limvar         ! LIM: sea-ice variables 
    37    USE limcons        ! LIM: conservation tests 
    38    USE limctl         ! LIM: control print 
     27   USE thd_ice        ! thermodynamic sea-ice variables 
     28   USE limthd_dif     ! vertical diffusion 
     29   USE limthd_dh      ! ice-snow growth and melt 
     30   USE limthd_da      ! lateral melting 
     31   USE limthd_sal     ! ice salinity 
     32   USE limthd_ent     ! ice enthalpy redistribution 
     33   USE limthd_lac     ! lateral accretion 
     34   USE limitd_th      ! remapping thickness distribution 
     35   USE limtab         ! 1D <==> 2D transformation 
     36   USE limvar         ! 
     37   USE limcons        ! conservation tests 
     38   USE limctl         ! control print 
    3939   ! 
    4040   USE in_out_manager ! I/O manager 
    41    USE prtctl         ! Print control 
    4241   USE lbclnk         ! lateral boundary condition - MPP links 
    4342   USE lib_mpp        ! MPP library 
    … …  
    8887      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
    8988      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
     89      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io, zfric   ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 
     90      ! 
    9091      !!------------------------------------------------------------------- 
    9192 
    9293      IF( nn_timing == 1 )   CALL timing_start('limthd') 
    9394 
     95      CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric ) 
     96 
     97      IF( kt == nit000 .AND. lwp ) THEN 
     98         WRITE(numout,*)''  
     99         WRITE(numout,*)' lim_thd ' 
     100         WRITE(numout,*)' ~~~~~~~~' 
     101      ENDIF 
     102       
    94103      ! conservation test 
    95       IF( ln_limdiahsb )   CALL lim_cons_hsm( 0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
     104      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    96105 
    97106      CALL lim_var_glo2eqv 
    98       !------------------------------------------------------------------------! 
    99       ! 1) Initialization of some variables                                    ! 
    100       !------------------------------------------------------------------------! 
     107 
     108      !---------------------------------------------! 
     109      ! computation of friction velocity at T points 
     110      !---------------------------------------------! 
     111      IF( ln_limdyn ) THEN 
     112         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
     113         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
     114         DO jj = 2, jpjm1  
     115            DO ji = fs_2, fs_jpim1 
     116               zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
     117                  &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
     118                  &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 
     119            END DO 
     120         END DO 
     121      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
     122         DO jj = 2, jpjm1 
     123            DO ji = fs_2, fs_jpim1 
     124               zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & 
     125                  &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
     126                  &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
     127            END DO 
     128         END DO 
     129      ENDIF 
     130      CALL lbc_lnk( zfric, 'T',  1. ) 
     131      ! 
     132      !----------------------------------! 
     133      ! Initialization and units change 
     134      !----------------------------------! 
    101135      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice 
    102136 
    103       !-------------------- 
    104       ! 1.2) Heat content     
    105       !-------------------- 
    106137      ! Change the units of heat content; from J/m2 to J/m3 
    107138      DO jl = 1, jpl 
    … …  
    109140            DO jj = 1, jpj 
    110141               DO ji = 1, jpi 
    111                   !0 if no ice and 1 if yes 
    112142                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  ) 
    113143                  !Energy of melting q(S,T) [J.m-3] 
    … …  
    119149            DO jj = 1, jpj 
    120150               DO ji = 1, jpi 
    121                   !0 if no ice and 1 if yes 
    122151                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 )  ) 
    123152                  !Energy of melting q(S,T) [J.m-3] 
    … …  
    128157      END DO 
    129158 
    130       ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    131       !-----------------------------------------------------------------------------! 
     159      !--------------------------------------------------------------------! 
     160      ! Partial computation of forcing for the thermodynamic sea ice model 
     161      !--------------------------------------------------------------------! 
    132162      DO jj = 1, jpj 
    133163         DO ji = 1, jpi 
    … …  
    148178 
    149179            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 
    150             zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
     180            zfric_u      = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
    151181            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
    152182            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
    … …  
    166196            ENDIF 
    167197            ! 
    168             ! ----------------------------------------- 
    169             ! Net heat flux on top of ice-ocean [W.m-2] 
    170             ! ----------------------------------------- 
     198            ! Net heat flux on top of the ice-ocean [W.m-2] 
     199            ! --------------------------------------------- 
    171200            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
    172  
    173             ! ----------------------------------------------------------------------------- 
    174             ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
    175             ! ----------------------------------------------------------------------------- 
    176             !     First  step here              :  non solar + precip - qlead - qturb 
    177             !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
    178             !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     201         END DO 
     202      END DO 
     203       
     204      ! In case we bypass open-water ice formation 
     205      IF( .NOT. ln_limdO )  qlead(:,:) = 0._wp 
     206      ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 
     207      IF( .NOT. ln_limdH )  hfx_in(:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     208      IF( .NOT. ln_limdH )  fhtur (:,:) = 0._wp  ;  fhld  (:,:) = 0._wp 
     209 
     210      ! --------------------------------------------------------------------- 
     211      ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
     212      ! --------------------------------------------------------------------- 
     213      !     First  step here              :  non solar + precip - qlead - qturb 
     214      !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
     215      !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     216      DO jj = 1, jpj 
     217         DO ji = 1, jpi 
    179218            hfx_out(ji,jj) =   pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj)  &  ! Non solar heat flux received by the ocean                
    180219               &             - qlead(ji,jj) * r1_rdtice                         &  ! heat flux taken from the ocean where there is open water ice formation 
    … …  
    186225 
    187226      !------------------------------------------------------------------------------! 
    188       ! 3) Select icy points and fulfill arrays for the vectorial grid.             
     227      ! Thermodynamic computation (only on grid points covered by ice) 
    189228      !------------------------------------------------------------------------------! 
    190229 
    191230      DO jl = 1, jpl      !loop over ice categories 
    192231 
    193          IF( kt == nit000 .AND. lwp ) THEN 
    194             WRITE(numout,*) ' lim_thd : transfer to 1D vectors. Category no : ', jl  
    195             WRITE(numout,*) ' ~~~~~~~~' 
    196          ENDIF 
    197  
     232         ! select ice covered grid points 
    198233         nbpb = 0 
    199234         DO jj = 1, jpj 
    … …  
    208243         ! debug point to follow 
    209244         jiindex_1d = 0 
    210          IF( ln_icectl ) THEN 
     245         IF( ln_limctl ) THEN 
    211246            DO ji = mi0(iiceprt), mi1(iiceprt) 
    212247               DO jj = mj0(jiceprt), mj1(jiceprt) 
    … …  
    217252         ENDIF 
    218253 
    219          !------------------------------------------------------------------------------! 
    220          ! 4) Thermodynamic computation 
    221          !------------------------------------------------------------------------------! 
    222  
    223          IF( lk_mpp )   CALL mpp_ini_ice( nbpb , numout ) 
     254         IF( lk_mpp )         CALL mpp_ini_ice( nbpb , numout ) 
    224255 
    225256         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing. 
    226             ! 
    227             CALL lim_thd_1d2d( nbpb, jl, 1 )                ! --- Move to 1D arrays ---! 
    228             ! 
    229             CALL lim_thd_dif ( 1, nbpb )                    ! --- Ice/Snow Temperature profile --- ! 
    230             ! 
    231             CALL lim_thd_dh  ( 1, nbpb )                    ! --- Ice/Snow thickness ---! 
    232             ! 
    233             CALL lim_thd_ent ( 1, nbpb, q_i_1d(1:nbpb,:) )  ! --- Ice enthalpy remapping --- ! 
    234             ! 
    235             CALL lim_thd_sal ( 1, nbpb )                    ! --- Ice salinity ---            ! 
    236             ! 
    237             CALL lim_thd_temp( 1, nbpb )                    ! --- temperature update ---      ! 
    238             ! 
    239             !                                               ! --- lateral melting if monocat --- ! 
    240             IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
    241                CALL lim_thd_lam( 1, nbpb ) 
     257            !                                                                 
     258            s_i_new   (:) = 0._wp ; dh_s_tot (:) = 0._wp                     ! --- some init --- ! 
     259            dh_i_surf (:) = 0._wp ; dh_i_bott(:) = 0._wp 
     260            dh_snowice(:) = 0._wp ; dh_i_sub (:) = 0._wp 
     261 
     262                              CALL lim_thd_1d2d( nbpb, jl, 1 )               ! --- Move to 1D arrays --- ! 
     263            ! 
     264            IF( ln_limdH )    CALL lim_thd_dif( 1, nbpb )                    ! --- Ice/Snow Temperature profile --- ! 
     265            ! 
     266            IF( ln_limdH )    CALL lim_thd_dh( 1, nbpb )                     ! --- Ice/Snow thickness --- !     
     267            ! 
     268            IF( ln_limdH )    CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  ! --- Ice enthalpy remapping --- ! 
     269            ! 
     270                              CALL lim_thd_sal( 1, nbpb )                    ! --- Ice salinity --- !     
     271            ! 
     272                              CALL lim_thd_temp( 1, nbpb )                   ! --- temperature update --- ! 
     273            ! 
     274            IF( ln_limdH ) THEN 
     275               IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
     276                              CALL lim_thd_lam( 1, nbpb )                    ! --- extra lateral melting if monocat --- ! 
     277               END IF 
    242278            END IF 
    243279            ! 
    244             CALL lim_thd_1d2d( nbpb, jl, 2 )                ! --- Move to 2D arrays --- 
    245             ! 
    246             IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
     280                              CALL lim_thd_1d2d( nbpb, jl, 2 )               ! --- Move to 2D arrays --- ! 
     281            ! 
     282            IF( lk_mpp )      CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
    247283         ENDIF 
    248284         ! 
    249285      END DO !jl 
    250286 
    251       !------------------------------------------------------------------------------! 
    252       ! 5) Global variables, diagnostics 
    253       !------------------------------------------------------------------------------! 
    254  
    255       !------------------------ 
    256       ! Ice heat content               
    257       !------------------------ 
     287      IF( ln_limdA)           CALL lim_thd_da                                ! --- lateral melting --- ! 
     288 
    258289      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    259290      DO jl = 1, jpl 
    … …  
    261292            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 
    262293         END DO 
    263       END DO 
    264  
    265       !------------------------ 
    266       ! Snow heat content               
    267       !------------------------ 
    268       ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    269       DO jl = 1, jpl 
    270294         DO jk = 1, nlay_s 
    271295            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 
    … …  
    273297      END DO 
    274298  
    275       !---------------------------------- 
    276299      ! Change thickness to volume 
    277       !---------------------------------- 
    278300      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:) 
    279301      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
    … …  
    292314      CALL lim_var_zapsmall 
    293315 
    294       !-------------------------------------------- 
    295       ! Diagnostic thermodynamic growth rates 
    296       !-------------------------------------------- 
    297       IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print 
    298  
    299       IF(ln_ctl) THEN            ! Control print 
    300          CALL prt_ctl_info(' ') 
    301          CALL prt_ctl_info(' - Cell values : ') 
    302          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    303          CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_thd  : cell area :') 
    304          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :') 
    305          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :') 
    306          CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_thd  : vt_s      :') 
    307          DO jl = 1, jpl 
    308             CALL prt_ctl_info(' ') 
    309             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    310             CALL prt_ctl_info('   ~~~~~~~~~~') 
    311             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_thd  : a_i      : ') 
    312             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_thd  : ht_i     : ') 
    313             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_thd  : ht_s     : ') 
    314             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_thd  : v_i      : ') 
    315             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_thd  : v_s      : ') 
    316             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_thd  : e_s      : ') 
    317             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_thd  : t_su     : ') 
    318             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_thd  : t_snow   : ') 
    319             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_thd  : sm_i     : ') 
    320             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_thd  : smv_i    : ') 
    321             DO jk = 1, nlay_i 
    322                CALL prt_ctl_info(' ') 
    323                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    324                CALL prt_ctl_info('   ~~~~~~~') 
    325                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_thd  : t_i      : ') 
    326                CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_thd  : e_i      : ') 
    327             END DO 
    328          END DO 
    329       ENDIF 
    330       ! 
    331       ! 
    332       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    333  
    334       !------------------------------------------------------------------------------| 
    335       !  6) Transport of ice between thickness categories.                           | 
    336       !------------------------------------------------------------------------------| 
     316      ! control checks 
     317      IF( ln_limctl )    CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print 
     318      ! 
     319      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     320 
     321      !------------------------------------------------! 
     322      !  Transport ice between thickness categories 
     323      !------------------------------------------------! 
    337324      ! Given thermodynamic growth rates, transport ice between thickness categories. 
    338       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     325      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    339326 
    340327      IF( jpl > 1 )      CALL lim_itd_th_rem( 1, jpl, kt ) 
    341328 
    342       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    343  
    344       !------------------------------------------------------------------------------| 
    345       !  7) Add frazil ice growing in leads. 
    346       !------------------------------------------------------------------------------| 
    347       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    348  
    349       CALL lim_thd_lac 
     329      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     330 
     331      !------------------------------------------------! 
     332      !  Add frazil ice growing in leads 
     333      !------------------------------------------------! 
     334      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     335 
     336      IF( ln_limdO )     CALL lim_thd_lac 
    350337       
    351       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     338      ! conservation test 
     339      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    352340 
    353341      ! Control print 
    354       IF(ln_ctl) THEN 
    355          CALL lim_var_glo2eqv 
    356  
    357          CALL prt_ctl_info(' ') 
    358          CALL prt_ctl_info(' - Cell values : ') 
    359          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    360          CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_th  : cell area :') 
    361          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :') 
    362          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :') 
    363          CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :') 
    364          DO jl = 1, jpl 
    365             CALL prt_ctl_info(' ') 
    366             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    367             CALL prt_ctl_info('   ~~~~~~~~~~') 
    368             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ') 
    369             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ') 
    370             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ') 
    371             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ') 
    372             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ') 
    373             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ') 
    374             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ') 
    375             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ') 
    376             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ') 
    377             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ') 
    378             DO jk = 1, nlay_i 
    379                CALL prt_ctl_info(' ') 
    380                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    381                CALL prt_ctl_info('   ~~~~~~~') 
    382                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ') 
    383                CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ') 
    384             END DO 
    385          END DO 
    386       ENDIF 
    387       ! 
    388       IF( nn_timing == 1 )   CALL timing_stop('limthd') 
    389       ! 
     342      IF( ln_ctl )       CALL lim_prt3D( 'limthd' ) 
     343      ! 
     344      CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric ) 
     345      ! 
     346      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
     347 
    390348   END SUBROUTINE lim_thd  
    391349 
    … …  
    449407            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 
    450408            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel )  
    451              ! adjust thickness 
     409            ! adjust thickness 
    452410            ht_i_1d(ji) = zvi / a_i_1d(ji)             
    453411            ht_s_1d(ji) = zvs / a_i_1d(ji)             
    … …  
    613571      !!------------------------------------------------------------------- 
    614572      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    615       !! 
    616       NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                & 
    617          &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,  & 
    618          &                nn_monocat, ln_it_qnsice 
     573      NAMELIST/namicethd/ rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,ln_it_qnsice,nn_monocat,  & 
     574         &                ln_limdH, rn_betas,                                                          & 
     575         &                ln_limdA, rn_beta, rn_dmin,                                                  & 
     576         &                ln_limdO, rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, rn_himin 
    619577      !!------------------------------------------------------------------- 
    620       ! 
    621       IF(lwp) THEN 
    622          WRITE(numout,*) 
    623          WRITE(numout,*) 'lim_thd : Ice Thermodynamics' 
    624          WRITE(numout,*) '~~~~~~~' 
    625       ENDIF 
    626578      ! 
    627579      REWIND( numnam_ice_ref )              ! Namelist namicethd in reference namelist : Ice thermodynamics 
    … …  
    642594      IF(lwp) THEN                          ! control print 
    643595         WRITE(numout,*) 
    644          WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation ' 
     596         WRITE(numout,*) 'lim_thd_init : Ice Thermodynamics' 
     597         WRITE(numout,*) '~~~~~~~~~~~~~' 
     598         WRITE(numout,*)'   -- limthd_dif --' 
     599         WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i 
     600         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nn_conv_dif  = ', nn_conv_dif 
     601         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif 
     602         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon 
     603         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice 
     604         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat 
     605         WRITE(numout,*)'   -- limthd_dh --' 
     606         WRITE(numout,*)'      activate ice thick change from top/bot (T) or not (F)   ln_limdH     = ', ln_limdH 
     607         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas 
     608         WRITE(numout,*)'   -- limthd_da --' 
     609         WRITE(numout,*)'      activate lateral melting (T) or not (F)                 ln_limdA     = ', ln_limdA 
     610         WRITE(numout,*)'      Coef. beta for lateral melting param.                   rn_beta      = ', rn_beta 
     611         WRITE(numout,*)'      Minimum floe diameter for lateral melting param.        rn_dmin      = ', rn_dmin 
     612         WRITE(numout,*)'   -- limthd_lac --' 
     613         WRITE(numout,*)'      activate ice growth in open-water (T) or not (F)        ln_limdO     = ', ln_limdO 
    645614         WRITE(numout,*)'      ice thick. for lateral accretion                        rn_hnewice   = ', rn_hnewice 
    646615         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       ln_frazil    = ', ln_frazil 
    … …  
    648617         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  rn_vfrazb    = ', rn_vfrazb 
    649618         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          rn_Cfrazb    = ', rn_Cfrazb 
     619         WRITE(numout,*)'   -- limitd_th --' 
    650620         WRITE(numout,*)'      minimum ice thickness                                   rn_himin     = ', rn_himin  
    651          WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice ' 
    652          WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas 
    653          WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i 
    654          WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nn_conv_dif  = ', nn_conv_dif 
    655          WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif 
    656          WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon 
    657621         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
    658          WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat 
    659          WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice 
    660622      ENDIF 
    661623      ! 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r6470 r7309  
    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 
    … …  
    116115 
    117116      ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 
    118       SELECT CASE( nn_icesal )                       ! varying salinity or not 
     117      SELECT CASE( nn_icesal )                  ! varying salinity or not 
    119118         CASE( 1, 3 ) ;   zswitch_sal = 0       ! prescribed salinity profile 
    120119         CASE( 2 )    ;   zswitch_sal = 1       ! varying salinity profile 
    … …  
    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 
    … …  
    618613         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 
    619614 
    620          IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
     615         IF( ln_limctl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
    621616      END DO 
    622617       
    … …  
    634629         ht_s_1d(ji)    = ht_s_1d(ji) - dh_snowice(ji) 
    635630 
    636          ! Salinity of snow ice 
    637          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  
    652631         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 
    653632         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    654          zfmdt          = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp )    ! <0 
     633         zfmdt          = ( rhosn - rhoic ) * dh_snowice(ji)    ! <0 
    655634         zsstK          = sst_m(ii,ij) + rt0                                 
    656635         zEw            = rcp * ( zsstK - rt0 ) 
    … …  
    662641         ! Contribution to salt flux 
    663642         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice  
    664            
     643 
    665644         ! virtual salt flux to keep salinity constant 
    666645         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN 
    667             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 
    668                &                            - 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  
    669648         ENDIF 
    670649 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r5512 r7309  
    734734      END DO  ! End of the do while iterative procedure 
    735735 
    736       IF( ln_icectl .AND. lwp ) THEN 
     736      IF( ln_limctl .AND. lwp ) THEN 
    737737         WRITE(numout,*) ' zerritmax : ', zerritmax 
    738738         WRITE(numout,*) ' nconv     : ', nconv 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r6416 r7309  
    2121   USE sbc_ice        ! Surface boundary condition: ice fields 
    2222   USE thd_ice        ! LIM thermodynamics 
    23    USE dom_ice        ! LIM domain 
    2423   USE ice            ! LIM variables 
    2524   USE limtab         ! LIM 2D <==> 1D 
    … …  
    7170      !!               update ht_s_1d, ht_i_1d and tbif_1d(:,:)       
    7271      !!------------------------------------------------------------------------ 
    73       INTEGER ::   ji,jj,jk,jl      ! dummy loop indices 
    74       INTEGER ::   nbpac            ! local integers  
    75       INTEGER ::   ii, ij, iter     !   -       - 
    76       REAL(wp)  ::   ztmelts, zdv, zfrazb, zweight, zde                         ! local scalars 
     72      INTEGER  ::   ji,jj,jk,jl      ! dummy loop indices 
     73      INTEGER  ::   nbpac            ! local integers  
     74      INTEGER  ::   ii, ij, iter     !   -       - 
     75      REAL(wp) ::   ztmelts, zdv, zfrazb, zweight, zde                          ! local scalars 
    7776      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf                     !   -      - 
    7877      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    … …  
    154153 
    155154      ! Default new ice thickness 
    156       WHERE( qlead(:,:) < 0._wp ) ; hicol = rn_hnewice 
    157       ELSEWHERE                   ; hicol = 0._wp 
     155      WHERE( qlead(:,:) < 0._wp ) ; hicol(:,:) = rn_hnewice 
     156      ELSEWHERE                   ; hicol(:,:) = 0._wp 
    158157      END WHERE 
    159158 
    … …  
    170169         zgamafr = 0.03 
    171170 
    172          DO jj = 2, jpj 
    173             DO ji = 2, jpi 
    174                IF ( qlead(ji,jj) < 0._wp ) THEN 
     171         DO jj = 2, jpjm1 
     172            DO ji = 2, jpim1 
     173               IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast 
    175174                  !------------- 
    176175                  ! Wind stress 
    … …  
    195194                  !------------------- 
    196195                  ! C-grid ice velocity 
    197                   rswitch = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  ) 
    198                   zvgx    = rswitch * ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 
    199                   zvgy    = rswitch * ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 
     196                  zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 
     197                  zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 
    200198 
    201199                  !----------------------------------- 
    … …  
    203201                  !----------------------------------- 
    204202                  ! absolute relative velocity 
    205                   zvrel2 = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   & 
    206                      &         + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) 
     203                  rswitch      = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
     204                  zvrel2       = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   & 
     205                     &               + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch 
    207206                  zvrel(ji,jj) = SQRT( zvrel2 ) 
    208207 
    … …  
    219218                     zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0 * hicol(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2 
    220219 
    221                      hicol(ji,jj) = hicol(ji,jj) - zf/zfp 
     220                     hicol(ji,jj) = hicol(ji,jj) - zf / MAX( zfp, epsi20 ) 
    222221                     iter = iter + 1 
    223222                  END DO 
    … …  
    228227         END DO  
    229228         !  
    230          CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 
    231          CALL lbc_lnk( hicol(:,:), 'T', 1. ) 
     229         CALL lbc_lnk( zvrel, 'T', 1. ) 
     230         CALL lbc_lnk( hicol, 'T', 1. ) 
    232231 
    233232      ENDIF ! End of computation of frazil ice collection thickness 
    … …  
    240239      ! Select points for new ice formation 
    241240      !------------------------------------- 
    242       ! This occurs if open water energy budget is negative 
     241      ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice 
    243242      nbpac = 0 
    244243      npac(:) = 0 
    … …  
    246245      DO jj = 1, jpj 
    247246         DO ji = 1, jpi 
    248             IF ( qlead(ji,jj)  <  0._wp ) THEN 
     247            IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN 
    249248               nbpac = nbpac + 1 
    250249               npac( nbpac ) = (jj - 1) * jpi + ji 
    … …  
    255254      ! debug point to follow 
    256255      jiindex_1d = 0 
    257       IF( ln_icectl ) THEN 
     256      IF( ln_limctl ) THEN 
    258257         DO ji = mi0(iiceprt), mi1(iiceprt) 
    259258            DO jj = mj0(jiceprt), mj1(jiceprt) 
    … …  
    265264      ENDIF 
    266265    
    267       IF( ln_icectl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
     266      IF( ln_limctl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
    268267 
    269268      !------------------------------ 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r6470 r7309  
    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                                       | 
    … …  
    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_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r6490 r7309  
    1717   USE dom_oce        ! ocean domain 
    1818   USE sbc_oce        ! ocean surface boundary condition 
    19    USE dom_ice        ! ice domain 
    2019   USE ice            ! ice variables 
    21    USE limadv         ! ice advection 
    2220   USE limhdf         ! ice horizontal diffusion 
    2321   USE limvar         !  
     22   USE limadv_prather ! advection scheme (Prather) 
     23   USE limadv_umx     ! advection scheme (ultimate-macho) 
    2424   ! 
    2525   USE in_out_manager ! I/O manager 
    … …  
    5757      !! ** method  : variables included in the process are scalar,    
    5858      !!     other values are considered as second order.  
    59       !!     For advection, a second order Prather scheme is used.   
     59      !!     For advection, one can choose between 
     60      !!     a) an Ultimate-Macho scheme (whose order is defined by nn_limadv_ord) => nn_limadv=0 
     61      !!     b) and a second order Prather scheme => nn_limadv=-1 
    6062      !! 
    6163      !! ** action : 
    6264      !!--------------------------------------------------------------------- 
    63       INTEGER, INTENT(in) ::   kt           ! number of iteration 
     65      INTEGER, INTENT(in) ::   kt   ! number of iteration 
    6466      ! 
    65       INTEGER  ::   ji, jj, jk, jm , jl, jt      ! dummy loop indices 
     67      INTEGER  ::   ji, jj, jk, jm, jl, jt  ! dummy loop indices 
    6668      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    6769      REAL(wp) ::   zcfl , zusnit           !   -      - 
    68       CHARACTER(len=80) ::   cltmp 
     70      CHARACTER(len=80) :: cltmp 
    6971      ! 
    70       REAL(wp), POINTER, DIMENSION(:,:)      ::   zsm 
     72      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
     73      REAL(wp) ::    zdv, zda 
     74      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold, zsmvold  
     75      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax, zviold, zvsold 
     76      ! --- diffusion --- ! 
     77      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhdfptab 
     78      INTEGER , PARAMETER                    ::   ihdf_vars  = 6 ! Number of variables in which we apply horizontal diffusion 
     79                                                                 !  inside limtrp for each ice category , not counting the  
     80                                                                 !  variables corresponding to ice_layers  
     81      ! --- ultimate macho only --- ! 
     82      REAL(wp)                               ::   zdt 
     83      REAL(wp), POINTER, DIMENSION(:,:)      ::   zudy, zvdx, zcu_box, zcv_box 
     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 ) 
    88       CALL wrk_alloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
    89       CALL wrk_alloc( jpi,jpj,1,          z0opw ) 
    90       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,*) '~~~~~~~~~~~~' 
     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,*)'~~~~~~' 
    100101         ncfl = 0                ! nb of time step with CFL > 1/2 
    101102      ENDIF 
    102  
    103       zsm(:,:) = e1e2t(:,:) 
    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 
     103       
     104      CALL lim_var_agg( 1 ) ! integrated values + ato_i 
     105 
     106      !-------------------------------------! 
     107      !   Advection of sea ice properties   ! 
     108      !-------------------------------------! 
     109 
     110      ! conservation test 
     111      IF( ln_limdiachk )   CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     112       
     113      ! store old values for diag 
     114      zviold = v_i 
     115      zvsold = v_s 
     116      zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 ) 
     117      zeiold (:,:) = et_i 
     118      zesold (:,:) = et_s  
     119 
     120      !--- Thickness correction init. --- ! 
     121      zatold(:,:) = at_i 
     122      DO jl = 1, jpl 
     123         DO jj = 1, jpj 
     124            DO ji = 1, jpi 
     125               rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
     126               ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     127               ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     128            END DO 
     129         END DO 
     130      END DO 
     131      ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- ! 
     132      zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 
     133      DO jl = 1, jpl 
     134         DO jj = 2, jpjm1 
     135            DO ji = 2, jpim1 
     136               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) ) 
     137            END DO 
     138         END DO 
     139         CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 
     140      END DO 
     141          
     142      ! --- If ice drift field is too fast, use an appropriate time step for advection --- !         
     143      zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )    ! CFL test for stability 
     144      zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
     145      IF( lk_mpp )   CALL mpp_max( zcfl ) 
     146       
     147      IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
     148      ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
     149      ENDIF 
     150       
     151!!      IF( zcfl > 0.5_wp .AND. lwp ) THEN 
     152!!         ncfl = ncfl + 1 
     153!!         IF( ncfl > 0 ) THEN    
     154!!            WRITE(cltmp,'(i6.1)') ncfl 
     155!!            CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 
     156!!         ENDIF 
     157!!      ENDIF 
     158 
     159      SELECT CASE ( nn_limadv ) 
     160          
     161                       !=============================! 
     162      CASE ( 0 )       !==  Ultimate-MACHO scheme  ==!                    
     163                       !=============================! 
     164       
     165         CALL wrk_alloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) 
     166       
     167         IF( kt == nit000 .AND. lwp ) THEN 
     168            WRITE(numout,*)'' 
     169            WRITE(numout,*)'lim_adv_umx : Ultimate-MACHO advection scheme' 
     170            WRITE(numout,*)'~~~~~~~~~~~' 
     171         ENDIF 
     172         ! 
     173         zdt = rdt_ice / REAL(initad) 
     174          
     175         ! transport 
     176         zudy(:,:) = u_ice(:,:) * e2u(:,:) 
     177         zvdx(:,:) = v_ice(:,:) * e1v(:,:) 
     178          
     179         ! define velocity for advection: u*grad(H) 
     180         DO jj = 2, jpjm1 
     181            DO ji = fs_2, fs_jpim1 
     182               IF    ( u_ice(ji,jj) * u_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp 
     183               ELSEIF( u_ice(ji,jj)                  >  0._wp ) THEN   ;   zcu_box(ji,jj) = u_ice(ji-1,jj) 
     184               ELSE                                                    ;   zcu_box(ji,jj) = u_ice(ji  ,jj) 
     185               ENDIF 
     186                
     187               IF    ( v_ice(ji,jj) * v_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp 
     188               ELSEIF( v_ice(ji,jj)                  >  0._wp ) THEN   ;   zcv_box(ji,jj) = v_ice(ji,jj-1) 
     189               ELSE                                                    ;   zcv_box(ji,jj) = v_ice(ji,jj  ) 
     190               ENDIF 
     191            END DO 
     192         END DO 
     193          
     194         ! advection 
     195         DO jt = 1, initad 
     196            CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, ato_i(:,:) )       ! Open water area  
     197            DO jl = 1, jpl 
     198               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, a_i(:,:,jl) )      ! Ice area 
     199               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_i(:,:,jl) )      ! Ice  volume 
     200               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, smv_i(:,:,jl) )    ! Salt content 
     201               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, oa_i (:,:,jl) )    ! Age content 
     202               DO jk = 1, nlay_i 
     203                  CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_i(:,:,jk,jl) )   ! Ice  heat content 
    127204               END DO 
    128             END DO 
    129          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) ) 
    139                END DO 
    140             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 
     205               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_s(:,:,jl) )      ! Snow volume 
     206               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_s(:,:,1,jl) )    ! Snow heat content 
     207            END DO 
     208         END DO 
     209         ! 
     210         at_i(:,:) = a_i(:,:,1)      ! total ice fraction 
     211         DO jl = 2, jpl 
     212            at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     213         END DO 
     214         ! 
     215         CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) 
     216          
     217                       !=============================! 
     218      CASE ( -1 )      !==     Prather scheme      ==!                    
     219                       !=============================! 
     220 
     221         CALL wrk_alloc( jpi,jpj,            zarea ) 
     222         CALL wrk_alloc( jpi,jpj,1,          z0opw ) 
     223         CALL wrk_alloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
     224         CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 
     225          
     226         IF( kt == nit000 .AND. lwp ) THEN 
     227            WRITE(numout,*)'' 
     228            WRITE(numout,*)'lim_adv_xy : Prather advection scheme' 
     229            WRITE(numout,*)'~~~~~~~~~~~' 
    155230         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  
     231          
     232         zarea(:,:) = e1e2t(:,:) 
     233          
    167234         !------------------------- 
    168235         ! transported fields                                         
    … …  
    176243            z0oi (:,:,jl)   = oa_i (:,:,  jl) * e1e2t(:,:)  ! Age content 
    177244            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e1e2t(:,:)  ! Snow heat content 
    178            DO jk = 1, nlay_i 
     245            DO jk = 1, nlay_i 
    179246               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content 
    180247            END DO 
    … …  
    184251         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==! 
    185252            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(:,:)  ) 
     253               CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
     254                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     255               CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   & 
     256                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    190257               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)  ) 
     258                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     259                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
     260                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   & 
     261                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
     262                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     263                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
     264                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   & 
     265                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
     266                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     267                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
     268                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   & 
     269                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
     270                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---      
     271                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
     272                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   & 
     273                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
     274                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations --- 
     275                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
     276                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &  
     277                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
     278                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &    !--- snow heat contents --- 
     279                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
     280                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   & 
     281                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    215282                  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) ) 
     283                     CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     284                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     285                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     286                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     287                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     288                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    222289                  END DO 
    223290               END DO 
    … …  
    225292         ELSE 
    226293            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(:,:)  ) 
     294               CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
     295                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     296               CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   & 
     297                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    231298               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)  ) 
     299                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     300                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
     301                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   & 
     302                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
     303                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     304                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
     305                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   & 
     306                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
     307                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     308                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
     309                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   & 
     310                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
     311                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
     312                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
     313                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   & 
     314                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
     315                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     316                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
     317                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
     318                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
     319                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     320                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
     321                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   & 
     322                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    256323                  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) ) 
     324                     CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     325                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     326                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     327                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     328                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     329                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    263330                  END DO 
    264331               END DO 
    … …  
    286353            at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    287354         END DO 
    288  
    289          !------------------------------------------------------------------------------! 
    290          ! Diffusion of Ice fields                   
    291          !------------------------------------------------------------------------------! 
    292          !------------------------------------ 
    293          !  Diffusion of other ice variables 
    294          !------------------------------------ 
     355          
     356         CALL wrk_dealloc( jpi,jpj,            zarea ) 
     357         CALL wrk_dealloc( jpi,jpj,1,          z0opw ) 
     358         CALL wrk_dealloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 
     359         CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 
     360 
     361      END SELECT 
     362       
     363      !------------------------------! 
     364      ! Diffusion of Ice fields                   
     365      !------------------------------! 
     366      IF( nn_ahi0 /= -1 .AND. nn_limdyn == 2 ) THEN 
     367         ! 
     368         ! --- Prepare diffusion for variables with categories --- ! 
     369         !     mask eddy diffusivity coefficient at ocean U- and V-points 
    295370         jm=1 
    296371         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 
    306372            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    307                DO ji = 1 , fs_jpim1   ! vector opt. 
     373               DO ji = 1 , fs_jpim1 
    308374                  pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,  jl ) ) ) )   & 
    309375                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,  jl ) ) ) ) * ahiu(ji,jj) 
    … …  
    313379            END DO 
    314380 
    315             zhdfptab(:,:,jm)= a_i  (:,:,  jl); jm = jm + 1     
     381            zhdfptab(:,:,jm)= a_i  (:,:,  jl); jm = jm + 1 
    316382            zhdfptab(:,:,jm)= v_i  (:,:,  jl); jm = jm + 1 
    317             zhdfptab(:,:,jm)= v_s  (:,:,  jl); jm = jm + 1  
     383            zhdfptab(:,:,jm)= v_s  (:,:,  jl); jm = jm + 1 
    318384            zhdfptab(:,:,jm)= smv_i(:,:,  jl); jm = jm + 1 
    319385            zhdfptab(:,:,jm)= oa_i (:,:,  jl); jm = jm + 1 
    320386            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          !---------------------------------------------------------------------------------------- 
     387            ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 
     388            !   zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1   
     389            !   zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1  
    327390            DO jk = 1, nlay_i 
    328391              zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 
    329392            END DO 
    330393         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           
     394 
     395         ! --- Prepare diffusion for open water area --- ! 
     396         !     mask eddy diffusivity coefficient at ocean U- and V-points 
    345397         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    346             DO ji = 1 , fs_jpim1   ! vector opt. 
     398            DO ji = 1 , fs_jpim1 
    347399               pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   & 
    348400                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    … …  
    353405         ! 
    354406         zhdfptab(:,:,jm)= ato_i  (:,:); 
    355          CALL lim_hdf( zhdfptab, ihdf_vars, jpl, nlay_i)  
    356  
     407 
     408         ! --- Apply diffusion --- ! 
     409         CALL lim_hdf( zhdfptab, ihdf_vars ) 
     410 
     411         ! --- Recover properties --- ! 
    357412         jm=1 
    358413         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          !----------------------------------------------------------- 
     414            a_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     415            v_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     416            v_s  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     417            smv_i(:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     418            oa_i (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     419            e_s  (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 
     420            ! Sample of adding more variables to apply lim_hdf 
     421            !   variable_1  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1  
     422            !   variable_2  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1 
    369423            DO jk = 1, nlay_i 
    370                e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1  
    371             END DO 
    372          END DO 
    373  
     424               e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 
     425            END DO 
     426         END DO 
    374427         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 ! 
     428               
     429      ENDIF 
     430 
     431      ! --- diags --- 
     432      DO jj = 1, jpj 
     433         DO ji = 1, jpi 
     434            diag_trp_ei (ji,jj) = ( SUM( e_i  (ji,jj,1:nlay_i,:) ) -  zeiold(ji,jj) ) * r1_rdtice 
     435            diag_trp_es (ji,jj) = ( SUM( e_s  (ji,jj,1:nlay_s,:) ) -  zesold(ji,jj) ) * r1_rdtice 
     436            diag_trp_smv(ji,jj) = ( SUM( smv_i(ji,jj,:)          ) - zsmvold(ji,jj) ) * r1_rdtice 
     437            diag_trp_vi (ji,jj) =   SUM(   v_i(ji,jj,:)            -  zviold(ji,jj,:) ) * r1_rdtice 
     438            diag_trp_vs (ji,jj) =   SUM(   v_s(ji,jj,:)            -  zvsold(ji,jj,:) ) * r1_rdtice 
     439         END DO 
     440      END DO 
     441       
     442      IF( nn_limdyn == 2) THEN 
     443 
     444         ! zap small areas 
     445         CALL lim_var_zapsmall 
     446            
     447         !--- Thickness correction in case too high --- ! 
    380448         DO jl = 1, jpl 
    381449            DO jj = 1, jpj 
    382450               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  
     451                   
    422452                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
    423  
     453                      
    424454                     rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
    425455                     ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    426456                     ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    427457                      
    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  
    434458                     zdv  = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl)   
    435  
     459                      
    436460                     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. & 
    437461                        & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN 
    438  
     462                         
    439463                        rswitch        = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) ) 
    440464                        a_i(ji,jj,jl)  = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 ) 
    441  
     465                         
    442466                        ! small correction due to *rswitch for a_i 
    443467                        v_i  (ji,jj,jl)        = rswitch * v_i  (ji,jj,jl) 
    … …  
    446470                        e_s(ji,jj,1,jl)        = rswitch * e_s(ji,jj,1,jl) 
    447471                        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  
     472                                                 
    456473                     ENDIF 
    457  
     474                      
    458475                  ENDIF 
    459  
     476                 
    460477               END DO 
    461478            END DO 
    … …  
    463480         ! ------------------------------------------------- 
    464481          
    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 
     482         ! Force the upper limit of ht_i to always be < hi_max (99 m). 
     483         DO jj = 1, jpj 
     484            DO ji = 1, jpi 
     485               rswitch         = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) ) 
     486               ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) ) 
     487               a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch 
     488            END DO 
     489         END DO 
     490 
     491      ENDIF 
     492          
     493      !------------------------------------------------------------ 
     494      ! Impose a_i < amax if no ridging/rafting or in mono-category 
     495      !------------------------------------------------------------ 
     496      ! 
     497      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     498      IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 
    481499         DO jl = 1, jpl 
    482500            DO jj = 1, jpj 
    483501               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) 
     502                  rswitch       = MAX( 0._wp, SIGN( 1._wp, at_i(ji,jj) - epsi20 ) ) 
     503                  zda           = rswitch * MIN( rn_amax_2d(ji,jj) - at_i(ji,jj), 0._wp )  & 
     504                     &                    * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi20 ) 
     505                  a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda 
    487506               END DO 
    488507            END DO 
    489508         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  
    502509      ENDIF 
    503  
     510       
     511      ! --- agglomerate variables ----------------- 
     512      vt_i(:,:) = SUM( v_i(:,:,:), dim=3 ) 
     513      vt_s(:,:) = SUM( v_s(:,:,:), dim=3 ) 
     514      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     515       
     516      ! --- open water = 1 if at_i=0 -------------------------------- 
     517      WHERE( at_i == 0._wp ) ato_i = 1._wp  
     518       
     519      ! conservation test 
     520      IF( ln_limdiachk )   CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     521         
    504522      ! ------------------------------------------------- 
    505523      ! control prints 
    506524      ! ------------------------------------------------- 
    507       IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 
     525      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 
    508526      ! 
    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) 
     527      CALL wrk_dealloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold ) 
     528      CALL wrk_dealloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold ) 
     529      CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab) 
    515530      ! 
    516531      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
    517  
     532      ! 
    518533   END SUBROUTINE lim_trp 
    519534 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r6403 r7309  
    1515   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1616   USE sbc_ice         ! Surface boundary condition: ice fields 
    17    USE dom_ice 
    1817   USE dom_oce 
    1918   USE phycst          ! physical constants 
    … …  
    2221   USE limitd_th 
    2322   USE limvar 
    24    USE prtctl          ! Print control 
    2523   USE wrk_nemo        ! work arrays 
    2624   USE timing          ! Timing 
    2725   USE limcons         ! conservation tests 
     26   USE limctl          ! control prints 
    2827   USE lib_mpp         ! MPP library 
    2928   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    5958      IF( nn_timing == 1 )  CALL timing_start('limupdate1') 
    6059 
    61       IF( ln_limdyn ) THEN  
    62  
    6360      IF( kt == nit000 .AND. lwp ) THEN 
    64          WRITE(numout,*) ' lim_update1 '  
    65          WRITE(numout,*) ' ~~~~~~~~~~~ ' 
     61         WRITE(numout,*)''  
     62         WRITE(numout,*)' lim_update1 '  
     63         WRITE(numout,*)' ~~~~~~~~~~~ ' 
    6664      ENDIF 
    6765 
    6866      ! conservation test 
    69       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     67      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    7068 
    7169      !---------------------------------------------------- 
    … …  
    137135 
    138136      ! conservation test 
    139       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     137      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    140138 
    141       ! ------------------------------------------------- 
    142139      ! control prints 
    143       ! ------------------------------------------------- 
    144       IF(ln_ctl) THEN   ! Control print 
    145          CALL prt_ctl_info(' ') 
    146          CALL prt_ctl_info(' - Cell values : ') 
    147          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    148          CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update1  : cell area   :') 
    149          CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :') 
    150          CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :') 
    151          CALL prt_ctl(tab2d_1=vt_s       , clinfo1=' lim_update1  : vt_s        :') 
    152          CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update1  : strength    :') 
    153          CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    154          CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
     140      IF( ln_ctl )       CALL lim_prt3D( 'limupdate1' ) 
     141    
     142      IF( nn_timing == 1 )  CALL timing_stop('limupdate1') 
    155143 
    156          DO jl = 1, jpl 
    157             CALL prt_ctl_info(' ') 
    158             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    159             CALL prt_ctl_info('   ~~~~~~~~~~') 
    160             CALL prt_ctl(tab2d_1=ht_i       (:,:,jl)        , clinfo1= ' lim_update1  : ht_i        : ') 
    161             CALL prt_ctl(tab2d_1=ht_s       (:,:,jl)        , clinfo1= ' lim_update1  : ht_s        : ') 
    162             CALL prt_ctl(tab2d_1=t_su       (:,:,jl)        , clinfo1= ' lim_update1  : t_su        : ') 
    163             CALL prt_ctl(tab2d_1=t_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : t_snow      : ') 
    164             CALL prt_ctl(tab2d_1=sm_i       (:,:,jl)        , clinfo1= ' lim_update1  : sm_i        : ') 
    165             CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update1  : o_i         : ') 
    166             CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ') 
    167             CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ') 
    168             CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ') 
    169             CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ') 
    170             CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ') 
    171             CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ') 
    172             CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1        : ') 
    173             CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1_b      : ') 
    174             CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2        : ') 
    175             CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2_b      : ') 
    176             CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ') 
    177             CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ') 
    178             CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ') 
    179             CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ') 
    180             CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ') 
    181             CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ') 
     144   END SUBROUTINE lim_update1 
    182145 
    183             DO jk = 1, nlay_i 
    184                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    185                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_update1  : t_i       : ') 
    186             END DO 
    187          END DO 
    188  
    189          CALL prt_ctl_info(' ') 
    190          CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    191          CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    192          CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update1 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    193  
    194          CALL prt_ctl_info(' ') 
    195          CALL prt_ctl_info(' - Stresses : ') 
    196          CALL prt_ctl_info('   ~~~~~~~~~~ ') 
    197          CALL prt_ctl(tab2d_1=utau       , clinfo1= ' lim_update1 : utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ') 
    198          CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' lim_update1 : utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ') 
    199          CALL prt_ctl(tab2d_1=u_oce      , clinfo1= ' lim_update1 : u_oce     : ', tab2d_2=v_oce      , clinfo2= ' v_oce     : ') 
    200       ENDIF 
    201     
    202       ENDIF ! ln_limdyn 
    203  
    204       IF( nn_timing == 1 )  CALL timing_stop('limupdate1') 
    205    END SUBROUTINE lim_update1 
    206146#else 
    207147   !!---------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r6403 r7309  
    1515   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1616   USE sbc_ice         ! Surface boundary condition: ice fields 
    17    USE dom_ice 
    1817   USE dom_oce 
    1918   USE phycst          ! physical constants 
    … …  
    2221   USE limitd_th 
    2322   USE limvar 
    24    USE prtctl          ! Print control 
    2523   USE lbclnk          ! lateral boundary condition - MPP exchanges 
    2624   USE wrk_nemo        ! work arrays 
    … …  
    6260 
    6361      IF( kt == nit000 .AND. lwp ) THEN 
    64          WRITE(numout,*) ' lim_update2 ' 
    65          WRITE(numout,*) ' ~~~~~~~~~~~ ' 
     62         WRITE(numout,*)'' 
     63         WRITE(numout,*)' lim_update2 ' 
     64         WRITE(numout,*)' ~~~~~~~~~~~ ' 
    6665      ENDIF 
    6766 
    6867      ! conservation test 
    69       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     68      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    7069 
    7170      !---------------------------------------------------------------------- 
    … …  
    176175 
    177176      ! conservation test 
    178       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     177      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    179178 
    180       ! necessary calls (at least for coupling) 
    181       CALL lim_var_glo2eqv 
    182       CALL lim_var_agg(2) 
    183  
    184       ! ------------------------------------------------- 
    185179      ! control prints 
    186       ! ------------------------------------------------- 
    187       IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )   ! control print 
    188  
    189       IF(ln_ctl) THEN   ! Control print 
    190          CALL prt_ctl_info(' ') 
    191          CALL prt_ctl_info(' - Cell values : ') 
    192          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    193          CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update2  : cell area   :') 
    194          CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update2  : at_i        :') 
    195          CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update2  : vt_i        :') 
    196          CALL prt_ctl(tab2d_1=vt_s       , clinfo1=' lim_update2  : vt_s        :') 
    197          CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update2  : strength    :') 
    198          CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update2  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    199          CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update2  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    200  
    201          DO jl = 1, jpl 
    202             CALL prt_ctl_info(' ') 
    203             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    204             CALL prt_ctl_info('   ~~~~~~~~~~') 
    205             CALL prt_ctl(tab2d_1=ht_i       (:,:,jl)        , clinfo1= ' lim_update2  : ht_i        : ') 
    206             CALL prt_ctl(tab2d_1=ht_s       (:,:,jl)        , clinfo1= ' lim_update2  : ht_s        : ') 
    207             CALL prt_ctl(tab2d_1=t_su       (:,:,jl)        , clinfo1= ' lim_update2  : t_su        : ') 
    208             CALL prt_ctl(tab2d_1=t_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : t_snow      : ') 
    209             CALL prt_ctl(tab2d_1=sm_i       (:,:,jl)        , clinfo1= ' lim_update2  : sm_i        : ') 
    210             CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update2  : o_i         : ') 
    211             CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ') 
    212             CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ') 
    213             CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ') 
    214             CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ') 
    215             CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ') 
    216             CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ') 
    217             CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_i1        : ') 
    218             CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_i1_b      : ') 
    219             CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update2  : e_i2        : ') 
    220             CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update2  : e_i2_b      : ') 
    221             CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ') 
    222             CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ') 
    223             CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ') 
    224             CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ') 
    225             CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ') 
    226             CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ') 
    227  
    228             DO jk = 1, nlay_i 
    229                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    230                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_update2  : t_i       : ') 
    231             END DO 
    232          END DO 
    233  
    234          CALL prt_ctl_info(' ') 
    235          CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    236          CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    237          CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update2 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    238  
    239          CALL prt_ctl_info(' ') 
    240          CALL prt_ctl_info(' - Stresses : ') 
    241          CALL prt_ctl_info('   ~~~~~~~~~~ ') 
    242          CALL prt_ctl(tab2d_1=utau       , clinfo1= ' lim_update2 : utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ') 
    243          CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' lim_update2 : utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ') 
    244          CALL prt_ctl(tab2d_1=u_oce      , clinfo1= ' lim_update2 : u_oce     : ', tab2d_2=v_oce      , clinfo2= ' v_oce     : ') 
    245       ENDIF 
     180      IF( ln_limctl )    CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) 
     181      IF( ln_ctl )       CALL lim_prt3D( 'limupdate2' ) 
    246182    
    247183      IF( nn_timing == 1 )  CALL timing_stop('limupdate2') 
    248184 
    249185   END SUBROUTINE lim_update2 
     186 
    250187#else 
    251188   !!---------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r6470 r7309  
    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 
    … …  
    4141   USE ice            ! ice variables 
    4242   USE thd_ice        ! ice variables (thermodynamics) 
    43    USE dom_ice        ! ice domain 
    4443   USE in_out_manager ! I/O manager 
    4544   USE lib_mpp        ! MPP library 
    … …  
    5453   PUBLIC   lim_var_eqv2glo       
    5554   PUBLIC   lim_var_salprof       
    56    PUBLIC   lim_var_icetm         
    5755   PUBLIC   lim_var_bv            
    5856   PUBLIC   lim_var_salprof1d     
    … …  
    8684      !!------------------------------------------------------------------ 
    8785 
    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 
     86      ! integrated values 
     87      vt_i (:,:) = SUM( v_i, dim=3 ) 
     88      vt_s (:,:) = SUM( v_s, dim=3 ) 
     89      at_i (:,:) = SUM( a_i, dim=3 ) 
     90      et_s(:,:)  = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 
     91      et_i(:,:)  = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 
     92 
     93      ! open water fraction 
     94      DO jj = 1, jpj 
     95         DO ji = 1, jpi 
     96            ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp )    
     97         END DO 
     98      END DO 
     99 
     100      IF( kn > 1 ) THEN 
     101 
     102         ! mean ice/snow thickness 
    97103         DO jj = 1, jpj 
    98104            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 
     105               rswitch      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
     106               htm_i(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 
     107               htm_s(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 
     108            ENDDO 
     109         ENDDO 
     110 
     111         ! mean temperature (K), salinity and age 
    119112         smt_i(:,:) = 0._wp 
    120          et_i (:,:) = 0._wp 
    121          ! 
     113         tm_i(:,:)  = 0._wp 
     114         tm_su(:,:) = 0._wp 
     115         om_i (:,:) = 0._wp 
    122116         DO jl = 1, jpl 
     117             
    123118            DO jj = 1, jpj 
    124119               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 
     120                  rswitch      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
     121                  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 ) 
     122                  om_i (ji,jj) = om_i (ji,jj) + rswitch *   oa_i(ji,jj,jl)                         / MAX( at_i(ji,jj) , epsi10 ) 
     123               END DO 
     124            END DO 
     125             
    135126            DO jk = 1, nlay_i 
    136                et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl)       ! ice heat content 
    137             END DO 
    138          END DO 
     127               DO jj = 1, jpj 
     128                  DO ji = 1, jpi 
     129                     rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
     130                     tm_i(ji,jj)  = tm_i(ji,jj)  + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  & 
     131                        &            / MAX( vt_i(ji,jj) , epsi10 ) 
     132                     smt_i(ji,jj) = smt_i(ji,jj) + r1_nlay_i * rswitch * s_i(ji,jj,jk,jl) * v_i(ji,jj,jl)  & 
     133                        &            / MAX( vt_i(ji,jj) , epsi10 ) 
     134                  END DO 
     135               END DO 
     136            END DO 
     137         END DO 
     138         tm_i  = tm_i  + rt0 
     139         tm_su = tm_su + rt0 
    139140         ! 
    140141      ENDIF 
    … …  
    243244      END DO 
    244245 
    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 
     246      ! integrated values 
     247      vt_i (:,:) = SUM( v_i, dim=3 ) 
     248      vt_s (:,:) = SUM( v_s, dim=3 ) 
     249      at_i (:,:) = SUM( a_i, dim=3 ) 
     250 
    266251      ! 
    267252   END SUBROUTINE lim_var_glo2eqv 
    … …  
    398383 
    399384 
    400    SUBROUTINE lim_var_icetm 
    401       !!------------------------------------------------------------------ 
    402       !!                ***  ROUTINE lim_var_icetm *** 
    403       !! 
    404       !! ** Purpose :   computes mean sea ice temperature 
     385   SUBROUTINE lim_var_bv 
     386      !!------------------------------------------------------------------ 
     387      !!                ***  ROUTINE lim_var_bv *** 
     388      !! 
     389      !! ** Purpose :   computes mean brine volume (%) in sea ice 
     390      !! 
     391      !! ** Method  : e = - 0.054 * S (ppt) / T (C) 
     392      !! 
     393      !! References : Vancoppenolle et al., JGR, 2007 
    405394      !!------------------------------------------------------------------ 
    406395      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    407396      !!------------------------------------------------------------------ 
    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 
     397      ! 
     398      bvm_i(:,:)   = 0._wp 
     399      bv_i (:,:,:) = 0._wp 
    416400      DO jl = 1, jpl 
    417401         DO jk = 1, nlay_i 
    418402            DO jj = 1, jpj 
    419403               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 
     404                  rswitch        = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) )  ) 
     405                  bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rswitch * tmut * s_i(ji,jj,jk,jl) * r1_nlay_i  & 
     406                     &                            / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) 
     407               END DO 
     408            END DO 
     409         END DO 
     410          
     411         DO jj = 1, jpj 
     412            DO ji = 1, jpi 
     413               rswitch      = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
     414               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 ) 
    462415            END DO 
    463416         END DO 
    … …  
    683636      INTEGER  :: ji, jk, jl             ! dummy loop indices 
    684637      INTEGER  :: ijpij, i_fill, jl0   
    685       REAL(wp) :: zarg, zV, zconv, zdh 
     638      REAL(wp) :: zarg, zV, zconv, zdh, zdv 
    686639      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zai    ! input ice/snow variables 
    687640      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zht_i, zht_s, za_i ! output ice/snow variables 
    … …  
    704657         IF( zhti(ji) > 0._wp ) THEN 
    705658 
    706          ! initialisation of tests 
    707          itest(:)  = 0 
     659            ! find which category (jl0) the input ice thickness falls into 
     660            jl0 = jpl 
     661            DO jl = 1, jpl 
     662               IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 
     663                  jl0 = jl 
     664                  CYCLE 
     665               ENDIF 
     666            END DO 
     667 
     668            ! initialisation of tests 
     669            itest(:)  = 0 
    708670          
    709          i_fill = jpl + 1                                             !==================================== 
    710          DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories   
    711             ! iteration                                               !==================================== 
    712             i_fill = i_fill - 1 
     671            i_fill = jpl + 1                                             !==================================== 
     672            DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories 
     673               ! iteration                                               !==================================== 
     674               i_fill = i_fill - 1 
     675                
     676               ! initialisation of ice variables for each try 
     677               zht_i(ji,1:jpl) = 0._wp 
     678               za_i (ji,1:jpl) = 0._wp 
     679               itest(:)        = 0            
     680                
     681               ! *** case very thin ice: fill only category 1 
     682               IF ( i_fill == 1 ) THEN 
     683                  zht_i(ji,1) = zhti(ji) 
     684                  za_i (ji,1) = zai (ji) 
     685                   
     686               ! *** case ice is thicker: fill categories >1 
     687               ELSE 
     688 
     689                  ! Fill ice thicknesses in the (i_fill-1) cat by hmean  
     690                  DO jl = 1, i_fill - 1 
     691                     zht_i(ji,jl) = hi_mean(jl) 
     692                  END DO 
     693                   
     694                  ! Concentrations in the (i_fill-1) categories  
     695                  za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl)) 
     696                  DO jl = 1, i_fill - 1 
     697                     IF ( jl /= jl0 ) THEN 
     698                        zarg        = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 
     699                        za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2) 
     700                     ENDIF 
     701                  END DO 
     702                   
     703                  ! Concentration in the last (i_fill) category 
     704                  za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) ) 
     705                   
     706                  ! Ice thickness in the last (i_fill) category 
     707                  zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) ) 
     708                  zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 )  
     709                   
     710                  ! clem: correction if concentration of upper cat is greater than lower cat 
     711                  !       (it should be a gaussian around jl0 but sometimes it is not) 
     712                  IF ( jl0 /= jpl ) THEN 
     713                     DO jl = jpl, jl0+1, -1 
     714                        IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN 
     715                           zdv = zht_i(ji,jl) * za_i(ji,jl) 
     716                           zht_i(ji,jl    ) = 0._wp 
     717                           za_i (ji,jl    ) = 0._wp 
     718                           za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 ) 
     719                        END IF 
     720                     ENDDO 
     721                  ENDIF 
     722                
     723               ENDIF ! case ice is thick or thin 
     724                
     725               !--------------------- 
     726               ! Compatibility tests 
     727               !---------------------  
     728               ! Test 1: area conservation 
     729               zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) ) 
     730               IF ( zconv < epsi06 ) itest(1) = 1 
    713731             
    714             ! initialisation of ice variables for each try 
    715             zht_i(ji,1:jpl) = 0._wp 
    716             za_i (ji,1:jpl) = 0._wp 
    717              
    718             ! *** case very thin ice: fill only category 1 
    719             IF ( i_fill == 1 ) THEN 
    720                zht_i(ji,1) = zhti(ji) 
    721                za_i (ji,1) = zai (ji) 
    722  
    723             ! *** case ice is thicker: fill categories >1 
    724             ELSE 
    725  
    726                ! Fill ice thicknesses except the last one (i_fill) by hmean  
    727                DO jl = 1, i_fill - 1 
    728                   zht_i(ji,jl) = hi_mean(jl) 
    729                END DO 
     732               ! Test 2: volume conservation 
     733               zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) ) 
     734               IF ( zconv < epsi06 ) itest(2) = 1 
    730735                
    731                ! find which category (jl0) the input ice thickness falls into 
    732                jl0 = i_fill 
     736               ! Test 3: thickness of the last category is in-bounds ? 
     737               IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 
     738                
     739               ! Test 4: positivity of ice concentrations 
     740               itest(4) = 1 
    733741               DO jl = 1, i_fill 
    734                   IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 
    735                      jl0 = jl 
    736            CYCLE 
    737                   ENDIF 
    738                END DO 
    739                 
    740                ! Concentrations in the (i_fill-1) categories  
    741                za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl)) 
    742                DO jl = 1, i_fill - 1 
    743                   IF ( jl == jl0 ) CYCLE 
    744                   zarg        = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 
    745                   za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2) 
    746                END DO 
    747                 
    748                ! Concentration in the last (i_fill) category 
    749                za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) ) 
    750                 
    751                ! Ice thickness in the last (i_fill) category 
    752                zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) ) 
    753                zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / za_i(ji,i_fill)  
    754                 
    755             ENDIF ! case ice is thick or thin 
    756              
    757             !--------------------- 
    758             ! Compatibility tests 
    759             !---------------------  
    760             ! Test 1: area conservation 
    761             zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) ) 
    762             IF ( zconv < epsi06 ) itest(1) = 1 
    763              
    764             ! Test 2: volume conservation 
    765             zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) ) 
    766             IF ( zconv < epsi06 ) itest(2) = 1 
    767              
    768             ! Test 3: thickness of the last category is in-bounds ? 
    769             IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 
    770              
    771             ! Test 4: positivity of ice concentrations 
    772             itest(4) = 1 
    773             DO jl = 1, i_fill 
    774                IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 
    775             END DO             
    776                                                            !============================ 
    777          END DO                                            ! end iteration on categories 
    778                                                            !============================ 
     742                  IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 
     743               END DO 
     744               !                                         !============================ 
     745            END DO                                       ! end iteration on categories 
     746               !                                         !============================ 
    779747         ENDIF ! if zhti > 0 
    780748      END DO ! i loop 
    781  
     749       
    782750      ! ------------------------------------------------ 
    783751      ! Adding Snow in each category where za_i is not 0 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r6418 r7309  
    1717   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1818   USE sbc_ice         ! Surface boundary condition: ice fields 
    19    USE dom_ice 
    2019   USE ice 
    2120   USE limvar 
    … …  
    5655      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices 
    5756      REAL(wp) ::  z1_365 
    58       REAL(wp) ::  ztmp 
    59       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei, zt_i, zt_s 
    60       REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace 
     57      REAL(wp) ::  z2da, z2db, ztmp 
     58      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zswi2 
     59      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, zswi    ! 2D workspace 
    6160      !!------------------------------------------------------------------- 
    6261 
    6362      IF( nn_timing == 1 )  CALL timing_start('limwri') 
    6463 
    65       CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
    66       CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi ) 
     64      CALL wrk_alloc( jpi,jpj,jpl, zswi2 ) 
     65      CALL wrk_alloc( jpi,jpj    , z2d, zswi ) 
    6766 
    6867      !----------------------------- 
    … …  
    7170      z1_365 = 1._wp / 365._wp 
    7271 
    73       CALL lim_var_icetm      ! mean sea ice temperature 
    74  
    75       CALL lim_var_bv         ! brine volume 
    76  
    77       DO jj = 1, jpj          ! presence indicator of ice 
     72      ! brine volume 
     73      CALL lim_var_bv  
     74 
     75      ! tresholds for outputs 
     76      DO jj = 1, jpj 
    7877         DO ji = 1, jpi 
    7978            zswi(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 
    8079         END DO 
    8180      END DO 
    82       ! 
    83       ! 
    84       !                                              
    85       IF ( iom_use( "icethic_cea" ) ) THEN                       ! mean ice thickness 
    86          DO jj = 1, jpj  
     81      DO jl = 1, jpl 
     82         DO jj = 1, jpj 
    8783            DO ji = 1, jpi 
    88                z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 
     84               zswi2(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    8985            END DO 
    9086         END DO 
    91          CALL iom_put( "icethic_cea"  , z2d              ) 
    92       ENDIF 
    93  
    94       IF ( iom_use( "snowthic_cea" ) ) THEN                      ! snow thickness = mean snow thickness over the cell  
    95          DO jj = 1, jpj                                             
    96             DO ji = 1, jpi 
    97                z2d(ji,jj)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 
    98             END DO 
    99          END DO 
    100          CALL iom_put( "snowthic_cea" , z2d              )        
    101       ENDIF 
     87      END DO 
    10288      ! 
     89      ! fluxes 
     90      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
     91      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
     92      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface 
     93      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface 
     94      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 
     95      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice 
     96      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )   
     97      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   & 
     98         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 
     99      IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )   
     100      IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )   
     101      IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce(:,:) )   ! emp over ocean (taking into account the snow blown away from the ice) 
     102      IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice(:,:) )   ! emp over ice   (taking into account the snow blown away from the ice) 
     103 
     104      ! velocity 
    103105      IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN  
    104106         DO jj = 2 , jpjm1 
    105107            DO ji = 2 , jpim1 
    106                z2da(ji,jj)  = (  u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 
    107                z2db(ji,jj)  = (  v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 
     108               z2da  = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 
     109               z2db  = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 
     110               z2d(ji,jj) = SQRT( z2da * z2da + z2db * z2db ) 
    108111           END DO 
    109112         END DO 
    110          CALL lbc_lnk( z2da, 'T', -1. ) 
    111          CALL lbc_lnk( z2db, 'T', -1. ) 
    112          CALL iom_put( "uice_ipa"     , z2da             )       ! ice velocity u component 
    113          CALL iom_put( "vice_ipa"     , z2db             )       ! ice velocity v component 
    114          DO jj = 1, jpj                                  
    115             DO ji = 1, jpi 
    116                z2d(ji,jj)  = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) )  
    117             END DO 
    118          END DO 
    119          CALL iom_put( "icevel"       , z2d              )       ! ice velocity module 
     113         CALL lbc_lnk( z2d, 'T', 1. ) 
     114         CALL iom_put( "uice_ipa"     , u_ice      )       ! ice velocity u component 
     115         CALL iom_put( "vice_ipa"     , v_ice      )       ! ice velocity v component 
     116         CALL iom_put( "icevel"       , z2d        )       ! ice velocity module 
    120117      ENDIF 
     118 
     119      IF ( iom_use( "tau_icebfr" ) )    CALL iom_put( "tau_icebfr"  , tau_icebfr             )  ! ice friction with ocean bottom (landfast ice)   
    121120      ! 
    122       IF ( iom_use( "miceage" ) ) THEN  
    123          z2d(:,:) = 0.e0 
    124          DO jl = 1, jpl 
    125             DO jj = 1, jpj 
    126                DO ji = 1, jpi 
    127                   rswitch    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
    128                   z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 ) 
    129                END DO 
    130             END DO 
    131          END DO 
    132          CALL iom_put( "miceage"     , z2d * z1_365      )        ! mean ice age 
    133       ENDIF 
    134  
    135       IF ( iom_use( "micet" ) ) THEN  
    136          DO jj = 1, jpj 
    137             DO ji = 1, jpi 
    138                z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj) 
    139             END DO 
    140          END DO 
    141          CALL iom_put( "micet"       , z2d               )        ! mean ice temperature 
    142       ENDIF 
     121      IF ( iom_use( "miceage" ) )       CALL iom_put( "miceage"     , om_i * zswi * z1_365   )  ! mean ice age 
     122      IF ( iom_use( "icethic_cea" ) )   CALL iom_put( "icethic_cea" , htm_i * zswi           )  ! ice thickness mean 
     123      IF ( iom_use( "snowthic_cea" ) )  CALL iom_put( "snowthic_cea", htm_s * zswi           )  ! snow thickness mean 
     124      IF ( iom_use( "micet" ) )         CALL iom_put( "micet"       , ( tm_i  - rt0 ) * zswi )  ! ice mean    temperature 
     125      IF ( iom_use( "icest" ) )         CALL iom_put( "icest"       , ( tm_su - rt0 ) * zswi )  ! ice surface temperature 
     126      IF ( iom_use( "icecolf" ) )       CALL iom_put( "icecolf"     , hicol                  )  ! frazil ice collection thickness 
    143127      ! 
    144       IF ( iom_use( "icest" ) ) THEN  
    145          z2d(:,:) = 0.e0 
    146          DO jl = 1, jpl 
    147             DO jj = 1, jpj 
    148                DO ji = 1, jpi 
    149                   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 ) 
    150                END DO 
    151             END DO 
    152          END DO 
    153          CALL iom_put( "icest"       , z2d              )        ! ice surface temperature 
    154       ENDIF 
    155  
    156       IF ( iom_use( "icecolf" ) )   CALL iom_put( "icecolf", hicol )  ! frazil ice collection thickness 
    157   
    158128      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature 
    159129      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity 
    160       CALL iom_put( "iceconc"     , at_i                )        ! ice concentration 
    161       CALL iom_put( "icevolu"     , vt_i                )        ! ice volume = mean ice thickness over the cell 
    162       CALL iom_put( "icehc"       , et_i                )        ! ice total heat content 
    163       CALL iom_put( "isnowhc"     , et_s                )        ! snow total heat content 
    164       CALL iom_put( "ibrinv"      , bv_i * 100._wp      )        ! brine volume 
     130      CALL iom_put( "iceconc"     , at_i  * zswi        )        ! ice concentration 
     131      CALL iom_put( "icevolu"     , vt_i  * zswi        )        ! ice volume = mean ice thickness over the cell 
     132      CALL iom_put( "icehc"       , et_i  * zswi        )        ! ice total heat content 
     133      CALL iom_put( "isnowhc"     , et_s  * zswi        )        ! snow total heat content 
     134      CALL iom_put( "ibrinv"      , bvm_i * zswi * 100. )        ! brine volume 
    165135      CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point 
    166136      CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point 
    167137      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation  
    168       CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity 
    169  
    170       CALL iom_put( "icestr"      , strength * 0.001    )        ! ice strength 
    171       CALL iom_put( "idive"       , divu_i * 1.0e8      )        ! divergence 
    172       CALL iom_put( "ishear"      , shear_i * 1.0e8     )        ! shear 
    173       CALL iom_put( "snowvol"     , vt_s                )        ! snow volume 
     138      CALL iom_put( "micesalt"    , smt_i   * zswi      )        ! mean ice salinity 
     139 
     140      CALL iom_put( "icestr"      , strength * zswi )    ! ice strength 
     141      CALL iom_put( "idive"       , divu_i * 1.0e8      )    ! divergence 
     142      CALL iom_put( "ishear"      , shear_i * 1.0e8     )    ! shear 
     143      CALL iom_put( "snowvol"     , vt_s   * zswi       )        ! snow volume 
    174144       
    175145      CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport 
    … …  
    180150 
    181151      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from bottom growth 
    182       CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from bottom melt 
    183       CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from surface melt 
     152      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from bottom melting 
     153      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from surface melting 
     154      CALL iom_put( "sfxlam"      , sfx_lam * rday      )        ! salt flux from lateral melting 
    184155      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from snow ice formation 
    185156      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from open water formation 
    186157      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting 
    187       CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from residual 
     158      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant) 
    188159      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines 
    189160      CALL iom_put( "sfxsub"      , sfx_sub * rday      )        ! salt flux from sublimation 
    … …  
    198169      CALL iom_put( "vfxsum"     , wfx_sum * ztmp       )        ! surface melt  
    199170      CALL iom_put( "vfxbom"     , wfx_bom * ztmp       )        ! bottom melt  
     171      CALL iom_put( "vfxlam"     , wfx_lam * ztmp       )        ! lateral melt  
    200172      CALL iom_put( "vfxice"     , wfx_ice * ztmp       )        ! total ice growth/melt  
     173 
     174      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations   
     175         WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog 
     176         ELSEWHERE                                       ; z2d = 0._wp 
     177         END WHERE 
     178         CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp ) 
     179      ENDIF 
     180 
     181      ztmp = rday / rhosn 
     182      CALL iom_put( "vfxspr"     , wfx_spr * ztmp       )        ! precip (snow) 
    201183      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp       )        ! total snw growth/melt  
    202       CALL iom_put( "vfxsub"     , wfx_sub * ztmp       )        ! sublimation (snow)  
    203       CALL iom_put( "vfxspr"     , wfx_spr * ztmp       )        ! precip (snow) 
     184      CALL iom_put( "vfxsub"     , wfx_sub * ztmp       )        ! sublimation (snow/ice)  
     185      CALL iom_put( "vfxsub_err" , wfx_err_sub * ztmp   )        ! "excess" of sublimation sent to ocean  
    204186       
    205187      CALL iom_put( "afxtot"     , afx_tot * rday       )        ! concentration tendency (total) 
    … …  
    222204      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   !   
    223205      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !   
    224       CALL iom_put ('hfxtur'     , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base  
     206      CALL iom_put ('hfxtur'     , fhtur(:,:) * at_i_b(:,:) ) ! turbulent heat flux at ice base  
    225207      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice  
    226208      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip  
    227        
    228       IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations   
    229          DO jj = 1, jpj  
    230             DO ji = 1, jpi 
    231                z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) ! mean ice thickness 
    232             END DO 
    233          END DO 
    234          WHERE( z2d(:,:) < 0.2 .AND. z2d(:,:) > 0. ) ; z2da = wfx_bog 
    235          ELSEWHERE                                   ; z2da = 0._wp 
    236          END WHERE 
    237          CALL iom_put( "vfxthin", ( wfx_opw + z2da ) * ztmp ) 
    238       ENDIF 
    239  
     209 
     210       
    240211      !-------------------------------- 
    241212      ! Output values for each category 
    242213      !-------------------------------- 
    243       CALL iom_put( "iceconc_cat"      , a_i         )        ! area for categories 
    244       CALL iom_put( "icethic_cat"      , ht_i        )        ! thickness for categories 
    245       CALL iom_put( "snowthic_cat"     , ht_s        )        ! snow depth for categories 
    246       CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories 
    247  
     214      IF ( iom_use( "iceconc_cat"  ) )  CALL iom_put( "iceconc_cat"      , a_i   * zswi2   )        ! area for categories 
     215      IF ( iom_use( "icethic_cat"  ) )  CALL iom_put( "icethic_cat"      , ht_i  * zswi2   )        ! thickness for categories 
     216      IF ( iom_use( "snowthic_cat" ) )  CALL iom_put( "snowthic_cat"     , ht_s  * zswi2   )        ! snow depth for categories 
     217      IF ( iom_use( "salinity_cat" ) )  CALL iom_put( "salinity_cat"     , sm_i  * zswi2   )        ! salinity for categories 
    248218      ! ice temperature 
    249       IF ( iom_use( "icetemp_cat" ) ) THEN  
    250          zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i 
    251          CALL iom_put( "icetemp_cat"   , zt_i - rt0  ) 
    252       ENDIF 
    253        
     219      IF ( iom_use( "icetemp_cat"  ) )  CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 ) 
    254220      ! snow temperature 
    255       IF ( iom_use( "snwtemp_cat" ) ) THEN  
    256          zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s 
    257          CALL iom_put( "snwtemp_cat"   , zt_s - rt0  ) 
    258       ENDIF 
    259  
    260       ! Compute ice age 
    261       IF ( iom_use( "iceage_cat" ) ) THEN  
    262          DO jl = 1, jpl  
    263             DO jj = 1, jpj 
    264                DO ji = 1, jpi 
    265                   rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
    266                   rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) ) 
    267                   zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch 
    268                END DO 
    269             END DO 
    270          END DO 
    271          CALL iom_put( "iceage_cat"   , zoi * z1_365 )        ! ice age for categories 
    272       ENDIF 
    273  
    274       ! Compute brine volume 
    275       IF ( iom_use( "brinevol_cat" ) ) THEN  
    276          zei(:,:,:) = 0._wp 
    277          DO jl = 1, jpl  
    278             DO jk = 1, nlay_i 
    279                DO jj = 1, jpj 
    280                   DO ji = 1, jpi 
    281                      rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    282                      zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 *  & 
    283                         ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 
    284                         rswitch * r1_nlay_i 
    285                   END DO 
    286                END DO 
    287             END DO 
    288          END DO 
    289          CALL iom_put( "brinevol_cat"     , zei      )        ! brine volume for categories 
    290       ENDIF 
     221      IF ( iom_use( "snwtemp_cat"  ) )  CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 ) 
     222      ! ice age 
     223      IF ( iom_use( "iceage_cat"   ) )  CALL iom_put( "iceage_cat" , o_i * zswi2 * z1_365 ) 
     224      ! brine volume 
     225      IF ( iom_use( "brinevol_cat" ) )  CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 ) 
    291226 
    292227      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
    … …  
    294229      !     not yet implemented 
    295230       
    296       CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
    297       CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db ) 
     231      CALL wrk_dealloc( jpi, jpj, jpl, zswi2 ) 
     232      CALL wrk_dealloc( jpi, jpj     , z2d, zswi ) 
    298233 
    299234      IF( nn_timing == 1 )  CALL timing_stop('limwri') 
    … …  
    312247      !! 
    313248      !! History : 
    314       !!   4.1  !  2013-06  (C. Rousset) 
     249      !!   4.0  !  2013-06  (C. Rousset) 
    315250      !!---------------------------------------------------------------------- 
    316       INTEGER, INTENT( in ) ::   kt               ! ocean time-step index) 
    317       INTEGER, INTENT( in ) ::   kid , kh_i        
     251      INTEGER, INTENT( in )   ::   kt               ! ocean time-step index) 
     252      INTEGER, INTENT( in )   ::   kid , kh_i 
     253      INTEGER                 ::   nz_i, jl 
     254      REAL(wp), DIMENSION(jpl) :: jcat 
    318255      !!---------------------------------------------------------------------- 
    319  
    320       CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      ,   & 
    321       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    322       CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      ,   & 
    323       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    324       CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      ,   & 
    325       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    326       CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    ,   & 
    327       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    328       CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    ,   & 
    329       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    330       CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa",   & 
    331       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    332       CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa",   & 
    333       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    334       CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2" ,   & 
    335       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    336       CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" ,   & 
     256      DO jl = 1, jpl 
     257         jcat(jl) = REAL(jl) 
     258      ENDDO 
     259       
     260      CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up") 
     261 
     262      CALL histdef( kid, "sithic", "Ice thickness"           , "m"      ,   & 
     263      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     264      CALL histdef( kid, "siconc", "Ice concentration"       , "%"      ,   & 
     265      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     266      CALL histdef( kid, "sitemp", "Ice temperature"         , "C"      ,   & 
     267      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     268      CALL histdef( kid, "sivelu", "i-Ice speed "            , "m/s"    ,   & 
     269      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     270      CALL histdef( kid, "sivelv", "j-Ice speed "            , "m/s"    ,   & 
     271      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     272      CALL histdef( kid, "sistru", "i-Wind stress over ice " , "Pa"     ,   & 
     273      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     274      CALL histdef( kid, "sistrv", "j-Wind stress over ice " , "Pa"     ,   & 
     275      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     276      CALL histdef( kid, "sisflx", "Solar flux over ocean"     , "w/m2" ,   & 
     277      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     278      CALL histdef( kid, "sinflx", "Non-solar flux over ocean" , "w/m2" ,   & 
    337279      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    338280      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   & 
    339281      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    340       CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    ,   & 
    341       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    342       CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      ,   & 
    343       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    344       CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1",   & 
    345       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    346       CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"    ,   & 
    347       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    348       CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"    ,   & 
    349       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    350       CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"    ,   & 
     282      CALL histdef( kid, "sisali", "Ice salinity"            , "PSU"    ,   & 
     283      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     284      CALL histdef( kid, "sivolu", "Ice volume"              , "m"      ,   & 
     285      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     286      CALL histdef( kid, "sidive", "Ice divergence"          , "10-8s-1",   & 
     287      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     288 
     289      CALL histdef( kid, "vfxbog", "Ice bottom production"   , "m/s"    ,   & 
     290      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     291      CALL histdef( kid, "vfxdyn", "Ice dynamic production"  , "m/s"    ,   & 
     292      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     293      CALL histdef( kid, "vfxopw", "Ice open water prod"     , "m/s"    ,   & 
    351294      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    352       CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"    ,   & 
    353       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    354       CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"    ,   & 
    355       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    356       CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"    ,   & 
    357       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    358       CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"    ,   & 
    359       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    360       CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics"  , ""       ,   & 
    361       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    362       CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""       ,   & 
    363       &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     295      CALL histdef( kid, "vfxsni", "Snow ice production "    , "m/s"    ,   & 
     296      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     297      CALL histdef( kid, "vfxres", "Ice prod from limupdate" , "m/s"    ,   & 
     298      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     299      CALL histdef( kid, "vfxbom", "Ice bottom melt"         , "m/s"    ,   & 
     300      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     301      CALL histdef( kid, "vfxsum", "Ice surface melt"        , "m/s"    ,   & 
     302      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     303 
     304      CALL histdef( kid, "sithicat", "Ice thickness"         , "m"      ,   & 
     305      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
     306      CALL histdef( kid, "siconcat", "Ice concentration"     , "%"      ,   & 
     307      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
     308      CALL histdef( kid, "sisalcat", "Ice salinity"           , ""      ,   & 
     309      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
     310      CALL histdef( kid, "sitemcat", "Ice temperature"       , "C"      ,   & 
     311      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
     312      CALL histdef( kid, "snthicat", "Snw thickness"         , "m"      ,   & 
     313      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
     314      CALL histdef( kid, "sntemcat", "Snw temperature"       , "C"      ,   & 
     315      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
    364316 
    365317      CALL histend( kid, snc4set )   ! end of the file definition 
    366318 
    367       CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )     
    368       CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) ) 
    369       CALL histwrite( kid, "iicetemp", kt, tm_i - rt0    , jpi*jpj, (/1/) ) 
    370       CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) ) 
    371       CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) ) 
    372       CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) ) 
    373       CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) ) 
    374       CALL histwrite( kid, "iicesflx", kt, qsr , jpi*jpj, (/1/) ) 
    375       CALL histwrite( kid, "iicenflx", kt, qns , jpi*jpj, (/1/) ) 
     319      CALL histwrite( kid, "sithic", kt, htm_i         , jpi*jpj, (/1/) )     
     320      CALL histwrite( kid, "siconc", kt, at_i          , jpi*jpj, (/1/) ) 
     321      CALL histwrite( kid, "sitemp", kt, tm_i - rt0    , jpi*jpj, (/1/) ) 
     322      CALL histwrite( kid, "sivelu", kt, u_ice          , jpi*jpj, (/1/) ) 
     323      CALL histwrite( kid, "sivelv", kt, v_ice          , jpi*jpj, (/1/) ) 
     324      CALL histwrite( kid, "sistru", kt, utau_ice       , jpi*jpj, (/1/) ) 
     325      CALL histwrite( kid, "sistrv", kt, vtau_ice       , jpi*jpj, (/1/) ) 
     326      CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) ) 
     327      CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) ) 
    376328      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) ) 
    377       CALL histwrite( kid, "iicesali", kt, smt_i          , jpi*jpj, (/1/) ) 
    378       CALL histwrite( kid, "iicevolu", kt, vt_i           , jpi*jpj, (/1/) ) 
    379       CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) ) 
    380  
    381       CALL histwrite( kid, "iicebopr", kt, wfx_bog        , jpi*jpj, (/1/) ) 
    382       CALL histwrite( kid, "iicedypr", kt, wfx_dyn        , jpi*jpj, (/1/) ) 
    383       CALL histwrite( kid, "iicelapr", kt, wfx_opw        , jpi*jpj, (/1/) ) 
    384       CALL histwrite( kid, "iicesipr", kt, wfx_sni        , jpi*jpj, (/1/) ) 
    385       CALL histwrite( kid, "iicerepr", kt, wfx_res        , jpi*jpj, (/1/) ) 
    386       CALL histwrite( kid, "iicebome", kt, wfx_bom        , jpi*jpj, (/1/) ) 
    387       CALL histwrite( kid, "iicesume", kt, wfx_sum        , jpi*jpj, (/1/) ) 
    388       CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn        , jpi*jpj, (/1/) ) 
    389       CALL histwrite( kid, "iisfxres", kt, sfx_res        , jpi*jpj, (/1/) ) 
     329      CALL histwrite( kid, "sisali", kt, smt_i          , jpi*jpj, (/1/) ) 
     330      CALL histwrite( kid, "sivolu", kt, vt_i           , jpi*jpj, (/1/) ) 
     331      CALL histwrite( kid, "sidive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) ) 
     332 
     333      CALL histwrite( kid, "vfxbog", kt, wfx_bog        , jpi*jpj, (/1/) ) 
     334      CALL histwrite( kid, "vfxdyn", kt, wfx_dyn        , jpi*jpj, (/1/) ) 
     335      CALL histwrite( kid, "vfxopw", kt, wfx_opw        , jpi*jpj, (/1/) ) 
     336      CALL histwrite( kid, "vfxsni", kt, wfx_sni        , jpi*jpj, (/1/) ) 
     337      CALL histwrite( kid, "vfxres", kt, wfx_res        , jpi*jpj, (/1/) ) 
     338      CALL histwrite( kid, "vfxbom", kt, wfx_bom        , jpi*jpj, (/1/) ) 
     339      CALL histwrite( kid, "vfxsum", kt, wfx_sum        , jpi*jpj, (/1/) ) 
     340 
     341      CALL histwrite( kid, "sithicat", kt, ht_i        , jpi*jpj*jpl, (/1/) )     
     342      CALL histwrite( kid, "siconcat", kt, a_i         , jpi*jpj*jpl, (/1/) )     
     343      CALL histwrite( kid, "sisalcat", kt, sm_i        , jpi*jpj*jpl, (/1/) )     
     344      CALL histwrite( kid, "sitemcat", kt, tm_i - rt0  , jpi*jpj*jpl, (/1/) )     
     345      CALL histwrite( kid, "snthicat", kt, ht_s        , jpi*jpj*jpl, (/1/) )     
     346      CALL histwrite( kid, "sntemcat", kt, tm_su - rt0 , jpi*jpj*jpl, (/1/) )     
    390347 
    391348      ! Close the file 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r6416 r7309  
    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_CNRS_AGRIF_2016/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90

    r3680 r7309  
    55   !!---------------------------------------------------------------------- 
    66   !! History :  3.4  ! 2012-08  (R. Benshila)  Original code 
     7   !!            3.6  ! 2016-05  (C. Rousset)   Add LIM3 compatibility 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_agrif && defined key_lim2 
    … …  
    5960   END FUNCTION agrif_ice_alloc 
    6061 
     62#elif defined key_agrif && defined key_lim3 
     63   !!---------------------------------------------------------------------- 
     64   !!   'key_agrif'                                              AGRIF zoom 
     65   !!----------------------------------------------------------------------    
     66   IMPLICIT NONE 
     67   PRIVATE  
     68 
     69   INTEGER, PUBLIC ::  u_ice_id, v_ice_id, tra_ice_id 
     70   INTEGER, PUBLIC ::  lim_nbstep = 0    ! child time position in sea-ice model 
     71 
     72   !!---------------------------------------------------------------------- 
     73   !! NEMO/NST 3.6 , NEMO Consortium (2016) 
     74   !! $Id$ 
     75   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     76   !!---------------------------------------------------------------------- 
     77 
    6178#endif 
    6279   !!====================================================================== 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    r5836 r7309  
    2727#elif defined key_lim3 
    2828   USE ice             ! LIM_3 ice variables 
    29    USE dom_ice         ! sea-ice domain 
    3029   USE limvar 
     30   USE limctl 
    3131#endif  
    3232   USE par_oce         ! ocean parameters 
    … …  
    8282      ! 
    8383#if defined key_lim3 
    84       CALL lim_var_zapsmall 
    85       CALL lim_var_agg(1) 
     84                        CALL lim_var_zapsmall 
     85                        CALL lim_var_agg(1) 
     86      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
    8687#endif 
    8788      ! 
    … …  
    121122      ! 
    122123#if defined key_lim2 
    123       DO jb = 1, idx%nblen(jgrd) 
     124      DO jb = 1, idx%nblenrim(jgrd) 
    124125         ji    = idx%nbi(jb,jgrd) 
    125126         jj    = idx%nbj(jb,jgrd) 
    … …  
    141142 
    142143      DO jl = 1, jpl 
    143          DO jb = 1, idx%nblen(jgrd) 
     144         DO jb = 1, idx%nblenrim(jgrd) 
    144145            ji    = idx%nbi(jb,jgrd) 
    145146            jj    = idx%nbj(jb,jgrd) 
    … …  
    177178 
    178179      DO jl = 1, jpl 
    179          DO jb = 1, idx%nblen(jgrd) 
     180         DO jb = 1, idx%nblenrim(jgrd) 
    180181            ji    = idx%nbi(jb,jgrd) 
    181182            jj    = idx%nbj(jb,jgrd) 
    … …  
    236237            END SELECT 
    237238            ! 
    238             IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_ice_sal 
     239            IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_icesal 
    239240               sm_i(ji,jj  ,jl) = rn_icesal 
    240241               s_i (ji,jj,:,jl) = rn_icesal 
    … …  
    325326            CASE ( 'U' )   
    326327               jgrd = 2      ! u velocity 
    327                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
     328               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    328329                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    329330                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    … …  
    352353            CASE ( 'V' ) 
    353354               jgrd = 3      ! v velocity 
    354                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
     355               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    355356                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    356357                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r6140 r7309  
    3838   PUBLIC   dia_hsb        ! routine called by step.F90 
    3939   PUBLIC   dia_hsb_init   ! routine called by nemogcm.F90 
    40    PUBLIC   dia_hsb_rst    ! routine called by step.F90 
    4140 
    4241   LOGICAL, PUBLIC ::   ln_diahsb   !: check the heat and salt budgets 
    … …  
    8685      !!--------------------------------------------------------------------------- 
    8786      IF( nn_timing == 1 )   CALL timing_start('dia_hsb')       
     87      ! 
    8888      CALL wrk_alloc( jpi,jpj,   z2d0, z2d1 ) 
    8989      ! 
    … …  
    171171      ENDDO 
    172172 
    173       ! Substract forcing from heat content, salt content and volume variations 
     173      ! ------------------------ ! 
     174      ! 3 -  Drifts              ! 
     175      ! ------------------------ ! 
    174176      zdiff_v1 = zdiff_v1 - frc_v 
    175177      IF( .NOT.ln_linssh )   zdiff_v2 = zdiff_v2 - frc_v 
    … …  
    184186 
    185187      ! ----------------------- ! 
    186       ! 3 - Diagnostics writing ! 
     188      ! 4 - Diagnostics writing ! 
    187189      ! ----------------------- ! 
    188190      zvol_tot = 0._wp                    ! total ocean volume (calculated with scale factors) 
    … …  
    197199!!gm end 
    198200 
    199       IF( ln_linssh ) THEN 
    200         CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content variation (C)  
    201         CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content variation (psu) 
    202         CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content variation (1.e20 J)  
    203         CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9   )              ! Salt content variation (psu*km3) 
    204         CALL iom_put( 'bgvolssh' , zdiff_v1  * 1.e-9   )              ! volume ssh variation (km3)   
    205         CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
    206         CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C)  
    207         CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu)  
     201      CALL iom_put(   'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
     202      CALL iom_put(   'bgfrctem' , frc_t    * rau0 * rcp * 1.e-20 )   ! hc  - surface forcing (1.e20 J)  
     203      CALL iom_put(   'bgfrchfx' , frc_t    * rau0 * rcp /  &         ! hc  - surface forcing (W/m2)  
     204         &                       ( surf_tot * kt * rdt )        ) 
     205      CALL iom_put(   'bgfrcsal' , frc_s    * 1.e-9    )              ! sc  - surface forcing (psu*km3)  
     206 
     207      IF( .NOT. ln_linssh ) THEN 
     208        CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature drift     (C)  
     209        CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    drift     (pss) 
     210        CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp )   ! Heat content drift    (1.e20 J)  
     211        CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp /  &         ! Heat flux drift       (W/m2)  
     212           &                       ( surf_tot * kt * rdt )        ) 
     213        CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content drift    (psu*km3) 
     214        CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)   
     215        CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9    )              ! volume e3t drift      (km3)   
     216      ELSE 
     217        CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content drift    (C)  
     218        CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content drift    (pss) 
     219        CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content drift    (1.e20 J)  
     220        CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp /  &        ! Heat flux drift       (W/m2)  
     221           &                       ( surf_tot * kt * rdt )         ) 
     222        CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content drift    (psu*km3) 
     223        CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)   
    208224        CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C) 
    209225        CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu) 
    210       ELSE 
    211         CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature variation (C)  
    212         CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    variation (psu) 
    213         CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp )   ! Heat content variation (1.e20 J)  
    214         CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content variation (psu*km3) 
    215         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh variation (km3)   
    216         CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9    )              ! volume e3t variation (km3)   
    217         CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
    218         CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C)  
    219         CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu)  
    220226      ENDIF 
    221227      ! 
    … …  
    231237   SUBROUTINE dia_hsb_rst( kt, cdrw ) 
    232238     !!--------------------------------------------------------------------- 
    233      !!                   ***  ROUTINE limdia_rst  *** 
     239     !!                   ***  ROUTINE dia_hsb_rst  *** 
    234240     !!                      
    235241     !! ** Purpose :   Read or write DIA file in restart file 
    … …  
    241247     ! 
    242248     INTEGER ::   ji, jj, jk   ! dummy loop indices 
    243      INTEGER ::   id1          ! local integers 
    244249     !!---------------------------------------------------------------------- 
    245250     ! 
    246251     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    247252        IF( ln_rstart ) THEN                   !* Read the restart file 
    248            !id1 = iom_varid( numror, 'frc_vol'  , ldstop = .FALSE. ) 
    249253           ! 
    250254           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    … …  
    259263           ENDIF 
    260264           CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 
    261            CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 
    262            CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 
    263            CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini ) 
    264            CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini ) 
     265           CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 
     266           CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 
     267           CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 
     268           CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 
    265269           IF( ln_linssh ) THEN 
    266               CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 
    267               CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 
     270              CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 
     271              CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 
    268272           ENDIF 
    269273       ELSE 
    … …  
    313317        ENDIF 
    314318        CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling 
    315         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 
    316         CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 
    317         CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 
    318         CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 
     319        CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 
     320        CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 
     321        CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 
     322        CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 
    319323        IF( ln_linssh ) THEN 
    320            CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 
    321            CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 
     324           CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 
     325           CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 
    322326        ENDIF 
    323327        ! 
    … …  
    339343      !!             - Compute coefficients for conversion 
    340344      !!--------------------------------------------------------------------------- 
    341       INTEGER ::   jk       ! dummy loop indice 
    342345      INTEGER ::   ierror   ! local integer 
    343346      INTEGER ::   ios 
    … …  
    345348      NAMELIST/namhsb/ ln_diahsb 
    346349      !!---------------------------------------------------------------------- 
    347  
    348       IF(lwp) THEN 
    349          WRITE(numout,*) 
    350          WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 
    351          WRITE(numout,*) '~~~~~~~~ ' 
    352       ENDIF 
    353350 
    354351      REWIND( numnam_ref )              ! Namelist namhsb in reference namelist 
    … …  
    361358      IF(lwm) WRITE ( numond, namhsb ) 
    362359 
    363       ! 
    364       IF(lwp) THEN                   ! Control print 
     360      IF(lwp) THEN 
    365361         WRITE(numout,*) 
    366          WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 
    367          WRITE(numout,*) '~~~~~~~~~~~~' 
    368          WRITE(numout,*) '   Namelist namhsb : set hsb parameters' 
    369          WRITE(numout,*) '      Switch for hsb diagnostic (T) or not (F)  ln_diahsb  = ', ln_diahsb 
    370          WRITE(numout,*) 
    371       ENDIF 
    372  
     362         WRITE(numout,*) 'dia_hsb_init' 
     363         WRITE(numout,*) '~~~~~~~~ ' 
     364         WRITE(numout,*) '  check the heat and salt budgets (T) or not (F)       ln_diahsb = ', ln_diahsb 
     365      ENDIF 
     366      ! 
    373367      IF( .NOT. ln_diahsb )   RETURN 
    374368         !      IF( .NOT. lk_mpp_rep ) & 
    … …  
    388382      IF( ln_linssh )   ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 
    389383      IF( ierror > 0 ) THEN 
    390          CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
     384         CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' )   ;   RETURN 
    391385      ENDIF 
    392386 
    … …  
    394388      ! 2 - Time independant variables and file opening ! 
    395389      ! ----------------------------------------------- ! 
    396       IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
    397       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    398390      surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)      ! masked surface grid cell area 
    399       surf_tot  = glob_sum( surf(:,:) )                                       ! total ocean surface area 
     391      surf_tot  = glob_sum( surf(:,:) )                   ! total ocean surface area 
    400392 
    401393      IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r6140 r7309  
    166166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
    167167   ! 
    168    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff                              !: coriolis factor                   [1/s] 
    169  
     168   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff                              !: coriolis factor at F_point [1/s] 
     169   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff_t                            !: coriolis factor at T-point [1/s] 
    170170   !!---------------------------------------------------------------------- 
    171171   !! vertical coordinate and scale factors 
    … …  
    289289   !!---------------------------------------------------------------------- 
    290290   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    291    !! $Id$ 
     291   !! $Id$  
    292292   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    293293   !!---------------------------------------------------------------------- 
    … …  
    309309   INTEGER FUNCTION dom_oce_alloc() 
    310310      !!---------------------------------------------------------------------- 
    311       INTEGER, DIMENSION(13) :: ierr 
     311      INTEGER, DIMENSION(12) :: ierr 
    312312      !!---------------------------------------------------------------------- 
    313313      ierr(:) = 0 
    … …  
    332332         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     & 
    333333         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     & 
    334          &        ff (jpi,jpj)                                                         , STAT=ierr(3) ) 
     334         &        ff (jpi,jpj) , ff_t    (jpi,jpj)                                     , STAT=ierr(3) ) 
    335335         ! 
    336336      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,     & 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r6981 r7309  
    9292      IF( ln_sco )   CALL dom_stiff             ! Maximum stiffness ratio/hydrostatic consistency 
    9393      ! 
    94       ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness 
    95       hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1) 
    96       hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1) 
    97       DO jk = 2, jpk 
     94      ht_0(:,:) = 0._wp  ! Reference ocean thickness 
     95      hu_0(:,:) = 0._wp 
     96      hv_0(:,:) = 0._wp 
     97      DO jk = 1, jpk 
    9898         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
    9999         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90

    r6140 r7309  
    5656         IF( jperio == 5 )   WRITE(numout,*) '      jperio= 5, north fold with F-point pivot' 
    5757         IF( jperio == 6 )   WRITE(numout,*) '      jperio= 6, cyclic east-west and north fold with F-point pivot' 
    58       ENDIF 
    59       ! 
    60       IF( jperio <  0 .OR. jperio > 6 )   CALL ctl_stop( 'jperio is out of range' ) 
     58         IF( jperio == 7 )   WRITE(numout,*) '      jperio= 7, cyclic east-west and north-south' 
     59      ENDIF 
     60      ! 
     61      IF( jperio <  0 .OR. jperio > 7 )   CALL ctl_stop( 'jperio is out of range' ) 
    6162      ! 
    6263      CALL dom_glo                   ! global domain versus zoom and/or local domain 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r6140 r7309  
    3838 
    3939   !!---------------------------------------------------------------------- 
    40    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     40   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    4141   !! $Id$  
    4242   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    321321         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1 
    322322         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1 
    323          ! 
     323 
     324      CASE ( 6 )                   ! clem: f-plane with irregular grid-spacing 
     325 
     326         IF(lwp) WRITE(numout,*) 
     327         IF(lwp) WRITE(numout,*) '          f-plane with irregular grid-spacing (+- 10%)' 
     328         IF(lwp) WRITE(numout,*) '          the max is given by ppe1_m and ppe2_m'  
     329 
     330         ! Position coordinates (in kilometers) 
     331         !                          ========== 
     332         glam0 = 0._wp 
     333         gphi0 = 0._wp 
     334          
     335#if defined key_agrif  
     336         IF( .NOT. Agrif_Root() ) THEN 
     337            glam0  = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-5 
     338            gphi0  = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-5 
     339            ppe1_m = Agrif_Parent(ppe1_m)/Agrif_Rhox() 
     340            ppe2_m = Agrif_Parent(ppe2_m)/Agrif_Rhoy()           
     341         ENDIF 
     342#endif          
     343 
     344         DO jj = 1, jpj 
     345            DO ji = 1, jpi 
     346               zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - 1 + njmpp - 1 ) 
     347               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 + njmpp - 1 ) 
     348               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5 
     349               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5 
     350 
     351               glamt(ji,jj) = glam0 + ppe1_m * 1.e-5 * zti 
     352               glamu(ji,jj) = glam0 + ppe1_m * 1.e-5 * zui 
     353               glamv(ji,jj) = glam0 + ppe1_m * 1.e-5 * zvi 
     354               glamf(ji,jj) = glam0 + ppe1_m * 1.e-5 * zfi 
     355    
     356               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-5 * ztj 
     357               gphiu(ji,jj) = gphi0 + ppe2_m * 1.e-5 * zuj 
     358               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-5 * zvj 
     359               gphif(ji,jj) = gphi0 + ppe2_m * 1.e-5 * zfj 
     360            END DO 
     361         END DO 
     362          
     363         ! Horizontal scale factors (in meters) 
     364         !                              ====== 
     365!! ==> EITHER 1) variable scale factors 
     366         DO jj = 1, jpj 
     367            DO ji = 1, jpi 
     368               !!e1t(ji,jj) = ppe1_m * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 )  ! gaussian shape 
     369               !!e2t(ji,jj) = ppe2_m * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 )  ! gaussian shape 
     370               e1t(ji,jj) = ppe1_m * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape 
     371               e2t(ji,jj) = ppe2_m * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape 
     372            END DO 
     373         END DO 
     374#if defined key_agrif  
     375         IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid 
     376            DO jj = 1, jpj 
     377               DO ji = 1, jpi 
     378                  e1t(ji,jj) = ppe1_m * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5)  & 
     379                     &                            * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) )       ! factor to match parent grid 
     380                  e2t(ji,jj) = ppe2_m * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5)  & 
     381                     &                            * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) )       ! factor to match parent grid 
     382               END DO 
     383            END DO 
     384         ENDIF 
     385#endif 
     386!! ==> OR 2) constant scale factors 
     387!!         e1t(:,:) = ppe1_m 
     388!!         e2t(:,:) = ppe2_m 
     389          
     390         e1u(:,:) = e1t(:,:)      ;      e2u(:,:) = e2t(:,:) 
     391         e1v(:,:) = e1t(:,:)      ;      e2v(:,:) = e2t(:,:) 
     392         e1f(:,:) = e1t(:,:)      ;      e2f(:,:) = e2t(:,:) 
     393 
    324394      CASE DEFAULT 
    325395         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh 
    … …  
    377447      CASE ( 0, 1, 4 )               ! mesh on the sphere 
    378448         ! 
    379          ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) )  
     449         ff  (:,:) = 2. * omega * SIN( rad * gphif(:,:) )  
     450         ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) )  
    380451         ! 
    381452      CASE ( 2 )                     ! f-plane at ppgphi0  
    382453         ! 
    383          ff(:,:) = 2. * omega * SIN( rad * ppgphi0 ) 
     454         ff  (:,:) = 2. * omega * SIN( rad * ppgphi0 ) 
     455         ff_t(:,:) = 2. * omega * SIN( rad * ppgphi0 )  ! clem: coriolis at T-point 
    384456         ! 
    385457         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1) 
    … …  
    399471         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south 
    400472         ! 
    401          ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south) 
     473         ff  (:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south) 
     474         ff_t(:,:) = ( zf0  + zbeta * gphit(:,:) * 1.e+3 )                        ! clem: coriolis at T-point 
    402475         ! 
    403476         IF(lwp) THEN 
    … …  
    420493         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south 
    421494         ! 
    422          ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south) 
     495         ff  (:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south) 
     496         ff_t(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra )   ! clem: coriolis at T-point 
    423497         ! 
    424498         IF(lwp) THEN 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r6492 r7309  
    145145      ! Build the vertical coordinate system 
    146146      ! ------------------------------------ 
     147#if defined key_sas2D 
     148      WRITE(numout,*) ' domzgr: we use SAS2D (i.e. no ocean) with jpk=',jpk 
     149      mbathy(:,:) = 1   ;   bathy(:,:) = rn_hmin 
     150 
     151      gdept_0 (:,:,:) = rn_hmin 
     152      gdepw_0 (:,:,:) = rn_hmin   ;   gdep3w_0(:,:,:) = rn_hmin 
     153      gdept_1d(:)     = rn_hmin   ;   gdepw_1d(:)     = rn_hmin 
     154 
     155      e3t_0 (:,:,:) = rn_hmin 
     156      e3u_0 (:,:,:) = rn_hmin   ;   e3v_0 (:,:,:) = rn_hmin 
     157      e3f_0 (:,:,:) = rn_hmin   ;   e3w_0 (:,:,:) = rn_hmin 
     158      e3uw_0(:,:,:) = rn_hmin   ;   e3vw_0(:,:,:) = rn_hmin 
     159      e3t_1d(:)     = rn_hmin   ;   e3w_1d(:)     = rn_hmin 
     160 
     161      mikt(:,:) = 1   ;   mikv(:,:) = 1 
     162      miku(:,:) = 1   ;   mikf(:,:) = 1 
     163#else 
    147164                          CALL zgr_z            ! Reference z-coordinate system (always called) 
    148165                          CALL zgr_bat          ! Bathymetry fields (levels and meters) 
    … …  
    164181      END IF 
    165182      ! 
     183#endif 
     184       
    166185      IF( nprint == 1 .AND. lwp )   THEN 
    167186         WRITE(numout,*) ' MIN val mbathy  ', MINVAL(  mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
    … …  
    476495            idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0._wp 
    477496            idta(jpidta, :    ) = 0                 ;      zdta(jpidta, :    ) =  0._wp 
     497         ELSEIF( jperio == 7 ) THEN 
     498!           Nothing to do here 
    478499         ELSE 
    479500            ih = 0                                  ;      zh = 0._wp 
    … …  
    738759         IF( lk_mpp ) THEN 
    739760            IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    740                IF( jperio /= 1 )   mbathy(1,:) = 0 
     761               IF( jperio /= 1 .AND. jperio /= 7 )   mbathy(1,:) = 0 
    741762            ENDIF 
    742763            IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    743                IF( jperio /= 1 )   mbathy(nlci,:) = 0 
     764               IF( jperio /= 1 .AND. jperio /= 7 )   mbathy(nlci,:) = 0 
    744765            ENDIF 
    745766         ELSE 
    … …  
    756777         mbathy( 1 ,:) = mbathy(jpim1,:) 
    757778         mbathy(jpi,:) = mbathy(  2  ,:) 
     779         IF (jperio == 7) THEN 
     780            IF(lwp) WRITE(numout,*)' north south boundary conditions on mbathy: jperio = ', jperio 
     781            mbathy( : ,1) = mbathy(:, jpjm1) 
     782            mbathy(:, jpj)= mbathy(:,2) 
     783         ENDIF 
    758784      ELSEIF( nperio == 2 ) THEN 
    759785         IF(lwp) WRITE(numout,*) '   equatorial boundary conditions on mbathy: nperio = ', nperio 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r6519 r7309  
    9696      CHARACTER(len=19) :: cldate  
    9797      CHARACTER(len=10) :: clname 
    98       INTEGER           ::   ji 
     98      INTEGER           :: ji, jkmin 
    9999      ! 
    100100      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 
    … …  
    169169 
    170170      ! Add vertical grid bounds 
     171      jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
    171172      z_bnds(:      ,1) = gdepw_1d(:) 
    172       z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
     173      z_bnds(1:jpkm1,2) = gdepw_1d(jkmin:jpk) 
    173174      z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
    174175      CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
    175176      CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
    176177      CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
    177       z_bnds(:    ,2) = gdept_1d(:) 
    178       z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 
    179       z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1) 
     178      z_bnds(:        ,2) = gdept_1d(:) 
     179      z_bnds(jkmin:jpk,1) = gdept_1d(1:jpkm1) 
     180      z_bnds(1        ,1) = gdept_1d(1) - e3w_1d(1) 
    180181      CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
    181182 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r6140 r7309  
    3939   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1) 
    4040 
    41    INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100   !: maximum number of simultaneously opened file 
    42    INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 600 !: maximum number of variables in one file 
     41   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100  !: maximum number of simultaneously opened file 
     42   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file 
    4343   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
    4444   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r6918 r7309  
    405405                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    406406         ENDIF 
    407          !                                   ! North-South boundaries (always closed) 
    408          IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
    409                                       ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
     407                                          ! North-south cyclic 
     408         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south only with no mpp split in latitude 
     409            ptab(:,1 , :) = ptab(:, jpjm1,:) 
     410            ptab(:,jpj,:) = ptab(:,     2,:) 
     411         ELSE   !                                   ! North-South boundaries (closed) 
     412            IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
     413                                         ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
     414         ENDIF 
    410415         ! 
    411416      ENDIF 
    … …  
    608613                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north 
    609614            ENDIF 
    610             !                                   ! North-South boundaries (always closed) 
     615                                                ! Noth-South boundaries 
     616            IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south 
     617               pt2d_array(ii)%pt2d(:, 1   ) =   pt2d_array(ii)%pt2d(:, jpjm1 ) 
     618               pt2d_array(ii)%pt2d(:, jpj ) =   pt2d_array(ii)%pt2d(:, 2 )           
     619            ELSE   !              
     620               !                                   ! North-South boundaries (closed) 
    611621               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point 
    612622                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north 
    613623            ! 
    614          ENDIF 
     624            ENDIF 
     625          ENDIF 
    615626      END DO 
    616627 
    … …  
    888899                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    889900         ENDIF 
    890          !                                   ! North-South boundaries (always closed) 
     901                                            ! North-South boudaries 
     902         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south 
     903            pt2d(:,  1 ) = pt2d(:,jpjm1) 
     904            pt2d(:, jpj) = pt2d(:,    2) 
     905         ELSE     
     906         !                                   ! North-South boundaries (closed) 
    891907            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point 
    892908                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
    893          ! 
     909         ENDIF      
    894910      ENDIF 
    895911 
    … …  
    10711087                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
    10721088      ENDIF 
    1073  
    1074  
    1075       !                                      ! North-South boundaries 
     1089                                            ! North-South boundaries 
     1090      IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south 
     1091         ptab1(:,     1       ,:) = ptab1(: ,  jpjm1 , :) 
     1092         ptab1(:,   jpj       ,:) = ptab1(: ,      2 , :) 
     1093         ptab2(:,     1       ,:) = ptab2(: ,  jpjm1 , :) 
     1094         ptab2(:,   jpj       ,:) = ptab2(: ,      2 , :) 
     1095      ELSE      
     1096      !                                      ! North-South boundaries closed 
    10761097      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point 
    10771098      IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0 
    10781099                                    ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north 
    10791100                                    ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
    1080  
     1101      ENDIF      
    10811102 
    10821103      ! 2. East and west directions exchange 
    … …  
    12671288      ! Order matters Here !!!! 
    12681289      ! 
    1269       !                                      !* North-South boundaries (always colsed) 
     1290                                           ! North-South cyclic 
     1291      IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south 
     1292         pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1) 
     1293         pt2d(:, jpj   :jpj+jprj) = pt2d ( :, 2         :2+jprj) 
     1294      ELSE 
     1295         
     1296      !                                      !* North-South boundaries (closed) 
    12701297      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point 
    12711298                                   pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north 
    1272  
     1299      ENDIF 
     1300                                 
    12731301      !                                      ! East-West boundaries 
    12741302      !                                           !* Cyclic east-west 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r6412 r7309  
    7676          &              'the domain is lay out for distributed memory computing! ' ) 
    7777 
     78      IF( jperio == 7 ) CALL ctl_stop( ' jperio = 7 needs distributed memory computing ',   & 
     79          &              ' with 1 process. Add key_mpp_mpi in the list of active cpp keys ' ) 
    7880   END SUBROUTINE mpp_init 
    7981 
    … …  
    379381      ! w a r n i n g  narea (zone) /= nproc (processors)! 
    380382 
    381       IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 
     383      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 
    382384         IF( jpni == 1 )THEN 
    383385            nbondi = 2 
    … …  
    446448      ENDIF 
    447449 
     450      IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) & 
     451         &                  CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' ) 
    448452      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' ) 
    449453 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r6140 r7309  
    44   !! Ocean forcing:  analytical momentum, heat and freshwater forcings 
    55   !!===================================================================== 
    6    !! History :  3.0   ! 2006-06  (G. Madec)  Original code 
    7    !!            3.2   ! 2009-07  (G. Madec)  Style only 
     6   !! History :  3.0   ! 2006-06  (G. Madec)    Original code 
     7   !!            3.2   ! 2009-07  (G. Madec)    Style only 
     8   !!            3.7   ! 2016-10  (C. Rousset)  Add analytic for LIM3 (ana_ice) 
    89   !!---------------------------------------------------------------------- 
    910 
    … …  
    1516   USE dom_oce         ! ocean space and time domain 
    1617   USE sbc_oce         ! Surface boundary condition: ocean fields 
     18   USE sbc_ice         ! Surface boundary condition: ice   fields 
    1719   USE phycst          ! physical constants 
    1820   USE in_out_manager  ! I/O manager 
    … …  
    2022   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2123   USE lib_fortran 
    22  
     24   USE wrk_nemo 
     25#if defined key_lim3 
     26   USE ice, ONLY       : pfrld, a_i_b 
     27   USE limthd_dh       ! for CALL lim_thd_snwblow 
     28#endif 
     29    
    2330   IMPLICIT NONE 
    2431   PRIVATE 
    2532 
    26    PUBLIC   sbc_ana    ! routine called in sbcmod module 
    27    PUBLIC   sbc_gyre   ! routine called in sbcmod module 
     33   PUBLIC   sbc_ana         ! routine called in sbcmod module 
     34   PUBLIC   sbc_gyre        ! routine called in sbcmod module 
     35#if defined key_lim3 
     36   PUBLIC   ana_ice_tau     ! routine called in sbc_ice_lim module 
     37   PUBLIC   ana_ice_flx     ! routine called in sbc_ice_lim module 
     38#endif 
    2839 
    2940   !                       !!* Namelist namsbc_ana * 
    30    INTEGER  ::   nn_tau000  ! nb of time-step during which the surface stress 
    31    !                        ! increase from 0 to its nominal value  
    32    REAL(wp) ::   rn_utau0   ! constant wind stress value in i-direction 
    33    REAL(wp) ::   rn_vtau0   ! constant wind stress value in j-direction 
    34    REAL(wp) ::   rn_qns0    ! non solar heat flux 
    35    REAL(wp) ::   rn_qsr0    !     solar heat flux 
    36    REAL(wp) ::   rn_emp0    ! net freshwater flux 
     41   ! --- oce variables --- ! 
     42   INTEGER  ::   nn_tau000 ! nb of time-step during which the surface stress 
     43   !                       ! increase from 0 to its nominal value  
     44   REAL(wp) ::   rn_utau0  ! constant wind stress value in i-direction 
     45   REAL(wp) ::   rn_vtau0  ! constant wind stress value in j-direction 
     46   REAL(wp) ::   rn_qns0   ! non solar heat flux 
     47   REAL(wp) ::   rn_qsr0   !     solar heat flux 
     48   REAL(wp) ::   rn_emp0   ! net freshwater flux 
     49   ! --- ice variables --- ! 
     50   REAL(wp) ::   rn_iutau0 ! constant wind stress value in i-direction over ice 
     51   REAL(wp) ::   rn_ivtau0 ! constant wind stress value in j-direction over ice 
     52   REAL(wp) ::   rn_iqns0  ! non solar heat flux over ice 
     53   REAL(wp) ::   rn_iqsr0  !     solar heat flux over ice 
     54   REAL(wp) ::   rn_sprec0 ! snow precip 
     55   REAL(wp) ::   rn_ievap0 ! sublimation 
    3756    
    3857   !! * Substitutions 
    … …  
    6887      REAL(wp) ::   zcoef, zty, zmod      !   -      - 
    6988      !! 
    70       NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0 
     89      NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0,  & 
     90         &                 rn_iutau0, rn_ivtau0, rn_iqsr0, rn_iqns0, rn_sprec0, rn_ievap0 
    7191      !!--------------------------------------------------------------------- 
    7292      ! 
    … …  
    85105         IF(lwp) WRITE(numout,*)' sbc_ana : Constant surface fluxes read in namsbc_ana namelist' 
    86106         IF(lwp) WRITE(numout,*)' ~~~~~~~ ' 
    87          IF(lwp) WRITE(numout,*)'              spin up of the stress  nn_tau000 = ', nn_tau000, ' time-steps' 
    88          IF(lwp) WRITE(numout,*)'              constant i-stress      rn_utau0  = ', rn_utau0 , ' N/m2' 
    89          IF(lwp) WRITE(numout,*)'              constant j-stress      rn_vtau0  = ', rn_vtau0 , ' N/m2' 
    90          IF(lwp) WRITE(numout,*)'              non solar heat flux    rn_qns0   = ', rn_qns0  , ' W/m2' 
    91          IF(lwp) WRITE(numout,*)'              solar heat flux        rn_qsr0   = ', rn_qsr0  , ' W/m2' 
    92          IF(lwp) WRITE(numout,*)'              net heat flux          rn_emp0   = ', rn_emp0  , ' Kg/m2/s' 
     107         IF(lwp) WRITE(numout,*)'              spin up of the stress         nn_tau000 = ', nn_tau000 , ' time-steps' 
     108         IF(lwp) WRITE(numout,*)'              constant i-stress             rn_utau0  = ', rn_utau0  , ' N/m2' 
     109         IF(lwp) WRITE(numout,*)'              constant j-stress             rn_vtau0  = ', rn_vtau0  , ' N/m2' 
     110         IF(lwp) WRITE(numout,*)'              non solar heat flux           rn_qns0   = ', rn_qns0   , ' W/m2' 
     111         IF(lwp) WRITE(numout,*)'              solar heat flux               rn_qsr0   = ', rn_qsr0   , ' W/m2' 
     112         IF(lwp) WRITE(numout,*)'              net freshwater flux           rn_emp0   = ', rn_emp0   , ' Kg/m2/s' 
     113         IF(lwp) WRITE(numout,*)'              constant ice-atm stress       rn_iutau0 = ', rn_iutau0 , ' N/m2' 
     114         IF(lwp) WRITE(numout,*)'              constant ice-atm stress       rn_ivtau0 = ', rn_ivtau0 , ' N/m2' 
     115         IF(lwp) WRITE(numout,*)'              solar heat flux over ice      rn_iqsr0  = ', rn_iqsr0  , ' W/m2' 
     116         IF(lwp) WRITE(numout,*)'              non solar heat flux over ice  rn_iqns0  = ', rn_iqns0  , ' W/m2' 
     117         IF(lwp) WRITE(numout,*)'              snow precip                   rn_sprec0 = ', rn_sprec0 , ' Kg/m2/s' 
     118         IF(lwp) WRITE(numout,*)'              sublimation                   rn_ievap0 = ', rn_ievap0 , ' Kg/m2/s' 
    93119         ! 
    94120         nn_tau000 = MAX( nn_tau000, 1 )     ! must be >= 1 
    … …  
    132158   END SUBROUTINE sbc_ana 
    133159 
    134  
     160#if defined key_lim3 
     161   SUBROUTINE ana_ice_tau 
     162      !!--------------------------------------------------------------------- 
     163      !!                     ***  ROUTINE ana_ice_tau  *** 
     164      !! 
     165      !! ** Purpose :   provide the surface boundary (momentum) condition over sea-ice 
     166      !!--------------------------------------------------------------------- 
     167      utau_ice(:,:) = rn_iutau0 
     168      vtau_ice(:,:) = rn_ivtau0 
     169      
     170   END SUBROUTINE ana_ice_tau 
     171    
     172   SUBROUTINE ana_ice_flx 
     173      !!--------------------------------------------------------------------- 
     174      !!                     ***  ROUTINE ana_ice_flx  *** 
     175      !! 
     176      !! ** Purpose :   provide the surface boundary (flux) condition over sea-ice 
     177      !!--------------------------------------------------------------------- 
     178      REAL(wp), DIMENSION(:,:), POINTER ::   zsnw       ! snw distribution after wind blowing 
     179      !!--------------------------------------------------------------------- 
     180      CALL wrk_alloc( jpi,jpj, zsnw )  
     181 
     182      ! ocean variables (renaming) 
     183      emp_oce (:,:)   = rn_emp0 
     184      qsr_oce (:,:)   = rn_qsr0 
     185      qns_oce (:,:)   = rn_qns0 
     186       
     187      ! ice variables 
     188      alb_ice (:,:,:) = 0.7_wp ! useless 
     189      qsr_ice (:,:,:) = rn_iqsr0 
     190      qns_ice (:,:,:) = rn_iqns0 
     191      sprecip (:,:)   = rn_sprec0 
     192      evap_ice(:,:,:) = rn_ievap0 
     193 
     194      ! ice variables deduced from above 
     195      zsnw(:,:) = 1._wp 
     196      !!CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing  
     197      emp_ice  (:,:)   = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:) 
     198      emp_oce  (:,:)   = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) ) 
     199      qevap_ice(:,:,:) =   0._wp 
     200      qprec_ice(:,:)   =   rhosn * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) ! in J/m3 
     201      qemp_oce (:,:)   = - emp_oce(:,:) * sst_m(:,:) * rcp 
     202      qemp_ice (:,:)   =   sprecip(:,:) * zsnw * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) ! solid precip (only) 
     203 
     204      ! total fluxes 
     205      emp_tot (:,:) = emp_ice  + emp_oce  
     206      qns_tot (:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
     207      qsr_tot (:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
     208 
     209      !-------------------------------------------------------------------- 
     210      ! FRACTIONs of net shortwave radiation which is not absorbed in the 
     211      ! thin surface layer and penetrates inside the ice cover 
     212      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
     213      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     214      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
     215 
     216      CALL wrk_dealloc( jpi,jpj, zsnw )  
     217       
     218   END SUBROUTINE ana_ice_flx 
     219#endif 
     220 
     221    
    135222   SUBROUTINE sbc_gyre( kt ) 
    136223      !!--------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r6813 r7309  
    1616   !!            3.4  !  2011-11  (C. Harris) Fill arrays required by CICE 
    1717   !!            3.7  !  2014-06  (L. Brodeau) simplification and optimization of CORE bulk 
     18   !!            4.0  !  2016-06  (C. Rousset) Add new param of drags with sea-ice (Lupkes at al 2012) 
    1819   !!---------------------------------------------------------------------- 
    1920 
    … …  
    3839   USE lib_fortran    ! to use key_nosignedzero 
    3940#if defined key_lim3 
    40    USE ice     , ONLY :   u_ice, v_ice, jpl, pfrld, a_i_b 
     41   USE ice, ONLY      : u_ice, v_ice, jpl, pfrld, a_i_b, at_i_b 
    4142   USE limthd_dh      ! for CALL lim_thd_snwblow 
    4243#elif defined key_lim2 
    43    USE ice_2   , ONLY :  u_ice, v_ice 
    44    USE par_ice_2      ! LIM-2 parameters 
     44   USE ice_2, ONLY    : u_ice, v_ice 
     45   USE par_ice_2 
    4546#endif 
    4647   ! 
    … …  
    6162   PUBLIC   blk_ice_core_flx     ! routine called in sbc_ice_lim module 
    6263#endif 
    63    PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
     64   PUBLIC   turb_core_2z         ! routine called in sbcblk_mfs module 
    6465 
    6566   INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read 
    … …  
    7778 
    7879   !                                             !!! CORE bulk parameters 
    79    REAL(wp), PARAMETER ::   rhoa =    1.22        ! air density 
    80    REAL(wp), PARAMETER ::   cpa  = 1000.5         ! specific heat of air 
    81    REAL(wp), PARAMETER ::   Lv   =    2.5e6       ! latent heat of vaporization 
    82    REAL(wp), PARAMETER ::   Ls   =    2.839e6     ! latent heat of sublimation 
    83    REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant 
    84    REAL(wp), PARAMETER ::   Cice =    1.4e-3      ! iovi 1.63e-3     ! transfer coefficient over ice 
    85    REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be constant 
     80   REAL(wp), PARAMETER ::   rhoa   =    1.22        ! air density 
     81   REAL(wp), PARAMETER ::   cpa    = 1000.5         ! specific heat of air 
     82   REAL(wp), PARAMETER ::   Lv     =    2.5e6       ! latent heat of vaporization 
     83   REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation 
     84   REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant 
     85   REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! transfer coefficient over ice 
     86   REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant 
    8687 
    8788   !                        !!* Namelist namsbc_core : CORE bulk parameters 
    … …  
    9293   REAL(wp) ::   rn_zqt      ! z(q,t) : height of humidity and temperature measurements 
    9394   REAL(wp) ::   rn_zu       ! z(u)   : height of wind measurements 
    94  
     95   LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm and oce-atm depending on ice concentration (from Lupkes et al. JGR2012) 
     96 
     97   ! 
     98   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_oce   ! air-ocean drag (clem) 
     99    
    95100   !! * Substitutions 
    96101#  include "vectopt_loop_substitute.h90" 
    … …  
    102107CONTAINS 
    103108 
     109   INTEGER FUNCTION sbc_blk_core_alloc() 
     110      !!------------------------------------------------------------------- 
     111      !!             ***  ROUTINE sbc_blk_core_alloc (clem) *** 
     112      !!------------------------------------------------------------------- 
     113      ALLOCATE( Cd_oce(jpi,jpj) , STAT=sbc_blk_core_alloc ) 
     114      ! 
     115      IF( lk_mpp                  )   CALL mpp_sum( sbc_blk_core_alloc ) 
     116      IF( sbc_blk_core_alloc /= 0 )   CALL ctl_warn('sbc_blk_core_alloc: failed to allocate arrays') 
     117   END FUNCTION sbc_blk_core_alloc 
     118 
     119    
    104120   SUBROUTINE sbc_blk_core( kt ) 
    105121      !!--------------------------------------------------------------------- 
    … …  
    149165      TYPE(FLD_N) ::   sn_tdif                                 !   "                                 " 
    150166      NAMELIST/namsbc_core/ cn_dir , ln_taudif, rn_pfac, rn_efac, rn_vfac,  & 
    151          &                  sn_wndi, sn_wndj  , sn_humi, sn_qsr ,           & 
    152          &                  sn_qlw , sn_tair  , sn_prec, sn_snow,           & 
    153          &                  sn_tdif, rn_zqt   ,  rn_zu 
     167         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
     168         &                  sn_qlw , sn_tair, sn_prec  , sn_snow,           & 
     169         &                  sn_tdif, rn_zqt,  rn_zu    , ln_Cd_L12 
    154170      !!--------------------------------------------------------------------- 
    155171      ! 
    … …  
    157173      IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    158174         !                                      ! ====================== ! 
     175         ! 
     176         !                                      ! allocate sbc_blk_core array (clem) 
     177         IF( sbc_blk_core_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_core : unable to allocate standard arrays' ) 
    159178         ! 
    160179         REWIND( numnam_ref )              ! Namelist namsbc_core in reference namelist : CORE bulk parameters 
    … …  
    321340         &               Cd, Ch, Ce, zt_zu, zq_zu ) 
    322341     
     342      Cd_oce(:,:) = Cd(:,:)  ! record value of pure ocean-atm. drag (clem) 
     343      
    323344      ! ... tau module, i and j component 
    324345      DO jj = 1, jpj 
    … …  
    439460      !!--------------------------------------------------------------------- 
    440461      INTEGER  ::   ji, jj    ! dummy loop indices 
    441       REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2 
    442462      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f               ! relative wind module and components at F-point 
    443463      REAL(wp) ::             zwndi_t , zwndj_t               ! relative wind components at T-point 
     464      REAL(wp), DIMENSION(:,:), POINTER ::   Cd               ! transfer coefficient for momentum      (tau) 
    444465      !!--------------------------------------------------------------------- 
    445466      ! 
    446467      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_tau') 
    447468      ! 
    448       ! local scalars ( place there for vector optimisation purposes) 
    449       zcoef_wnorm  = rhoa * Cice 
    450       zcoef_wnorm2 = rhoa * Cice * 0.5 
     469      CALL wrk_alloc( jpi,jpj, Cd ) 
     470 
     471      Cd(:,:) = Cd_ice 
     472       
     473      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 
     474#if defined key_lim3 
     475      IF( ln_Cd_L12 ) THEN 
     476         CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 
     477      ENDIF 
     478#endif 
    451479 
    452480!!gm brutal.... 
    … …  
    469497               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
    470498                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj) 
    471                zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
     499               zwnorm_f = rhoa * Cd(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    472500               ! ... ice stress at I-point 
    473501               utau_ice(ji,jj) = zwnorm_f * zwndi_f 
    … …  
    478506               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   & 
    479507                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  ) 
    480                wndm_ice(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     508               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    481509            END DO 
    482510         END DO 
    … …  
    495523         DO jj = 2, jpjm1 
    496524            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    497                utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          & 
     525               utau_ice(ji,jj) = rhoa * Cd(ji,jj) * 0.5_wp * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          & 
    498526                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 
    499                vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          & 
     527               vtau_ice(ji,jj) = rhoa * Cd(ji,jj) * 0.5_wp * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          & 
    500528                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 
    501529            END DO 
    … …  
    511539         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice_core: wndm_ice : ') 
    512540      ENDIF 
     541 
     542      CALL wrk_dealloc( jpi,jpj, Cd ) 
    513543 
    514544      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_tau') 
    … …  
    542572      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
    543573      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw       ! evaporation and snw distribution after wind blowing (LIM3) 
     574      REAL(wp), DIMENSION(:,:)  , POINTER ::   Cd                ! transfer coefficient for momentum      (tau) 
    544575      !!--------------------------------------------------------------------- 
    545576      ! 
    … …  
    547578      ! 
    548579      CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )  
     580      CALL wrk_alloc( jpi,jpj, Cd ) 
     581 
     582      Cd(:,:) = Cd_ice 
     583 
     584      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 
     585#if defined key_lim3 
     586      IF( ln_Cd_L12 ) THEN 
     587         CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 
     588      ENDIF 
     589#endif 
    549590 
    550591      ! local scalars ( place there for vector optimisation purposes) 
    551592      zcoef_dqlw   = 4.0 * 0.95 * Stef 
    552       zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
    553       zcoef_dqsb   = rhoa * cpa * Cice 
     593      zcoef_dqla   = -Ls * 11637800. * (-5897.8) 
     594      zcoef_dqsb   = rhoa * cpa 
    554595 
    555596      zztmp = 1. / ( 1. - albo ) 
    … …  
    577618               ! ... turbulent heat fluxes 
    578619               ! Sensible Heat 
    579                z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
     620               z_qsb(ji,jj,jl) = rhoa * cpa * Cd(ji,jj) * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
    580621               ! Latent Heat 
    581                qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * wndm_ice(ji,jj)   &                            
     622               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cd(ji,jj) * wndm_ice(ji,jj)   &                            
    582623                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    583624              ! Latent heat sensitivity for ice (Dqla/Dt) 
    584625               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
    585                   dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) ) 
     626                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Cd(ji,jj) * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) ) 
    586627               ELSE 
    587628                  dqla_ice(ji,jj,jl) = 0._wp 
    … …  
    589630 
    590631               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    591                z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj) 
     632               z_dqsb(ji,jj,jl) = zcoef_dqsb * Cd(ji,jj) * wndm_ice(ji,jj) 
    592633 
    593634               ! ----------------------------! 
    … …  
    668709 
    669710      CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
     711      CALL wrk_dealloc( jpi,jpj, Cd ) 
    670712      ! 
    671713      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_flx') 
    … …  
    905947   END FUNCTION psi_h 
    906948 
     949 
     950#if defined key_lim3 
     951   SUBROUTINE Cdn10_Lupkes2012( Cd ) 
     952      !!---------------------------------------------------------------------- 
     953      !!                      ***  ROUTINE  Cdn10_Lupkes2012  *** 
     954      !! 
     955      !! ** Purpose :    Recompute the ice-atm drag at 10m height to make 
     956      !!                 it dependent on edges at leads, melt ponds and flows. 
     957      !!                 After some approximations, this can be resumed to a dependency 
     958      !!                 on ice concentration. 
     959      !!                 
     960      !! ** Method :     The parameterization is taken from Lupkes et al. (2012) eq.(50) 
     961      !!                 with the highest level of approximation: level4, eq.(59) 
     962      !!                 The generic drag over a cell partly covered by ice can be re-written as follows: 
     963      !! 
     964      !!                 Cd = Cdw * (1-A) + Cdi * A + Ce * (1-A)**(nu+1/(10*beta)) * A**mu 
     965      !! 
     966      !!                    Ce = 2.23e-3       , as suggested by Lupkes (eq. 59) 
     967      !!                    nu = mu = beta = 1 , as suggested by Lupkes (eq. 59) 
     968      !!                    A is the concentration of ice minus melt ponds (if any) 
     969      !! 
     970      !!                 This new drag has a parabolic shape (as a function of A) starting at 
     971      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5  
     972      !!                 and going down to Cdi(say 1.4e-3) for A=1 
     973      !! 
     974      !!                 It is theoretically applicable to all ice conditions (not only MIZ) 
     975      !!                 => see Lupkes et al (2013) 
     976      !! 
     977      !! ** References : Lupkes et al. JGR 2012 (theory) 
     978      !!                 Lupkes et al. GRL 2013 (application to GCM) 
     979      !! 
     980      !!---------------------------------------------------------------------- 
     981      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd 
     982      REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp 
     983      REAL(wp), PARAMETER ::   znu   = 1._wp 
     984      REAL(wp), PARAMETER ::   zmu   = 1._wp 
     985      REAL(wp), PARAMETER ::   zbeta = 1._wp 
     986      REAL(wp)            ::   zcoef 
     987      !!---------------------------------------------------------------------- 
     988      zcoef = znu + 1._wp / ( 10._wp * zbeta ) 
     989 
     990      ! generic drag over a cell partly covered by ice 
     991      !!Cd(:,:) = Cd_oce(:,:) * ( 1._wp - at_i_b(:,:) ) +  &                        ! pure ocean drag 
     992      !!   &      Cd_ice      *           at_i_b(:,:)   +  &                        ! pure ice drag 
     993      !!   &      zCe         * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**zmu   ! change due to sea-ice morphology 
     994 
     995      ! ice-atm drag 
     996      Cd(:,:) = Cd_ice +  &                                                          ! pure ice drag 
     997         &      zCe    * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)   ! change due to sea-ice morphology 
     998       
     999   END SUBROUTINE Cdn10_Lupkes2012 
     1000#endif 
     1001    
    9071002   !!====================================================================== 
    9081003END MODULE sbcblk_core 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r6722 r7309  
    168168#  include "vectopt_loop_substitute.h90" 
    169169   !!---------------------------------------------------------------------- 
    170    !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     170   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    171171   !! $Id$ 
    172172   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    15991599      ENDIF 
    16001600 
    1601       !! clem: we should output qemp_oce and qemp_ice (at least) 
    1602       IF( iom_use('hflx_snow_cea') )   CALL iom_put( 'hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) )   ! heat flux from snow (cell average) 
    1603       !! these diags are not outputed yet 
    1604 !!      IF( iom_use('hflx_rain_cea') )   CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) )   ! heat flux from rain (cell average) 
    1605 !!      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put( 'hflx_snow_ao_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 
    1606 !!      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 
     1601      ! some more outputs 
     1602      IF( iom_use('hflx_snow_cea') )    CALL iom_put('hflx_snow_cea',   sprecip(:,:) * ( zcptn(:,:) - Lfus ) )                       ! heat flux from snow (cell average) 
     1603      IF( iom_use('hflx_rain_cea') )    CALL iom_put('hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) )                 ! heat flux from rain (cell average) 
     1604      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 
     1605      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) )           ! heat flux from snow (cell average) 
    16071606 
    16081607#else 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r6416 r7309  
    2424   USE ice             ! LIM-3: ice variables 
    2525   USE thd_ice         ! LIM-3: thermodynamical variables 
    26    USE dom_ice         ! LIM-3: ice domain 
    2726   ! 
    2827   USE sbc_oce         ! Surface boundary condition: ocean fields 
    … …  
    3130   USE sbcblk_clio     ! Surface boundary condition: CLIO bulk 
    3231   USE sbccpl          ! Surface boundary condition: coupled interface 
     32   USE sbcana          ! Surface boundary condition: analytic formulation 
    3333   USE albedo          ! ocean & ice albedo 
    3434   ! 
    … …  
    4848   USE limvar          ! Ice variables switch 
    4949   USE limctl          !  
    50    USE limmsh          ! LIM mesh 
    5150   USE limistate       ! LIM initial state 
    5251   USE limthd_sal      ! LIM ice thermodynamics: salinity 
    … …  
    6564   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine) 
    6665#endif 
     66# if defined key_agrif 
     67   USE agrif_ice 
     68   USE agrif_lim3_update 
     69   USE agrif_lim3_interp 
     70# endif 
    6771 
    6872   IMPLICIT NONE 
    … …  
    102106      !!--------------------------------------------------------------------- 
    103107      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    104       INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED) 
    105       !! 
    106       INTEGER  ::    jl                 ! dummy loop index 
     108      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=1 ANALYTIC, =3 CLIO, =4 CORE, =5 COUPLED) 
     109      !! 
     110      INTEGER  ::   jl                 ! dummy loop index 
    107111      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    108112      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice  
    … …  
    110114 
    111115      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
     116 
     117      ! clem: it is important to initialize agrif_lim3 variables here and not in sbc_lim_init 
     118# if defined key_agrif 
     119      IF( kt == nit000 ) THEN 
     120         IF( .NOT. Agrif_Root() )   CALL Agrif_InitValues_cont_lim3 
     121      ENDIF 
     122# endif 
    112123 
    113124      !-----------------------! 
    … …  
    115126      !-----------------------! 
    116127      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
     128 
     129# if defined key_agrif 
     130         IF( .NOT. Agrif_Root() )  lim_nbstep = MOD( lim_nbstep, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1 
     131# endif 
    117132 
    118133         ! mean surface ocean current at ice velocity point (C-grid dynamics :  U- & V-points as the ocean) 
    … …  
    136151         !----------------------------------------------------------------- 
    137152         SELECT CASE( kblk ) 
    138          CASE( jp_clio    )   ;   CALL blk_ice_clio_tau                         ! CLIO bulk formulation             
    139          CASE( jp_core    )   ;   CALL blk_ice_core_tau                         ! CORE bulk formulation 
    140          CASE( jp_purecpl )   ;   CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation 
     153            CASE( jp_ana     )   ;    CALL ana_ice_tau                              ! analytic formulation             
     154            CASE( jp_clio    )   ;    CALL blk_ice_clio_tau                         ! CLIO bulk formulation             
     155            CASE( jp_core    )   ;    CALL blk_ice_core_tau                         ! CORE bulk formulation 
     156            CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation 
    141157         END SELECT 
    142158          
    143          IF( ln_mixcpl) THEN   ! Case of a mixed Bulk/Coupled formulation 
     159         IF( ln_mixcpl) THEN                                                       ! Case of a mixed Bulk/Coupled formulation 
    144160            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice) 
    145             CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     161                                      CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    146162            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
    147163            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
    … …  
    154170         numit = numit + nn_fsbc                  ! Ice model time step 
    155171         !                                                    
    156          CALL sbc_lim_bef                         ! Store previous ice values 
    157          CALL sbc_lim_diag0                       ! set diag of mass, heat and salt fluxes to 0 
    158          CALL lim_rst_opn( kt )                   ! Open Ice restart file 
    159          ! 
    160          IF( .NOT. lk_c1d ) THEN 
     172                                      CALL sbc_lim_bef         ! Store previous ice values 
     173                                      CALL sbc_lim_diag0       ! set diag of mass, heat and salt fluxes to 0 
     174                                      CALL lim_rst_opn( kt )   ! Open Ice restart file 
     175         ! 
     176         ! --- zap this if no ice dynamics --- ! 
     177         IF( .NOT. lk_c1d .AND. ln_limdyn ) THEN 
    161178            ! 
    162             CALL lim_dyn( kt )                    ! Ice dynamics    ( rheology/dynamics )    
    163             ! 
    164             CALL lim_trp( kt )                    ! Ice transport   ( Advection/diffusion ) 
    165             ! 
    166             IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 
    167             ! 
    168 #if defined key_bdy 
    169             CALL bdy_ice_lim( kt )                ! bdy ice thermo  
    170             IF( ln_icectl )       CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
    171 #endif 
    172             ! 
    173             CALL lim_update1( kt )                ! Corrections 
     179            IF( nn_limdyn /= 0 ) THEN                          ! -- Ice dynamics 
     180                                      CALL lim_dyn( kt )       !     rheology   
     181            ELSE 
     182               u_ice(:,:) = rn_uice * umask(:,:,1)             !     or prescribed velocity 
     183               v_ice(:,:) = rn_vice * vmask(:,:,1) 
     184            ENDIF 
     185                                      CALL lim_trp( kt )       ! -- Ice transport (Advection/diffusion) 
     186            IF( nn_limdyn == 2 .AND. nn_monocat /= 2 )  &      ! -- Mechanical redistribution (ridging/rafting) 
     187               &                      CALL lim_itd_me          
     188            IF( nn_limdyn == 2 )      CALL lim_update1( kt )   ! -- Corrections 
    174189            ! 
    175190         ENDIF 
    176           
     191 
     192         ! --- 
     193#if defined key_agrif 
     194         IF( .NOT. Agrif_Root() )     CALL agrif_interp_lim3('T') 
     195#endif 
     196#if defined key_bdy 
     197         IF( ln_limthd )              CALL bdy_ice_lim( kt )   ! -- bdy ice thermo  
     198#endif 
     199 
    177200         ! previous lead fraction and ice volume for flux calculations 
    178          CALL sbc_lim_bef                         
    179          CALL lim_var_glo2eqv                     ! ht_i and ht_s for ice albedo calculation 
    180          CALL lim_var_agg(1)                      ! at_i for coupling (via pfrld)  
     201                                      CALL sbc_lim_bef                         
     202                                      CALL lim_var_glo2eqv     ! ht_i and ht_s for ice albedo calculation 
     203                                      CALL lim_var_agg(1)      ! at_i for coupling (via pfrld)  
     204         ! 
    181205         pfrld(:,:)   = 1._wp - at_i(:,:) 
    182206         phicif(:,:)  = vt_i(:,:) 
    … …  
    193217         !---------------------------------------------------------------------------------------- 
    194218         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 
    195          CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    196  
     219          
     220                                      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    197221         SELECT CASE( kblk ) 
    198          CASE( jp_clio )                                       ! CLIO bulk formulation 
    199             ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
    200             ! (alb_ice) is computed within the bulk routine 
    201                                  CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 
    202             IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    203             IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    204          CASE( jp_core )                                       ! CORE bulk formulation 
    205             ! albedo depends on cloud fraction because of non-linear spectral effects 
    206             alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    207                                  CALL blk_ice_core_flx( t_su, alb_ice ) 
    208             IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    209             IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    210          CASE ( jp_purecpl ) 
    211             ! albedo depends on cloud fraction because of non-linear spectral effects 
    212             alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    213                                  CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    214             IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     222 
     223            CASE( jp_ana )                                        ! analytic formulation 
     224                                      CALL ana_ice_flx 
     225                
     226            CASE( jp_clio )                                       ! CLIO bulk formulation 
     227               ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     228               ! (alb_ice) is computed within the bulk routine 
     229                                      CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 
     230               IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
     231               IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     232                
     233            CASE( jp_core )                                       ! CORE bulk formulation 
     234               ! albedo depends on cloud fraction because of non-linear spectral effects 
     235               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     236                                      CALL blk_ice_core_flx( t_su, alb_ice ) 
     237               IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
     238               IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     239                
     240            CASE ( jp_purecpl )                                    ! Coupled formulation 
     241               ! albedo depends on cloud fraction because of non-linear spectral effects 
     242               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     243                                      CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
     244               IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     245 
    215246         END SELECT 
     247 
    216248         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 
    217249 
    … …  
    219251         ! --- ice thermodynamics --- ! 
    220252         !----------------------------! 
    221          CALL lim_thd( kt )                         ! Ice thermodynamics       
    222          ! 
    223          CALL lim_update2( kt )                     ! Corrections 
    224          ! 
    225          CALL lim_sbc_flx( kt )                     ! Update surface ocean mass, heat and salt fluxes 
    226          ! 
    227          IF(ln_limdiaout) CALL lim_diahsb           ! Diagnostics and outputs  
    228          ! 
    229          CALL lim_wri( 1 )                          ! Ice outputs  
     253         ! --- zap this if no ice thermo --- ! 
     254         IF( ln_limthd )              CALL lim_thd( kt )        ! -- Ice thermodynamics       
     255         IF( ln_limthd )              CALL lim_update2( kt )    ! -- Corrections 
     256         ! --- 
     257# if defined key_agrif 
     258         IF( .NOT. Agrif_Root() )     CALL agrif_update_lim3( kt ) 
     259# endif 
     260                                      CALL lim_var_glo2eqv      ! necessary calls (at least for coupling) 
     261                                      CALL lim_var_agg( 2 )     ! necessary calls (at least for coupling) 
     262                                      ! 
     263# if defined key_agrif 
     264!!         IF( .NOT. Agrif_Root() )     CALL Agrif_ChildGrid_To_ParentGrid()  ! clem: should be called at the update frequency only (cf agrif_lim3_update) 
     265# endif 
     266                                      CALL lim_sbc_flx( kt )    ! -- Update surface ocean mass, heat and salt fluxes 
     267# if defined key_agrif 
     268!!         IF( .NOT. Agrif_Root() )     CALL Agrif_ParentGrid_To_ChildGrid()  ! clem: should be called at the update frequency only (cf agrif_lim3_update) 
     269# endif 
     270         IF( ln_limdiahsb )           CALL lim_diahsb( kt )     ! -- Diagnostics and outputs  
     271         ! 
     272                                      CALL lim_wri( 1 )         ! -- Ice outputs  
    230273         ! 
    231274         IF( kt == nit000 .AND. ln_rstart )   & 
    232             &             CALL iom_close( numrir )  ! close input ice restart file 
    233          ! 
    234          IF( lrst_ice )   CALL lim_rst_write( kt )  ! Ice restart file  
    235          ! 
    236          IF( ln_icectl )  CALL lim_ctl( kt )        ! alerts in case of model crash 
     275            &                         CALL iom_close( numrir )  ! close input ice restart file 
     276         ! 
     277         IF( lrst_ice )               CALL lim_rst_write( kt )  ! -- Ice restart file  
     278         ! 
     279         IF( ln_limctl )              CALL lim_ctl( kt )        ! alerts in case of model crash 
    237280         ! 
    238281      ENDIF   ! End sea-ice time step only 
    … …  
    242285      !-------------------------! 
    243286      ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere 
    244       IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
     287      !    using before instantaneous surf. currents 
     288      IF( ln_limdyn )                 CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) 
    245289!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    246290      ! 
    … …  
    259303      !!---------------------------------------------------------------------- 
    260304      IF(lwp) WRITE(numout,*) 
    261       IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition'  
     305      IF(lwp) WRITE(numout,*) 'sbc_lim_init : update ocean surface boudary condition'  
    262306      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping' 
    263307      ! 
    … …  
    271315      !                                ! Allocate the ice arrays 
    272316      ierr =        ice_alloc        ()      ! ice variables 
    273       ierr = ierr + dom_ice_alloc    ()      ! domain 
    274317      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing 
    275318      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics 
    276       ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics 
     319      IF( ln_limdyn )   ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics 
    277320      ! 
    278321      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    279322      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays') 
    280323      ! 
    281       !                                ! adequation jpk versus ice/snow layers/categories 
    282       IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk )   & 
    283          &      CALL ctl_stop( 'STOP',                          & 
    284          &     'sbc_lim_init: the 3rd dimension of workspace arrays is too small.',   & 
    285          &     'use more ocean levels or less ice/snow layers/categories.' ) 
     324      CALL lim_dyn_init                ! set ice dynamics parameters 
    286325      ! 
    287326      CALL lim_itd_init                ! ice thickness distribution initialization 
    … …  
    293332      CALL lim_thd_sal_init            ! set ice salinity parameters 
    294333      ! 
    295       CALL lim_msh                     ! ice mesh initialization 
    296       ! 
    297       CALL lim_itd_me_init             ! ice thickness distribution initialization for mecanical deformation 
     334      IF( ln_limdyn )   CALL lim_itd_me_init             ! ice thickness distribution initialization for mecanical deformation 
    298335      !                                ! Initial sea-ice state 
    299336      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst 
    … …  
    305342         numit = nit000 - 1 
    306343      ENDIF 
    307       CALL lim_var_agg(1) 
     344      CALL lim_var_agg(2) 
    308345      CALL lim_var_glo2eqv 
    309346      ! 
    310347      CALL lim_sbc_init                 ! ice surface boundary condition    
     348      ! 
     349      IF( ln_limdiahsb) CALL lim_diahsb_init  ! initialization for diags 
    311350      ! 
    312351      fr_i(:,:)     = at_i(:,:)         ! initialisation of sea-ice fraction 
    … …  
    342381      !!------------------------------------------------------------------- 
    343382      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    344       NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  & 
    345          &                ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt   
     383      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, rn_amax_n, rn_amax_s, cn_icerst_in, cn_icerst_indir,   & 
     384         &                cn_icerst_out, cn_icerst_outdir, ln_limthd, ln_limdyn, nn_limdyn, rn_uice, rn_vice   
     385      NAMELIST/namicediag/ ln_limdiachk, ln_limdiahsb, ln_limctl, iiceprt, jiceprt   
    346386      !!------------------------------------------------------------------- 
    347387      !                     
    348388      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice 
    349389      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 
    350 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 
    351       ! 
     390901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 
     391 
    352392      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice 
    353393      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 
    354 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 
    355       IF(lwm) WRITE( numoni, namicerun ) 
     394902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 
     395      IF(lwm) WRITE ( numoni, namicerun ) 
     396      ! 
     397      REWIND( numnam_ice_ref )              ! Namelist namicediag in reference namelist : Parameters for ice 
     398      READ  ( numnam_ice_ref, namicediag, IOSTAT = ios, ERR = 903) 
     399903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in reference namelist', lwp ) 
     400 
     401      REWIND( numnam_ice_cfg )              ! Namelist namicediag in configuration namelist : Parameters for ice 
     402      READ  ( numnam_ice_cfg, namicediag, IOSTAT = ios, ERR = 904 ) 
     403904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in configuration namelist', lwp ) 
     404      IF(lwm) WRITE ( numoni, namicediag ) 
    356405      ! 
    357406      IF(lwp) THEN                        ! control print 
    … …  
    362411         WRITE(numout,*) '   number of ice  layers                                   = ', nlay_i 
    363412         WRITE(numout,*) '   number of snow layers                                   = ', nlay_s 
    364          WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn 
    365413         WRITE(numout,*) '   maximum ice concentration for NH                        = ', rn_amax_n  
    366414         WRITE(numout,*) '   maximum ice concentration for SH                        = ', rn_amax_s 
    367          WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb 
    368          WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout 
    369          WRITE(numout,*) '   control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 
    370          WRITE(numout,*) '   i-index for control prints (ln_icectl=true)             = ', iiceprt 
    371          WRITE(numout,*) '   j-index for control prints (ln_icectl=true)             = ', jiceprt 
     415         WRITE(numout,*) '   Ice thermodynamics (T) or not (F)            ln_limthd  = ', ln_limthd 
     416         WRITE(numout,*) '   Ice dynamics       (T) or not (F)            ln_limdyn  = ', ln_limdyn 
     417         WRITE(numout,*) '     (ln_limdyn=T) Ice dynamics switch          nn_limdyn  = ', nn_limdyn 
     418         WRITE(numout,*) '       2: total' 
     419         WRITE(numout,*) '       1: advection only (no diffusion, no ridging/rafting)' 
     420         WRITE(numout,*) '       0: advection only (as 1 + prescribed velocity, bypass rheology)' 
     421         WRITE(numout,*) '     (ln_limdyn=T) prescribed u-vel (case nn_limdyn=0)     = ', rn_uice 
     422         WRITE(numout,*) '     (ln_limdyn=T) prescribed v-vel (case nn_limdyn=0)     = ', rn_vice 
     423         WRITE(numout,*) 
     424         WRITE(numout,*) '...and ice diagnostics' 
     425         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~' 
     426         WRITE(numout,*) '   Diagnose online heat/mass/salt budget     ln_limdiachk  = ', ln_limdiachk 
     427         WRITE(numout,*) '   Output          heat/mass/salt budget     ln_limdiahsb  = ', ln_limdiahsb 
     428         WRITE(numout,*) '   control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_limctl 
     429         WRITE(numout,*) '   i-index for control prints (ln_limctl=true)             = ', iiceprt 
     430         WRITE(numout,*) '   j-index for control prints (ln_limctl=true)             = ', jiceprt 
    372431      ENDIF 
    373432      ! 
    374433      ! sea-ice timestep and inverse 
    375       rdt_ice   = nn_fsbc * rdt   
     434      rdt_ice   = REAL(nn_fsbc) * rdt   
    376435      r1_rdtice = 1._wp / rdt_ice  
    377436 
    … …  
    381440      ! 
    382441#if defined key_bdy 
    383       IF( lwp .AND. ln_limdiahsb )  CALL ctl_warn('online conservation check activated but it does not work with BDY') 
     442      IF( lwp .AND. ln_limdiachk )  CALL ctl_warn('online conservation check activated but it does not work with BDY') 
    384443#endif 
     444      ! 
     445      IF( lwp ) WRITE(numout,*) '   ice timestep rdt_ice  = ', rdt_ice 
    385446      ! 
    386447   END SUBROUTINE ice_run 
    … …  
    404465      ! 
    405466      REWIND( numnam_ice_ref )              ! Namelist namiceitd in reference namelist : Parameters for ice 
    406       READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903) 
    407 903   IF( ios /= 0 )  CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 
    408       ! 
     467      READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 905) 
     468905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 
     469 
    409470      REWIND( numnam_ice_cfg )              ! Namelist namiceitd in configuration namelist : Parameters for ice 
    410       READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 ) 
    411 904   IF( ios /= 0 )  CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 
    412       IF(lwm) WRITE( numoni, namiceitd ) 
     471      READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 906 ) 
     472906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 
     473      IF(lwm) WRITE ( numoni, namiceitd ) 
    413474      ! 
    414475      IF(lwp) THEN                        ! control print 
    415476         WRITE(numout,*) 
    416          WRITE(numout,*) 'ice_itd : ice cat distribution' 
    417          WRITE(numout,*) ' ~~~~~~' 
    418          WRITE(numout,*) '   shape of ice categories distribution                     nn_catbnd = ', nn_catbnd 
    419          WRITE(numout,*) '   mean ice thickness in the domain (used if nn_catbnd=2)  rn_himean = ', rn_himean 
     477         WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 
     478         WRITE(numout,*) '~~~~~~~~~~~~' 
     479         WRITE(numout,*) '   shape of ice categories distribution                          nn_catbnd = ', nn_catbnd 
     480         WRITE(numout,*) '   mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean 
    420481      ENDIF 
    421482      ! 
    … …  
    423484      !- Thickness categories boundaries  
    424485      !---------------------------------- 
    425       IF(lwp) WRITE(numout,*) 
    426       IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 
    427       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    428       ! 
    429486      hi_max(:) = 0._wp 
    430487      ! 
    … …  
    463520 
    464521    
    465    SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice ,    & 
    466       &                    pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 
     522   SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 
    467523      !!--------------------------------------------------------------------- 
    468524      !!                  ***  ROUTINE ice_lim_flx  *** 
    … …  
    557613      u_ice_b(:,:)     = u_ice(:,:) 
    558614      v_ice_b(:,:)     = v_ice(:,:) 
    559       !       
     615      at_i_b (:,:)     = SUM( a_i_b(:,:,:), dim=3 ) 
     616       
    560617   END SUBROUTINE sbc_lim_bef 
    561618 
    … …  
    569626      !!---------------------------------------------------------------------- 
    570627      sfx    (:,:) = 0._wp   ; 
    571       sfx_bri(:,:) = 0._wp   ;  
     628      sfx_bri(:,:) = 0._wp   ;   sfx_lam(:,:) = 0._wp 
    572629      sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
    573630      sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
    … …  
    580637      wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
    581638      wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
    582       wfx_spr(:,:) = 0._wp   ;    
    583       ! 
     639      wfx_spr(:,:) = 0._wp   ;   wfx_lam(:,:) = 0._wp   
     640       
    584641      hfx_thd(:,:) = 0._wp   ;    
    585642      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
    … …  
    597654      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp ; 
    598655      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp ; 
    599       ! 
     656 
     657      tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here) 
     658       
    600659   END SUBROUTINE sbc_lim_diag0 
    601660 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r6460 r7309  
    115115      ! 
    116116      !                          ! overwrite namelist parameter using CPP key information 
    117       IF( Agrif_Root() ) THEN                ! AGRIF zoom 
    118         IF( lk_lim2 )   nn_ice      = 2 
    119         IF( lk_lim3 )   nn_ice      = 3 
    120         IF( lk_cice )   nn_ice      = 4 
    121       ENDIF 
    122       IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration 
    123           ln_ana      = .TRUE.    
    124           nn_ice      =   0 
    125       ENDIF 
    126       ! 
     117#if defined key_agrif 
     118      IF( Agrif_Root() ) THEN                ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid) 
     119         IF( lk_lim2 )   nn_ice      = 2 
     120         IF( lk_lim3 )   nn_ice      = 3 
     121         IF( lk_cice )   nn_ice      = 4 
     122      ENDIF 
     123#else 
     124      IF( lk_lim2 )   nn_ice      = 2 
     125      IF( lk_lim3 )   nn_ice      = 3 
     126      IF( lk_cice )   nn_ice      = 4      
     127#endif 
     128 
     129      IF( cp_cfg == 'gyre' )   ln_ana = .TRUE.          ! GYRE configuration 
     130              
    127131      IF(lwp) THEN               ! Control print 
    128132         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)' 
    … …  
    200204 
    201205      !                                            ! restartability    
    202       IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   & 
    203          &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
    204206      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   & 
    205207         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r7048 r7309  
    205205         DO jj = 2, jpjm1 
    206206            DO ji = fs_2, fs_jpim1 
    207                IF( fsdept(ji,jj,jk) < ekm_dep(ji,jj) ) THEN 
     207               IF( gdept_n(ji,jj,jk) < ekm_dep(ji,jj) ) THEN 
    208208                  avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix ) 
    209209                  avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), rn_wvmix ) 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r6140 r7309  
    2525 
    2626   PUBLIC   glob_sum      ! used in many places (masked with tmask_i) 
    27    PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie omly over the halos) 
     27   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie only over the halos) 
    2828   PUBLIC   DDPDD         ! also used in closea module 
    2929   PUBLIC   glob_min, glob_max 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r6152 r7309  
    104104 
    105105   !!---------------------------------------------------------------------- 
    106    !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     106   !! NEMO/OPA 3.7 , NEMO Consortium (2016) 
    107107   !! $Id$ 
    108108   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    141141# endif 
    142142# if defined key_lim2 
    143       CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
     143      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM2 
     144# endif 
     145# if defined key_lim3 
     146      CALL Agrif_Declare_Var_lim3  !  "      "   "   "      "  LIM3 
    144147# endif 
    145148#endif 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/step.F90

    r6464 r7309  
    295295      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors 
    296296      ! 
     297      IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics 
    297298 
    298299!!gm : This does not only concern the dynamics ==>>> add a new title 
    … …  
    316317      ENDIF 
    317318#endif 
    318       IF( ln_diahsb  )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics 
    319319      IF( ln_diaobs  )   CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    320320 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    r6140 r7309  
    268268 
    269269      ! since we no longer call rst_opn, need to define nitrst here, used by ice restart routine 
    270       IF( kt == nit000 ) nitrst = nitend 
     270      IF( kt == nit000 )  THEN 
     271         nitrst = nitend 
     272         lrst_oce = .FALSE.  ! init restart ocean (done in rst_opn when not SAS) 
     273      ENDIF 
     274 
    271275      IF( MOD( kt - 1, nstock ) == 0 ) THEN 
    272276         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r6165 r7309  
    4949   USE step            ! NEMO time-stepping                 (stp     routine) 
    5050   USE lib_mpp         ! distributed memory computing 
    51 #if defined key_nosignedzero 
    5251   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    53 #endif 
    5452#if defined key_iomput 
    5553   USE xios 
    … …  
    5856   USE sbcssm 
    5957   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
     58   USE icbini          ! handle bergs, initialisation 
    6059   USE icbstp          ! handle bergs, calving, themodynamics and transport 
    61 #if defined key_bdy 
     60 
    6261   USE bdyini          ! open boundary cond. setting       (bdy_init routine). clem: mandatory for LIM3 
    63    USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine). clem: mandatory for LIM3 
    64 #endif 
     62   USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine)           - - 
    6563   USE bdy_par 
    66  
     64    
    6765   IMPLICIT NONE 
    6866   PRIVATE 
    … …  
    9896      ! 
    9997#if defined key_agrif 
    100       CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
    101 #endif 
    102  
     98     CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
     99#endif 
     100       
    103101      !                            !-----------------------! 
    104102      CALL nemo_init               !==  Initialisations  ==! 
    … …  
    113111      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
    114112# endif 
     113# if defined key_lim3 
     114      CALL Agrif_Declare_Var_lim3  !  "      "   "   "      "  LIM3 
     115# endif 
    115116#endif 
    116117      ! check that all process are still there... If some process have an error, 
    … …  
    124125      !                            !-----------------------! 
    125126      istp = nit000 
     127 
     128#if defined key_agrif 
     129          CALL Agrif_Regrid() 
     130#endif 
    126131         
    127132      DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    128133#if defined key_agrif 
    129          CALL Agrif_Step( stp )           ! AGRIF: time stepping 
     134         CALL stp                         ! AGRIF: time stepping 
    130135#else 
    131136         CALL stp( istp )                 ! standard time stepping 
    … …  
    148153      ! 
    149154#if defined key_agrif 
    150       CALL Agrif_ParentGrid_To_ChildGrid() 
    151       IF( nn_timing == 1 )   CALL timing_finalize 
    152       CALL Agrif_ChildGrid_To_ParentGrid() 
     155      IF( .NOT. Agrif_Root() ) THEN 
     156         CALL Agrif_ParentGrid_To_ChildGrid() 
     157         IF( nn_timing == 1 )   CALL timing_finalize 
     158         CALL Agrif_ChildGrid_To_ParentGrid() 
     159      ENDIF 
    153160#endif 
    154161      IF( nn_timing == 1 )   CALL timing_finalize 
    … …  
    287294         jpnij = jpni*jpnj 
    288295#endif 
    289       END IF 
     296      ENDIF 
    290297 
    291298      ! Calculate domain dimensions given calculated jpni and jpnj 
    … …  
    301308#endif 
    302309      ENDIF 
    303          jpk = jpkdta                                             ! third dim 
     310#if defined key_sas2D 
     311         jpk = 1                                             ! third dim 
     312         jpkm1 = 1                                           !   "           " 
     313#else 
     314         jpk = jpkdta                                        ! third dim 
     315         jpkm1 = jpk-1                                       !   "           " 
     316#endif 
     317#if defined key_agrif 
     318         ! simple trick to use same vertical grid as parent 
     319         ! but different number of levels:  
     320         ! Save maximum number of levels in jpkdta, then define all vertical grids 
     321         ! with this number. 
     322         ! Suppress once vertical online interpolation is ok 
     323         IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta) 
     324#endif 
    304325         jpim1 = jpi-1                                            ! inner domain indices 
    305326         jpjm1 = jpj-1                                            !   "           " 
    306          jpkm1 = jpk-1                                            !   "           " 
    307327         jpij  = jpi*jpj                                          !  jpi x j 
    308328 
    … …  
    330350      ENDIF 
    331351 
    332       ! Now we know the dimensions of the grid and numout has been set we can  
    333       ! allocate arrays 
     352      ! Now we know the dimensions of the grid and numout has been set we can allocate arrays 
    334353      CALL nemo_alloc() 
    335354 
    … …  
    353372                            CALL dom_init   ! Domain 
    354373 
    355       IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
    356  
    357       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
     374     IF( ln_nnogather )     CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
     375 
     376      IF( ln_ctl      )     CALL prt_ctl_init   ! Print control 
    358377                            CALL day_init   ! model calendar (using both namelist and restart infos) 
    359378 
    360379                            CALL sbc_init   ! Forcings : surface module  
    361                              
     380 
    362381      ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from   
    363382      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.  
    … …  
    366385      IF( lk_bdy        )   CALL bdy_dta_init 
    367386      ! ==> 
     387                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
    368388       
    369389      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
    … …  
    514534      USE diawri    , ONLY: dia_wri_alloc 
    515535      USE dom_oce   , ONLY: dom_oce_alloc 
     536      USE oce  
    516537#if defined key_bdy    
    517538      USE bdy_oce   , ONLY: bdy_oce_alloc 
    518       USE oce         ! clem: mandatory for LIM3 because needed for bdy arrays 
    519 #else 
    520       USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    521 #endif 
    522       ! 
    523       INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7,ierr8 
    524       INTEGER :: jpm 
     539#endif 
     540      ! 
     541      INTEGER :: ierr 
    525542      !!---------------------------------------------------------------------- 
    526543      ! 
    527544      ierr =        dia_wri_alloc   () 
    528545      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
     546      ierr = ierr + oce_alloc       ()          ! (tsn...) needed for agrif and/or lim3 and bdy 
    529547#if defined key_bdy 
    530548      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization) 
    531       ierr = ierr + oce_alloc       ()          ! (tsn...) 
    532 #endif 
    533  
    534 #if ! defined key_bdy 
    535        ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
    536          &      snwice_fmass(jpi,jpj)  , STAT= ierr1 ) 
    537       ! 
    538       ! lim code currently uses surface temperature and salinity in tsn array for initialisation 
    539       ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use 
    540       ! clem: should not be needed. To be checked out 
    541       jpm = MAX(jp_tem, jp_sal) 
    542       ALLOCATE( tsn(jpi,jpj,1,jpm)  , STAT=ierr2 ) 
    543       ALLOCATE( ub(jpi,jpj,1)       , STAT=ierr3 ) 
    544       ALLOCATE( vb(jpi,jpj,1)       , STAT=ierr4 ) 
    545       ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 ) 
    546       ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 ) 
    547       ALLOCATE( un(jpi,jpj,1)       , STAT=ierr7 ) 
    548       ALLOCATE( vn(jpi,jpj,1)       , STAT=ierr8 ) 
    549       ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 + ierr7 + ierr8 
    550549#endif 
    551550      ! 
    … …  
    618617      INTEGER :: ifac, jl, inu 
    619618      INTEGER, PARAMETER :: ntest = 14 
    620       INTEGER :: ilfax(ntest) 
     619      INTEGER, DIMENSION(ntest) :: ilfax 
     620      !!---------------------------------------------------------------------- 
    621621      ! 
    622622      ! lfax contains the set of allowed factors. 
    623       data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    624          &                            128,   64,   32,   16,    8,   4,   2  / 
    625       !!---------------------------------------------------------------------- 
     623      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    626624 
    627625      ! Clear the error flag and initialise output vars 
    … …  
    721719                   nsndto = nsndto + 1 
    722720                   isendto(nsndto) = jn 
    723                 END IF 
     721                ENDIF 
    724722          END DO 
    725723          nfsloop = 1 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    r6140 r7309  
    3939   LOGICAL              ::   ln_3d_uve     !: specify whether input velocity data is 3D 
    4040   LOGICAL              ::   ln_read_frq   !: specify whether we must read frq or not 
     41   LOGICAL              ::   l_sasread     !: Ice intilisation: read a file (.TRUE.) or anaytical initilaistion in namelist &namsbc_sas 
    4142   LOGICAL              ::   l_initdone = .false. 
    4243   INTEGER     ::   nfld_3d 
    … …  
    8182      ! 
    8283      IF( nn_timing == 1 )  CALL timing_start( 'sbc_ssm') 
    83  
    84       IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==! 
    85       IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
    86       !  
    87       IF( ln_3d_uve ) THEN 
    88          ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    89          ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
    90          IF( .NOT.ln_linssh )   e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity  
     84      
     85      IF ( l_sasread ) THEN 
     86         IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==! 
     87         IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
     88         !  
     89         IF( ln_3d_uve ) THEN 
     90            IF( .NOT. ln_linssh )   e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity  
     91                                    ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
     92                                    ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     93         ELSE 
     94            IF( .NOT. ln_linssh )   e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity  
     95                                    ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
     96                                    ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     97         ENDIF 
     98         ! 
     99         sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1)    ! temperature 
     100         sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity 
     101         ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height 
     102         IF( ln_read_frq ) THEN 
     103            frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! solar penetration 
     104         ELSE 
     105            frq_m(:,:) = 1._wp 
     106         ENDIF 
    91107      ELSE 
    92          ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    93          ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
    94          IF( .NOT.ln_linssh )   e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity  
    95       ENDIF 
    96       ! 
    97       sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1)    ! temperature 
    98       sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity 
    99       ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height 
    100       IF( ln_read_frq )   frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height 
    101       ! 
     108         sst_m(:,:) = 0._wp 
     109         sss_m(:,:) = 0._wp 
     110         ssu_m(:,:) = 0._wp 
     111         ssv_m(:,:) = 0._wp 
     112         ssh_m(:,:) = 0._wp 
     113         e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D 
     114         frq_m(:,:) = 1._wp        !              - - 
     115         sshn (:,:) = 0._wp        !              - - 
     116      ENDIF 
     117       
    102118      IF ( nn_ice == 1 ) THEN 
    103119         tsn(:,:,1,jp_tem) = sst_m(:,:) 
    … …  
    108124      ub (:,:,1) = ssu_m(:,:) 
    109125      vb (:,:,1) = ssv_m(:,:) 
    110  
     126  
    111127      IF(ln_ctl) THEN                  ! print control 
    112128         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask, ovlap=1   ) 
    … …  
    155171      TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 
    156172      ! 
    157       NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 
     173      NAMELIST/namsbc_sas/l_sasread, cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 
    158174      !!---------------------------------------------------------------------- 
    159175       
    … …  
    176192         WRITE(numout,*) '~~~~~~~~~~~ ' 
    177193         WRITE(numout,*) '   Namelist namsbc_sas' 
     194         WRITE(numout,*) '      Initialisation using an input file  = ',l_sasread  
    178195         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve 
    179196         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq 
    … …  
    204221         nn_closea = 0 
    205222      ENDIF 
     223      IF (l_sasread) THEN 
    206224      !  
    207225      !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 
    … …  
    285303      IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 
    286304 
     305   ENDIF 
     306  
    287307      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in limistate 
    288308      IF( .NOT. ln_read_frq )   frq_m(:,:) = 1. 

  • branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/SAS_SRC/step.F90

    r6140 r7309  
    2424   USE diawri           ! Standard run outputs             (dia_wri routine) 
    2525   USE bdy_par          ! clem: mandatory for LIM3 
    26 #if defined key_bdy 
    2726   USE bdydta           ! clem: mandatory for LIM3 
    28 #endif 
    2927   USE stpctl           ! time stepping control            (stp_ctl routine) 
    3028   ! 
    … …  
    3836#endif 
    3937 
     38#if defined key_agrif 
     39   USE agrif_oce, ONLY: lk_agrif_debug  !clem 
     40#endif 
     41    
    4042   IMPLICIT NONE 
    4143   PRIVATE 
    … …  
    7072#if defined key_agrif 
    7173      kstp = nit000 + Agrif_Nb_Step() 
     74      IF ( lk_agrif_debug ) THEN 
     75         IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
     76         IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 
     77      ENDIF 
     78 
     79      IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
     80 
    7281# if defined key_iomput 
    7382      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    7483# endif    
    7584#endif    
     85                             indic = 0                    ! although indic is not changed in stp_ctl 
     86                                                          ! need to keep the same interface  
    7687      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    7788      IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init) 
    … …  
    90101                             CALL dia_wri( kstp )         ! ocean model: outputs 
    91102 
    92                              indic = 0                    ! although indic is not changed in stp_ctl 
    93                                                           ! need to keep the same interface  
     103#if defined key_agrif 
     104      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     105      ! AGRIF 
     106      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     107                             CALL Agrif_Integrate_ChildGrids( stp )   
     108#endif 
     109                              
     110      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     111      ! Control 
     112      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    94113                             CALL stp_ctl( kstp, indic ) 
     114      IF( indic < 0  )  THEN 
     115                             CALL ctl_stop( 'step: indic < 0' ) 
     116                             CALL dia_wri_state( 'output.abort', kstp ) 
     117      ENDIF 
     118      IF( kstp == nit000   ) CALL iom_close( numror )     ! close input  ocean restart file (clem: not sure...) 
     119       
    95120      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    96121      ! Coupled mode 
Note: See TracChangeset for help on using the changeset viewer.