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 4634 for branches/2013/dev_r4028_CNRS_LIM3 – NEMO

Ignore:
Timestamp:
2014-05-12T22:46:18+02:00 (10 years ago)
Author:
clem
Message:

major changes in heat budget

Location:
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM
Files:
41 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/field_def.xml

    r4345 r4634  
    2929         <field id="mldr10_1"     long_name="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        /> 
    3030         <field id="rhop"         long_name="potential density (sigma0)"                unit="kg/m3" grid_ref="grid_T_3D"/> 
     31         <field id="heatc"        long_name="Heat content vertically integrated"        unit="J/m2"                      /> 
     32         <field id="saltc"        long_name="Salt content vertically integrated"        unit="PSU*kg/m2"                /> 
    3133         <!-- next variables available with key_diahth --> 
    3234         <field id="mlddzt"       long_name="Thermocline Depth (max dT/dz)"             unit="m"                        /> 
     
    186188         <field id="ice_cover"    long_name="Ice fraction"                                                 unit="1"        /> 
    187189 
    188          <field id="ioceflxb"     long_name="Oceanic flux at the ice base"                                 unit="W/m2"     /> 
    189190         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     /> 
    190191         <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     /> 
     
    214215          
    215216         <field id="iceconc"      long_name="ice concentration"                                            unit="%"        /> 
    216          <field id="icebopr"      long_name="daily bottom thermo ice prod."                                unit="m/day"   /> 
    217          <field id="icedypr"      long_name="daily  dynamic ice prod."                                     unit="m/day"   /> 
    218     <field id="ioceflxb"     long_name="Oceanic flux at the ice base"                                 unit="W/m2"     /> 
    219217         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      /> 
    220218         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      /> 
     
    224222         <field id="qsr_oce"      long_name="solar heat flux at ocean surface"                             unit="W/m2"     /> 
    225223         <field id="qns_oce"      long_name="non-solar heat flux at ocean surface"                         unit="W/m2"     /> 
    226          <field id="hfbri"        long_name="heat flux due to brine release"                               unit="W/m2"     /> 
    227224         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     /> 
    228225         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     /> 
     
    231228         <field id="micesalt"     long_name="Mean ice salinity"                                            unit="psu"      /> 
    232229         <field id="miceage"      long_name="Mean ice age"                                                 unit="years"    /> 
    233          <field id="icelapr"      long_name="daily lateral thermo ice prod."                               unit="m/day"   /> 
    234          <field id="icesipr"      long_name="daily snowice ice prod."                                      unit="m/day"   /> 
     230 
     231         <field id="iceage_cat"   long_name="Ice age for categories"                                       unit="days"   axis_ref="ncatice" /> 
     232         <field id="iceconc_cat"  long_name="Ice concentration for categories"                             unit="%"      axis_ref="ncatice" /> 
     233         <field id="icethic_cat"  long_name="Ice thickness for categories"                                 unit="m"      axis_ref="ncatice" /> 
     234         <field id="snowthic_cat" long_name="Snow thicknessi for categories"                               unit="m"      axis_ref="ncatice" /> 
     235         <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories"                         unit="ppt"    axis_ref="ncatice" /> 
     236         <field id="brinevol_cat" long_name="Brine volume for categories"                                  unit="%"      axis_ref="ncatice" /> 
     237 
    235238         <field id="micet"        long_name="Mean ice temperature"                                         unit="degC"     /> 
    236239         <field id="icehc"        long_name="ice total heat content"                                       unit="10^9 J"   />  
    237240         <field id="isnowhc"      long_name="snow total heat content"                                      unit="10^9J"    /> 
    238241         <field id="icest"        long_name="ice surface temperature"                                      unit="degC"     /> 
    239          <field id="sfxbri"       long_name="brine salt flux"                                              unit="psu*kg/m2/day" /> 
    240          <field id="sfxthd"       long_name="equivalent FW salt flux"                                      unit="psu*kg/m2/day" /> 
    241242         <field id="ibrinv"       long_name="brine volume"                                                 unit="%"        /> 
    242243         <field id="icecolf"      long_name="frazil ice collection thickness"                              unit="m"        /> 
    243244         <field id="icestr"       long_name="ice strength"                                                 unit="N/m"      /> 
    244245         <field id="icevel"       long_name="ice velocity"                                                 unit="m/s"      /> 
    245          <field id="isume"        long_name="surface melt"                                                 unit="m/day"   /> 
    246          <field id="ibome"        long_name="bottom melt"                                                  unit="m/day"   /> 
    247246         <field id="idive"        long_name="divergence"                                                   unit="10-8s-1"  /> 
    248247         <field id="ishear"       long_name="shear"                                                        unit="10-8s-1"  /> 
    249          <field id="icerepr"      long_name="daily resultant ice prod./melting from limupdate"             unit="m/day"   /> 
    250248         <field id="icevolu"      long_name="ice volume"                                                   unit="m"      /> 
    251249         <field id="snowvol"      long_name="snow volume"                                                  unit="m"      /> 
    252          <field id="sfxmec"       long_name="salt flux from ridging rafting"                               unit="psu*kg/m2/day" /> 
     250 
     251         <field id="icetrp"       long_name="ice volume transport"                                         unit="m/day"   /> 
     252         <field id="snwtrp"       long_name="snw volume transport"                                         unit="m/day"   /> 
     253         <field id="deitrp"       long_name="advected ice enhalpy"                                         unit="W/2"   /> 
     254         <field id="destrp"       long_name="advected snw enhalpy"                                         unit="W/2"   /> 
     255 
     256         <field id="sfxbri"       long_name="brine salt flux"                                              unit="psu*kg/m2/day" /> 
     257         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="psu*kg/m2/day" /> 
    253258         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="psu*kg/m2/day" /> 
    254          <field id="icetrp"       long_name="ice volume transport"                                         unit="m/day"   /> 
    255  
     259         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="psu*kg/m2/day" /> 
     260         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="psu*kg/m2/day" /> 
     261         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="psu*kg/m2/day" /> 
     262         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="psu*kg/m2/day" /> 
     263         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="psu*kg/m2/day" /> 
     264         <field id="sfx"          long_name="salt flux total"                                              unit="psu*kg/m2/day" /> 
     265 
     266         <field id="vfxbog"       long_name="daily bottom thermo ice prod."                                unit="m/day"   /> 
     267         <field id="vfxdyn"       long_name="daily  dynamic ice prod."                                     unit="m/day"   /> 
     268         <field id="vfxopw"       long_name="daily lateral thermo ice prod."                               unit="m/day"   /> 
     269         <field id="vfxsni"       long_name="daily snowice ice prod."                                      unit="m/day"   /> 
     270         <field id="vfxsum"       long_name="surface melt"                                                 unit="m/day"   /> 
     271         <field id="vfxbom"       long_name="bottom melt"                                                  unit="m/day"   /> 
     272         <field id="vfxres"       long_name="daily resultant ice prod./melting from limupdate"             unit="m/day"   /> 
     273         <field id="vfxice"       long_name="ice melt/growth"                                              unit="m/day"   /> 
     274         <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="m/day"   /> 
     275         <field id="vfxsub"       long_name="snw sublimation"                                              unit="m/day"   /> 
     276 
     277         <field id="hfxdhc1"   long_name="Heat content variation in snow and ice"   unit="W/m2" /> 
     278         <field id="hfxspr"    long_name="Heat content of snow precip"              unit="W/m2" /> 
     279         <field id="hfxqsr"    long_name="solar fluxes given to ocean"             unit="W/m2"  /> 
     280         <field id="hfxqns"    long_name="non solar fluxes given to ocean"         unit="W/m2"  /> 
     281 
     282         <field id="hfxthd"   long_name="heat fluxes from ice-ocean exchange during thermo"              unit="W/m2"  /> 
     283         <field id="hfxdyn"   long_name="heat fluxes from ice-ocean exchange during dynamic"             unit="W/m2"  /> 
     284         <field id="hfxres"   long_name="heat fluxes from ice-ocean exchange during resultant"           unit="W/m2"  /> 
     285         <field id="hfxsnw"   long_name="heat fluxes from snow-ocean exchange"                           unit="W/m2"  /> 
     286         <field id="hfxsub"   long_name="heat fluxes from sublimation"                                   unit="W/m2"  /> 
     287         <field id="hfxerr"   long_name="heat fluxes error after heat diffusion"                         unit="W/m2"  /> 
     288         <field id="hfxerr_rem" long_name="heat fluxes error after remapping"                         unit="W/m2"  /> 
     289         <field id="hfxtot"   long_name="heat fluxes total used by ice"                                  unit="W/m2"  /> 
     290         <field id="hfxout"   long_name="non solar heat fluxes received by the ocean"             unit="W/m2"  /> 
     291         <field id="hfxin"    long_name="total     heat fluxes at the ice surface"             unit="W/m2"  /> 
    256292 
    257293      </field_group> 
     
    272308         <field id="u_masstr"     long_name="ocean eulerian mass transport along i-axis"  unit="kg/s" grid_ref="grid_U_3D" /> 
    273309         <field id="u_heattr"     long_name="ocean eulerian heat transport along i-axis"  unit="W"    /> 
     310         <field id="u_salttr"     long_name="ocean eulerian salt transport along i-axis"  unit="PSU*kg/s"    /> 
    274311         <field id="ueiv_heattr"  long_name="ocean bolus heat transport along i-axis"     unit="W"    /> 
    275312         <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis" unit="W"    /> 
     
    291328         <field id="v_masstr"     long_name="ocean eulerian mass transport along j-axis"  unit="kg/s" grid_ref="grid_V_3D" /> 
    292329         <field id="v_heattr"     long_name="ocean eulerian heat transport along j-axis"  unit="W"     /> 
     330         <field id="v_salttr"     long_name="ocean eulerian salt transport along i-axis"  unit="PSU*kg/s"    /> 
    293331         <field id="veiv_heattr"  long_name="ocean bolus heat transport along j-axis"     unit="W"     /> 
    294332         <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis" unit="W"     /> 
     
    324362 
    325363      <field_group id="scalar"  domain_ref="1point" > 
    326          <field id="voltot"     long_name="global mean volume"                         unit="m3"   /> 
    327          <field id="sshtot"     long_name="global mean ssh"                            unit="m"    /> 
    328          <field id="sshsteric"  long_name="global mean ssh steric"                     unit="m"    /> 
    329          <field id="sshthster"  long_name="global mean ssh thermosteric"               unit="m"    /> 
    330          <field id="masstot"    long_name="global mean mass"                           unit="kg"   /> 
    331          <field id="temptot"    long_name="global mean temperature"                    unit="degC" /> 
    332          <field id="saltot"     long_name="global mean salinity"                       unit="psu"  /> 
    333          <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
     364     <field id="voltot"     long_name="global mean volume"                         unit="m3"   /> 
     365     <field id="sshtot"     long_name="global mean ssh"                            unit="m"    /> 
     366     <field id="sshsteric"  long_name="global mean ssh steric"                     unit="m"    /> 
     367     <field id="sshthster"  long_name="global mean ssh thermosteric"               unit="m"    /> 
     368     <field id="masstot"    long_name="global mean mass"                           unit="kg"   /> 
     369     <field id="temptot"    long_name="global mean temperature"                    unit="degC" /> 
     370     <field id="saltot"     long_name="global mean salinity"                       unit="psu"  /> 
     371     <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
    334372       <!-- available with ln_diahsb --> 
    335373    <field id="bgtemper" long_name="global mean temperature variation"            unit="degC"/> 
     
    357395    <field id="ibgsaltco"    long_name="global mean ice salt content"             unit="psu*km3"   /> 
    358396 
    359     <field id="ibgemp"       long_name="global mean volume flux (emp)"               unit="m/day"   /> 
    360     <field id="ibgempbog"    long_name="global mean volume flux (bottom growth)"     unit="m/day"   /> 
    361     <field id="ibgemplag"    long_name="global mean volume flux (open water growth)" unit="m/day"   /> 
    362     <field id="ibgempsig"    long_name="global mean volume flux (snow-ice growth)"   unit="m/day"   /> 
    363     <field id="ibgempdyg"    long_name="global mean volume flux (dynamic growth)"    unit="m/day"   /> 
    364     <field id="ibgempbom"    long_name="global mean volume flux (bottom melt)"       unit="m/day"   /> 
    365     <field id="ibgempsum"    long_name="global mean volume flux (surface melt)"      unit="m/day"   /> 
    366     <field id="ibgempres"    long_name="global mean volume flux (resultant)"         unit="m/day"   /> 
     397    <field id="ibgvfx"       long_name="global mean volume flux (emp)"               unit="m/day"   /> 
     398    <field id="ibgvfxbog"    long_name="global mean volume flux (bottom growth)"     unit="m/day"   /> 
     399    <field id="ibgvfxopw"    long_name="global mean volume flux (open water growth)" unit="m/day"   /> 
     400    <field id="ibgvfxsni"    long_name="global mean volume flux (snow-ice growth)"   unit="m/day"   /> 
     401    <field id="ibgvfxdyn"    long_name="global mean volume flux (dynamic growth)"    unit="m/day"   /> 
     402    <field id="ibgvfxbom"    long_name="global mean volume flux (bottom melt)"       unit="m/day"   /> 
     403    <field id="ibgvfxsum"    long_name="global mean volume flux (surface melt)"      unit="m/day"   /> 
     404    <field id="ibgvfxres"    long_name="global mean volume flux (resultant)"         unit="m/day"   /> 
    367405 
    368406    <field id="ibgsfx"       long_name="global mean salt flux (total)"            unit="psu*m/day"   /> 
    369407    <field id="ibgsfxbri"    long_name="global mean salt flux (brines)"           unit="psu*m/day"   /> 
    370     <field id="ibgsfxthd"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
    371     <field id="ibgsfxmec"    long_name="global mean salt flux (dynamic)"          unit="psu*m/day"   /> 
     408    <field id="ibgsfxdyn"    long_name="global mean salt flux (dynamic)"          unit="psu*m/day"   /> 
    372409    <field id="ibgsfxres"    long_name="global mean salt flux (resultant)"        unit="psu*m/day"   /> 
     410    <field id="ibgsfxbog"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     411    <field id="ibgsfxopw"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     412    <field id="ibgsfxsni"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     413    <field id="ibgsfxbom"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     414    <field id="ibgsfxsum"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     415 
     416 
     417        <field id="ibghfxdhc1"   long_name="Heat content variation in snow and ice"   unit="W" /> 
     418        <field id="ibghfxspr"    long_name="Heat content of snow precip"              unit="W" /> 
     419        <field id="ibghfxqsr"    long_name="solar fluxes given to ocean"             unit="W"  /> 
     420        <field id="ibghfxqns"    long_name="non solar fluxes given to ocean"         unit="W"  /> 
     421 
     422        <field id="ibghfxthd"   long_name="heat fluxes from ice-ocean exchange during thermo"              unit="W"  /> 
     423        <field id="ibghfxdyn"   long_name="heat fluxes from ice-ocean exchange during dynamic"             unit="W"  /> 
     424        <field id="ibghfxres"   long_name="heat fluxes from ice-ocean exchange during resultant"           unit="W"  /> 
     425        <field id="ibghfxsub"   long_name="heat fluxes from sublimation"                                   unit="W"  /> 
     426        <field id="ibghfxsnw"   long_name="heat fluxes from snow-ocean exchange"                           unit="W"  /> 
     427        <field id="ibghfxtot"   long_name="heat fluxes total used by ice"                                  unit="W"  /> 
     428        <field id="ibghfxout"   long_name="non solar heat fluxes received by the ocean"                    unit="W"  /> 
     429        <field id="ibghfxin"    long_name="total heat fluxes at the ice surface"                           unit="W"  /> 
    373430 
    374431    <field id="ibgfrcvol"    long_name="global mean forcing volume (emp)"         unit="km3"      /> 
    375432    <field id="ibgfrcsfx"    long_name="global mean forcing salt   (sfx)"         unit="psu*km3"   /> 
    376     <field id="ibggrme"      long_name="global mean ice growth+melt volume"       unit="km3"      /> 
     433    <field id="ibgvolgrm"    long_name="global mean ice growth+melt volume"       unit="km3"      /> 
    377434      </field_group> 
    378435   
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml

    r4350 r4634  
    4747     <field field_ref="mldkz5"       /> 
    4848     <field field_ref="mldr10_1"     /> 
     49          <field field_ref="heatc"        name="heatc"    long_name="Heat content vertically integrated"            /> 
     50          <field field_ref="saltc"        name="saltc"    long_name="Salt content vertically integrated"            /> 
    4951   </file> 
    5052 
    5153   <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 
    5254     <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     /> 
    53      <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           /> 
    54      <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          /> 
    55      <field field_ref="saltflx"      name="sosflxdo"  /> 
     55     <field field_ref="qsr"          name="hfxqsr"   long_name="surface_net_downward_shortwave_flux"           /> 
     56     <field field_ref="qt"           name="hfxtot"   long_name="surface_net_downward_total_heat_flux"          /> 
     57     <field field_ref="saltflx"      name="sfx"  /> 
    5658     <field field_ref="taum"         name="taum" /> 
    57      <field field_ref="wspd"         name="sowindsp"  /> 
    58           <field field_ref="precip"       name="soprecip" /> 
     59     <field field_ref="wspd"         name="windsp"  /> 
     60          <field field_ref="precip"       name="precip" /> 
    5961     <!-- ice and snow --> 
    6062     <field field_ref="snowpre"      /> 
     63          <field field_ref="utau_ice"         name="utau_ice" /> 
     64          <field field_ref="vtau_ice"         name="vtau_ice" /> 
     65     <!-- clem 
    6166          <field field_ref="qsr_io"           name="iicesflx" /> 
    6267          <field field_ref="qns_io"           name="iicenflx" /> 
    63           <field field_ref="utau_ice"         name="iicestru" /> 
    64           <field field_ref="vtau_ice"         name="iicestrv" /> 
     68     --> 
    6569 
    6670   </file> 
     
    7377     <field field_ref="u_masstr"     name="vozomatr"  /> 
    7478     <field field_ref="u_heattr"     name="sozohetr"  /> 
     79          <field field_ref="u_salttr"     name="sozosatr"  /> 
    7580   </file> 
    7681    
     
    8287     <field field_ref="v_masstr"     name="vomematr"  /> 
    8388     <field field_ref="v_heattr"     name="somehetr"  /> 
     89          <field field_ref="v_salttr"     name="somesatr"  /> 
    8490   </file> 
    8591    
     
    9096   </file> 
    9197 
    92    <file id="file6" name_suffix="_icemod" description="ice variables" > 
    93  
     98   <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 
    9499     <field field_ref="snowthic_cea"     name="sndept"     long_name="surface_snow_thickness"   /> 
    95100     <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        /> 
     
    98103          <field field_ref="iceconc"          name="siconc"  /> 
    99104 
    100           <field field_ref="icebopr"          name="sibopr" /> 
    101           <field field_ref="icedypr"          name="sidypr" /> 
    102           <field field_ref="icelapr"          name="silapr" /> 
    103           <field field_ref="icesipr"          name="sisipr" /> 
    104           <field field_ref="isume"            name="sisume" /> 
    105           <field field_ref="ibome"            name="sibome" /> 
    106           <field field_ref="icerepr"          name="sirepr" /> 
     105          <field field_ref="vfxbog"          name="vfxbog" /> 
     106          <field field_ref="vfxdyn"          name="vfxdyn" /> 
     107          <field field_ref="vfxopw"          name="vfxopw" /> 
     108          <field field_ref="vfxsni"          name="vfxsni" /> 
     109          <field field_ref="vfxsum"          name="vfxsum" /> 
     110          <field field_ref="vfxbom"          name="vfxbom" /> 
     111          <field field_ref="vfxres"          name="vfxres" /> 
     112          <field field_ref="vfxice"          name="vfxice" /> 
     113          <field field_ref="vfxsnw"          name="vfxsnw" /> 
     114          <field field_ref="vfxsub"          name="vfxsub" /> 
     115 
     116          <field field_ref="icetrp"          name="sivtrp" /> 
     117          <field field_ref="snwtrp"          name="snvtrp" /> 
     118          <field field_ref="deitrp"          name="deitrp" /> 
     119          <field field_ref="destrp"          name="destrp" /> 
    107120 
    108121          <field field_ref="sfxbri"           name="sfxbri" /> 
    109           <field field_ref="sfxthd"           name="sfxthd" /> 
    110           <field field_ref="sfxmec"           name="sfxmec" /> 
     122          <field field_ref="sfxdyn"           name="sfxdyn" /> 
    111123          <field field_ref="sfxres"           name="sfxres" /> 
     124          <field field_ref="sfxbog"           name="sfxbog" /> 
     125          <field field_ref="sfxbom"           name="sfxbom" /> 
     126          <field field_ref="sfxsum"           name="sfxsum" /> 
     127          <field field_ref="sfxsni"           name="sfxsni" /> 
     128          <field field_ref="sfxopw"           name="sfxopw" /> 
     129          <field field_ref="sfx"              name="sfx" /> 
     130 
     131          <field field_ref="hfxdhc1"          name="hfxdhc1"    /> 
     132          <field field_ref="hfxspr"           name="hfxspr"    /> 
     133          <field field_ref="hfxqsr"           name="hfxqsr"    /> 
     134          <field field_ref="hfxqns"           name="hfxqns"    /> 
     135 
     136          <field field_ref="hfxthd"          name="hfxthd"    /> 
     137          <field field_ref="hfxdyn"          name="hfxdyn"    /> 
     138          <field field_ref="hfxres"          name="hfxres"    /> 
     139          <field field_ref="hfxout"          name="hfxout"    /> 
     140          <field field_ref="hfxin"           name="hfxin"    /> 
     141          <field field_ref="hfxtot"          name="hfxtot"    /> 
     142          <field field_ref="hfxsnw"          name="hfxsnw"    /> 
     143          <field field_ref="hfxsub"          name="hfxsub"    /> 
     144          <field field_ref="hfxerr"          name="hfxerr"    /> 
     145          <field field_ref="hfxerr_rem"      name="hfxerr_rem"    /> 
    112146 
    113147          <field field_ref="isst"             name="sst" /> 
     
    115149          <field field_ref="micesalt"         name="sisali" /> 
    116150          <field field_ref="micet"            name="sitemp" /> 
    117           <field field_ref="icest"            name="sisurt" /> 
     151          <field field_ref="icest"            name="sistem" /> 
    118152          <field field_ref="icehc"            name="siheco" /> 
    119153          <field field_ref="isnowhc"          name="snheco" /> 
    120154          <field field_ref="miceage"          name="siages" /> 
    121           <field field_ref="ioceflxb"         name="ioceflxb" /> 
    122155 
    123156          <field field_ref="uice_ipa"         name="sivelu" /> 
     
    126159          <field field_ref="idive"            name="sidive" /> 
    127160          <field field_ref="ishear"           name="sishea" /> 
    128           <field field_ref="icetrp"           name="sivtrp" /> 
    129161          <field field_ref="icestr"           name="sistre" /> 
    130162 
     
    132164          <field field_ref="icecolf"          name="sicolf" /> 
    133165 
    134    </file> 
    135  
    136         <file id="file7" name_suffix="_scalar" description="scalar variables" > 
     166          <field field_ref="iceage_cat"       name="siagecat"/> 
     167          <field field_ref="iceconc_cat"      name="siconcat"/> 
     168          <field field_ref="icethic_cat"      name="sithicat"/> 
     169          <field field_ref="snowthic_cat"     name="sndeptcat"/> 
     170          <field field_ref="salinity_cat"     name="salincat"/> 
     171          <field field_ref="brinevol_cat"     name="sibrincat"/> 
     172 
     173   </file> 
     174 
     175        <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." > 
    137176          <field field_ref="voltot"       name="scvoltot"  /> 
    138177          <field field_ref="sshtot"       name="scsshtot"  /> 
     
    152191          <field field_ref="bgfrctem"     name="bgfrctem"    /> 
    153192          <field field_ref="bgfrcsal"     name="bgfrcsal"    /> 
     193     <!-- 
    154194          <field field_ref="bgmistem"     name="bgmistem"    /> 
    155195          <field field_ref="bgmissal"     name="bgmissal"    /> 
     196     --> 
    156197        </file> 
    157198 
    158         <file id="file8" name_suffix="_SBC_scalar" description="scalar variables" > 
     199        <file id="file8" name_suffix="_SBC_scalar" description="scalar variables" enabled=".true." > 
    159200          <field field_ref="ibgvoltot"    name="ibgvoltot"   /> 
    160201          <field field_ref="sbgvoltot"    name="sbgvoltot"   /> 
     
    166207          <field field_ref="ibgsaltco"    name="ibgsaltco"   /> 
    167208 
    168           <field field_ref="ibgemp"       name="ibgemp"      /> 
    169           <field field_ref="ibgempbog"    name="ibgempbog"      /> 
    170           <field field_ref="ibgemplag"    name="ibgemplag"      /> 
    171           <field field_ref="ibgempsig"    name="ibgempsig"      /> 
    172           <field field_ref="ibgempdyg"    name="ibgempdyg"      /> 
    173           <field field_ref="ibgempbom"    name="ibgempbom"      /> 
    174           <field field_ref="ibgempsum"    name="ibgempsum"      /> 
    175           <field field_ref="ibgempres"    name="ibgempres"      /> 
     209          <field field_ref="ibgvfx"       name="ibgvfx"      /> 
     210          <field field_ref="ibgvfxbog"    name="ibgvfxbog"      /> 
     211          <field field_ref="ibgvfxopw"    name="ibgvfxopw"      /> 
     212          <field field_ref="ibgvfxsni"    name="ibgvfxsni"      /> 
     213          <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"      /> 
     214          <field field_ref="ibgvfxbom"    name="ibgvfxbom"      /> 
     215          <field field_ref="ibgvfxsum"    name="ibgvfxsum"      /> 
     216          <field field_ref="ibgvfxres"    name="ibgvfxres"      /> 
    176217 
    177218          <field field_ref="ibgsfx"       name="ibgsfx"     /> 
    178219          <field field_ref="ibgsfxbri"    name="ibgsfxbri"    /> 
    179           <field field_ref="ibgsfxthd"    name="ibgsfxthd"    /> 
    180           <field field_ref="ibgsfxmec"    name="ibgsfxmec" /> 
     220          <field field_ref="ibgsfxdyn"    name="ibgsfxdyn" /> 
    181221          <field field_ref="ibgsfxres"    name="ibgsfxres" /> 
     222          <field field_ref="ibgsfxbog"    name="ibgsfxbog"      /> 
     223          <field field_ref="ibgsfxopw"    name="ibgsfxopw"      /> 
     224          <field field_ref="ibgsfxsni"    name="ibgsfxsni"      /> 
     225          <field field_ref="ibgsfxbom"    name="ibgsfxbom"      /> 
     226          <field field_ref="ibgsfxsum"    name="ibgsfxsum"      /> 
     227 
     228          <field field_ref="ibghfxdhc1"    name="ibghfxdhc1"    /> 
     229          <field field_ref="ibghfxspr"    name="ibghfxspr"    /> 
     230          <field field_ref="ibghfxqsr"    name="ibghfxqsr"    /> 
     231          <field field_ref="ibghfxqns"    name="ibghfxqns"    /> 
     232 
     233          <field field_ref="ibghfxres"    name="ibghfxres"    /> 
     234          <field field_ref="ibghfxsub"    name="ibghfxsub"    /> 
     235          <field field_ref="ibghfxdyn"    name="ibghfxdyn"    /> 
     236          <field field_ref="ibghfxthd"    name="ibghfxthd"    /> 
     237          <field field_ref="ibghfxout"    name="ibghfxout"    /> 
     238          <field field_ref="ibghfxin"    name="ibghfxin"    /> 
     239          <field field_ref="ibghfxtot"    name="ibghfxtot"    /> 
     240          <field field_ref="ibghfxsnw"    name="ibghfxsnw"    /> 
    182241 
    183242          <field field_ref="ibgfrcvol"    name="ibgfrcvol"   /> 
    184243          <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  /> 
    185           <field field_ref="ibggrme"      name="ibggrme"    /> 
     244          <field field_ref="ibgvolgrm"    name="ibgvolgrm"    /> 
    186245        </file> 
    187246 
     
    219278      <axis id="nfloat" long_name="Float number"      unit="-"  /> 
    220279      <axis id="icbcla" long_name="Iceberg class"     unit="-"  /> 
     280      <axis id="ncatice" long_name="Ice categories"   unit="-"  /> 
    221281   </axis_definition>  
    222282     
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_default.xml

    r4345 r4634  
    4747     <field field_ref="mldkz5"       /> 
    4848     <field field_ref="mldr10_1"     /> 
     49          <field field_ref="heatc"        name="heatc"    long_name="Heat content vertically integrated"            /> 
     50          <field field_ref="saltc"        name="saltc"    long_name="Salt content vertically integrated"            /> 
    4951   </file> 
    5052 
    5153   <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 
    5254     <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     /> 
    53      <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           /> 
    54      <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          /> 
    55      <field field_ref="saltflx"      name="sosflxdo"  /> 
     55     <field field_ref="qsr"          name="hfxqsr"   long_name="surface_net_downward_shortwave_flux"           /> 
     56     <field field_ref="qt"           name="hfxtot"   long_name="surface_net_downward_total_heat_flux"          /> 
     57     <field field_ref="saltflx"      name="sfx"  /> 
    5658     <field field_ref="taum"         name="taum" /> 
    57      <field field_ref="wspd"         name="sowindsp"  /> 
    58           <field field_ref="precip"       name="soprecip" /> 
     59     <field field_ref="wspd"         name="windsp"  /> 
     60          <field field_ref="precip"       name="precip" /> 
    5961     <!-- ice and snow --> 
    6062     <field field_ref="snowpre"      /> 
     63          <field field_ref="utau_ice"         name="utau_ice" /> 
     64          <field field_ref="vtau_ice"         name="vtau_ice" /> 
     65     <!-- clem 
    6166          <field field_ref="qsr_io"           name="iicesflx" /> 
    6267          <field field_ref="qns_io"           name="iicenflx" /> 
    63           <field field_ref="utau_ice"         name="iicestru" /> 
    64           <field field_ref="vtau_ice"         name="iicestrv" /> 
     68     --> 
    6569 
    6670   </file> 
     
    7377     <field field_ref="u_masstr"     name="vozomatr"  /> 
    7478     <field field_ref="u_heattr"     name="sozohetr"  /> 
     79          <field field_ref="u_salttr"     name="sozosatr"  /> 
    7580   </file> 
    7681    
     
    8287     <field field_ref="v_masstr"     name="vomematr"  /> 
    8388     <field field_ref="v_heattr"     name="somehetr"  /> 
     89          <field field_ref="v_salttr"     name="somesatr"  /> 
    8490   </file> 
    8591    
     
    9096   </file> 
    9197 
    92    <file id="file6" name_suffix="_icemod" description="ice variables" > 
    93      <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   /> 
    94      <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        /> 
    95           <field field_ref="icevolu"      name="iicevolu" /> 
    96           <field field_ref="snowvol"      name="isnowvol" /> 
    97           <field field_ref="iceconc"      name="iiceconc"  /> 
    98  
    99           <field field_ref="icebopr"          name="iicebopr" /> 
    100           <field field_ref="icedypr"          name="iicedypr" /> 
    101           <field field_ref="ioceflxb"         name="ioceflxb" /> 
    102           <field field_ref="uice_ipa"         name="iicevelu" /> 
    103           <field field_ref="vice_ipa"         name="iicevelv" /> 
    104           <field field_ref="isst"             name="isstempe" /> 
    105           <field field_ref="isss"             name="isssalin" /> 
    106           <field field_ref="micesalt"         name="iicesali" /> 
    107           <field field_ref="miceage"          name="iiceages" /> 
    108           <field field_ref="icelapr"          name="iicelapr" /> 
    109           <field field_ref="icesipr"          name="iicesipr" /> 
    110           <field field_ref="micet"            name="iicetemp" /> 
    111           <field field_ref="icehc"            name="iiceheco" /> 
    112           <field field_ref="isnowhc"          name="isnoheco" /> 
    113           <field field_ref="icest"            name="iicesurt" /> 
    114           <field field_ref="sfxbri"            name="iicefsbr" /> 
    115           <field field_ref="sfxthd"            name="iicefseq" /> 
    116           <field field_ref="ibrinv"           name="ibrinvol" /> 
    117           <field field_ref="icecolf"          name="iicecolf" /> 
    118           <field field_ref="icestr"           name="iicestre" /> 
    119           <field field_ref="icevel"           name="iicevelo" /> 
    120           <field field_ref="isume"            name="iicesume" /> 
    121           <field field_ref="ibome"            name="iicebome" /> 
    122           <field field_ref="idive"            name="iicedive" /> 
    123           <field field_ref="ishear"           name="iiceshea" /> 
    124           <field field_ref="icerepr"          name="iicerepr" /> 
    125           <field field_ref="sfxmec"            name="iicefsrp" /> 
    126           <field field_ref="sfxres"            name="iicefsre" /> 
    127           <field field_ref="icetrp"           name="iicevtrp" /> 
     98   <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 
     99     <field field_ref="snowthic_cea"     name="sndept"     long_name="surface_snow_thickness"   /> 
     100     <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        /> 
     101          <field field_ref="icevolu"          name="sivolu" /> 
     102          <field field_ref="snowvol"          name="snvolu" /> 
     103          <field field_ref="iceconc"          name="siconc"  /> 
     104 
     105          <field field_ref="vfxbog"          name="vfxbog" /> 
     106          <field field_ref="vfxdyn"          name="vfxdyn" /> 
     107          <field field_ref="vfxopw"          name="vfxopw" /> 
     108          <field field_ref="vfxsni"          name="vfxsni" /> 
     109          <field field_ref="vfxsum"          name="vfxsum" /> 
     110          <field field_ref="vfxbom"          name="vfxbom" /> 
     111          <field field_ref="vfxres"          name="vfxres" /> 
     112          <field field_ref="vfxice"          name="vfxice" /> 
     113          <field field_ref="vfxsnw"          name="vfxsnw" /> 
     114          <field field_ref="vfxsub"          name="vfxsub" /> 
     115 
     116          <field field_ref="icetrp"          name="sivtrp" /> 
     117          <field field_ref="snwtrp"          name="snvtrp" /> 
     118          <field field_ref="deitrp"          name="deitrp" /> 
     119          <field field_ref="destrp"          name="destrp" /> 
     120 
     121          <field field_ref="sfxbri"           name="sfxbri" /> 
     122          <field field_ref="sfxdyn"           name="sfxdyn" /> 
     123          <field field_ref="sfxres"           name="sfxres" /> 
     124          <field field_ref="sfxbog"           name="sfxbog" /> 
     125          <field field_ref="sfxbom"           name="sfxbom" /> 
     126          <field field_ref="sfxsum"           name="sfxsum" /> 
     127          <field field_ref="sfxsni"           name="sfxsni" /> 
     128          <field field_ref="sfxopw"           name="sfxopw" /> 
     129          <field field_ref="sfx"              name="sfx" /> 
     130 
     131          <field field_ref="hfxdhc1"          name="hfxdhc1"    /> 
     132          <field field_ref="hfxspr"           name="hfxspr"    /> 
     133          <field field_ref="hfxqsr"           name="hfxqsr"    /> 
     134          <field field_ref="hfxqns"           name="hfxqns"    /> 
     135 
     136          <field field_ref="hfxthd"          name="hfxthd"    /> 
     137          <field field_ref="hfxdyn"          name="hfxdyn"    /> 
     138          <field field_ref="hfxres"          name="hfxres"    /> 
     139          <field field_ref="hfxout"          name="hfxout"    /> 
     140          <field field_ref="hfxin"           name="hfxin"    /> 
     141          <field field_ref="hfxtot"          name="hfxtot"    /> 
     142          <field field_ref="hfxsnw"          name="hfxsnw"    /> 
     143          <field field_ref="hfxsub"          name="hfxsub"    /> 
     144          <field field_ref="hfxerr"          name="hfxerr"    /> 
     145          <field field_ref="hfxerr_rem"      name="hfxerr_rem"    /> 
     146 
     147          <field field_ref="isst"             name="sst" /> 
     148          <field field_ref="isss"             name="sss" /> 
     149          <field field_ref="micesalt"         name="sisali" /> 
     150          <field field_ref="micet"            name="sitemp" /> 
     151          <field field_ref="icest"            name="sistem" /> 
     152          <field field_ref="icehc"            name="siheco" /> 
     153          <field field_ref="isnowhc"          name="snheco" /> 
     154          <field field_ref="miceage"          name="siages" /> 
     155 
     156          <field field_ref="uice_ipa"         name="sivelu" /> 
     157          <field field_ref="vice_ipa"         name="sivelv" /> 
     158          <field field_ref="icevel"           name="sivelo" /> 
     159          <field field_ref="idive"            name="sidive" /> 
     160          <field field_ref="ishear"           name="sishea" /> 
     161          <field field_ref="icestr"           name="sistre" /> 
     162 
     163          <field field_ref="ibrinv"           name="sibrin" /> 
     164          <field field_ref="icecolf"          name="sicolf" /> 
     165 
     166          <field field_ref="iceage_cat"       name="siagecat"/> 
     167          <field field_ref="iceconc_cat"      name="siconcat"/> 
     168          <field field_ref="icethic_cat"      name="sithicat"/> 
     169          <field field_ref="snowthic_cat"     name="sndeptcat"/> 
     170          <field field_ref="salinity_cat"     name="salincat"/> 
     171          <field field_ref="brinevol_cat"     name="sibrincat"/> 
     172 
    128173   </file> 
    129174 
     
    146191          <field field_ref="bgfrctem"     name="bgfrctem"    /> 
    147192          <field field_ref="bgfrcsal"     name="bgfrcsal"    /> 
     193     <!-- 
    148194          <field field_ref="bgmistem"     name="bgmistem"    /> 
    149195          <field field_ref="bgmissal"     name="bgmissal"    /> 
     196     --> 
    150197        </file> 
    151198 
     
    160207          <field field_ref="ibgsaltco"    name="ibgsaltco"   /> 
    161208 
    162           <field field_ref="ibgemp"       name="ibgemp"      /> 
    163           <field field_ref="ibgempbog"    name="ibgempbog"      /> 
    164           <field field_ref="ibgemplag"    name="ibgemplag"      /> 
    165           <field field_ref="ibgempsig"    name="ibgempsig"      /> 
    166           <field field_ref="ibgempdyg"    name="ibgempdyg"      /> 
    167           <field field_ref="ibgempbom"    name="ibgempbom"      /> 
    168           <field field_ref="ibgempsum"    name="ibgempsum"      /> 
    169           <field field_ref="ibgempres"    name="ibgempres"      /> 
     209          <field field_ref="ibgvfx"       name="ibgvfx"      /> 
     210          <field field_ref="ibgvfxbog"    name="ibgvfxbog"      /> 
     211          <field field_ref="ibgvfxopw"    name="ibgvfxopw"      /> 
     212          <field field_ref="ibgvfxsni"    name="ibgvfxsni"      /> 
     213          <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"      /> 
     214          <field field_ref="ibgvfxbom"    name="ibgvfxbom"      /> 
     215          <field field_ref="ibgvfxsum"    name="ibgvfxsum"      /> 
     216          <field field_ref="ibgvfxres"    name="ibgvfxres"      /> 
    170217 
    171218          <field field_ref="ibgsfx"       name="ibgsfx"     /> 
    172219          <field field_ref="ibgsfxbri"    name="ibgsfxbri"    /> 
    173           <field field_ref="ibgsfxthd"    name="ibgsfxthd"    /> 
    174           <field field_ref="ibgsfxmec"    name="ibgsfxmec" /> 
     220          <field field_ref="ibgsfxdyn"    name="ibgsfxdyn" /> 
    175221          <field field_ref="ibgsfxres"    name="ibgsfxres" /> 
     222          <field field_ref="ibgsfxbog"    name="ibgsfxbog"      /> 
     223          <field field_ref="ibgsfxopw"    name="ibgsfxopw"      /> 
     224          <field field_ref="ibgsfxsni"    name="ibgsfxsni"      /> 
     225          <field field_ref="ibgsfxbom"    name="ibgsfxbom"      /> 
     226          <field field_ref="ibgsfxsum"    name="ibgsfxsum"      /> 
     227 
     228          <field field_ref="ibghfxdhc1"    name="ibghfxdhc1"    /> 
     229          <field field_ref="ibghfxspr"    name="ibghfxspr"    /> 
     230          <field field_ref="ibghfxqsr"    name="ibghfxqsr"    /> 
     231          <field field_ref="ibghfxqns"    name="ibghfxqns"    /> 
     232 
     233          <field field_ref="ibghfxres"    name="ibghfxres"    /> 
     234          <field field_ref="ibghfxsub"    name="ibghfxsub"    /> 
     235          <field field_ref="ibghfxdyn"    name="ibghfxdyn"    /> 
     236          <field field_ref="ibghfxthd"    name="ibghfxthd"    /> 
     237          <field field_ref="ibghfxout"    name="ibghfxout"    /> 
     238          <field field_ref="ibghfxin"    name="ibghfxin"    /> 
     239          <field field_ref="ibghfxtot"    name="ibghfxtot"    /> 
     240          <field field_ref="ibghfxsnw"    name="ibghfxsnw"    /> 
    176241 
    177242          <field field_ref="ibgfrcvol"    name="ibgfrcvol"   /> 
    178243          <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  /> 
    179           <field field_ref="ibggrme"      name="ibggrme"    /> 
     244          <field field_ref="ibgvolgrm"    name="ibgvolgrm"    /> 
    180245        </file> 
    181246 
     
    213278      <axis id="nfloat" long_name="Float number"      unit="-"  /> 
    214279      <axis id="icbcla" long_name="Iceberg class"     unit="-"  /> 
     280      <axis id="ncatice" long_name="Ice categories"   unit="-"  /> 
    215281   </axis_definition>  
    216282     
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice

    r4345 r4634  
    2727&namiceini     !   ice initialisation 
    2828!----------------------------------------------------------------------- 
    29    ttest       =  2.0      !  threshold water temperature for initial sea ice 
    30    hninn       =  0.3      !  initial snow thickness in the north 
    31    hnins       =  0.1      !        "            "          south 
    32    hginn       =  3.50     !  initial undeformed ice thickness in the north 
    33    hgins       =  1.0      !        "            "              "     south 
    34    aginn       =  0.95     !  initial undeformed ice concentration in the north 
    35    agins       =  0.9      !        "            "              "         south 
    36    sinn        =  6.301    !  initial salinity in the north 
    37    sins        =  6.301    !        "            "    south 
     29   ln_limini   = .true.    !  activate ice initialization (T) or not (F) 
     30   thres_sst   =  2.0      !  threshold water temperature for initial sea ice 
     31   hts_ini_n   =  0.3      !  initial snow thickness in the north 
     32   hts_ini_s   =  0.1      !        "            "          south 
     33   hti_ini_n   =  3.50     !  initial ice thickness in the north 
     34   hti_ini_s   =  1.0      !        "            "         south 
     35   ati_ini_n   =  0.95     !  initial ice concentration in the north 
     36   ati_ini_s   =  0.9      !        "            "             south 
     37   smi_ini_n   =  6.301    !  initial ice salinity in the north 
     38   smi_ini_s   =  6.301    !        "            "    south 
     39   tmi_ini_n   =  270.     !  initial ice/snw temp in the north 
     40   tmi_ini_s   =  270.     !  initial ice/snw temp in the south 
    3841/ 
    3942!----------------------------------------------------------------------- 
     
    5861   telast      =9600.0     !  timescale for elastic waves, SB, 720.0 
    5962   alphaevp    =   1.0     !  coefficient for the solution of internal ice stresses 
    60    hminrhg     =   0.001   !  ice thickness (m) below which ice velocity equal ocean velocity 
     63   hminrhg     =   0.001   !  ice volume (a*h in m) below which ice velocity equal ocean velocity 
    6164/ 
    6265!----------------------------------------------------------------------- 
     
    149152&namiceout     !   parameters for outputs 
    150153!----------------------------------------------------------------------- 
    151    noumef      =   43      !  number of fields 
    152    add_diag_swi=    1      !  1 -> diagnose distribution in thickness space 
    153                            !  0 -> only simple diagnostics 
     154!   noumef      =   43      !  number of fields 
     155!SF   add_diag_swi=    1      !  1 -> diagnose distribution in thickness space 
     156!SF                           !  0 -> only simple diagnostics 
    154157! 
    155158!           !         title of the field           !  name     !   units   !  save  ! multipl. ! additive ! 
    156159!           !                                      !           !           ! or not !  factor  !  factor  ! 
    157    field_1  = 'Ice concentration                  ', 'iiceconc', '%       ',    1   ,  1.0     ,    0.0 
    158    field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0 
    159    field_3  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0 
    160    field_4  = 'Daily bottom thermo ice production ', 'iicebopr', 'km3/day ',    1   , 1.0e-9   ,    0.0 
    161    field_5  = 'Daily dynamic ice production       ', 'iicedypr', 'km3/day ',    1   , 1.0e-9   ,    0.0 
    162    field_6  = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0 
    163    field_7  = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0 
    164    field_8  = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0 
    165    field_9  = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15 
    166    field_10 = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0 
    167    field_11 = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    168    field_12 = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    169    field_13 = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0 
    170    field_14 = 'Heat flux due to brine release     ', 'iocehebr', 'w/m2    ',    1   ,  1.0     ,    0.0 
    171    field_15 = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0 
    172    field_16 = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0  
    173    field_17 = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    174    field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    175    field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    176    field_20 = 'Mean ice salinity                  ', 'iicesali', 'psu     ',    1   ,  1.0     ,    0.0 
    177    field_21 = 'Mean ice age                       ', 'iiceages', 'years   ',    1   ,  0.002739,    0.0 
    178    field_22 = 'Daily lateral thermo ice prod.     ', 'iicelapr', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    179    field_23 = 'Daily snowice ice production       ', 'iicesipr', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    180    field_24 = 'Mean ice temperature               ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15 
    181    field_25 = 'Ice total heat content             ', 'iiceheco', '10^9 J  ',    1   ,  1.0     ,    0.0 
    182    field_26 = 'Ice surface temperature            ', 'iicesurt', 'C       ',    1   ,  1.0     , -273.15 
    183    field_27 = 'Snow temperature                   ', 'isnotem2', 'C       ',    1   ,  1.0     , -273.15 
    184    field_28 = 'Fsbri - brine salt flux            ', 'iicefsbr', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    185    field_29 = 'Fseqv - equivalent FW salt flux    ', 'iicefseq', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    186    field_30 = 'Brine volume                       ', 'ibrinvol', '%       ',    1   ,  100.0   ,    0.0 
    187    field_31 = 'Frazil ice collection thickness    ', 'iicecolf', 'm       ',    1   ,  1.0     ,    0.0 
    188    field_32 = 'Ice strength                       ', 'iicestre', 'N/m     ',    1   ,  0.001   ,    0.0 
    189    field_33 = 'Ice velocity                       ', 'iicevelo', 'm/s     ',    1   ,  1.0     ,    0.0 
    190    field_34 = 'Surface melt                       ', 'iicesume', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    191    field_35 = 'Bottom melt                        ', 'iicebome', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    192    field_36 = 'Divergence                         ', 'iicedive', '10-8s-1 ',    1   ,  1.0e8   ,    0.0 
    193    field_37 = 'Shear                              ', 'iiceshea', '10-8s-1 ',    1   ,  1.0e8   ,    0.0 
    194    field_38 = 'Daily resultant ice prod/melt      ', 'iicerepr', 'km3/day ',    1   ,  1.0e-9  ,    0.0 
    195    field_39 = 'Ice volume                         ', 'iicevolu', 'km3     ',    1   ,  1.0e-9  ,    0.0 
    196    field_40 = 'Snow volume                        ', 'isnowvol', 'km3     ',    1   ,  1.0e-9  ,    0.0 
    197    field_41 = 'Fsrpo - salt flux from ridg/raft   ', 'iicefsrp', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    198    field_42 = 'Fsres - salt flux from limupdate   ', 'iicefsre', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    199    field_43 = 'Ice volume transport               ', 'iicevtrp', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    200160/  
    201161 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice_lim3

    r4345 r4634  
    2727&namiceini     !   ice initialisation 
    2828!----------------------------------------------------------------------- 
    29    ttest       =  2.0      !  threshold water temperature for initial sea ice 
    30    hninn       =  0.3      !  initial snow thickness in the north 
    31    hnins       =  0.1      !        "            "          south 
    32    hginn       =  3.50     !  initial undeformed ice thickness in the north 
    33    hgins       =  1.0      !        "            "              "     south 
    34    aginn       =  0.95     !  initial undeformed ice concentration in the north 
    35    agins       =  0.9      !        "            "              "         south 
    36    sinn        =  6.301    !  initial salinity in the north 
    37    sins        =  6.301    !        "            "    south 
     29   ln_limini   = .true.    !  activate ice initialization (T) or not (F) 
     30   thres_sst   =  2.0      !  threshold water temperature for initial sea ice 
     31   hts_ini_n   =  0.3      !  initial snow thickness in the north 
     32   hts_ini_s   =  0.1      !        "            "          south 
     33   hti_ini_n   =  3.50     !  initial ice thickness in the north 
     34   hti_ini_s   =  1.0      !        "            "         south 
     35   ati_ini_n   =  0.95     !  initial ice concentration in the north 
     36   ati_ini_s   =  0.9      !        "            "             south 
     37   smi_ini_n   =  6.301    !  initial ice salinity in the north 
     38   smi_ini_s   =  6.301    !        "            "    south 
     39   tmi_ini_n   =  270.     !  initial ice/snw temp in the north 
     40   tmi_ini_s   =  270.     !  initial ice/snw temp in the south 
    3841/ 
    3942!----------------------------------------------------------------------- 
     
    149152&namiceout     !   parameters for outputs 
    150153!----------------------------------------------------------------------- 
    151    noumef      =   43      !  number of fields 
    152    add_diag_swi=    1      !  1 -> diagnose distribution in thickness space 
    153                            !  0 -> only simple diagnostics 
     154!   noumef      =   43      !  number of fields 
     155!SF   add_diag_swi=    1      !  1 -> diagnose distribution in thickness space 
     156!SF                           !  0 -> only simple diagnostics 
    154157! 
    155158!           !         title of the field           !  name     !   units   !  save  ! multipl. ! additive ! 
    156159!           !                                      !           !           ! or not !  factor  !  factor  ! 
    157    field_1  = 'Ice concentration                  ', 'iiceconc', '%       ',    1   ,  1.0     ,    0.0 
    158    field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0 
    159    field_3  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0 
    160    field_4  = 'Daily bottom thermo ice production ', 'iicebopr', 'km3/day ',    1   , 1.0e-9   ,    0.0 
    161    field_5  = 'Daily dynamic ice production       ', 'iicedypr', 'km3/day ',    1   , 1.0e-9   ,    0.0 
    162    field_6  = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0 
    163    field_7  = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0 
    164    field_8  = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0 
    165    field_9  = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15 
    166    field_10 = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0 
    167    field_11 = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    168    field_12 = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    169    field_13 = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0 
    170    field_14 = 'Heat flux due to brine release     ', 'iocehebr', 'w/m2    ',    1   ,  1.0     ,    0.0 
    171    field_15 = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0 
    172    field_16 = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0  
    173    field_17 = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    174    field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    175    field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    176    field_20 = 'Mean ice salinity                  ', 'iicesali', 'psu     ',    1   ,  1.0     ,    0.0 
    177    field_21 = 'Mean ice age                       ', 'iiceages', 'years   ',    1   ,  0.002739,    0.0 
    178    field_22 = 'Daily lateral thermo ice prod.     ', 'iicelapr', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    179    field_23 = 'Daily snowice ice production       ', 'iicesipr', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    180    field_24 = 'Mean ice temperature               ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15 
    181    field_25 = 'Ice total heat content             ', 'iiceheco', '10^9 J  ',    1   ,  1.0     ,    0.0 
    182    field_26 = 'Ice surface temperature            ', 'iicesurt', 'C       ',    1   ,  1.0     , -273.15 
    183    field_27 = 'Snow temperature                   ', 'isnotem2', 'C       ',    1   ,  1.0     , -273.15 
    184    field_28 = 'Fsbri - brine salt flux            ', 'iicefsbr', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    185    field_29 = 'Fseqv - equivalent FW salt flux    ', 'iicefseq', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    186    field_30 = 'Brine volume                       ', 'ibrinvol', '%       ',    1   ,  100.0   ,    0.0 
    187    field_31 = 'Frazil ice collection thickness    ', 'iicecolf', 'm       ',    1   ,  1.0     ,    0.0 
    188    field_32 = 'Ice strength                       ', 'iicestre', 'N/m     ',    1   ,  0.001   ,    0.0 
    189    field_33 = 'Ice velocity                       ', 'iicevelo', 'm/s     ',    1   ,  1.0     ,    0.0 
    190    field_34 = 'Surface melt                       ', 'iicesume', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    191    field_35 = 'Bottom melt                        ', 'iicebome', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    192    field_36 = 'Divergence                         ', 'iicedive', '10-8s-1 ',    1   ,  1.0e8   ,    0.0 
    193    field_37 = 'Shear                              ', 'iiceshea', '10-8s-1 ',    1   ,  1.0e8   ,    0.0 
    194    field_38 = 'Daily resultant ice prod/melt      ', 'iicerepr', 'km3/day ',    1   ,  1.0e-9  ,    0.0 
    195    field_39 = 'Ice volume                         ', 'iicevolu', 'km3     ',    1   ,  1.0e-9  ,    0.0 
    196    field_40 = 'Snow volume                        ', 'isnowvol', 'km3     ',    1   ,  1.0e-9  ,    0.0 
    197    field_41 = 'Fsrpo - salt flux from ridg/raft   ', 'iicefsrp', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    198    field_42 = 'Fsres - salt flux from limupdate   ', 'iicefsre', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    199    field_43 = 'Ice volume transport               ', 'iicevtrp', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    200160/  
    201161 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/cfg.txt

    r4332 r4634  
    77ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    88AMM12 OPA_SRC 
     9ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
    910ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
    10 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4332 r4634  
    207207   !                                               ! 3 - salinity profile, constant in time 
    208208   INTEGER , PUBLIC ::   sal_prof    = 1           !: salinity profile or not  
    209    INTEGER , PUBLIC ::   thcon_i_swi = 1           !: thermal conductivity: =1 Untersteiner (1964) ; =2 Pringle et al (2007) 
     209   INTEGER , PUBLIC ::   thcon_i_swi = 1           !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
    210210 
    211211   !                                              !!** ice-mechanical redistribution namelist (namiceitdme) 
     
    249249   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i        !: Shear of the velocity field [s-1] 
    250250   ! 
    251    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   firic       !: IR flux over the ice (diag only) 
    252    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcsic       !: Sensible heat flux over the ice (diag only) 
    253    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fleic       !: Latent heat flux over the ice (diag only) 
    254    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlatic      !: latent flux 
    255    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvosif     !: Variation of volume at surface (diag only) 
    256    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvobif     !: Variation of ice volume at the bottom ice (diag only) 
    257    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdvolif     !: Total variation of ice volume (diag only) 
    258    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvonif     !: Lateral Variation of ice volume (diag only) 
    259251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist        !: Average Sea-Ice Surface Temperature [Kelvin] 
    260252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   icethi      !: total ice thickness (for all categories) (diag only) 
    261253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    262    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicifp      !: Ice production/melting==>!obsolete... can be removed 
    263254   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction 
    264255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld       !: Leads fraction at previous time   
    265256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif      !: Old ice thickness 
    266    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif        !: Heat flux at the ice base 
    267    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_snw     !: Variation of snow mass over 1 time step     [Kg/m2] 
    268    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_snw     !: Heat content associated with rdm_snw        [J/m2] 
    269    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_ice     !: Variation of ice mass over 1 time step      [Kg/m2] 
    270    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_ice     !: Heat content associated with rdm_ice        [J/m2] 
    271    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif       !: heat balance of the lead (or of the open ocean) 
    272    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif       !: Energy needed to bring the ocean to freezing  
    273    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdtcn       !: net downward heat flux from the ice to the ocean 
    274    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qdtcn       !: energy from the ice to the ocean 
    275    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric      !: transmitted solar radiation under ice 
    276    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fscmbq      !: associated with lead chipotage with solar flux 
    277    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif     !: related to max heat contained in brine pockets (?) 
    278    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbbq       !: Also linked with the solar flux below the ice (?) 
    279    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qfvbq       !: store energy in case of total lateral ablation (?) 
    280    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dmgwi       !: Variation of the mass of snow ice 
    281    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_thd     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
     258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur       !: net downward heat flux from the ice to the ocean 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
     260 
     261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: Variation of snow mass over 1 time step     [Kg/m2] 
     262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: Variation of ice mass over 1 time step      [Kg/m2] 
     263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: Variation of snow mass over 1 time step due to sublimation [Kg/m2] 
     264 
     265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni   ! snow ice growth  
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw   ! lateral ice growth  
     267   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog   ! bottom ice growth  
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn   ! dynamical ice growth  
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom   ! vertical bottom melt  
     270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum   ! vertical surface melt 
     271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res   ! production (growth+melt) due to limupdate 
     272 
     273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     275   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     276   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     277   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_opw     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    282278   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bri     !: salt flux due to brine rejection                      [PSU/m2/s] 
    283    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_mec     !: salt flux due to porous ridged ice formation          [PSU/m2/s] 
     279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_dyn     !: salt flux due to porous ridged ice formation          [PSU/m2/s] 
    284280   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: residual salt flux due to correction of ice thickness [PSU/m2/s] 
    285    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhbri       !: heat flux due to brine rejection 
    286    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_mec   !: heat flux associated with porous ridged ice formation [???] 
    287    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_res   !: residual heat flux due to correction of ice thickness 
    288    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmec       !: mass flux due to snow loss during compression         [Kg/m2/s] 
    289    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhmec       !: heat flux due to snow loss during compression 
     281 
     282   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  
     283   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  
     284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_tot     !: total heat flux lost/gained by ice  
     285   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  
     286   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness 
     287   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt  
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation  
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion  
     290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping  
     291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations  
     292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  
     293 
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice     !: transmitted solar radiation under ice 
    290295 
    291296   ! temporary arrays for dummy version of the code 
    292    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D, q_s 
     297   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, q_s 
    293298 
    294299   !!-------------------------------------------------------------------------- 
     
    404409   LOGICAL , PUBLIC                                      ::   ln_limdiahsb  = .FALSE. !: flag for ice diag (T) or not (F) 
    405410   LOGICAL , PUBLIC                                      ::   ln_limdiaout  = .FALSE. !: flag for ice diag (T) or not (F) 
    406    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   v_newice   !: volume of ice formed in the leads 
    407411   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd  !: thermodynamic growth rates  
    408    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   izero, fstroc, fhbricat 
    409    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sni_gr   ! snow ice growth  
    410    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_lat_gr   ! lateral ice growth  
    411    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_gr   ! bottom ice growth  
    412    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_dyn_gr   ! dynamical ice growth  
    413    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_me   ! vertical bottom melt  
    414    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sur_me   ! vertical surface melt 
    415    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_res_pr   ! production (growth+melt) due to limupdate 
     412   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   izero 
    416413   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   ! transport of ice volume 
     414   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   ! transport of snw volume 
     415   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_ei   ! transport of ice enthalpy (W/m2) 
     416   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_es   ! transport of snw enthalpy (W/m2) 
     417   ! 
     418   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc1    ! snw/ice heat content variation   [W/m2]  
     419   ! 
    417420   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    418421 
     
    447450 
    448451      ii = ii + 1 
    449       ALLOCATE( firic    (jpi,jpj) , fcsic  (jpi,jpj) , fleic  (jpi,jpj) , qlatic   (jpi,jpj) ,     & 
    450          &      rdvosif  (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif(jpi,jpj) , rdvonif  (jpi,jpj) ,     & 
    451          &      sist     (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) , hicifp   (jpi,jpj) ,     & 
    452          &      frld     (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) , fbif     (jpi,jpj) ,     & 
    453          &      rdm_snw  (jpi,jpj) , rdq_snw(jpi,jpj) , rdm_ice(jpi,jpj) , rdq_ice  (jpi,jpj) ,     & 
    454          &                                              qldif  (jpi,jpj) , qcmif    (jpi,jpj) ,     & 
    455          &      fdtcn    (jpi,jpj) , qdtcn  (jpi,jpj) , fstric (jpi,jpj) , fscmbq   (jpi,jpj) ,     & 
    456          &      ffltbif  (jpi,jpj) , fsbbq  (jpi,jpj) , qfvbq  (jpi,jpj) , dmgwi    (jpi,jpj) ,     & 
    457          &      sfx_res  (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_mec(jpi,jpj) , fheat_mec(jpi,jpj) ,     & 
    458          &      fhbri    (jpi,jpj) , fmmec  (jpi,jpj) , sfx_thd(jpi,jpj) , fhmec    (jpi,jpj) ,     & 
    459          &      fheat_res(jpi,jpj)                                                            , STAT=ierr(ii) ) 
    460  
    461       ii = ii + 1 
    462       ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , fstbif(jpi,jpj) ,     & 
    463          &      fsup2D     (jpi,jpj) , focea2D    (jpi,jpj) , q_s   (jpi,jpj) , STAT=ierr(ii) ) 
     452      ALLOCATE( sist     (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,      & 
     453         &      frld     (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,      & 
     454         &      wfx_snw  (jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,    & 
     455         &      wfx_bog(jpi,jpj)  , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     & 
     456         &      wfx_res(jpi,jpj)  , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) ,  qlead  (jpi,jpj) ,     & 
     457         &      fhtur    (jpi,jpj) , ftr_ice(jpi,jpj,jpl) ,      & 
     458         &      sfx_res  (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,      & 
     459         &      sfx_bog  (jpi,jpj) , sfx_bom  (jpi,jpj) , sfx_sum  (jpi,jpj) ,  sfx_sni  (jpi,jpj) ,  sfx_opw  (jpi,jpj) ,   & 
     460         &      hfx_res  (jpi,jpj) , hfx_snw  (jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj), hfx_err_rem(jpi,jpj), & 
     461         &      hfx_in   (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,  & 
     462         &      hfx_tot  (jpi,jpj) , hfx_thd  (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj),  STAT=ierr(ii) ) 
     463 
     464      ii = ii + 1 
     465      ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) ) 
    464466 
    465467      ! * Ice global state variables 
     
    522524      ! * Ice diagnostics 
    523525      ii = ii + 1 
    524       ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , diag_sni_gr(jpi,jpj) , diag_lat_gr(jpi,jpj) ,     & 
    525          &      izero    (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) ,     & 
    526          &      fstroc   (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) ,     & 
    527          &      fhbricat (jpi,jpj,jpl) , diag_res_pr(jpi,jpj) , diag_trp_vi(jpi,jpj) , v_newice(jpi,jpj) , STAT=ierr(ii) ) 
     526      ALLOCATE( dv_dt_thd(jpi,jpj,jpl) ,     & 
     527         &      izero    (jpi,jpj,jpl)  , diag_trp_vi(jpi,jpj) , diag_trp_vs(jpi,jpj), diag_trp_ei(jpi,jpj), diag_trp_es(jpi,jpj),     &  
     528         &      diag_heat_dhc1(jpi,jpj) ,  STAT=ierr(ii) ) 
    528529 
    529530      ice_alloc = MAXVAL( ierr(:) ) 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r4045 r4634  
    3232 
    3333   REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values 
    34    REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    35    REAL(wp)  ::   rone   = 1._wp       !    -       - 
    3634 
    3735   !! * Substitutions 
     
    8482      DO jj = 1, jpj 
    8583         DO ji = 1, jpi 
    86             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     84            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    8785            zs1max  = 1.5 * zslpmax 
    8886            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 
    8987            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    9088               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    91             zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     89            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    9290 
    9391            ps0 (ji,jj) = zslpmax   
     
    106104      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0  
    107105         DO ji = 1, jpi 
    108             zbet(ji,jj)  =  MAX( rzero, SIGN( rone, put(ji,jj) ) ) 
    109             zalf         =  MAX( rzero, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
     106            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
     107            zalf         =  MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
    110108            zalfq        =  zalf * zalf 
    111109            zalf1        =  1.0 - zalf 
     
    133131      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0. 
    134132         DO ji = 1, fs_jpim1 
    135             zalf          = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
     133            zalf          = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
    136134            zalg  (ji,jj) = zalf 
    137135            zalfq         = zalf * zalf 
     
    269267      DO jj = 1, jpj 
    270268         DO ji = 1, jpi 
    271             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     269            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    272270            zs1max  = 1.5 * zslpmax 
    273271            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 
    274272            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    275273               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    276             zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     274            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    277275            ! 
    278276            ps0 (ji,jj) = zslpmax   
     
    291289      DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0    
    292290         DO ji = 1, jpi 
    293             zbet(ji,jj)  =  MAX( rzero, SIGN( rone, pvt(ji,jj) ) ) 
    294             zalf         =  MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
     291            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
     292            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
    295293            zalfq        =  zalf * zalf 
    296294            zalf1        =  1.0 - zalf 
     
    318316      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    319317         DO ji = 1, jpi 
    320             zalf          = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
     318            zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
    321319            zalg  (ji,jj) = zalf 
    322320            zalfq         = zalf * zalf 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r4345 r4634  
    1818   USE dom_oce         ! ocean domain 
    1919   USE sbc_oce         ! surface boundary condition: ocean fields 
     20   USE sbc_ice         ! Surface boundary condition: sea-ice fields 
    2021   USE daymod          ! model calendar 
    2122   USE phycst          ! physical constant 
     
    3435   !!PUBLIC   lim_diahsb_rst   ! routine called by ice_init.F90 
    3536 
    36    REAL(dp) ::   frc_sal, frc_vol   ! global forcing trends 
    37    REAL(dp) ::   bg_grme            ! global ice growth+melt trends 
     37   REAL(wp) ::   frc_sal, frc_vol   ! global forcing trends 
     38   REAL(wp) ::   bg_grme            ! global ice growth+melt trends 
    3839   REAL(wp) ::   epsi06 = 1.e-6_wp  ! small number 
    39    REAL(wp) ::   epsi03 = 1.e-3_wp  ! small number 
    40  
    4140 
    4241   !! * Substitutions 
     
    4847   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4948   !!---------------------------------------------------------------------- 
    50  
    5149CONTAINS 
    5250 
     
    5957      !!--------------------------------------------------------------------------- 
    6058      !! 
    61       REAL(dp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
    62       REAL(dp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_thd, zbg_sfx_res, zbg_sfx_mec  
    63       REAL(dp)   ::   zbg_emp, zbg_emp_bog, zbg_emp_lag, zbg_emp_sig, zbg_emp_dyg, zbg_emp_bom, zbg_emp_sum, zbg_emp_res  
    64       REAL(dp)   ::   z_frc_vol, z_frc_sal, z_bg_grme  
    65       REAL(dp)   ::   z1_area                     !    -     - 
    66       REAL(dp)   ::   zinda, zindb 
     59      REAL(wp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
     60      REAL(wp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn  
     61      REAL(wp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn, zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res  
     62      REAL(wp)   ::   zbg_hfx_dhc1, zbg_hfx_spr, zbg_hfx_qsr, zbg_hfx_qns 
     63      REAL(wp)   ::   zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_tot, zbg_hfx_out, zbg_hfx_in    
     64      REAL(wp)   ::   z_frc_vol, z_frc_sal, z_bg_grme  
     65      REAL(wp)   ::   z1_area, zcoef                     
     66      REAL(wp)   ::   zinda, zindb 
    6767      !!--------------------------------------------------------------------------- 
    6868      IF( nn_timing == 1 )   CALL timing_start('lim_diahsb') 
     
    7070      IF( numit == nstart ) CALL lim_diahsb_init  
    7171 
    72       ! 1/area 
    73       z1_area = 1.d0 / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
    74  
    75       zinda = MAX( 0.d0 , SIGN( 1.d0 , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 
     72      z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
     73 
     74      zinda = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 
    7675      ! ----------------------- ! 
    7776      ! 1 -  Content variations ! 
     
    8079      zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow 
    8180      zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area 
    82       zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )       ! mean salt content 
     81      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 )      * area(:,:) * tms(:,:) )  ! mean salt content 
    8382      zbg_tem = glob_sum( ( tm_i(:,:) - rtt ) * vt_i(:,:) * area(:,:) * tms(:,:) )  ! mean temp content 
    8483 
    85       !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 
    86       !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
    87  
    88       zbg_ihc = glob_sum( et_i(:,:) * 1.e-11 ) ! ice heat content  [10^9*1.e-11 J] 
    89       zbg_shc = glob_sum( et_s(:,:) * 1.e-11 ) ! snow heat content [10^9*1.e-11 J] 
    90  
    91       zbg_emp     = zinda * glob_sum(         emp(:,:) * area(:,:) * tms(:,:) ) * z1_area         * r1_rau0 * rday 
    92       zbg_emp_bog = zinda * glob_sum( diag_bot_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    93       zbg_emp_lag = zinda * glob_sum( diag_lat_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    94       zbg_emp_sig = zinda * glob_sum( diag_sni_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    95       zbg_emp_dyg = zinda * glob_sum( diag_dyn_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    96       zbg_emp_bom = zinda * glob_sum( diag_bot_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    97       zbg_emp_sum = zinda * glob_sum( diag_sur_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    98       zbg_emp_res = zinda * glob_sum( diag_res_pr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    99  
    100       zbg_sfx     = zinda * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    101       zbg_sfx_bri = zinda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    102       zbg_sfx_thd = zinda * glob_sum( sfx_thd(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    103       zbg_sfx_res = zinda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    104       zbg_sfx_mec = zinda * glob_sum( sfx_mec(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    105        
     84      zcoef = zinda * z1_area * r1_rau0 * rday 
     85      ! Volume 
     86      zbg_vfx     = glob_sum(     emp(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     87      zbg_vfx_bog = glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     88      zbg_vfx_opw = glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     89      zbg_vfx_sni = glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     90      zbg_vfx_dyn = glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     91      zbg_vfx_bom = glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     92      zbg_vfx_sum = glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     93      zbg_vfx_res = glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     94 
     95      ! Salt 
     96      zbg_sfx     = glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     97      zbg_sfx_bri = glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     98      zbg_sfx_res = glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     99      zbg_sfx_dyn = glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     100 
     101      zbg_sfx_bog = glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     102      zbg_sfx_opw = glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     103      zbg_sfx_sni = glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     104      zbg_sfx_bom = glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     105      zbg_sfx_sum = glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) * zcoef 
     106 
     107      ! Heat budget 
     108      zbg_ihc      = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content  [1.e-20 J] 
     109      zbg_shc      = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J] 
     110      zbg_hfx_dhc1 = glob_sum( diag_heat_dhc1(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     111      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     112      zbg_hfx_qsr  = glob_sum( qsr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     113      zbg_hfx_qns  = glob_sum( qns(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     114 
     115      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     116      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     117      zbg_hfx_res  = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     118      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     119      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     120      zbg_hfx_tot  = glob_sum( hfx_tot(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     121      zbg_hfx_out  = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     122      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     123     
    106124      ! --------------------------------------------- ! 
    107125      ! 2 - Trends due to forcing and ice growth/melt ! 
     
    109127      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 
    110128      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes 
    111       z_bg_grme = glob_sum( ( diag_bot_gr(:,:) + diag_lat_gr(:,:) + diag_sni_gr(:,:) + diag_dyn_gr(:,:) + & 
    112                           &    diag_bot_me(:,:) + diag_sur_me(:,:) + diag_res_pr(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 
    113       ! 
    114       frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
    115       frc_sal  = frc_sal  + z_frc_sal  * rdt_ice 
    116       bg_grme  = bg_grme  + z_bg_grme  * rdt_ice 
    117        
    118       ! difference 
    119       !frc_vol = zbg_ivo - frc_vol 
    120       !frc_sal = zbg_sal - frc_sal 
    121        
     129      z_bg_grme = glob_sum( ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
     130                          &   wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) ) / rhoic * area(:,:) * tms(:,:) ) ! volume fluxes 
     131      ! 
     132      frc_vol  = frc_vol + z_frc_vol * rdt_ice 
     133      frc_sal  = frc_sal + z_frc_sal * rdt_ice 
     134      bg_grme  = bg_grme + z_bg_grme * rdt_ice 
     135             
    122136      ! ----------------------- ! 
    123137      ! 3 - Diagnostics writing ! 
    124138      ! ----------------------- ! 
    125       zindb = MAX( 0.d0 , SIGN( 1.d0 , zbg_ivo - epsi06 ) ) 
     139      zindb = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 
    126140      ! 
    127141      CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9        )   ! ice volume (km3 equivalent liquid)          
     
    134148      CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9        )   ! ice salt content (psu*km3 equivalent liquid)         
    135149 
    136       CALL iom_put( 'ibgemp'    , zbg_emp                                  )   ! volume flux emp (m/day liquid) 
    137       CALL iom_put( 'ibgempbog' , zbg_emp_bog                              )   ! volume flux bottom growth     -(m/day equivalent liquid) 
    138       CALL iom_put( 'ibgemplag' , zbg_emp_lag                              )   ! volume flux open water growth - 
    139       CALL iom_put( 'ibgempsig' , zbg_emp_sig                              )   ! volume flux snow ice growth   - 
    140       CALL iom_put( 'ibgempdyg' , zbg_emp_dyg                              )   ! volume flux dynamic growth    - 
    141       CALL iom_put( 'ibgempbom' , zbg_emp_bom                              )   ! volume flux bottom melt       - 
    142       CALL iom_put( 'ibgempsum' , zbg_emp_sum                              )   ! volume flux surface melt      - 
    143       CALL iom_put( 'ibgempres' , zbg_emp_res                              )   ! volume flux resultant         - 
     150      CALL iom_put( 'ibgvfx'    , zbg_vfx                                  )   ! volume flux emp (m/day liquid) 
     151      CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog                              )   ! volume flux bottom growth     -(m/day equivalent liquid) 
     152      CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw                              )   ! volume flux open water growth - 
     153      CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni                              )   ! volume flux snow ice growth   - 
     154      CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn                              )   ! volume flux dynamic growth    - 
     155      CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom                              )   ! volume flux bottom melt       - 
     156      CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum                              )   ! volume flux surface melt      - 
     157      CALL iom_put( 'ibgvfxres' , zbg_vfx_res                              )   ! volume flux resultant         - 
    144158           
    145159      CALL iom_put( 'ibgsfx'    , zbg_sfx                                  )   ! salt flux         -(psu*m/day equivalent liquid)        
    146160      CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri                              )   ! salt flux brines  -       
    147       CALL iom_put( 'ibgsfxthd' , zbg_sfx_thd                              )   ! salt flux thermo  -     
    148       CALL iom_put( 'ibgsfxmec' , zbg_sfx_mec                              )   ! salt flux dynamic -     
     161      CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn                              )   ! salt flux dynamic -     
    149162      CALL iom_put( 'ibgsfxres' , zbg_sfx_res                              )   ! salt flux result  -     
     163      CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog                              )   ! salt flux bottom growth    
     164      CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw                              )   ! salt flux open water growth - 
     165      CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni                              )   ! salt flux snow ice growth   - 
     166      CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom                              )   ! salt flux bottom melt       - 
     167      CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum                              )   ! salt flux surface melt      - 
     168 
     169      CALL iom_put( 'ibghfxdhc1', zbg_hfx_dhc1                            )   ! Heat content variation in snow and ice [W] 
     170      CALL iom_put( 'ibghfxspr' , zbg_hfx_spr                              )   ! Heat content of snow precip [W] 
     171      CALL iom_put( 'ibghfxqsr' , zbg_hfx_qsr                              )   !     solar fluxes used by snw/ice [W] 
     172      CALL iom_put( 'ibghfxqns' , zbg_hfx_qns                              )   ! non solar fluxes used by snw/ice [W] 
     173 
     174      CALL iom_put( 'ibghfxres' , zbg_hfx_res                              )   !  
     175      CALL iom_put( 'ibghfxsub' , zbg_hfx_sub                              )   !  
     176      CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn                              )   !  
     177      CALL iom_put( 'ibghfxthd' , zbg_hfx_thd                              )   !  
     178      CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw                              )   !  
     179      CALL iom_put( 'ibghfxtot' , zbg_hfx_tot                              )   !  
     180      CALL iom_put( 'ibghfxout' , zbg_hfx_out                              )   !  
     181      CALL iom_put( 'ibghfxin'  , zbg_hfx_in                              )   !  
    150182 
    151183      CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9                          )   ! vol - forcing     (km3 equivalent liquid)  
    152184      CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9                          )   ! sal - forcing     (psu*km3 equivalent liquid)    
    153       CALL iom_put( 'ibggrme'   , bg_grme * rhoic * r1_rau0 * 1.e-9        )   ! vol growth + melt (km3 equivalent liquid)          
     185      CALL iom_put( 'ibgvolgrm' , bg_grme * rhoic * r1_rau0 * 1.e-9        )   ! vol growth + melt (km3 equivalent liquid)          
     186 
    154187      ! 
    155188      IF( lrst_ice )   CALL lim_diahsb_rst( numit, 'WRITE' ) 
    156189      ! 
    157190      IF( nn_timing == 1 )   CALL timing_stop('lim_diahsb') 
    158 ! 
     191      ! 
    159192   END SUBROUTINE lim_diahsb 
    160193 
     
    190223      ! 2 - initial conservation variables ! 
    191224      ! ---------------------------------- ! 
    192       !frc_vol = 0.d0                                           ! volume       trend due to forcing 
    193       !frc_sal = 0.d0                                           ! salt content   -    -   -    -          
    194       !bg_grme = 0.d0                                           ! ice growth + melt volume trend 
    195225      ! 
    196226      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files 
     
    226256           IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' 
    227257           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    228            frc_vol  = 0.d0                                            
    229            frc_sal  = 0.d0                                                   
    230            bg_grme  = 0.d0                                         
     258           frc_vol  = 0._wp                                            
     259           frc_sal  = 0._wp                                                   
     260           bg_grme  = 0._wp                                         
    231261       ENDIF    
    232262 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4155 r4634  
    8080         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    8181         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    82          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    83          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     82         zchk_fw_b  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 
     83         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 
    8484      ENDIF 
    8585      !- check conservation (C Rousset) 
     
    227227      !- check conservation (C Rousset) 
    228228      IF (ln_limdiahsb) THEN 
    229          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    230          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     229         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     230         zchk_fw  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    231231  
    232          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
    233          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
     232         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - ( zchk_fw / rhoic ) 
     233         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    234234 
    235235         zchk_vmin = glob_min(v_i) 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4337 r4634  
    3030   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3131   USE wrk_nemo         ! work arrays 
     32   USE cpl_oasis3, ONLY : lk_cpl 
    3233 
    3334   IMPLICIT NONE 
     
    3839   !! * Module variables 
    3940   REAL(wp) ::             & !!! ** init namelist (namiceini) ** 
    40       ttest    = 2.0  ,    &  ! threshold water temperature for initial sea ice 
    41       hninn    = 0.5  ,    &  ! initial snow thickness in the north 
    42       hnins    = 0.1  ,    &  ! initial snow thickness in the south 
    43       hginn    = 2.5  ,    &  ! initial ice thickness in the north 
    44       hgins    = 1.0  ,    &  ! initial ice thickness in the south 
    45       aginn    = 0.7  ,    &  ! initial leads area in the north 
    46       agins    = 0.7  ,    &  ! initial leads area in the south 
    47       sinn     = 6.301 ,   &  ! initial salinity  
    48       sins     = 6.301 
    49  
     41      thres_sst   = 2.0   ,    &  ! threshold water temperature for initial sea ice 
     42      hts_ini_n   = 0.5   ,    &  ! initial snow thickness in the north 
     43      hts_ini_s   = 0.1   ,    &  ! initial snow thickness in the south 
     44      hti_ini_n   = 2.5   ,    &  ! initial ice thickness in the north 
     45      hti_ini_s   = 1.0   ,    &  ! initial ice thickness in the south 
     46      ati_ini_n   = 0.7   ,    &  ! initial leads area in the north 
     47      ati_ini_s   = 0.7   ,    &  ! initial leads area in the south 
     48      smi_ini_n   = 6.301 ,    &  ! initial salinity  
     49      smi_ini_s   = 6.301 ,    &  ! initial salinity 
     50      tmi_ini_n   = 270.  ,    &  ! initial temperature 
     51      tmi_ini_s   = 270.          ! initial temperature 
     52 
     53   LOGICAL  ::  ln_limini = .TRUE. 
    5054   !!---------------------------------------------------------------------- 
    5155   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
     
    9094      INTEGER    :: i_hemis, i_fill, jl0   
    9195      REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 
    92       REAL(wp), POINTER, DIMENSION(:)     :: zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini 
    93       REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, za_i_ini, zv_i_ini 
    94       REAL(wp), POINTER, DIMENSION(:,:)   :: zidto    ! ice indicator 
     96      REAL(wp), POINTER, DIMENSION(:)     :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini 
     97      REAL(wp), POINTER, DIMENSION(:,:)   :: zh_i_ini, za_i_ini, zv_i_ini 
     98      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator 
    9599      INTEGER,  POINTER, DIMENSION(:,:)   :: zhemis   ! hemispheric index 
    96100      !-------------------------------------------------------------------- 
    97101 
    98       CALL wrk_alloc( jpi, jpj, zidto ) 
     102      CALL wrk_alloc( jpi, jpj, zswitch ) 
    99103      CALL wrk_alloc( jpi, jpj, zhemis ) 
    100       CALL wrk_alloc( jpl,   2, zht_i_ini,  za_i_ini,  zv_i_ini ) 
    101       CALL wrk_alloc(   2,      zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 
    102  
    103       epsi20   = 1.0e-20 
     104      CALL wrk_alloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     105      CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
     106 
     107      epsi20   = 1.e-20_wp 
     108 
    104109      IF(lwp) WRITE(numout,*) 
    105110      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
     
    112117      CALL lim_istate_init     !  reading the initials parameters of the ice 
    113118 
    114 !!gm  in lim2  the initialisation if only done if required in the namelist : 
    115 !!gm      IF( .NOT. ln_limini ) THEN 
    116 !!gm  this should be added in lim3 namelist... 
     119# if defined key_coupled 
     120      albege(:,:)   = 0.8 * tms(:,:) 
     121# endif 
     122 
     123      ! surface temperature 
     124      DO jl = 1, jpl ! loop over categories 
     125         t_su  (:,:,jl) = rtt * tms(:,:) 
     126         tn_ice(:,:,jl) = rtt * tms(:,:) 
     127      END DO 
     128      ! Basal temperature is set to the freezing point of seawater in Kelvin 
     129      t_bo(:,:) = ( tfreez( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:)  
     130 
     131      IF( ln_limini ) THEN 
    117132 
    118133      !-------------------------------------------------------------------- 
    119134      ! 2) Basal temperature, ice mask and hemispheric index 
    120135      !-------------------------------------------------------------------- 
    121  
    122       ! Basal temperature is set to the freezing point of seawater in Celsius 
    123       t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    124  
    125       DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
     136      ! ice if sst <= t-freez + thres_sst 
     137      DO jj = 1, jpj                                        
    126138         DO ji = 1, jpi 
    127             IF( tsn(ji,jj,1,jp_tem)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0._wp      ! no ice 
    128             ELSE                                                     ;   zidto(ji,jj) = 1._wp      !    ice 
     139            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN  ; zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice 
     140            ELSE                                                                                   ; zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice 
    129141            ENDIF 
    130142         END DO 
    131143      END DO 
    132144 
    133       t_bo(:,:) = t_bo(:,:) + rt0                          ! conversion to Kelvin 
    134145 
    135146      ! Hemispheric index 
     
    153164      ! 3.1) Hemisphere-dependent arrays 
    154165      !----------------------------- 
    155       ! assign initial thickness, concentration, snow depth and salinity to 
    156       ! an hemisphere-dependent array 
    157       zhm_i_ini(1) = hginn ; zhm_i_ini(2) = hgins  ! ice thickness 
    158       zat_i_ini(1) = aginn ; zat_i_ini(2) = agins  ! ice concentration 
    159       zvt_i_ini(:) = zhm_i_ini(:) * zat_i_ini(:)   ! ice volume 
    160       zhm_s_ini(1) = hninn ; zhm_s_ini(2) = hnins  ! snow depth 
    161       zsm_i_ini(1) = sinn  ; zsm_i_ini(2) = sins   ! bulk ice salinity 
     166      ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
     167      zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s  ! ice thickness 
     168      zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s  ! snow depth 
     169      zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s  ! ice concentration 
     170      zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s  ! bulk ice salinity 
     171      ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s  ! temperature (ice and snow) 
     172 
     173      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume 
    162174 
    163175      !--------------------------------------------------------------------- 
     
    183195            ! *** 1 category to fill 
    184196            IF ( i_fill .EQ. 1 ) THEN 
    185                zht_i_ini(1,i_hemis)       = zhm_i_ini(i_hemis) 
    186                za_i_ini(1,i_hemis)        = zat_i_ini(i_hemis) 
    187                zht_i_ini(2:jpl,i_hemis)   = 0._wp 
    188                za_i_ini(2:jpl,i_hemis)    = 0._wp 
     197               zh_i_ini(1,i_hemis)       = zht_i_ini(i_hemis) 
     198               za_i_ini(1,i_hemis)       = zat_i_ini(i_hemis) 
     199               zh_i_ini(2:jpl,i_hemis)   = 0._wp 
     200               za_i_ini(2:jpl,i_hemis)   = 0._wp 
    189201            ELSE 
    190202 
    191             ! *** >1 categores to fill 
    192             !--- Ice thicknesses in the i_fill - 1 first categories 
     203               ! *** >1 categores to fill 
     204               !--- Ice thicknesses in the i_fill - 1 first categories 
    193205               DO jl = 1, i_fill - 1 
    194                   zht_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
     206                  zh_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
    195207               END DO 
    196  
    197             !--- jl0: most likely index where cc will be maximum 
     208                
     209               !--- jl0: most likely index where cc will be maximum 
    198210               DO jl = 1, jpl 
    199                   IF ( ( zhm_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
    200                        ( zhm_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
     211                  IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
     212                     ( zht_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
    201213                     jl0 = jl 
    202214                  ENDIF 
    203215               END DO 
    204216               jl0 = MIN(jl0, i_fill) 
    205  
    206             !--- Concentrations 
     217                
     218               !--- Concentrations 
    207219               za_i_ini(jl0,i_hemis)      = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 
    208220               DO jl = 1, i_fill - 1 
    209221                  IF ( jl .NE. jl0 ) THEN 
    210                      zsigma               = 0.5 * zhm_i_ini(i_hemis) 
    211                      zarg                 = ( zht_i_ini(jl,i_hemis) - zhm_i_ini(i_hemis) ) / zsigma 
     222                     zsigma               = 0.5 * zht_i_ini(i_hemis) 
     223                     zarg                 = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma 
    212224                     za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 
    213225                  ENDIF 
    214                END DO  
    215  
     226               END DO 
     227                
    216228               zA = 0. ! sum of the areas in the jpl categories  
    217229               DO jl = 1, i_fill - 1 
     
    221233               IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    222234          
    223             !--- Ice thickness in the last category 
     235               !--- Ice thickness in the last category 
    224236               zV = 0. ! sum of the volumes of the N-1 categories 
    225237               DO jl = 1, i_fill - 1 
    226                   zV = zV + za_i_ini(jl,i_hemis)*zht_i_ini(jl,i_hemis) 
     238                  zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis) 
    227239               END DO 
    228                zht_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
    229                IF ( i_fill .LT. jpl ) zht_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    230  
    231             !--- volumes 
    232                zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zht_i_ini(:,i_hemis) 
     240               zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
     241               IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
     242 
     243               !--- volumes 
     244               zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis) 
    233245               IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    234246 
     
    262274 
    263275            ! Test 3: thickness of the last category is in-bounds ? 
    264             IF ( zht_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
     276            IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
    265277               ztest_3 = 1 
    266278            ELSE 
    267279               ! this write is useful 
    268                IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zht_i_ini(i_fill,i_hemis) = ', & 
    269                zht_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
     280               IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 
     281               zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
    270282               ztest_3 = 0 
    271283            ENDIF 
     
    291303         IF ( ztests .NE. 4 ) THEN 
    292304            WRITE(numout,*) 
    293             WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
    294             WRITE(numout,*), ' !!!! RED ALERT                  !!! ' 
    295             WRITE(numout,*), ' !!!! BIIIIP BIIIP BIIIIP BIIIIP !!!' 
     305            WRITE(numout,*), ' !!!! ALERT                  !!! ' 
    296306            WRITE(numout,*), ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    297             WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
    298307            WRITE(numout,*) 
    299308            WRITE(numout,*), ' *** ztests is not equal to 4 ' 
    300309            WRITE(numout,*), ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    301310            WRITE(numout,*), ' zat_i_ini : ', zat_i_ini(i_hemis) 
    302             WRITE(numout,*), ' zhm_i_ini : ', zhm_i_ini(i_hemis) 
     311            WRITE(numout,*), ' zht_i_ini : ', zht_i_ini(i_hemis) 
    303312         ENDIF ! ztests .NE. 4 
    304313      ENDIF 
     
    314323         DO jj = 1, jpj 
    315324            DO ji = 1, jpi 
    316                a_i(ji,jj,jl)   = zidto(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
    317                ht_i(ji,jj,jl)  = zidto(ji,jj) * zht_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
    318                ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zhm_s_ini( zhemis(ji,jj) ) / zhm_i_ini( zhemis(ji,jj) ) )  ! snow depth 
    319                sm_i(ji,jj,jl)  = zidto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min ! salinity 
    320                o_i(ji,jj,jl)   = zidto(ji,jj) * 1._wp + ( 1._wp - zidto(ji,jj) ) ! age 
    321                t_su(ji,jj,jl)  = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * 270.0 ! surf temp 
     325               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
     326               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
     327               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth 
     328               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity 
     329               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 
     330               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp 
    322331 
    323332               ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
     
    343352            DO jj = 1, jpj 
    344353               DO ji = 1, jpi 
    345                    t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * rtt 
     354                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 
    346355                   ! Snow energy of melting 
    347                    e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
     356                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    348357                   ! Change dimensions 
    349358                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    350                    ! Multiply by volume, so that heat content in 10^9 Joules 
     359                   ! Multiply by volume, so that heat content in Joules 
    351360                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
    352361               END DO ! ji 
     
    360369            DO jj = 1, jpj 
    361370               DO ji = 1, jpi 
    362                    t_i(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1._wp - zidto(ji,jj) ) * rtt  
    363                    s_i(ji,jj,jk,jl) = zidto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min 
     371                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt  
     372                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min 
    364373                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    365374 
    366375                   ! heat content per unit volume 
    367                    e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     376                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    368377                      +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
    369378                      -   rcp     * ( ztmelts - rtt ) ) 
     
    372381                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    373382 
    374                    ! Mutliply by ice volume, and divide by number of layers  
    375                    ! to get heat content in 10^9 J 
     383                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J 
    376384                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 
    377385               END DO ! ji 
     
    380388      END DO ! jk 
    381389 
    382       !-------------------------------------------------------------------- 
    383       ! 4) Global ice variables for output diagnostics                    |  
    384       !-------------------------------------------------------------------- 
    385       fsbbq (:,:)     = 0._wp 
    386       u_ice (:,:)     = 0._wp 
    387       v_ice (:,:)     = 0._wp 
    388       stress1_i(:,:)  = 0._wp 
    389       stress2_i(:,:)  = 0._wp 
    390       stress12_i(:,:) = 0._wp 
    391  
    392 # if defined key_coupled 
    393       albege(:,:)   = 0.8 * tms(:,:) 
    394 # endif 
    395  
    396       !-------------------------------------------------------------------- 
    397       ! 5) Moments for advection 
    398       !-------------------------------------------------------------------- 
    399  
    400       sxopw (:,:) = 0._wp  
    401       syopw (:,:) = 0._wp  
    402       sxxopw(:,:) = 0._wp  
    403       syyopw(:,:) = 0._wp  
    404       sxyopw(:,:) = 0._wp 
    405  
    406       sxice (:,:,:)  = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:)  = 0._wp 
    407       syice (:,:,:)  = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:)  = 0._wp 
    408       sxxice(:,:,:)  = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:)  = 0._wp 
    409       syyice(:,:,:)  = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:)  = 0._wp 
    410       sxyice(:,:,:)  = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:)  = 0._wp 
    411  
    412       sxc0  (:,:,:)  = 0._wp   ;   sxe  (:,:,:,:)= 0._wp    
    413       syc0  (:,:,:)  = 0._wp   ;   sye  (:,:,:,:)= 0._wp    
    414       sxxc0 (:,:,:)  = 0._wp   ;   sxxe (:,:,:,:)= 0._wp    
    415       syyc0 (:,:,:)  = 0._wp   ;   syye (:,:,:,:)= 0._wp    
    416       sxyc0 (:,:,:)  = 0._wp   ;   sxye (:,:,:,:)= 0._wp    
    417  
    418       sxsal  (:,:,:)  = 0._wp 
    419       sysal  (:,:,:)  = 0._wp 
    420       sxxsal (:,:,:)  = 0._wp 
    421       syysal (:,:,:)  = 0._wp 
    422       sxysal (:,:,:)  = 0._wp 
    423  
    424       sxage  (:,:,:)  = 0._wp 
    425       syage  (:,:,:)  = 0._wp 
    426       sxxage (:,:,:)  = 0._wp 
    427       syyage (:,:,:)  = 0._wp 
    428       sxyage (:,:,:)  = 0._wp 
    429  
    430       !-------------------------------------------------------------------- 
    431       ! 6) Lateral boundary conditions                                    |  
    432       !-------------------------------------------------------------------- 
    433  
     390      tn_ice (:,:,:) = t_su (:,:,:) 
     391 
     392      !-------------------------------------------------------------------- 
     393      ! 4) Lateral boundary conditions                                    |  
     394      !-------------------------------------------------------------------- 
    434395      DO jl = 1, jpl 
    435396 
     
    445406         CALL lbc_lnk( o_i(:,:,jl)  , 'T', 1. ) 
    446407         CALL lbc_lnk( t_su(:,:,jl) , 'T', 1. ) 
     408         CALL lbc_lnk( tn_ice(:,:,jl) , 'T', 1. ) 
    447409         DO jk = 1, nlay_s 
    448410            CALL lbc_lnk(t_s(:,:,jk,jl), 'T', 1. ) 
     
    454416         END DO 
    455417         ! 
    456          a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl) 
     418!         a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl) 
    457419      END DO 
     420 
     421      ELSE  
     422         ! if ln_limini=false 
     423         a_i  (:,:,:) = 0._wp 
     424         v_i  (:,:,:) = 0._wp 
     425         v_s  (:,:,:) = 0._wp 
     426         smv_i(:,:,:) = 0._wp 
     427         oa_i (:,:,:) = 0._wp 
     428         ht_i (:,:,:) = 0._wp 
     429         ht_s (:,:,:) = 0._wp 
     430         sm_i (:,:,:) = 0._wp 
     431         o_i  (:,:,:) = 0._wp 
     432 
     433         e_i(:,:,:,:) = 0._wp 
     434         e_s(:,:,:,:) = 0._wp 
     435 
     436         DO jl = 1, jpl 
     437            DO jk = 1, nlay_i 
     438               t_i(:,:,jk,jl) = rtt * tms(:,:) 
     439            END DO 
     440            DO jk = 1, nlay_s 
     441               t_s(:,:,jk,jl) = rtt * tms(:,:) 
     442            END DO 
     443         END DO 
     444       
     445      ENDIF ! ln_limini 
    458446       
    459447      at_i (:,:) = 0.0_wp 
     
    461449         at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
    462450      END DO 
    463  
    464451      CALL lbc_lnk( at_i , 'T', 1. ) 
    465       at_i(:,:) = tms(:,:) * at_i(:,:)                       ! put 0 over land 
     452!      at_i(:,:) = tms(:,:) * at_i(:,:) 
    466453      ! 
    467       CALL lbc_lnk( fsbbq  , 'T', 1. ) 
    468       ! 
    469       !-------------------------------------------------------------------- 
    470       ! 6) ????                                                           |  
    471       !-------------------------------------------------------------------- 
    472       tn_ice (:,:,:) = t_su (:,:,:) 
    473  
    474       CALL wrk_dealloc( jpi, jpj, zidto ) 
     454      !-------------------------------------------------------------------- 
     455      ! 5) Global ice variables for output diagnostics                    |  
     456      !-------------------------------------------------------------------- 
     457      u_ice (:,:)     = 0._wp 
     458      v_ice (:,:)     = 0._wp 
     459      stress1_i(:,:)  = 0._wp 
     460      stress2_i(:,:)  = 0._wp 
     461      stress12_i(:,:) = 0._wp 
     462 
     463      !-------------------------------------------------------------------- 
     464      ! 6) Moments for advection 
     465      !-------------------------------------------------------------------- 
     466 
     467      sxopw (:,:) = 0._wp  
     468      syopw (:,:) = 0._wp  
     469      sxxopw(:,:) = 0._wp  
     470      syyopw(:,:) = 0._wp  
     471      sxyopw(:,:) = 0._wp 
     472 
     473      sxice (:,:,:)  = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:)  = 0._wp 
     474      syice (:,:,:)  = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:)  = 0._wp 
     475      sxxice(:,:,:)  = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:)  = 0._wp 
     476      syyice(:,:,:)  = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:)  = 0._wp 
     477      sxyice(:,:,:)  = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:)  = 0._wp 
     478 
     479      sxc0  (:,:,:)  = 0._wp   ;   sxe  (:,:,:,:)= 0._wp    
     480      syc0  (:,:,:)  = 0._wp   ;   sye  (:,:,:,:)= 0._wp    
     481      sxxc0 (:,:,:)  = 0._wp   ;   sxxe (:,:,:,:)= 0._wp    
     482      syyc0 (:,:,:)  = 0._wp   ;   syye (:,:,:,:)= 0._wp    
     483      sxyc0 (:,:,:)  = 0._wp   ;   sxye (:,:,:,:)= 0._wp    
     484 
     485      sxsal  (:,:,:)  = 0._wp 
     486      sysal  (:,:,:)  = 0._wp 
     487      sxxsal (:,:,:)  = 0._wp 
     488      syysal (:,:,:)  = 0._wp 
     489      sxysal (:,:,:)  = 0._wp 
     490 
     491      sxage  (:,:,:)  = 0._wp 
     492      syage  (:,:,:)  = 0._wp 
     493      sxxage (:,:,:)  = 0._wp 
     494      syyage (:,:,:)  = 0._wp 
     495      sxyage (:,:,:)  = 0._wp 
     496 
     497 
     498      CALL wrk_dealloc( jpi, jpj, zswitch ) 
    475499      CALL wrk_dealloc( jpi, jpj, zhemis ) 
    476       CALL wrk_dealloc( jpl,   2, zht_i_ini,  za_i_ini,  zv_i_ini ) 
    477       CALL wrk_dealloc(   2,      zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 
     500      CALL wrk_dealloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     501      CALL wrk_dealloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    478502 
    479503   END SUBROUTINE lim_istate 
     
    495519      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    496520      !!----------------------------------------------------------------------------- 
    497       NAMELIST/namiceini/ ttest, hninn, hnins, hginn, hgins, aginn, agins, sinn, sins 
     521      NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s,  & 
     522         &                                      ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s 
    498523      !!----------------------------------------------------------------------------- 
    499524 
     
    508533         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    509534         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    510          WRITE(numout,*) '   threshold water temp. for initial sea-ice    ttest      = ', ttest 
    511          WRITE(numout,*) '   initial snow thickness in the north          hninn      = ', hninn 
    512          WRITE(numout,*) '   initial snow thickness in the south          hnins      = ', hnins  
    513          WRITE(numout,*) '   initial ice thickness  in the north          hginn      = ', hginn 
    514          WRITE(numout,*) '   initial ice thickness  in the south          hgins      = ', hgins 
    515          WRITE(numout,*) '   initial ice concentr.  in the north          aginn      = ', aginn 
    516          WRITE(numout,*) '   initial ice concentr.  in the north          agins      = ', agins 
    517          WRITE(numout,*) '   initial  ice salinity  in the north          sinn       = ', sinn 
    518          WRITE(numout,*) '   initial  ice salinity  in the south          sins       = ', sins 
     535         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini   = ', ln_limini 
     536         WRITE(numout,*) '   threshold water temp. for initial sea-ice    thres_sst  = ', thres_sst 
     537         WRITE(numout,*) '   initial snow thickness in the north          hts_ini_n  = ', hts_ini_n 
     538         WRITE(numout,*) '   initial snow thickness in the south          hts_ini_s  = ', hts_ini_s  
     539         WRITE(numout,*) '   initial ice thickness  in the north          hti_ini_n  = ', hti_ini_n 
     540         WRITE(numout,*) '   initial ice thickness  in the south          hti_ini_s  = ', hti_ini_s 
     541         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_n  = ', ati_ini_n 
     542         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_s  = ', ati_ini_s 
     543         WRITE(numout,*) '   initial  ice salinity  in the north          smi_ini_n  = ', smi_ini_n 
     544         WRITE(numout,*) '   initial  ice salinity  in the south          smi_ini_s  = ', smi_ini_s 
     545         WRITE(numout,*) '   initial  ice/snw temp  in the north          tmi_ini_n  = ', tmi_ini_n 
     546         WRITE(numout,*) '   initial  ice/snw temp  in the south          tmi_ini_s  = ', tmi_ini_s 
    519547      ENDIF 
    520548 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4345 r4634  
    55   !!====================================================================== 
    66   !! History :  LIM  ! 2006-02  (M. Vancoppenolle) Original code  
    7    !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_mec 
     7   !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_dyn 
    88   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
    99   !!---------------------------------------------------------------------- 
     
    143143      REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    144144      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
    145       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     145      REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b  
    146146      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    147       ! mass and salt flux (clem) 
    148       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
    149147      !!----------------------------------------------------------------------------- 
    150148      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    151149 
    152150      CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    153  
    154       CALL wrk_alloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    155151 
    156152      IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only) 
     
    165161      !- check conservation (C Rousset) 
    166162      IF (ln_limdiahsb) THEN 
    167          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     163         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 
    168164         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    169          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    170          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     165         zchk_e_i_b = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 
     166         zchk_fw_b  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 
     167         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 
     168         zchk_ft_b  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 
    171169      ENDIF 
    172170      !- check conservation (C Rousset) 
    173171      ! ------------------------------- 
    174  
    175       ! mass and salt flux init (clem) 
    176       zviold(:,:,:) = v_i(:,:,:) 
    177       zvsold(:,:,:) = v_s(:,:,:) 
    178       zsmvold(:,:,:) = smv_i(:,:,:) 
    179172 
    180173      !-----------------------------------------------------------------------------! 
     
    362355            ! 5) Heat, salt and freshwater fluxes 
    363356            !-----------------------------------------------------------------------------! 
    364             fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
    365             fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean 
     357            wfx_snw(ji,jj) = wfx_snw(ji,jj) - msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
     358            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice  ! heat sink for ocean (<0, W.m-2) 
    366359 
    367360         END DO 
     
    399392      CALL lim_itd_me_zapsmall 
    400393 
    401       !-------------------------------- 
    402       ! Update mass/salt fluxes (clem) 
    403       !-------------------------------- 
    404       DO jl = 1, jpl 
    405          DO jj = 1, jpj  
    406             DO ji = 1, jpi 
    407                diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 
    408                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    409                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    410                sfx_mec(ji,jj) = sfx_mec(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic * r1_rdtice  
    411             END DO 
    412          END DO 
    413       END DO 
    414394 
    415395      IF(ln_ctl) THEN     ! Control print 
     
    448428      !- check conservation (C Rousset) 
    449429      IF (ln_limdiahsb) THEN 
    450          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    451          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     430         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     431         zchk_fw  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     432         zchk_ft  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 
    452433  
    453          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
     434         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw  
    454435         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
     436         zchk_e_i =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 
    455437 
    456438         zchk_vmin = glob_min(v_i) 
     
    459441        
    460442         IF(lwp) THEN 
    461             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_me) = ',(zchk_v_i * rday) 
     443            IF ( ABS( zchk_v_i   ) >  1.e-2 ) WRITE(numout,*) 'violation volume [kg/day]     (limitd_me) = ',(zchk_v_i * rday) 
    462444            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_me) = ',(zchk_smv * rday) 
     445            IF ( ABS( zchk_e_i   ) >  1.e-4 ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (limitd_me) = ',(zchk_e_i) 
    463446            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_me) = ',(zchk_vmin * 1.e-3) 
    464447            IF ( zchk_amax >  kamax+epsi10  ) WRITE(numout,*) 'violation a_i>amax            (limitd_me) = ',zchk_amax 
     
    472455      ! 
    473456      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    474       ! 
    475       CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    476457      ! 
    477458      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
     
    908889      INTEGER ::   ij                ! horizontal index, combines i and j loops 
    909890      INTEGER ::   icells            ! number of cells with aicen > puny 
    910       REAL(wp) ::   zindb, zsrdg2   ! local scalar 
     891      REAL(wp) ::   zindb    ! local scalar 
    911892      REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration 
     893      REAL(wp) ::   zsstK            ! SST in Kelvin 
    912894 
    913895      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices 
     
    917899 
    918900      REAL(wp), POINTER, DIMENSION(:,:,:) ::   aicen_init, vicen_init   ! ice  area    & volume before ridging 
    919       REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnon_init, esnon_init   ! snow volume  & energy before ridging 
     901      REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnwn_init, esnwn_init   ! snow volume  & energy before ridging 
    920902      REAL(wp), POINTER, DIMENSION(:,:,:) ::   smv_i_init, oa_i_init    ! ice salinity & age    before ridging 
    921903 
     
    952934      CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    953935      CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    954       CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 
     936      CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    955937      CALL wrk_alloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    956938      CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init ) 
     
    1008990         aicen_init(:,:,jl) = a_i(:,:,jl) 
    1009991         vicen_init(:,:,jl) = v_i(:,:,jl) 
    1010          vsnon_init(:,:,jl) = v_s(:,:,jl) 
     992         vsnwn_init(:,:,jl) = v_s(:,:,jl) 
    1011993         ! 
    1012994         smv_i_init(:,:,jl) = smv_i(:,:,jl) 
     
    1014996      END DO !jl 
    1015997 
    1016       esnon_init(:,:,:) = e_s(:,:,1,:) 
     998      esnwn_init(:,:,:) = e_s(:,:,1,:) 
    1017999 
    10181000      DO jl = 1, jpl   
     
    10951077            vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por 
    10961078 
    1097             vsrdg(ji,jj) = vsnon_init(ji,jj,jl1) * afrac(ji,jj) 
    1098             esrdg(ji,jj) = esnon_init(ji,jj,jl1) * afrac(ji,jj) 
     1079            vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     1080            esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    10991081            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
    1100             srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
     1082            srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 
    11011083 
    11021084            ! rafting volumes, heat contents ... 
    11031085            virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
    1104             vsrft(ji,jj) = vsnon_init(ji,jj,jl1) * afrft(ji,jj) 
    1105             esrft(ji,jj) = esnon_init(ji,jj,jl1) * afrft(ji,jj) 
     1086            vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     1087            esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    11061088            smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
    11071089 
     
    11201102            ! Salinity 
    11211103            !------------- 
    1122             smsw(ji,jj)  = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0       ! salt content of seawater frozen in voids 
    1123  
    1124             zsrdg2       = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
    1125  
    1126             srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
     1104            smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014 
     1105            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
     1106 
     1107            !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
    11271108             
    1128             !                                                             ! excess of salt is flushed into the ocean 
    1129             !sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 
    1130  
    1131             !rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic    ! gurvan: increase in ice volume du to seawater frozen in voids              
     1109            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
     1110            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) + vsw (ji,jj) * rhoic * r1_rdtice   ! gurvan: increase in ice volume du to seawater frozen in voids              
     1111            ! MV HC 2014 this previous line seems ok, i'm not sure at this moment of the sign convention 
    11321112 
    11331113            !------------------------------------             
     
    11581138               &                                + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 
    11591139 
    1160             esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
    1161                &                                + esrft(ji,jj)*(1.0-fsnowrft)           
     1140            ! in 1e-9 Joules (same as e_s) 
     1141            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
     1142               &                                - esrft(ji,jj)*(1.0-fsnowrft)           
    11621143 
    11631144            !----------------------------------------------------------------- 
     
    11871168               eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 
    11881169               e_i  (ji,jj,jk,jl1)  = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) 
    1189                ! sea water heat content 
    1190                ztmelts          = - tmut * sss_m(ji,jj) + rtt 
    1191                ! heat content per unit volume 
    1192                zdummy0          = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 
    1193  
    1194                ! corrected sea water salinity 
    1195                zindb  = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - epsi20 ) ) 
    1196                zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), epsi20 ) 
    1197  
    1198                ztmelts          = - tmut * zdummy + rtt 
    1199                ersw(ji,jj,jk)   = - rcp * ( ztmelts - rtt ) * vsw(ji,jj) 
    1200  
    1201                ! heat flux 
    1202                fheat_mec(ji,jj) = fheat_mec(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) * r1_rdtice 
     1170                
     1171                
     1172               ! enthalpy of the trapped seawater (J/m2, >0) 
     1173               ! clem: if sst>0, then ersw <0 (is that possible?) 
     1174               zsstK  = sst_m(ji,jj) + rt0 
     1175               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i ) 
     1176 
     1177               ! heat flux to the ocean 
     1178               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux  
    12031179 
    12041180               ! Correct dimensions to avoid big values 
    1205                ersw(ji,jj,jk)   = ersw(ji,jj,jk) * 1.e-09 
    1206  
    1207                ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    1208                ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / REAL( nlay_i ) 
     1181               ersw(ji,jj,jk)   = ersw(ji,jj,jk) / unit_fac 
     1182 
     1183               ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J 
     1184               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean  
     1185               !! MV HC 2014 
     1186               ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) 
    12091187 
    12101188               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
     1189 
    12111190            END DO ! ij 
    12121191         END DO !jk 
     
    13611340      CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    13621341      CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    1363       CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 
     1342      CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    13641343      CALL wrk_dealloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    13651344      CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init ) 
     
    14551434 
    14561435      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask   ! 2D workspace 
    1457       REAL(wp)                          ::   zmask_glo 
     1436      REAL(wp)                          ::   zmask_glo, zsal, zvi, zvs, zei, zes 
    14581437!!gm      REAL(wp) ::   xtmp      ! temporary variable 
    14591438      !!------------------------------------------------------------------- 
     
    14711450         DO jj = 1, jpj 
    14721451            DO ji = 1, jpi 
    1473                IF(  ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) <  0._wp   ) .OR.   & 
    1474                   & ( a_i(ji,jj,jl) >  0._wp   .AND. a_i(ji,jj,jl) <= epsi10  ) .OR.   & 
    1475                   & ( v_i(ji,jj,jl) == 0._wp   .AND. a_i(ji,jj,jl) >  0._wp   ) .OR.   & 
    1476                   & ( v_i(ji,jj,jl) >  0._wp   .AND. v_i(ji,jj,jl) <= epsi10  ) )   zmask(ji,jj) = 1._wp 
     1452!               IF(  ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) <  0._wp   ) .OR.   & 
     1453!                  & ( a_i(ji,jj,jl) >  0._wp   .AND. a_i(ji,jj,jl) <= epsi10  ) .OR.   & 
     1454!                  & ( v_i(ji,jj,jl) == 0._wp   .AND. a_i(ji,jj,jl) >  0._wp   ) .OR.   & 
     1455!                  & ( v_i(ji,jj,jl) >  0._wp   .AND. v_i(ji,jj,jl) <= epsi10  ) )   zmask(ji,jj) = 1._wp 
     1456               IF(  ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) <= epsi10  ) .OR.   & 
     1457                  & ( v_i(ji,jj,jl) >= 0._wp   .AND. v_i(ji,jj,jl) <= epsi10  ) )   zmask(ji,jj) = 1._wp 
    14771458            END DO 
    14781459         END DO 
     
    14871468            DO jj = 1 , jpj 
    14881469               DO ji = 1 , jpi 
    1489 !!gm                  xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) * r1_rdtice 
    1490 !!gm                  xtmp = xtmp * unit_fac 
    1491                   ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
     1470                  zei  = e_i(ji,jj,jk,jl) 
    14921471                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 
     1472                  ! update exchanges with ocean 
     1473                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    14931474               END DO 
    14941475            END DO 
     
    14971478         DO jj = 1 , jpj 
    14981479            DO ji = 1 , jpi 
    1499  
     1480                
     1481               zsal = smv_i(ji,jj,jl) 
     1482               zvi  = v_i(ji,jj,jl) 
     1483               zvs  = v_s(ji,jj,jl) 
     1484               zes  = e_s(ji,jj,1,jl) 
    15001485               !----------------------------------------------------------------- 
    15011486               ! Zap snow energy and use ocean heat to melt snow 
     
    15071492               ! fluxes are positive to the ocean 
    15081493               ! here the flux has to be negative for the ocean 
    1509 !!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice 
    1510                !           fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
    1511  
    1512 !!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice !RB   ??????? 
    1513  
    15141494               t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
    15151495 
     
    15321512               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    15331513               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1534                ! 
     1514               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
     1515               ! additional condition 
     1516               IF( v_s(ji,jj,jl) <= epsi10 ) THEN 
     1517                  v_s(ji,jj,jl)   = 0._wp 
     1518                  e_s(ji,jj,1,jl) = 0._wp 
     1519               ENDIF 
     1520               ! update exchanges with ocean 
     1521               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     1522               wfx_res(ji,jj)  = wfx_res(ji,jj) + ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice 
     1523               wfx_snw(ji,jj)  = wfx_snw(ji,jj) + ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice 
     1524               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    15351525            END DO 
    15361526         END DO 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r4332 r4634  
    6565      INTEGER, INTENT(in) ::   kt   ! time step index 
    6666      ! 
    67       INTEGER ::   jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index          
    68       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     67      INTEGER ::   ji,jj, jk, jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index          
     68      REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b ! Check conservation (C Rousset) 
    6969      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    7070      !!------------------------------------------------------------------ 
     
    7474      !- check conservation (C Rousset) 
    7575      IF (ln_limdiahsb) THEN 
    76          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     76         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 
    7777         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    78          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    79          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     78         zchk_e_i_b = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 
     79         zchk_fw_b  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 
     80         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 
     81         zchk_ft_b  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 
    8082       ENDIF 
    8183      !- check conservation (C Rousset) 
     
    108110      CALL lim_thd_lac 
    109111      CALL lim_var_glo2eqv    ! only for info 
    110  
    111      IF(ln_ctl) THEN   ! Control print 
     112      
     113      IF(ln_ctl) THEN   ! Control print 
    112114         CALL prt_ctl_info(' ') 
    113115         CALL prt_ctl_info(' - Cell values : ') 
     
    144146      !- check conservation (C Rousset) 
    145147      IF( ln_limdiahsb ) THEN 
    146          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    147          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     148         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     149         zchk_fw  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     150         zchk_ft  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 
    148151  
    149          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
     152         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw  
    150153         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
     154         zchk_e_i =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 
    151155 
    152156         zchk_vmin = glob_min(v_i) 
     
    155159 
    156160         IF(lwp) THEN 
    157             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_th) = ',(zchk_v_i * rday) 
     161            IF ( ABS( zchk_v_i   ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (limitd_th) = ',(zchk_v_i * rday) 
    158162            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_th) = ',(zchk_smv * rday) 
     163            IF ( ABS( zchk_e_i   ) >  1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (limitd_th) = ',(zchk_e_i) 
    159164            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_th) = ',(zchk_vmin * 1.e-3) 
    160165            IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limitd_th) = ',zchk_amax 
     
    258263               zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 
    259264               zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb 
    260                IF( a_i(ji,jj,jl) > epsi06 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
     265               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
    261266            END DO 
    262267         END DO 
     
    302307            ij = nind_j(ji) 
    303308            ! 
    304             IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. &  
    305                ( zht_i_o(ii,ij,jl+1) .GT. epsi10 ) ) THEN 
     309            zhbnew(ii,ij,jl) = hi_max(jl) 
     310            IF ( old_a_i(ii,ij,jl) > epsi10 .AND. old_a_i(ii,ij,jl+1) > epsi10 ) THEN 
    306311               !interpolate between adjacent category growth rates 
    307                zslope = ( zdhice(ii,ij,jl+1)     - zdhice(ii,ij,jl) ) / & 
    308                   ( zht_i_o   (ii,ij,jl+1) - zht_i_o   (ii,ij,jl) ) 
    309                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + & 
    310                   zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 
    311             ELSEIF (zht_i_o(ii,ij,jl).gt.epsi10) THEN 
     312               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_o(ii,ij,jl+1) - zht_i_o(ii,ij,jl) ) 
     313               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 
     314            ELSEIF ( old_a_i(ii,ij,jl) > epsi10) THEN 
    312315               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 
    313             ELSEIF (zht_i_o(ii,ij,jl+1).gt.epsi10) THEN 
     316            ELSEIF ( old_a_i(ii,ij,jl+1) > epsi10) THEN 
    314317               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 
    315             ELSE 
    316                zhbnew(ii,ij,jl) = hi_max(jl) 
    317318            ENDIF 
    318319         END DO 
     
    320321         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
    321322         DO ji = 1, nbrem 
    322             ! jl, ji 
    323323            ii = nind_i(ji) 
    324324            ij = nind_j(ji) 
    325             ! jl, ji 
    326             IF ( ( a_i(ii,ij,jl) .GT.epsi10) .AND. &  
    327                ( ht_i(ii,ij,jl).GE. zhbnew(ii,ij,jl) ) & 
    328                ) THEN 
     325            IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 
    329326               zremap_flag(ii,ij) = 0 
    330             ELSEIF ( ( a_i(ii,ij,jl+1) .GT. epsi10 ) .AND. & 
    331                ( ht_i(ii,ij,jl+1).LE. zhbnew(ii,ij,jl) ) & 
    332                ) THEN 
     327            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 
    333328               zremap_flag(ii,ij) = 0 
    334329            ENDIF 
    335330 
    336331            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max   
    337             ! jl, ji 
    338             IF (zhbnew(ii,ij,jl).gt.hi_max(jl+1)) THEN 
    339                zremap_flag(ii,ij) = 0 
    340             ENDIF 
    341             ! jl, ji 
    342             IF (zhbnew(ii,ij,jl).lt.hi_max(jl-1)) THEN 
    343                zremap_flag(ii,ij) = 0 
    344             ENDIF 
    345             ! jl, ji 
    346          END DO !ji 
    347          ! ji 
     332            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 
     333            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     334         END DO 
     335 
    348336      END DO !jl 
    349337 
     
    354342      DO jj = 1, jpj 
    355343         DO ji = 1, jpi 
    356             IF ( zremap_flag(ji,jj) == 1 ) THEN 
     344            IF( zremap_flag(ji,jj) == 1 ) THEN 
    357345               nbrem         = nbrem + 1 
    358346               nind_i(nbrem) = ji 
    359347               nind_j(nbrem) = jj 
    360348            ENDIF 
    361          END DO !ji 
    362       END DO !jj 
     349         END DO  
     350      END DO  
    363351 
    364352      !----------------------------------------------------------------------------------------------- 
     
    380368            ENDIF 
    381369 
    382             IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) )   zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
     370            IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
    383371 
    384372         END DO !jj 
     
    444432      DO jl = klbnd, kubnd 
    445433         CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 
    446             g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl),     & 
    447             zremap_flag) 
     434            g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag) 
    448435      END DO 
    449436 
     
    493480            nd   = zdonor(ii,ij,jl) 
    494481            zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 
    495             zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + & 
    496                zdaice(ii,ij,jl)*hL(ii,ij,nd) 
     482            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 
    497483 
    498484         END DO ! ji 
     
    511497         ii = nind_i(ji) 
    512498         ij = nind_j(ji) 
    513          IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim ) ) THEN 
     499         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN 
    514500            a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim  
    515501            ht_i(ii,ij,1) = hiclim 
    516             v_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless 
    517502         ENDIF 
    518503      END DO !ji 
     
    799784            !-------------- 
    800785 
    801             zdvsnow          = v_s(ii,ij,jl1) * zworka(ii,ij) 
     786            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij) 
    802787            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 
    803788            v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow  
     
    807792            !-------------------- 
    808793 
    809             zdesnow              = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
     794            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
    810795            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow 
    811796            e_s(ii,ij,1,jl2)   = e_s(ii,ij,1,jl2) + zdesnow 
     
    815800            !-------------- 
    816801 
    817             zdo_aice             = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
     802            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
    818803            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice 
    819804            oa_i(ii,ij,jl2)    = oa_i(ii,ij,jl2) + zdo_aice 
     
    823808            !-------------- 
    824809 
    825             zdsm_vice            = smv_i(ii,ij,jl1) * zworka(ii,ij) 
     810            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij) 
    826811            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice 
    827812            smv_i(ii,ij,jl2)   = smv_i(ii,ij,jl2) + zdsm_vice 
     
    831816            !--------------------- 
    832817 
    833             zdaTsf               = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
     818            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
    834819            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf 
    835820            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf  
     
    910895      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories 
    911896      !!------------------------------------------------------------------ 
     897      !! clem 2014/04: be carefull, rebining does not conserve salt => the difference is taken into account in limupdate 
    912898       
    913899      CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger 
     
    10151001 
    10161002!clem-change 
     1003         DO jj = 1, jpj 
     1004            DO ji = 1, jpi 
     1005               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     1006                  ! 
     1007                  zshiftflag = 1 
     1008                  zdonor(ji,jj,jl) = jl + 1 
     1009                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1)  
     1010                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
     1011               ENDIF 
     1012            END DO                 ! ji 
     1013         END DO                 ! jj 
     1014 
     1015         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
     1016          
     1017         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories 
     1018            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
     1019            ! Reset shift parameters 
     1020            zdonor(:,:,jl) = 0 
     1021            zdaice(:,:,jl) = 0._wp 
     1022            zdvice(:,:,jl) = 0._wp 
     1023         ENDIF 
     1024!clem-change 
     1025 
     1026!         ! clem-change begin: why not doing that? 
    10171027!         DO jj = 1, jpj 
    10181028!            DO ji = 1, jpi 
    1019 !               IF( a_i(ji,jj,jl+1) >  epsi10 .AND.   & 
    1020 !                  ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    1021 !                  ! 
    1022 !                  zshiftflag = 1 
    1023 !                  zdonor(ji,jj,jl) = jl + 1 
    1024 !                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1)  
    1025 !                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
     1029!               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     1030!                  ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
     1031!                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    10261032!               ENDIF 
    10271033!            END DO                 ! ji 
    10281034!         END DO                 ! jj 
    1029 ! 
    1030 !         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
    1031 !          
    1032 !         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories 
    1033 !            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    1034 !            ! Reset shift parameters 
    1035 !            zdonor(:,:,jl) = 0 
    1036 !            zdaice(:,:,jl) = 0._wp 
    1037 !            zdvice(:,:,jl) = 0._wp 
    1038 !         ENDIF 
    1039 !clem-change 
    1040  
    1041          ! clem-change begin: why not doing that? 
    1042          DO jj = 1, jpj 
    1043             DO ji = 1, jpi 
    1044                IF( a_i(ji,jj,jl+1) >  epsi10 .AND.   & 
    1045                   ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    1046                   ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
    1047                   a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    1048                ENDIF 
    1049             END DO                 ! ji 
    1050          END DO                 ! jj 
    10511035         ! clem-change end 
    10521036 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r4345 r4634  
    5151 
    5252   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   rzero   = 0._wp   ! constant values 
    54    REAL(wp) ::   rone    = 1._wp   ! constant values 
    5553       
    5654   !! * Substitutions 
     
    514512!CDIR NOVERRCHK 
    515513               DO ji = fs_2, fs_jpim1 
    516                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
     514                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    517515                  zsang        = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 
    518516                  z0           = zmass1(ji,jj)/dtevp 
     
    547545               DO ji = fs_2, fs_jpim1 
    548546 
    549                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
     547                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    550548                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    551549                  z0           = zmass2(ji,jj)/dtevp 
     
    579577!CDIR NOVERRCHK 
    580578               DO ji = fs_2, fs_jpim1 
    581                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
     579                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    582580                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    583581                  z0           = zmass2(ji,jj)/dtevp 
     
    611609!CDIR NOVERRCHK 
    612610               DO ji = fs_2, fs_jpim1 
    613                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
     611                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    614612                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    615613                  z0           = zmass1(ji,jj)/dtevp 
     
    661659      ! 4) Prevent ice velocities when the ice is thin 
    662660      !------------------------------------------------------------------------------! 
    663       !clem : add hminrhg in the namelist 
    664       ! 
    665661      ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 
    666662      ! ocean velocity,  
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r4220 r4634  
    162162      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'        , u_ice      ) 
    163163      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'        , v_ice      ) 
    164       CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'        , fsbbq      ) 
    165164      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'    , stress1_i  ) 
    166165      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  ) 
     
    393392      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      ) 
    394393      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      ) 
    395       CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      ) 
    396394      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  ) 
    397395      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  ) 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4345 r4634  
    2727   USE par_ice          ! ice parameters 
    2828   USE dom_oce          ! ocean domain 
    29    USE dom_ice,    ONLY : tms 
     29   USE dom_ice,    ONLY : tms, area 
    3030   USE ice              ! LIM sea-ice variables 
    3131   USE sbc_ice          ! Surface boundary condition: sea-ice fields 
     
    5050   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
    5151 
    52    REAL(wp)  ::   rzero  = 0._wp     
    53    REAL(wp)  ::   rone   = 1._wp 
     52   REAL(wp)  ::   epsi10 = 1.e-10   ! 
     53   REAL(wp)  ::   epsi20 = 1.e-20   ! 
    5454 
    5555   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2] 
     
    102102      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    103103      ! 
    104       INTEGER  ::   ji, jj, jl           ! dummy loop indices 
    105       INTEGER  ::   ierr, ifvt, i1mfr, idfr           ! local integer 
    106       INTEGER  ::   iflt, ial , iadv , ifral, ifrdv   !   -      - 
    107       REAL(wp) ::   zinda, zemp, zemp_snow, zfmm      ! local scalars 
    108       REAL(wp) ::   zemp_snw                          !   -      - 
    109       REAL(wp) ::   zfcm1 , zfcm2                     !   -      - 
     104      INTEGER  ::   ji, jj, jl, jk           ! dummy loop indices 
     105      REAL(wp) ::   zinda, zemp      ! local scalars 
    110106      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
    111       REAL(wp) ::   zzfcm1, zfscmbq ! clem: for light penetration 
     107      REAL(wp) ::   ztmelts         ! clem 2014: for HC diags 
     108 
     109      REAL(wp) ::   zf_mass         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     110      REAL(wp) ::   zfcm1           ! New solar flux received by the ocean 
    112111      !!--------------------------------------------------------------------- 
    113112       
    114113      IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 
    115114 
    116       !------------------------------------------! 
    117       !      heat flux at the ocean surface      ! 
    118       !------------------------------------------! 
    119115      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    120       ! changed to old_frld and old ht_i 
    121  
    122116      DO jj = 1, jpj 
    123117         DO ji = 1, jpi 
    124             zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    125             ifvt    = zinda  *  MAX( rzero , SIGN( rone, - phicif(ji,jj) ) )  !subscripts are bad here 
    126             i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - at_i(ji,jj) ) ) 
    127             idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 
    128             iflt    = zinda  * (1 - i1mfr) * (1 - ifvt ) 
    129             ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr 
    130             iadv    = ( 1  - i1mfr ) * zinda 
    131             ifral   = ( 1  - i1mfr * ( 1 - ial ) )    
    132             ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv  
    133  
    134             ! switch --- 1.0 ---------------- 0.0 -------------------- 
    135             ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    136             ! zinda   | if pfrld = 1       | if pfrld < 1            | 
    137             !  -> ifvt| if pfrld old_ht_i 
    138             ! i1mfr   | if frld = 1        | if frld  < 1            | 
    139             ! idfr    | if frld <= pfrld    | if frld > pfrld        | 
    140             ! iflt    |  
    141             ! ial     | 
    142             ! iadv    | 
    143             ! ifral 
    144             ! ifrdv 
    145  
    146             !   computation the solar flux at ocean surface 
    147             IF (lk_cpl) THEN ! be carfeful: not been tested yet 
     118 
     119            !------------------------------------------! 
     120            !      heat flux at the ocean surface      ! 
     121            !------------------------------------------! 
     122            zinda   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice 
     123 
     124            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
     125            !--------------------------------------------------- 
     126            IF( lk_cpl ) THEN ! be carfeful: not been tested yet 
    148127               ! original line 
    149                !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 
    150                ! new line to include solar penetration (not tested) 
    151                zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     128               zfcm1 = qsr_tot(ji,jj) 
     129               !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
    152130               DO jl = 1, jpl 
    153                   zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 
     131                  zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) 
    154132               END DO 
    155133            ELSE 
    156                zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
    157                     &    ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     134               !!!zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
     135               !!!     &    ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
     136               zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
     137               DO jl = 1, jpl 
     138                  zfcm1   = zfcm1 + old_a_i(ji,jj,jl) * ftr_ice(ji,jj,jl) 
     139               END DO 
    158140            ENDIF 
    159             ! fstric     Solar flux transmitted trough the ice 
    160             ! qsr        Net short wave heat flux on free ocean 
    161             ! new line 
    162             fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
    163  
    164             ! solar flux and fscmbq with light penetration (clem) 
    165             zzfcm1  = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 
    166             zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 
    167  
    168             !  computation the non solar heat flux at ocean surface 
    169             zfcm2 = - zzfcm1                                                                    & ! 
    170                &    + iflt    * zfscmbq                                                         & ! total ablation: heat given to the ocean 
    171                &    + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   & 
    172                &    + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice   & 
    173                &    + fhmec(ji,jj)                                                              & ! snow melt when ridging 
    174                &    + fheat_mec(ji,jj)                                                          & ! ridge formation 
    175                &    + fheat_res(ji,jj)                                                            ! residual heat flux 
    176             ! qcmif   Energy needed to bring the ocean surface layer until its freezing (ok) 
    177             ! qldif   heat balance of the lead (or of the open ocean) 
    178             ! qfvbq   latent heat uptake/release after accretion/ablation 
    179             ! qdtcn   Energy from the turbulent oceanic heat flux heat flux coming in the lead 
    180  
    181             IF( num_sal == 2 )   zfcm2 = zfcm2 + fhbri(ji,jj)    ! add contribution due to brine drainage  
    182  
    183             ! bottom radiative component is sent to the computation of the oceanic heat flux 
    184             fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj)      
    185  
    186             ! used to compute the oceanic heat flux at the next time step 
    187             qsr(ji,jj) = zfcm1                                       ! solar heat flux  
    188             qns(ji,jj) = zfcm2 - fdtcn(ji,jj)                        ! non solar heat flux 
    189             !                           ! fdtcn : turbulent oceanic heat flux 
    190          END DO 
    191       END DO 
    192  
    193       !------------------------------------------! 
    194       !      mass flux at the ocean surface      ! 
    195       !------------------------------------------! 
    196  
    197 !!gm   optimisation: this loop have to be merged with the previous one 
    198       DO jj = 1, jpj 
    199          DO ji = 1, jpi 
     141 
     142            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
     143            !--------------------------------------------------- 
     144            zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     145            hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 
     146 
     147            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
     148            !--------------------------------------------------- 
     149            qsr(ji,jj) = zfcm1                                       
     150            qns(ji,jj) = hfx_out(ji,jj) - zfcm1               
     151 
     152            !------------------------------------------! 
     153            !      mass flux at the ocean surface      ! 
     154            !------------------------------------------! 
    200155            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 
    201156            !  -------------------------------------------------------------------------------------  
     
    206161            !                     Even if i see Ice melting as a FW and SALT flux 
    207162            !         
    208  
    209163            !  computing freshwater exchanges at the ice/ocean interface 
    210             IF (lk_cpl) THEN  
     164            !  clem 2014/04: why not 1-pfrld instead of at_i here??? 
     165            IF( lk_cpl ) THEN  
    211166               zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
    212                   &   - rdm_snw(ji,jj) / rdt_ice 
     167                  &   - wfx_snw(ji,jj) 
    213168            ELSE 
    214                zemp =   emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
    215                   &   - tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
    216                   &   + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
    217                   &   - fmmec(ji,jj)                                         ! snow falling when ridging 
     169               zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
     170                  &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean 
     171                  &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas )       ! except solid precip intercepted by sea-ice 
    218172            ENDIF 
    219173 
    220             ! mass flux at the ocean/ice interface (sea ice fraction) 
    221             zemp_snw = rdm_snw(ji,jj) * r1_rdtice                         ! snow melting = pure water that enters the ocean 
    222             zfmm     = rdm_ice(ji,jj) * r1_rdtice                         ! Freezing minus melting   
    223  
    224             fmmflx(ji,jj) = zfmm                                     ! F/M mass flux save at least for biogeochemical model 
    225  
    226             emp(ji,jj) = zemp + zemp_snw + zfmm  ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     174            ! mass flux from ice/ocean 
     175            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     176 
     177            ! mass flux at the ocean/ice interface 
     178            fmmflx(ji,jj) = wfx_ice(ji,jj) * rdt_ice                   ! F/M mass flux save at least for biogeochemical model 
     179            emp(ji,jj)    = zemp + wfx_ice(ji,jj) + wfx_snw(ji,jj)     ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    227180             
    228             !  correcting brine salt fluxes   (zinda = 1  if pfrld=1 , =0 otherwise) 
    229             zinda        = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    230             sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj) 
    231181         END DO 
    232182      END DO 
     
    235185      !      salt flux at the ocean surface      ! 
    236186      !------------------------------------------! 
    237  
    238       IF( num_sal == 2 ) THEN      ! variable ice salinity: brine drainage included in the salt flux 
    239          sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 
    240       ELSE                         ! constant ice salinity: 
    241          sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 
    242       ENDIF 
    243       !-----------------------------------------------! 
    244       !   mass of snow and ice per unit area          ! 
    245       !-----------------------------------------------! 
    246       IF( nn_ice_embd /= 0 ) THEN                               ! embedded sea-ice (mass required) 
    247          snwice_mass_b(:,:) = snwice_mass(:,:)                  ! save mass from the previous ice time step 
    248          !                                                      ! new mass per unit area 
     187      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 
     188 
     189      !-------------------------------------------------------------! 
     190      !   mass of snow and ice per unit area for embedded sea-ice   ! 
     191      !-------------------------------------------------------------! 
     192      IF( nn_ice_embd /= 0 ) THEN 
     193         ! save mass from the previous ice time step 
     194         snwice_mass_b(:,:) = snwice_mass(:,:)                   
     195         ! new mass per unit area 
    249196         snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
    250          !                                                      ! time evolution of snow+ice mass 
     197         ! time evolution of snow+ice mass 
    251198         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
    252199      ENDIF 
     
    263210      IF( lk_cpl ) THEN          ! coupled case 
    264211         CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo 
    265          ! 
    266212         alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys) 
    267213      ENDIF 
     214 
     215      ! ------------------------------------------------- 
     216      ! C. Rousset Begin Diagnostics for heat in W/m2 
     217      ! ------------------------------------------------- 
     218      DO jj = 1, jpj 
     219         DO ji = 1, jpi             
     220            diag_heat_dhc1(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) +  &  
     221               &                      SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) ) ) * unit_fac * r1_rdtice / area(ji,jj)    
     222         END DO 
     223      END DO 
     224      ! ------------------------------------------------- 
     225      ! C. Rousset End Diagnostics 
     226      ! ------------------------------------------------- 
    268227 
    269228      IF(ln_ctl) THEN 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4332 r4634  
    88   !!            3.0  ! 2005-11 (M. Vancoppenolle)  LIM-3 : Multi-layer thermodynamics + salinity variations 
    99   !!             -   ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif 
    10    !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw 
     10   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw 
    1111   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 
    1212   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     
    4343   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4444   USE timing         ! Timing 
     45   USE cpl_oasis3, ONLY : lk_cpl 
    4546 
    4647   IMPLICIT NONE 
     
    5152 
    5253   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   zzero  = 0._wp      ! 
    54    REAL(wp) ::   zone   = 1._wp      ! 
    5554 
    5655   !! * Substitutions 
     
    8483      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    8584      !! 
    86       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    87       INTEGER  ::   nbpb             ! nb of icy pts for thermo. cal. 
    88       REAL(wp) ::   zfric_umin = 5e-03_wp    ! lower bound for the friction velocity 
    89       REAL(wp) ::   zfric_umax = 2e-02_wp    ! upper bound for the friction velocity 
    90       REAL(wp) ::   zinda, zindb, zthsnice, zfric_u     ! local scalar 
    91       REAL(wp) ::   zfntlat, zpareff, zareamin, zcoef   !    -         - 
    92       REAL(wp), POINTER, DIMENSION(:,:) ::   zqlbsbq   ! link with lead energy budget qldif 
    93       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     85      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
     86      INTEGER  :: nbpb             ! nb of icy pts for thermo. cal. 
     87      INTEGER  :: ii, ij           ! temporary dummy loop index 
     88      REAL(wp) :: zfric_umin = 5e-03_wp    ! lower bound for the friction velocity 
     89      REAL(wp) :: zfric_umax = 2e-02_wp    ! upper bound for the friction velocity 
     90      REAL(wp) :: zinda, zindb, zfric_u     ! local scalar 
     91      REAL(wp) :: zareamin  !    -         - 
     92      REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b  
    9493      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     94      REAL(wp) :: zqld, zqfr 
     95      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx, zqfx 
     96      REAL(wp)                        :: zhfx_err, ztest 
    9597      !!------------------------------------------------------------------- 
    9698      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    9799 
    98       CALL wrk_alloc( jpi, jpj, zqlbsbq ) 
     100      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx, zqfx ) 
    99101    
     102      ! init debug 
     103      zdq(:) = 0._wp ; zq_ini(:) = 0._wp ; zhfx(:) = 0._wp ; zqfx(:) = 0._wp       
     104 
    100105      ! ------------------------------- 
    101106      !- check conservation (C Rousset) 
    102107      IF (ln_limdiahsb) THEN 
    103          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     108         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 
    104109         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    105          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    106          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     110         zchk_e_i_b = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 
     111         zchk_fw_b  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 
     112         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 
     113         zchk_ft_b  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 
    107114      ENDIF 
    108115      !- check conservation (C Rousset) 
     
    121128            DO jj = 1, jpj 
    122129               DO ji = 1, jpi 
    123                   !Energy of melting q(S,T) [J.m-3] 
    124                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 
    125130                  !0 if no ice and 1 if yes 
    126131                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  ) 
    127                   !convert units ! very important that this line is here 
    128                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb  
     132                  !Energy of melting q(S,T) [J.m-3] 
     133                  e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 
     134                  !convert units ! very important that this line is here         
     135                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac  
    129136               END DO 
    130137            END DO 
     
    133140            DO jj = 1, jpj 
    134141               DO ji = 1, jpi 
    135                   !Energy of melting q(S,T) [J.m-3] 
    136                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 
    137142                  !0 if no ice and 1 if yes 
    138143                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  ) 
     144                  !Energy of melting q(S,T) [J.m-3] 
     145                  e_s(ji,jj,jk,jl) = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 
    139146                  !convert units ! very important that this line is here 
    140                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb  
     147                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac  
    141148               END DO 
    142149            END DO 
    143150         END DO 
    144151      END DO 
    145  
    146       !----------------------------------- 
    147       ! 1.4) Compute global heat content 
    148       !----------------------------------- 
    149       qt_i_in  (:,:) = 0.e0 
    150       qt_s_in  (:,:) = 0.e0 
    151       qt_i_fin (:,:) = 0.e0 
    152       qt_s_fin (:,:) = 0.e0 
    153       sum_fluxq(:,:) = 0.e0 
    154       fatm     (:,:) = 0.e0 
    155152 
    156153      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
     
    161158!CDIR NOVERRCHK 
    162159         DO ji = 1, jpi 
    163             zinda          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) + epsi10 ) ) ) 
     160            zinda          = tms(ji,jj) * ( 1.0 - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 
    164161            ! 
    165162            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
     
    168165            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
    169166            !           !  temperature and turbulent mixing (McPhee, 1992) 
     167 
    170168            ! friction velocity 
    171169            zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )  
    172170 
    173             ! here the drag will depend on ice thickness and type (0.006) 
    174             fdtcn(ji,jj)  = zinda * rau0 * rcp * 0.006  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) )  
    175             ! also category dependent 
    176             !           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead  
    177             qdtcn(ji,jj)  = zinda * fdtcn(ji,jj) * ( 1.0 - at_i(ji,jj) ) * rdt_ice 
    178             !                        
    179             !           !-- Lead heat budget, qldif (part 1, next one is in limthd_dh)  
    180             !           !   caution: exponent betas used as more snow can fallinto leads 
    181             qldif(ji,jj) =  tms(ji,jj) * rdt_ice  * (                             & 
    182                &   pfrld(ji,jj)        * (  qsr(ji,jj) * oatte(ji,jj)             &   ! solar heat + clem modif 
    183                &                            + qns(ji,jj)                          &   ! non solar heat 
    184                &                            + fdtcn(ji,jj)                        &   ! turbulent ice-ocean heat 
    185                &                            + fsbbq(ji,jj) * ( 1.0 - zinda )  )   &   ! residual heat from previous step 
    186                & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus                    )   ! latent heat of sprecip melting 
     171            !-- Energy from the turbulent oceanic heat flux. here the drag will depend on ice thickness and type (0.006) 
     172            fhtur(ji,jj)  = zinda * rau0 * rcp * 0.006  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2  
     173            ! clem: why not the following?  
     174            !fhtur(ji,jj)  = zinda * rau0 * rcp * 0.006  * SQRT( ust2s(ji,jj) ) * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) 
     175 
     176            !-- Energy received in the lead, zqld is defined everywhere (J.m-2) 
     177            !   It includes turbulent ocean heat flux (only in the leads, the rest is used for bottom melting) 
     178            zqld =  tms(ji,jj) * rdt_ice *                               & 
     179               &  ( pfrld(ji,jj)        * ( qsr(ji,jj) * oatte(ji,jj)           &   ! solar heat + clem modif 
     180               &                          + qns(ji,jj)                          &   ! non solar heat 
     181               &                          + fhtur(ji,jj) )                      &   ! turbulent ice-ocean heat (0 if no ice) 
     182               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     183               &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     184               &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     185 
     186            !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) 
     187            zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj,1) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     188 
     189            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 
     190            qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )  
     191 
     192            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting  
     193            IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN 
     194               fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by a_i since this is (re)multiplied by a_i in limthd_dh.F90 
     195               qlead(ji,jj) = 0._wp 
     196            ENDIF 
    187197            ! 
    188             ! Positive heat budget is used for bottom ablation 
    189             zfntlat        = 1.0 - MAX( zzero , SIGN( zone ,  - qldif(ji,jj) ) ) 
    190             != 1 if positive heat budget 
    191             zpareff        = 1.0 - zinda * zfntlat 
    192             != 0 if ice and positive heat budget and 1 if one of those two is false 
    193             zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / ( rdt_ice * MAX( at_i(ji,jj), epsi10 ) ) 
     198            IF( qlead(ji,jj) == 0._wp )  zqld = 0._wp ; zqfr = 0._wp 
    194199            ! 
    195             ! Heat budget of the lead, energy transferred from ice to ocean 
    196             qldif  (ji,jj) = zpareff * qldif(ji,jj) 
    197             qdtcn  (ji,jj) = zpareff * qdtcn(ji,jj) 
    198             ! 
    199             ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx) 
    200             qcmif  (ji,jj) =  rau0 * rcp * fse3t_m(ji,jj,1) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
    201             ! 
    202             ! oceanic heat flux (limthd_dh) 
    203             fbif   (ji,jj) = zinda * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) + fdtcn(ji,jj) ) 
    204             ! 
     200            ! ----------------------------------------- 
     201            ! Net heat flux on top of ice-ocean [W.m-2] 
     202            ! ----------------------------------------- 
     203            !     First  step here      : heat flux at the ocean surface + precip 
     204            !     Second step below     : heat flux at the ice   surface (after limthd_dif)  
     205            hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
     206               ! heat flux above the ocean 
     207               &    +             pfrld(ji,jj)   * ( qns(ji,jj) + qsr(ji,jj) )                                                    & 
     208               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     209               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     210               &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) 
     211 
     212            ! ----------------------------------------------------------------------------- 
     213            ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 
     214            ! ----------------------------------------------------------------------------- 
     215            !     First  step here              :  non solar + precip - qlead - qturb 
     216            !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
     217            !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     218            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                                        &  
     219               ! Non solar heat flux received by the ocean 
     220               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                                             & 
     221               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     222               &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     223               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )                        & 
     224               ! heat flux taken from the ocean where there is open water ice formation 
     225               &    -      qlead(ji,jj) * r1_rdtice                                                                                                & 
     226               ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 
     227               &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                                              & 
     228               &    -      at_i(ji,jj) *  fhld(ji,jj) 
     229 
    205230         END DO 
    206231      END DO 
     
    234259               DO jj = mj0(jjindx), mj1(jjindx) 
    235260                  jiindex_1d = (jj - 1) * jpi + ji 
     261                  WRITE(numout,*) ' lim_thd : Category no : ', jl  
    236262               END DO 
    237263            END DO 
     
    271297            CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
    272298            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) ) 
    273             CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    274 #if ! defined key_coupled 
    275             CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    276             CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    277 #endif 
     299            CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     300            CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     301            IF( .NOT. lk_cpl ) THEN 
     302               CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     303               CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     304            ENDIF 
    278305            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    279306            CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
    280307            CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) )  
    281             CALL tab_2d_1d( nbpb, fbif_1d    (1:nbpb), fbif            , jpi, jpj, npb(1:nbpb) ) 
    282             CALL tab_2d_1d( nbpb, qldif_1d   (1:nbpb), qldif           , jpi, jpj, npb(1:nbpb) ) 
    283             CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice         , jpi, jpj, npb(1:nbpb) ) 
    284             CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw         , jpi, jpj, npb(1:nbpb) ) 
    285             CALL tab_2d_1d( nbpb, dmgwi_1d   (1:nbpb), dmgwi           , jpi, jpj, npb(1:nbpb) ) 
    286             CALL tab_2d_1d( nbpb, qlbbq_1d   (1:nbpb), zqlbsbq         , jpi, jpj, npb(1:nbpb) ) 
    287  
    288             CALL tab_2d_1d( nbpb, sfx_thd_1d (1:nbpb), sfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     308            CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) ) 
     309            CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
     310            CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
     311 
     312            CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     313            CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     314 
     315            CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     316            CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     317            CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     318            CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) ) 
     319 
     320            CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     321            CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     322            CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     323            CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) ) 
    289324            CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    290             CALL tab_2d_1d( nbpb, fhbri_1d   (1:nbpb), fhbri           , jpi, jpj, npb(1:nbpb) ) 
    291             CALL tab_2d_1d( nbpb, fstbif_1d  (1:nbpb), fstric          , jpi, jpj, npb(1:nbpb) ) 
    292             CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq           , jpi, jpj, npb(1:nbpb) ) 
    293  
    294             CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) ) ! clem modif 
    295             CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) ) ! clem modif 
     325 
     326            CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) )  
     327            CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) )  
     328 
     329            CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     330            CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     331            CALL tab_2d_1d( nbpb, hfx_tot_1d (1:nbpb), hfx_tot         , jpi, jpj, npb(1:nbpb) ) 
     332            CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     333            CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     334            CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) ) 
     335            CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) ) 
     336            CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
     337 
    296338            !-------------------------------- 
    297339            ! 4.3) Thermodynamic processes 
    298340            !-------------------------------- 
    299  
    300             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_enmelt( 1, nbpb )   ! computes sea ice energy of melting 
    301             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_glohec( qt_i_in, qt_s_in, q_i_layer_in, 1, nbpb, jl ) 
    302  
    303             !                                 !---------------------------------! 
    304             CALL lim_thd_dif( 1, nbpb, jl )   ! Ice/Snow Temperature profile    ! 
    305             !                                 !---------------------------------! 
    306  
    307             CALL lim_thd_enmelt( 1, nbpb )    ! computes sea ice energy of melting compulsory for limthd_dh 
    308  
    309             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_glohec ( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl )  
    310             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_con_dif( 1 , nbpb , jl ) 
    311  
    312             !                                 !---------------------------------! 
    313             CALL lim_thd_dh( 1, nbpb, jl )    ! Ice/Snow thickness              !  
    314             !                                 !---------------------------------! 
    315  
    316             !                                 !---------------------------------! 
    317             CALL lim_thd_ent( 1, nbpb, jl )   ! Ice/Snow enthalpy remapping     ! 
    318             !                                 !---------------------------------! 
    319  
    320             !                                 !---------------------------------! 
    321             CALL lim_thd_sal( 1, nbpb )       ! Ice salinity computation        ! 
    322             !                                 !---------------------------------! 
     341            ! --- diag error on heat diffusion - PART 1 --- ! 
     342            DO ji = 1, nbpb 
     343               zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  & 
     344                  &           SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) )  
     345            END DO 
     346 
     347            !---------------------------------! 
     348            ! Ice/Snow Temperature profile    ! 
     349            !---------------------------------! 
     350            CALL lim_thd_dif( 1, nbpb, jl ) 
     351 
     352            ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 
     353            CALL lim_thd_enmelt( 1, nbpb ) 
     354 
     355            DO ji = 1, nbpb 
     356              ! --- diag error on heat diffusion - PART 2 --- ! 
     357               zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  & 
     358                  &                              SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 
     359               zhfx_err       = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - ftr_ice_1d(ji) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
     360               hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 
     361               ! --- correction of qns_ice and surface conduction flux --- ! 
     362               qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err  
     363               fc_su     (ji) = fc_su     (ji) - zhfx_err  
     364               ! --- Heat flux at the ice surface in W.m-2 --- ! 
     365               ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     366               hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 
     367 
     368            END DO 
     369 
     370            !---------------------------------! 
     371            ! Ice/Snow thicnkess              ! 
     372            !---------------------------------! 
     373            ! --- diag error on heat remapping - PART 1 --- ! 
     374            DO ji = 1, nbpb 
     375               zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 
     376                  &           SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) )  
     377            END DO 
     378 
     379            CALL lim_thd_dh( 1, nbpb, jl )     
     380 
     381            ! --- Ice/Snow enthalpy remapping --- ! 
     382            CALL lim_thd_ent( 1, nbpb, jl )  
     383            !                                 
     384            ! --- diag error on heat remapping - PART 2 --- ! 
     385            DO ji = 1, nbpb 
     386               zdq(ji)        = - ( zq_ini(ji) + dq_i(ji) + dq_s(ji) )   & 
     387                  &             + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  & 
     388                  &                 SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 
     389               hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + zdq(ji) * a_i_b(ji) * r1_rdtice 
     390            END DO 
     391 
     392            !---------------------------------! 
     393            ! Ice salinity                    ! 
     394            !---------------------------------! 
     395            CALL lim_thd_sal( 1, nbpb )     
    323396 
    324397            !           CALL lim_thd_enmelt(1,nbpb)   ! computes sea ice energy of melting 
    325             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_glohec( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl )  
    326             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_con_dh ( 1 , nbpb , jl ) 
    327  
    328398            !-------------------------------- 
    329399            ! 4.4) Move 1D to 2D vectors 
     
    345415               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b     (1:nbpb,jk), jpi, jpj) 
    346416            END DO 
    347                CALL tab_1d_2d( nbpb, fstric        , npb, fstbif_1d (1:nbpb)   , jpi, jpj ) 
    348                CALL tab_1d_2d( nbpb, qldif         , npb, qldif_1d  (1:nbpb)   , jpi, jpj ) 
    349                CALL tab_1d_2d( nbpb, qfvbq         , npb, qfvbq_1d  (1:nbpb)   , jpi, jpj ) 
    350                CALL tab_1d_2d( nbpb, rdm_ice       , npb, rdm_ice_1d(1:nbpb)   , jpi, jpj ) 
    351                CALL tab_1d_2d( nbpb, rdm_snw       , npb, rdm_snw_1d(1:nbpb)   , jpi, jpj ) 
    352                CALL tab_1d_2d( nbpb, dmgwi         , npb, dmgwi_1d  (1:nbpb)   , jpi, jpj ) 
    353                CALL tab_1d_2d( nbpb, rdvosif       , npb, dvsbq_1d  (1:nbpb)   , jpi, jpj ) 
    354                CALL tab_1d_2d( nbpb, rdvobif       , npb, dvbbq_1d  (1:nbpb)   , jpi, jpj ) 
    355                CALL tab_1d_2d( nbpb, fdvolif       , npb, dvlbq_1d  (1:nbpb)   , jpi, jpj ) 
    356                CALL tab_1d_2d( nbpb, rdvonif       , npb, dvnbq_1d  (1:nbpb)   , jpi, jpj )  
    357                CALL tab_1d_2d( nbpb, sfx_thd       , npb, sfx_thd_1d(1:nbpb)   , jpi, jpj ) 
     417               CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
     418 
     419               CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     420               CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     421 
     422               CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     423               CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     424               CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     425               CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     426 
     427               CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     428               CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     429               CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     430               CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj ) 
    358431            ! 
    359432            IF( num_sal == 2 ) THEN 
    360433               CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
    361                CALL tab_1d_2d( nbpb, fhbri         , npb, fhbri_1d  (1:nbpb)   , jpi, jpj ) 
    362434            ENDIF 
     435 
     436              CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
     437              CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     438              CALL tab_1d_2d( nbpb, hfx_tot       , npb, hfx_tot_1d(1:nbpb)   , jpi, jpj ) 
     439              CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     440              CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     441              CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj ) 
     442              CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
     443              CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj ) 
    363444            ! 
    364445            !+++++       temporary stuff for a dummy version 
    365             CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj ) 
    366             CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj ) 
    367             CALL tab_1d_2d( nbpb, fsup2D     , npb, fsup     (1:nbpb)      , jpi, jpj ) 
    368             CALL tab_1d_2d( nbpb, focea2D    , npb, focea    (1:nbpb)      , jpi, jpj ) 
    369             CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj ) 
    370             CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj ) 
    371             CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 
     446              CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj ) 
     447              CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj ) 
     448              CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj ) 
     449              CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj ) 
    372450            !+++++ 
     451              CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
     452              CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
    373453            ! 
    374454            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
     
    384464      ! 5.1) Ice heat content               
    385465      !------------------------ 
    386       ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    387       zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 
     466      ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
    388467      DO jl = 1, jpl 
    389468         DO jk = 1, nlay_i 
    390             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef 
     469            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) ) 
    391470         END DO 
    392471      END DO 
     
    395474      ! 5.2) Snow heat content               
    396475      !------------------------ 
    397       ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    398       zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 
     476      ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
    399477      DO jl = 1, jpl 
    400478         DO jk = 1, nlay_s 
    401             e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef 
     479            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) ) 
    402480         END DO 
    403481      END DO 
     
    411489      ! 5.4) Diagnostic thermodynamic growth rates 
    412490      !-------------------------------------------- 
    413 !clem@useless      d_v_i_thd(:,:,:) = v_i      (:,:,:) - old_v_i(:,:,:)    ! ice volumes  
    414 !clem@mv-to-itd    dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    415  
    416       IF( con_i .AND. jiindex_1d > 0 )   fbif(:,:) = fbif(:,:) + zqlbsbq(:,:) 
    417  
    418491      IF(ln_ctl) THEN            ! Control print 
    419492         CALL prt_ctl_info(' ') 
     
    451524      !- check conservation (C Rousset) 
    452525      IF (ln_limdiahsb) THEN 
    453          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    454          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     526         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     527         zchk_fw  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     528         zchk_ft  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 
    455529  
    456          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
     530         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw  
    457531         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
     532         zchk_e_i =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 
    458533 
    459534         zchk_vmin = glob_min(v_i) 
     
    462537        
    463538         IF(lwp) THEN 
    464             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limthd) = ',(zchk_v_i * rday) 
     539            IF ( ABS( zchk_v_i   ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (limthd) = ',(zchk_v_i * rday) 
    465540            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limthd) = ',(zchk_smv * rday) 
     541            IF ( ABS( zchk_e_i   ) >  1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (limthd) = ',(zchk_e_i) 
    466542            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limthd) = ',(zchk_vmin * 1.e-3) 
    467543            IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limthd) = ',zchk_amax 
     
    472548      ! ------------------------------- 
    473549      ! 
    474       CALL wrk_dealloc( jpi, jpj, zqlbsbq ) 
    475       ! 
     550      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx, zqfx ) 
     551 
    476552      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
    477553   END SUBROUTINE lim_thd 
    478554 
    479  
    480    SUBROUTINE lim_thd_glohec( eti, ets, etilayer, kideb, kiut, jl ) 
    481       !!----------------------------------------------------------------------- 
    482       !!                   ***  ROUTINE lim_thd_glohec ***  
    483       !!                  
    484       !! ** Purpose :  Compute total heat content for each category 
    485       !!               Works with 1d vectors only 
    486       !!----------------------------------------------------------------------- 
    487       INTEGER , INTENT(in   )                         ::   kideb, kiut   ! bounds for the spatial loop 
    488       INTEGER , INTENT(in   )                         ::   jl            ! category number 
    489       REAL(wp), INTENT(  out), DIMENSION (jpij,jpl  ) ::   eti, ets      ! vertically-summed heat content for ice & snow 
    490       REAL(wp), INTENT(  out), DIMENSION (jpij,jkmax) ::   etilayer      ! heat content for ice layers 
    491       !! 
    492       INTEGER  ::   ji,jk   ! loop indices 
    493       !!----------------------------------------------------------------------- 
    494       eti(:,:) = 0._wp 
    495       ets(:,:) = 0._wp 
    496       ! 
    497       DO jk = 1, nlay_i                ! total q over all layers, ice [J.m-2] 
    498          DO ji = kideb, kiut 
    499             etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 
    500             eti     (ji,jl) = eti(ji,jl) + etilayer(ji,jk)  
    501          END DO 
    502       END DO 
    503       DO ji = kideb, kiut              ! total q over all layers, snow [J.m-2] 
    504          ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / REAL( nlay_s ) 
    505       END DO 
    506       ! 
    507       WRITE(numout,*) ' lim_thd_glohec ' 
    508       WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) * r1_rdtice 
    509       WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) * r1_rdtice 
    510       WRITE(numout,*) ' qt_in   : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) * r1_rdtice 
    511       ! 
    512    END SUBROUTINE lim_thd_glohec 
    513  
    514  
    515    SUBROUTINE lim_thd_con_dif( kideb, kiut, jl ) 
    516       !!----------------------------------------------------------------------- 
    517       !!                   ***  ROUTINE lim_thd_con_dif ***  
    518       !!                  
    519       !! ** Purpose :   Test energy conservation after heat diffusion 
    520       !!------------------------------------------------------------------- 
    521       INTEGER , INTENT(in   ) ::   kideb, kiut   ! bounds for the spatial loop 
    522       INTEGER , INTENT(in   ) ::   jl            ! category number 
    523  
    524       INTEGER  ::   ji, jk         ! loop indices 
    525       INTEGER  ::   ii, ij 
    526       INTEGER  ::   numce          ! number of points for which conservation is violated 
    527       REAL(wp) ::   meance         ! mean conservation error 
    528       REAL(wp) ::   max_cons_err, max_surf_err 
    529       !!--------------------------------------------------------------------- 
    530  
    531       max_cons_err =  1.0_wp          ! maximum tolerated conservation error 
    532       max_surf_err =  0.001_wp        ! maximum tolerated surface error 
    533  
    534       !-------------------------- 
    535       ! Increment of energy 
    536       !-------------------------- 
    537       ! global 
    538       DO ji = kideb, kiut 
    539          dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 
    540       END DO 
    541       ! layer by layer 
    542       dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) 
    543  
    544       !---------------------------------------- 
    545       ! Atmospheric heat flux, ice heat budget 
    546       !---------------------------------------- 
    547       DO ji = kideb, kiut 
    548          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    549          ij =    ( npb(ji) - 1 ) / jpi + 1 
    550          fatm     (ji,jl) = qnsr_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) 
    551          sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(ii,ij,jl) 
    552       END DO 
    553  
    554       !-------------------- 
    555       ! Conservation error 
    556       !-------------------- 
    557       DO ji = kideb, kiut 
    558          cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    559       END DO 
    560  
    561       numce  = 0 
    562       meance = 0._wp 
    563       DO ji = kideb, kiut 
    564          IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 
    565             numce = numce + 1 
    566             meance = meance + cons_error(ji,jl) 
    567          ENDIF 
    568       END DO 
    569       IF( numce > 0 )   meance = meance / numce 
    570  
    571       WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 
    572       WRITE(numout,*) ' After lim_thd_dif, category : ', jl 
    573       WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 
    574       WRITE(numout,*) ' Number of points where there is a cons err gt than c.e. : ', numce, numit 
    575  
    576       !------------------------------------------------------- 
    577       ! Surface error due to imbalance between Fatm and Fcsu 
    578       !------------------------------------------------------- 
    579       numce  = 0 
    580       meance = 0._wp 
    581  
    582       DO ji = kideb, kiut 
    583          surf_error(ji,jl) = ABS ( fatm(ji,jl) - fc_su(ji) ) 
    584          IF( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) THEN 
    585             numce = numce + 1  
    586             meance = meance + surf_error(ji,jl) 
    587          ENDIF 
    588       ENDDO 
    589       IF( numce > 0 )   meance = meance / numce 
    590  
    591       WRITE(numout,*) ' Maximum tolerated surface error : ', max_surf_err 
    592       WRITE(numout,*) ' After lim_thd_dif, category : ', jl 
    593       WRITE(numout,*) ' Mean surface error on big error points ', meance, numit 
    594       WRITE(numout,*) ' Number of points where there is a surf err gt than surf_err : ', numce, numit 
    595  
    596       WRITE(numout,*) ' fc_su      : ', fc_su(jiindex_1d) 
    597       WRITE(numout,*) ' fatm       : ', fatm(jiindex_1d,jl) 
    598       WRITE(numout,*) ' t_su       : ', t_su_b(jiindex_1d) 
    599  
    600       !--------------------------------------- 
    601       ! Write ice state in case of big errors 
    602       !--------------------------------------- 
    603       DO ji = kideb, kiut 
    604          IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. & 
    605             ( cons_error(ji,jl) .GT. max_cons_err  ) ) THEN 
    606             ii                 = MOD( npb(ji) - 1, jpi ) + 1 
    607             ij                 = ( npb(ji) - 1 ) / jpi + 1 
    608             ! 
    609             WRITE(numout,*) ' alerte 1     ' 
    610             WRITE(numout,*) ' Untolerated conservation / surface error after ' 
    611             WRITE(numout,*) ' heat diffusion in the ice ' 
    612             WRITE(numout,*) ' Category   : ', jl 
    613             WRITE(numout,*) ' ii , ij  : ', ii, ij 
    614             WRITE(numout,*) ' lat, lon   : ', gphit(ii,ij), glamt(ii,ij) 
    615             WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    616             WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 
    617             WRITE(numout,*) ' dq_i       : ', - dq_i(ji,jl) * r1_rdtice 
    618             WRITE(numout,*) ' Fdt        : ', sum_fluxq(ji,jl) 
    619             WRITE(numout,*) 
    620             !        WRITE(numout,*) ' qt_i_in   : ', qt_i_in(ji,jl) 
    621             !        WRITE(numout,*) ' qt_s_in   : ', qt_s_in(ji,jl) 
    622             !        WRITE(numout,*) ' qt_i_fin  : ', qt_i_fin(ji,jl) 
    623             !        WRITE(numout,*) ' qt_s_fin  : ', qt_s_fin(ji,jl) 
    624             !        WRITE(numout,*) ' qt        : ', qt_i_fin(ji,jl) + qt_s_fin(ji,jl) 
    625             WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
    626             WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
    627             WRITE(numout,*) ' t_su       : ', t_su_b(ji) 
    628             WRITE(numout,*) ' t_s        : ', t_s_b(ji,1) 
    629             WRITE(numout,*) ' t_i        : ', t_i_b(ji,1:nlay_i) 
    630             WRITE(numout,*) ' t_bo       : ', t_bo_b(ji) 
    631             WRITE(numout,*) ' q_i        : ', q_i_b(ji,1:nlay_i) 
    632             WRITE(numout,*) ' s_i        : ', s_i_b(ji,1:nlay_i) 
    633             WRITE(numout,*) ' tmelts     : ', rtt - tmut*s_i_b(ji,1:nlay_i) 
    634             WRITE(numout,*) 
    635             WRITE(numout,*) ' Fluxes ' 
    636             WRITE(numout,*) ' ~~~~~~ ' 
    637             WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
    638             WRITE(numout,*) ' fc_su      : ', fc_su    (ji) 
    639             WRITE(numout,*) ' fstr_inice : ', qsr_ice_1d(ji)*i0(ji) 
    640             WRITE(numout,*) ' fc_bo      : ', - fc_bo_i  (ji) 
    641             WRITE(numout,*) ' foc        : ', fbif_1d(ji) 
    642             WRITE(numout,*) ' fstroc     : ', fstroc   (ii,ij,jl) 
    643             WRITE(numout,*) ' i0         : ', i0(ji) 
    644             WRITE(numout,*) ' qsr_ice    : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
    645             WRITE(numout,*) ' qns_ice    : ', qnsr_ice_1d(ji) 
    646             WRITE(numout,*) ' Conduction fluxes : ' 
    647             WRITE(numout,*) ' fc_s      : ', fc_s(ji,0:nlay_s) 
    648             WRITE(numout,*) ' fc_i      : ', fc_i(ji,0:nlay_i) 
    649             WRITE(numout,*) 
    650             WRITE(numout,*) ' Layer by layer ... ' 
    651             WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 
    652             WRITE(numout,*) ' dfc_snow  : ', fc_s(ji,1) - fc_s(ji,0) 
    653             DO jk = 1, nlay_i 
    654                WRITE(numout,*) ' layer  : ', jk 
    655                WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) * r1_rdtice   
    656                WRITE(numout,*) ' radab  : ', radab(ji,jk) 
    657                WRITE(numout,*) ' dfc_i  : ', fc_i(ji,jk) - fc_i(ji,jk-1) 
    658                WRITE(numout,*) ' tot f  : ', fc_i(ji,jk) - fc_i(ji,jk-1) - radab(ji,jk) 
    659             END DO 
    660  
    661          ENDIF 
    662          ! 
    663       END DO 
    664       ! 
    665    END SUBROUTINE lim_thd_con_dif 
    666  
    667  
    668    SUBROUTINE lim_thd_con_dh( kideb, kiut, jl ) 
    669       !!----------------------------------------------------------------------- 
    670       !!                   ***  ROUTINE lim_thd_con_dh  ***  
    671       !!                  
    672       !! ** Purpose :   Test energy conservation after enthalpy redistr. 
    673       !!----------------------------------------------------------------------- 
    674       INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
    675       INTEGER, INTENT(in) ::   jl            ! category number 
    676       ! 
    677       INTEGER  ::   ji                ! loop indices 
    678       INTEGER  ::   ii, ij, numce         ! local integers 
    679       REAL(wp) ::   meance, max_cons_err    !local scalar 
    680       !!--------------------------------------------------------------------- 
    681  
    682       max_cons_err = 1._wp 
    683  
    684       !-------------------------- 
    685       ! Increment of energy 
    686       !-------------------------- 
    687       DO ji = kideb, kiut 
    688          dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl)   ! global 
    689       END DO 
    690       dq_i_layer(:,:)    = q_i_layer_fin(:,:) - q_i_layer_in(:,:)                            ! layer by layer 
    691  
    692       !---------------------------------------- 
    693       ! Atmospheric heat flux, ice heat budget 
    694       !---------------------------------------- 
    695       DO ji = kideb, kiut 
    696          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    697          ij =    ( npb(ji) - 1 ) / jpi + 1 
    698  
    699          fatm      (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji)                       ! total heat flux 
    700          sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(ii,ij,jl)  
    701          cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    702       END DO 
    703  
    704       !-------------------- 
    705       ! Conservation error 
    706       !-------------------- 
    707       DO ji = kideb, kiut 
    708          cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    709       END DO 
    710  
    711       numce = 0 
    712       meance = 0._wp 
    713       DO ji = kideb, kiut 
    714          IF( cons_error(ji,jl) .GT. max_cons_err ) THEN 
    715             numce = numce + 1 
    716             meance = meance + cons_error(ji,jl) 
    717          ENDIF 
    718       ENDDO 
    719       IF(numce > 0 ) meance = meance / numce 
    720  
    721       WRITE(numout,*) ' Error report - Category : ', jl 
    722       WRITE(numout,*) ' ~~~~~~~~~~~~ ' 
    723       WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 
    724       WRITE(numout,*) ' After lim_thd_ent, category : ', jl 
    725       WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 
    726       WRITE(numout,*) ' Number of points where there is a cons err gt than 0.1 W/m2 : ', numce, numit 
    727  
    728       !--------------------------------------- 
    729       ! Write ice state in case of big errors 
    730       !--------------------------------------- 
    731       DO ji = kideb, kiut 
    732          IF ( cons_error(ji,jl) .GT. max_cons_err  ) THEN 
    733             ii = MOD( npb(ji) - 1, jpi ) + 1 
    734             ij =    ( npb(ji) - 1 ) / jpi + 1 
    735             ! 
    736             WRITE(numout,*) ' alerte 1 - category : ', jl 
    737             WRITE(numout,*) ' Untolerated conservation error after limthd_ent ' 
    738             WRITE(numout,*) ' ii , ij  : ', ii, ij 
    739             WRITE(numout,*) ' lat, lon   : ', gphit(ii,ij), glamt(ii,ij) 
    740             WRITE(numout,*) ' * ' 
    741             WRITE(numout,*) ' Ftotal     : ', sum_fluxq(ji,jl) 
    742             WRITE(numout,*) ' dq_t       : ', - dq_i(ji,jl) * r1_rdtice 
    743             WRITE(numout,*) ' dq_i       : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) * r1_rdtice 
    744             WRITE(numout,*) ' dq_s       : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 
    745             WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    746             WRITE(numout,*) ' * ' 
    747             WRITE(numout,*) ' Fluxes        --- : ' 
    748             WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
    749             WRITE(numout,*) ' foce       : ', fbif_1d(ji) 
    750             WRITE(numout,*) ' fres       : ', ftotal_fin(ji) 
    751             WRITE(numout,*) ' fhbri      : ', fhbricat(ii,ij,jl) 
    752             WRITE(numout,*) ' * ' 
    753             WRITE(numout,*) ' Heat contents --- : ' 
    754             WRITE(numout,*) ' qt_s_in    : ', qt_s_in(ji,jl) * r1_rdtice 
    755             WRITE(numout,*) ' qt_i_in    : ', qt_i_in(ji,jl) * r1_rdtice 
    756             WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) * r1_rdtice 
    757             WRITE(numout,*) ' qt_s_fin   : ', qt_s_fin(ji,jl) * r1_rdtice 
    758             WRITE(numout,*) ' qt_i_fin   : ', qt_i_fin(ji,jl) * r1_rdtice 
    759             WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) * r1_rdtice 
    760             WRITE(numout,*) ' * ' 
    761             WRITE(numout,*) ' Ice variables --- : ' 
    762             WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
    763             WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
    764             WRITE(numout,*) ' dh_s_tot  : ', dh_s_tot(ji) 
    765             WRITE(numout,*) ' dh_snowice: ', dh_snowice(ji) 
    766             WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji) 
    767             WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    768          ENDIF 
    769          ! 
    770       END DO 
    771       ! 
    772    END SUBROUTINE lim_thd_con_dh 
    773  
    774  
     555  
    775556   SUBROUTINE lim_thd_enmelt( kideb, kiut ) 
    776557      !!----------------------------------------------------------------------- 
     
    859640         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd 
    860641         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     thcon_i_swi  = ', thcon_i_swi 
     642         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
    861643      ENDIF 
    862644      ! 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

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

    r4332 r4634  
    2525   USE wrk_nemo       ! work arrays 
    2626   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     27   USE cpl_oasis3, ONLY : lk_cpl 
    2728 
    2829   IMPLICIT NONE 
     
    111112      REAL(wp) ::   zraext_s  =  1.e+8_wp     ! extinction coefficient of radiation in the snow 
    112113      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
     114      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered as 0°C  
    113115      REAL(wp) ::   ztmelt_i    ! ice melting temperature 
    114116      REAL(wp) ::   zerritmax   ! current maximal error on temperature  
     
    145147      REAL(wp), DIMENSION(kiut,jkmax+2) ::   zdiagbis 
    146148      REAL(wp), DIMENSION(kiut,jkmax+2,3) ::   ztrid   ! tridiagonal system terms 
     149      REAL(wp) ::   ztemp   ! local scalar  
    147150      !!------------------------------------------------------------------      
    148151      !  
     
    150153      ! 1) Initialization                                                            ! 
    151154      !------------------------------------------------------------------------------! 
    152       ! 
     155      ! clem clean: replace just ztfs by rtt 
    153156      DO ji = kideb , kiut 
    154157         ! is there snow or not 
    155158         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
    156159         ! surface temperature of fusion 
    157 !!gm ???  ztfs(ji) = rtt !!!???? 
    158160         ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 
    159161         ! layer thickness 
     
    194196      ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface  
    195197      ! zftrice = io.qsr_ice       is below the surface  
    196       ! fstbif = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
     198      ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
    197199 
    198200      DO ji = kideb , kiut 
     
    253255 
    254256      DO ji = kideb, kiut           ! Radiation transmitted below the ice 
    255          fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 
    256       END DO 
    257  
    258       ! +++++ 
    259       ! just to check energy conservation 
    260       DO ji = kideb, kiut 
    261          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    262          ij =    ( npb(ji) - 1 ) / jpi + 1 
    263          fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 
    264       END DO 
    265       ! +++++ 
    266  
    267       DO layer = 1, nlay_i 
    268          DO ji = kideb, kiut 
    269             radab(ji,layer) = zradab_i(ji,layer) 
    270          END DO 
     257         !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 
     258         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i)  
    271259      END DO 
    272260 
     
    279267         ztsuold  (ji) =  t_su_b(ji)                              ! temperature at the beg of iter pr. 
    280268         ztsuoldit(ji) =  t_su_b(ji)                              ! temperature at the previous iter 
    281          t_su_b   (ji) =  MIN( t_su_b(ji), ztfs(ji)-0.00001 )     ! necessary 
     269         t_su_b   (ji) =  MIN( t_su_b(ji), ztfs(ji) - ztsu_err )  ! necessary 
     270         !!ztsuold  (ji) =  t_su_b(ji)                              ! temperature at the beg of iter pr. 
     271         !!ztsuoldit(ji) =  t_su_b(ji)                              ! temperature at the previous iter 
    282272         zerrit   (ji) =  1000._wp                                ! initial value of error 
    283273      END DO 
     
    328318            DO layer = 1, nlay_i-1 
    329319               DO ji = kideb , kiut 
    330                   ztcond_i(ji,layer) = rcdic + 0.090_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) )   & 
    331                      &                                  / MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt)   & 
    332                      &                       - 0.0055_wp* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt )   
     320                  ztemp = t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2._wp * rtt 
     321                  ztcond_i(ji,layer) = rcdic + 0.0900_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) )   & 
     322                     &                                   / MIN( -2.0_wp * epsi10, ztemp )   & 
     323                     &                       - 0.0055_wp * ztemp 
    333324                  ztcond_i(ji,layer) = MAX( ztcond_i(ji,layer), zkimin ) 
    334325               END DO 
    335326            END DO 
    336327            DO ji = kideb , kiut 
    337                ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN(-epsi10,t_bo_b(ji)-rtt)   & 
    338                   &                        - 0.011_wp * ( t_bo_b(ji) - rtt )   
     328               ztemp = t_bo_b(ji) - rtt 
     329               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN( -epsi10, ztemp )   & 
     330                  &                        - 0.011_wp * ztemp   
    339331               ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin ) 
    340332            END DO 
     
    405397 
    406398            ! update of the non solar flux according to the update in T_su 
    407             qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * &  
    408                ( t_su_b(ji) - ztsuoldit(ji) ) 
     399            qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 
    409400 
    410401            ! update incoming flux 
    411402            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    412                + qnsr_ice_1d(ji)           ! non solar total flux  
     403               + qns_ice_1d(ji)                  ! non solar total flux  
    413404            ! (LWup, LWdw, SH, LH) 
    414405 
     406            ! heat flux used to change surface temperature 
     407            !hfx_tot_1d(ji) = hfx_tot_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) * a_i_b(ji) 
    415408         END DO 
    416409 
     
    713706      !-------------------------------------------------------------------------! 
    714707      DO ji = kideb, kiut 
    715 #if ! defined key_coupled 
    716708         ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux)  
    717          qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 
    718 #endif 
     709         IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 
    719710         !                                ! surface ice conduction flux 
    720711         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  ) 
     
    725716      END DO 
    726717 
    727       !-------------------------! 
    728       ! Heat conservation       ! 
    729       !-------------------------! 
    730       IF( con_i .AND. jiindex_1d > 0 ) THEN 
    731          DO ji = kideb, kiut 
    732             ! Upper snow value 
    733             fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) )  
    734             ! Bott. snow value 
    735             fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) )  
    736          END DO 
    737          DO ji = kideb, kiut         ! Upper ice layer 
    738             fc_i(ji,0) = - REAL( isnow(ji) ) * &  ! interface flux if there is snow 
    739                ( zkappa_i(ji,0)  * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 
    740                - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
    741                zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 
    742          END DO 
    743          DO layer = 1, nlay_i - 1         ! Internal ice layers 
    744             DO ji = kideb, kiut 
    745                fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - t_i_b(ji,layer) ) 
    746                ii = MOD( npb(ji) - 1, jpi ) + 1 
    747                ij = ( npb(ji) - 1 ) / jpi + 1 
    748             END DO 
    749          END DO 
    750          DO ji = kideb, kiut         ! Bottom ice layers 
    751             fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    752          END DO 
    753       ENDIF 
     718      !----------------------------------------- 
     719      ! Heat flux used to warm/cool ice in W.m-2 
     720      !----------------------------------------- 
     721      DO ji = kideb, kiut 
     722         IF( t_su_b(ji) < rtt ) THEN  ! case T_su < 0degC 
     723            hfx_tot_1d(ji) = hfx_tot_1d(ji) + ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 
     724         ELSE                                    ! case T_su = 0degC 
     725            hfx_tot_1d(ji) = hfx_tot_1d(ji) + ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 
     726         ENDIF 
     727      END DO 
     728 
    754729      ! 
    755730   END SUBROUTINE lim_thd_dif 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

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

    r4332 r4634  
    3737 
    3838   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    39    REAL(wp) ::   zzero  = 0._wp      ! 
    40    REAL(wp) ::   zone   = 1._wp      ! 
     39   REAL(wp) ::   epsi20 = 1.e-20_wp   ! 
    4140 
    4241   !!---------------------------------------------------------------------- 
     
    7675      INTEGER ::   layer, nbpac     ! local integers  
    7776      INTEGER ::   ii, ij, iter   !   -       - 
    78       REAL(wp)  ::   ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zinda, zde  ! local scalars 
     77      REAL(wp)  ::   ztmelts, zdv, zfrazb, zweight, zindb, zinda, zde  ! local scalars 
    7978      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      - 
    8079      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    8180      LOGICAL  ::   iterate_frazil   ! iterate frazil ice collection thickness 
    8281      CHARACTER (len = 15) :: fieldid 
    83       ! 
     82 
     83      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 
     84      REAL(wp) ::   zEi          ! sea ice specific enthalpy (J/kg) 
     85      REAL(wp) ::   zEw          ! seawater specific enthalpy (J/kg) 
     86      REAL(wp) ::   zfmdt        ! mass flux x time step (kg/m2, >0 towards ocean) 
     87        
    8488      INTEGER , POINTER, DIMENSION(:) ::   zcatac      ! indexes of categories where new ice grows 
    8589      REAL(wp), POINTER, DIMENSION(:) ::   zswinew     ! switch for new ice or not 
     
    9599      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_ac    ! total ice fraction     
    96100      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_lev   ! total ice fraction for level ice only (type 1)    
    97       REAL(wp), POINTER, DIMENSION(:) ::   zdh_frazb   ! accretion of frazil ice at the ice bottom 
     101      REAL(wp), POINTER, DIMENSION(:) ::   zv_frazb   ! accretion of frazil ice at the ice bottom 
    98102      REAL(wp), POINTER, DIMENSION(:) ::   zvrel_ac    ! relative ice / frazil velocity (1D vector) 
    99103 
    100       REAL(wp), POINTER, DIMENSION(:,:) ::   zhice_old   ! previous ice thickness 
    101       REAL(wp), POINTER, DIMENSION(:,:) ::   zdummy      ! dummy thickness of new ice  
    102       REAL(wp), POINTER, DIMENSION(:,:) ::   zdhicbot    ! thickness of new ice which is accreted vertically 
    103104      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_old      ! old volume of ice in category jl 
    104105      REAL(wp), POINTER, DIMENSION(:,:) ::   za_old      ! old area of ice in category jl 
     
    110111      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_ac   !: 1-D version of e_i 
    111112 
    112       REAL(wp), POINTER, DIMENSION(:) ::   zqbgow    ! heat budget of the open water (negative) 
    113       REAL(wp), POINTER, DIMENSION(:) ::   zdhex     ! excessively thick accreted sea ice (hlead-hice) 
    114  
    115113      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqm0      ! old layer-system heat content 
    116114      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zthick0   ! old ice thickness 
     
    125123      CALL wrk_alloc( jpij, zcatac )   ! integer 
    126124      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    127       CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 
    128       CALL wrk_alloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
     125      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zv_frazb, zvrel_ac ) 
     126      CALL wrk_alloc( jpij,jpl, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
    129127      CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac ) 
    130128      CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 
     
    154152               DO ji = 1, jpi 
    155153                  !Energy of melting q(S,T) [J.m-3] 
    156                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * REAL( nlay_i ) 
    157154                  zindb = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes 
    158                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 
     155                  e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i ) 
     156                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 
    159157               END DO 
    160158            END DO 
     
    196194            DO ji = 1, jpi 
    197195 
    198                IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 
     196               IF ( qlead(ji,jj) < 0._wp ) THEN 
    199197                  !------------- 
    200198                  ! Wind stress 
     
    278276      DO jj = 1, jpj 
    279277         DO ji = 1, jpi 
    280             IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) )  >  0._wp ) THEN 
     278            IF ( qlead(ji,jj)  <  0._wp ) THEN 
    281279               nbpac = nbpac + 1 
    282280               npac( nbpac ) = (jj - 1) * jpi + ji 
     
    290288         DO ji = mi0(jiindx), mi1(jiindx) 
    291289            DO jj = mj0(jjindx), mj1(jjindx) 
    292                IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) )  >  0._wp ) THEN 
     290               IF ( qlead(ji,jj)  <  0._wp ) THEN 
    293291                  jiindex_1d = (jj - 1) * jpi + ji 
    294292               ENDIF 
     
    318316         END DO ! jl 
    319317 
    320          CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif  , jpi, jpj, npac(1:nbpac) ) 
    321          CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif  , jpi, jpj, npac(1:nbpac) ) 
     318         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) ) 
    322319         CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) ) 
    323          CALL tab_2d_1d( nbpac, sfx_thd_1d(1:nbpac)     , sfx_thd, jpi, jpj, npac(1:nbpac) ) 
    324          CALL tab_2d_1d( nbpac, rdm_ice_1d(1:nbpac)     , rdm_ice, jpi, jpj, npac(1:nbpac) ) 
     320         CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw, jpi, jpj, npac(1:nbpac) ) 
     321         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw, jpi, jpj, npac(1:nbpac) ) 
     322         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw, jpi, jpj, npac(1:nbpac) ) 
    325323         CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) ) 
    326324         CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) ) 
     325 
     326         CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd, jpi, jpj, npac(1:nbpac) ) 
     327         CALL tab_2d_1d( nbpac, hfx_tot_1d(1:nbpac)     , hfx_tot, jpi, jpj, npac(1:nbpac) ) 
    327328 
    328329         !------------------------------------------------------------------------------! 
    329330         ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice 
    330331         !------------------------------------------------------------------------------! 
     332 
     333         !----------------------------------------- 
     334         ! Keep old ice areas and volume in memory 
     335         !----------------------------------------- 
     336         zv_old(:,:) = zv_i_ac(:,:)  
     337         za_old(:,:) = za_i_ac(:,:) 
    331338 
    332339         !---------------------- 
     
    365372               &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )   & 
    366373               &                       - rcp  *         ( ztmelts - rtt )  ) 
     374            ! MV HC 2014 comment I dont see why this line below is here... ? 
     375            ! This implies that ze_newice gets to rhoic*Lfus if it was negative, but this should never happen 
    367376            ze_newice(ji) =   MAX( ze_newice(ji) , 0._wp )    & 
    368377               &          +   MAX(  0.0 , SIGN( 1.0 , - ze_newice(ji) )  ) * rhoic * lfus 
     
    375384         END DO ! ji 
    376385 
    377          !-------------------------- 
    378          ! Open water energy budget  
    379          !-------------------------- 
    380          DO ji = 1, nbpac 
    381             zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji)     !<0 
    382          END DO ! ji 
    383  
    384386         !------------------- 
    385387         ! Volume of new ice 
    386388         !------------------- 
    387389         DO ji = 1, nbpac 
    388             zv_newice(ji) = - zqbgow(ji) / ze_newice(ji) 
     390 
     391            zEi           = - ze_newice(ji) / rhoic                ! specific enthalpy of forming ice [J/kg] 
     392 
     393            zEw           = rcp * ( t_bo_b(ji) - rt0 )             ! specific enthalpy of seawater at t_bo_b [J/kg] 
     394                                                                   ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied)  
     395                                                                    
     396            zdE           = zEi - zEw                              ! specific enthalpy difference [J/kg] 
     397                                               
     398            zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0)  
     399                                                                   ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point    
     400            zv_newice(ji) = - zfmdt / rhoic 
     401 
     402            zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux   
     403 
     404            ! Contribution to heat flux to the ocean [W.m-2], >0   
     405            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice 
     406            ! Total heat flux used in this process [W.m-2]   
     407            hfx_tot_1d(ji) = hfx_tot_1d(ji) - zfmdt * zdE * r1_rdtice 
     408            ! mass flux 
     409            wfx_opw_1d(ji) = wfx_opw_1d(ji) + zv_newice(ji) * rhoic * r1_rdtice 
     410            ! salt flux 
     411            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 
    389412 
    390413            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    391414            zfrazb        = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 
    392             zdh_frazb(ji) =         zfrazb   * zv_newice(ji) 
     415            zv_frazb(ji) =         zfrazb   * zv_newice(ji) 
    393416            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
    394417         END DO 
     
    402425            ! 
    403426            zde = ze_newice(ji) / unit_fac * area(ii,ij) * zv_newice(ji) 
     427            !zde = ze_newice(ji) * area(ii,ij) * zv_newice(ji) 
    404428            ! 
     429            ! clem: change that? 
    405430            vt_i_init(ii,ij) = vt_i_init(ii,ij) + zv_newice(ji)             ! volume 
    406431            et_i_init(ii,ij) = et_i_init(ii,ij) + zde                       ! Energy 
    407432 
    408433         END DO 
    409  
    410          ! keep new ice volume in memory 
    411          CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , jpi, jpj ) 
    412434 
    413435         !----------------- 
     
    415437         !----------------- 
    416438         DO ji = 1, nbpac 
    417             ii = MOD( npac(ji) - 1 , jpi ) + 1 
    418             ij =    ( npac(ji) - 1 ) / jpi + 1 
    419439            za_newice(ji) = zv_newice(ji) / zh_newice(ji) 
    420             diag_lat_gr(ii,ij) = diag_lat_gr(ii,ij) + zv_newice(ji) * r1_rdtice ! clem 
    421440         END DO !ji 
    422441 
     
    424443         ! 6) Redistribute new ice area and volume into ice categories                  ! 
    425444         !------------------------------------------------------------------------------! 
    426  
    427          !----------------------------------------- 
    428          ! Keep old ice areas and volume in memory 
    429          !----------------------------------------- 
    430          zv_old(:,:) = zv_i_ac(:,:)  
    431          za_old(:,:) = za_i_ac(:,:) 
    432445 
    433446         !------------------------------------------- 
     
    458471                  za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 
    459472                  zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) 
    460                   zat_i_ac(ji)    = zat_i_ac(ji)    + za_i_ac  (ji,jl) 
    461473                  zcatac  (ji)    = jl 
    462474               ENDIF 
     475               zat_i_ac(ji)    = zat_i_ac(ji)    + za_i_ac  (ji,jl) 
    463476            END DO 
    464477         END DO 
     
    469482         DO ji = 1, nbpac 
    470483            jl = zcatac(ji)                                                           ! categroy in which new ice is put 
    471             zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) + epsi10 ) )             ! zindb=1 if ice =0 otherwise 
    472             zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb  ! old ice thickness 
    473             zdhex    (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) )           ! difference in thickness 
    474             zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) )   ! ice totally new in jl category 
     484            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) )   ! 0 if old ice 
    475485         END DO 
    476486 
     
    478488            DO ji = 1, nbpac 
    479489               jl = zcatac(ji) 
    480                zqold   = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 
    481                zalphai = MIN( zhice_old(ji,jl) * REAL( jk )     / REAL( nlay_i ), zh_newice(ji) )   & 
    482                   &    - MIN( zhice_old(ji,jl) * REAL( jk - 1 ) / REAL( nlay_i ), zh_newice(ji) ) 
    483                ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji)                                     & 
    484                   + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / REAL( nlay_i )  & 
    485                   + za_newice(ji)  * ze_newice(ji) * zalphai                                       & 
    486                   + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / REAL( nlay_i ) ) / ( ( zv_i_ac(ji,jl) ) / REAL( nlay_i ) ) 
     490               ze_i_ac(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji)                & 
     491                  &      + ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_ac(ji,jk,jl) * zv_old(ji,jl) ) / zv_i_ac(ji,jl) 
    487492            END DO 
    488493         END DO 
     
    491496         ! Add excessive volume of new ice at the bottom 
    492497         !----------------------------------------------- 
    493          ! If the ice concentration exceeds 1, the remaining volume of new ice 
    494          ! is equally redistributed among all ice categories in which there is 
    495          ! ice 
    496  
    497          ! Fraction of level ice 
    498498         jm = 1 
    499          zat_i_lev(:) = 0._wp 
    500  
    501          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    502             DO ji = 1, nbpac 
    503                zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl)  
    504             END DO 
    505          END DO 
    506  
    507          IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 
    508          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    509             DO ji = 1, nbpac 
    510                zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) ) 
    511                zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_lev(ji) - epsi10 ) )  ! clem 
    512                zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zinda * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi10 ) 
    513             END DO 
    514          END DO 
    515          IF( ln_nicep .AND. jiindex_1d > 0 )   WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 
    516  
    517          !--------------------------------- 
    518          ! Heat content - bottom accretion 
    519          !--------------------------------- 
    520          jm = 1 
    521          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    522             DO ji = 1, nbpac 
    523                zindb =  1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) + epsi10 ) )       ! zindb=1 if ice =0 otherwise 
    524                zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 
    525                zdhicbot (ji,jl) = zdv_res(ji)    / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    & 
    526                   &             +  zindb * zdh_frazb(ji)                               ! frazil ice may coalesce 
    527                zdummy(ji,jl)    = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb      ! thickness of residual ice 
    528             END DO 
    529          END DO 
    530  
    531          ! old layers thicknesses and enthalpies 
     499 
     500         ! ---  Redistributing energy on the new grid (energy is equally distributed in every layer) --- ! 
     501!         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     502!            DO jk = 1, nlay_i 
     503!               DO ji = 1, nbpac 
     504!                  ze_i_ac(ji,jk,jl) = ( ze_i_ac(ji,jk,jl) * zv_i_ac(ji,jl) + ze_newice(ji) * ( zdv_res(ji) + zv_frazb(ji) ) ) / & 
     505!                     &                ( zv_i_ac(ji,jl) + ( zdv_res(ji) + zv_frazb(ji) ) )  
     506!               END DO 
     507!            END DO 
     508!         END DO 
     509 
     510         ! --- Redistributing energy on the new grid (energy is sent to the bottom) PART 1 --- ! 
    532511         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    533512            DO jk = 1, nlay_i 
    534513               DO ji = 1, nbpac 
    535                   zthick0(ji,jk,jl) =  zhice_old(ji,jl) / REAL( nlay_i ) 
     514                  zthick0(ji,jk,jl) =  zv_i_ac(ji,jl) / REAL( nlay_i ) 
    536515                  zqm0   (ji,jk,jl) =  ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 
    537516               END DO 
    538517            END DO 
    539518         END DO 
    540 !!gm ???  why the previous do loop  if ocerwriten by the following one ? 
    541519         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    542520            DO ji = 1, nbpac 
    543                zthick0(ji,nlay_i+1,jl) =  zdhicbot(ji,jl) 
    544                zqm0   (ji,nlay_i+1,jl) =  ze_newice(ji) * zdhicbot(ji,jl) 
     521               zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_ac(ji) - epsi10 ) ) 
     522               zthick0(ji,nlay_i+1,jl) =  zinda * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_ac(ji,jl) / MAX( zat_i_ac(ji) , epsi10 ) 
     523               zqm0   (ji,nlay_i+1,jl) =  ze_newice(ji) * zthick0(ji,nlay_i+1,jl) 
    545524            END DO ! ji 
    546525         END DO ! jl 
    547526 
    548          ! Redistributing energy on the new grid 
    549527         ze_i_ac(:,:,:) = 0._wp 
    550528         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     
    552530               DO layer = 1, nlay_i + 1 
    553531                  DO ji = 1, nbpac 
    554                      zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  
    555                      ! Redistributing energy on the new grid 
    556                      zweight = MAX (  MIN( zhice_old(ji,jl) * REAL( layer ), zdummy(ji,jl) * REAL( jk ) )   & 
    557                         &    - MAX( zhice_old(ji,jl) * REAL( layer - 1 ) , zdummy(ji,jl) * REAL( jk - 1 ) ) , 0._wp )   & 
    558                         &    /( MAX(REAL(nlay_i) * zthick0(ji,layer,jl),epsi10) ) * zindb 
    559                      ze_i_ac(ji,jk,jl) =  ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl)   
    560                   END DO ! ji 
    561                END DO ! layer 
    562             END DO ! jk 
    563          END DO ! jl 
    564  
     532                      zindb   =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zthick0(ji,layer,jl) + epsi10 ) )  
     533                      zweight = zindb * MAX( 0._wp,                                                                                              & 
     534                         &      MIN( zv_i_ac(ji,jl) * REAL( layer     ), ( zv_i_ac(ji,jl) +  zthick0(ji,nlay_i+1,jl) ) * REAL( jk     ) )     & 
     535                         &    - MAX( zv_i_ac(ji,jl) * REAL( layer - 1 ), ( zv_i_ac(ji,jl) +  zthick0(ji,nlay_i+1,jl) ) * REAL( jk - 1 ) ) )   & 
     536                         &  / ( REAL( nlay_i ) * MAX( zthick0(ji,layer,jl), epsi10 ) ) 
     537                      ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl)   
     538                  END DO  
     539               END DO  
     540            END DO  
     541         END DO 
     542 
     543         ! --- new volumes and layer thickness --- 
     544         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     545            DO ji = 1, nbpac 
     546               zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_ac(ji) - epsi10 ) ) 
     547               zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zinda * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_ac(ji,jl) / MAX( zat_i_ac(ji) , epsi10 ) 
     548            END DO 
     549         END DO 
     550 
     551         ! --- Redistributing energy on the new grid (energy is sent to the bottom) PART 2 --- ! 
    565552         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    566553            DO jk = 1, nlay_i 
    567554               DO ji = 1, nbpac 
    568555                  zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  
    569                   ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl)   & 
    570                      &              / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * REAL( nlay_i ) * zindb 
     556                  ze_i_ac(ji,jk,jl) = zindb * ze_i_ac(ji,jk,jl) / MAX( zv_i_ac(ji,jl), epsi10 ) * REAL( nlay_i ) 
    571557               END DO 
    572558            END DO 
    573559         END DO 
     560 
    574561 
    575562         !------------ 
     
    589576            DO jl = 1, jpl 
    590577               DO ji = 1, nbpac 
    591                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    592578                  zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    593                   zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) * zindb ! clem modif 
     579                  zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) 
    594580               END DO 
    595581            END DO    
    596582         !clem ENDIF 
    597  
    598          !-------------------------------- 
    599          ! Update mass/salt fluxes (clem) 
    600          !-------------------------------- 
    601          DO jl = 1, jpl 
    602             DO ji = 1, nbpac 
    603                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    604                zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    605                rdm_ice_1d(ji) = rdm_ice_1d(ji) + zdv * rhoic * zindb 
    606                sfx_thd_1d(ji)   =   sfx_thd_1d(ji) - zdv * rhoic * zs_newice(ji) * r1_rdtice * zindb 
    607            END DO 
    608          END DO 
    609583 
    610584         !------------------------------------------------------------------------------! 
     
    615589            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 
    616590            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 
    617             !clem IF (  num_sal == 2  )   & 
    618                CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 
     591            CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 
    619592            DO jk = 1, nlay_i 
    620593               CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 
    621594            END DO 
    622595         END DO 
    623          CALL tab_1d_2d( nbpac, sfx_thd, npac(1:nbpac), sfx_thd_1d(1:nbpac), jpi, jpj ) 
    624          CALL tab_1d_2d( nbpac, rdm_ice, npac(1:nbpac), rdm_ice_1d(1:nbpac), jpi, jpj ) 
     596         CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj ) 
     597         CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 
     598         CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 
     599 
     600         CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj ) 
     601         CALL tab_1d_2d( nbpac, hfx_tot, npac(1:nbpac), hfx_tot_1d(1:nbpac), jpi, jpj ) 
    625602         ! 
    626603      ENDIF ! nbpac > 0 
     
    630607      !------------------------------------------------------------------------------!     
    631608      DO jl = 1, jpl 
    632          DO jk = 1, nlay_i          ! heat content in 10^9 Joules 
    633             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / REAL( nlay_i )  / unit_fac  
     609         DO jk = 1, nlay_i 
     610            DO jj = 1, jpj 
     611               DO ji = 1, jpi 
     612                  ! heat content in Joules 
     613                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ) * unit_fac )  
     614                  !e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ) )  
     615               END DO 
     616            END DO 
    634617         END DO 
    635618      END DO 
     
    669652      CALL wrk_dealloc( jpij, zcatac )   ! integer 
    670653      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    671       CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 
    672       CALL wrk_dealloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
     654      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zv_frazb, zvrel_ac ) 
     655      CALL wrk_dealloc( jpij,jpl, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
    673656      CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac ) 
    674657      CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r4045 r4634  
    5353      ! 
    5454      INTEGER  ::   ji, jk     ! dummy loop indices  
    55       REAL(wp) ::   zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch, ztmelts   ! local scalars 
     55      REAL(wp) ::   iflush, igravdr, ztmelts   ! local scalars 
    5656      REAL(wp) ::   zaaa, zbbb, zccc, zdiscrim   ! local scalars 
    57       REAL(wp), POINTER, DIMENSION(:) ::   ze_init, zhiold, zsiold 
    5857      !!--------------------------------------------------------------------- 
    59  
    60       CALL wrk_alloc( jpij, ze_init, zhiold, zsiold ) 
    6158 
    6259      !------------------------------------------------------------------------------| 
     
    7774      IF(  num_sal == 2  ) THEN 
    7875 
    79          !--------------------------------- 
    80          ! Thickness at previous time step 
    81          !--------------------------------- 
    82          DO ji = kideb, kiut 
    83             zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji) 
    84             zsiold(ji) = sm_i_b(ji) 
    85          END DO 
    86  
    87          !--------------------- 
    88          ! Global heat content 
    89          !--------------------- 
    90          ze_init(:)  =  0._wp 
    91          DO jk = 1, nlay_i 
    92             DO ji = kideb, kiut 
    93                ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / REAL (nlay_i ) 
    94             END DO 
    95          END DO 
    96  
    9776         DO ji = kideb, kiut 
    9877            ! 
    9978            ! Switches  
    10079            !---------- 
    101             iflush       =         MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt )        )    ! =1 if summer  
    102             igravdr      =         MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) )    ! =1 if t_su < t_bo 
    103             iaccrbo      =         MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) )           )    ! =1 if bottom accretion 
    104             i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) ) 
    105             isnowic      = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch   ! =1 if snow ice formation 
     80            iflush       =         MAX( 0._wp , SIGN( 1._wp , t_su_b(ji) - rtt )        )    ! =1 if summer  
     81            igravdr      =         MAX( 0._wp , SIGN( 1._wp , t_bo_b(ji) - t_su_b(ji) ) )    ! =1 if t_su < t_bo 
    10682 
    10783            !--------------------- 
    10884            ! Salinity tendencies 
    10985            !--------------------- 
    110             !                                   ! drainage by gravity drainage 
    111             dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice  
    112             !                                   ! drainage by flushing   
    113             dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 
    114  
     86            !                                
     87            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice  ! drainage by gravity 
     88            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice  ! drainage by flushing  
     89            ! 
    11590            !----------------- 
    11691            ! Update salinity    
     
    12095            sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
    12196 
    122             ! if no ice, salinity = 0.1 
    123             i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 
    124             sm_i_b(ji)   = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch ) 
    125  
    126             !---------------------------- 
    127             ! Heat flux - brine drainage 
    128             !---------------------------- 
    129             fhbri_1d(ji) = 0._wp 
    130  
    13197            !---------------------------- 
    13298            ! Salt flux - brine drainage 
    13399            !---------------------------- 
    134             sfx_bri_1d(ji) = sfx_bri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) * ( sm_i_b(ji) - zsiold(ji) ) * r1_rdtice 
     100            sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_b(ji) * ht_i_b(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 
    135101 
    136102         END DO 
     
    164130      IF(  num_sal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
    165131 
    166       ! 
    167       CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold ) 
    168132      ! 
    169133   END SUBROUTINE lim_thd_sal 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r4332 r4634  
    3737 
    3838   REAL(wp)  ::   epsi10 = 1.e-10_wp   
    39    REAL(wp)  ::   rzero  = 0._wp    
    40    REAL(wp)  ::   rone   = 1._wp 
     39   REAL(wp)  ::   epsi20 = 1.e-20_wp   
    4140 
    4241   !! * Substitution 
     
    6766      INTEGER  ::   ierr                    ! error status 
    6867      REAL(wp) ::   zindb  , zindsn , zindic, zindh, zinda      ! local scalar 
    69       REAL(wp) ::   zusvosn, zusvoic, zbigval     !   -      - 
    7068      REAL(wp) ::   zcfl , zusnit                 !   -      - 
    71       REAL(wp) ::   ze   , zsal   , zage          !   -      - 
     69      REAL(wp) ::   zsal   , zage          !   -      - 
    7270      ! 
    7371      REAL(wp), POINTER, DIMENSION(:,:)      ::   zui_u, zvi_v, zsm, zs0at, zs0ow 
    7472      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 
    7573      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e 
    76       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     74      REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b ! Check conservation (C Rousset) 
    7775      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset) 
    7876      ! mass and salt flux (clem) 
    79       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold   ! old ice volume... 
    80       ! correct ice thickness (clem) 
     77      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold   ! old ice volume... 
    8178      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaiold, zhimax   ! old ice concentration and thickness 
    82       REAL(wp) :: zdv, zda, zvi, zvs, zsmv 
     79      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeiold, zesold   ! old enthalpies 
     80      REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei 
    8381      !!--------------------------------------------------------------------- 
    8482      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
    8583 
    86       CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
     84      CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 
    8785      CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    8886      CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 
    8987 
    90       CALL wrk_alloc( jpi,jpj,jpl,zviold )   ! clem 
    91       CALL wrk_alloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
     88      CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold )   ! clem 
    9289 
    9390      ! ------------------------------- 
    9491      !- check conservation (C Rousset) 
    9592      IF( ln_limdiahsb ) THEN 
    96          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     93         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 
    9794         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    98          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    99          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     95         zchk_e_i_b = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 
     96         zchk_fw_b  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 
     97         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 
     98         zchk_ft_b  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 
    10099      ENDIF 
    101100      !- check conservation (C Rousset) 
     
    117116         ! mass and salt flux init (clem) 
    118117         zviold(:,:,:)  = v_i(:,:,:) 
     118         zeiold(:,:)  = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )  
     119         zesold(:,:)  = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )  
    119120 
    120121         !--- Thickness correction init. (clem) ------------------------------- 
     
    167168!         ENDIF 
    168169!!gm end 
    169          initad = 1 + NINT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
     170         initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 
    170171         zusnit = 1.0 / REAL( initad )  
    171172         IF( zcfl > 0.5 .AND. lwp )   & 
     
    175176         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==! 
    176177            DO jk = 1,initad 
    177                CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
     178               CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    178179                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    179                CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
     180               CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   & 
    180181                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    181182               DO jl = 1, jpl 
    182                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     183                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    183184                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    184                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     185                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
    185186                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    186                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     187                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    187188                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    188                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     189                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
    189190                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    190                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     191                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    191192                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    192                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     193                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
    193194                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    194                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---      
     195                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---      
    195196                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    196                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     197                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
    197198                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    198                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     199                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    199200                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    200                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &  
     201                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &  
    201202                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    202                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     203                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    203204                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    204                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     205                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
    205206                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    206207                  DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    207                      CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
     208                     CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    208209                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    209210                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    210                      CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
     211                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    211212                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    212213                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
     
    216217         ELSE 
    217218            DO jk = 1, initad 
    218                CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
     219               CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    219220                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    220                CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
     221               CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   & 
    221222                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    222223               DO jl = 1, jpl 
    223                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     224                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    224225                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    225                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     226                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
    226227                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    227                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     228                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    228229                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    229                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     230                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
    230231                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    231                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     232                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    232233                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    233                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     234                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
    234235                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    235236 
    236                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
     237                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    237238                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    238                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     239                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
    239240                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    240                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     241                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    241242                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    242                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
     243                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
    243244                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    244                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     245                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    245246                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    246                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     247                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
    247248                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    248249                  DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    249                      CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
     250                     CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    250251                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    251252                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    252                      CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
     253                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    253254                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    254255                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
     
    268269            zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:) 
    269270            zs0a  (:,:,jl) = zs0a  (:,:,jl) / area(:,:) 
    270             zs0c0 (:,:,jl) = zs0c0 (:,:,jl) / area(:,:) 
    271             DO jk = 1, nlay_i 
    272                zs0e(:,:,jk,jl) = zs0e(:,:,jk,jl) / area(:,:) 
    273             END DO 
     271            ! 
    274272         END DO 
    275273 
     
    289287         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    290288            DO ji = 1 , fs_jpim1   ! vector opt. 
    291                pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji  ,jj) ) ) )   & 
    292                   &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    293                pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji,jj  ) ) ) )   & 
    294                   &        * ( 1._wp - MAX( rzero, SIGN( rone,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 
     289               pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji  ,jj) ) ) )   & 
     290                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 
     291               pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj  ) ) ) )   & 
     292                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 
    295293            END DO 
    296294         END DO 
     
    305303            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    306304               DO ji = 1 , fs_jpim1   ! vector opt. 
    307                   pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji  ,jj,jl) ) ) )   & 
    308                      &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
    309                   pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji,jj  ,jl) ) ) )   & 
    310                      &        * ( 1._wp - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
     305                  pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji  ,jj,jl) ) ) )   & 
     306                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
     307                  pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj  ,jl) ) ) )   & 
     308                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
    311309               END DO 
    312310            END DO 
     
    334332            DO jj = 1, jpj 
    335333               DO ji = 1, jpi 
    336                   zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl) ) 
    337                   zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl) ) 
    338                   zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl) ) 
    339                   zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl) ) 
    340                   zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl) ) 
    341                   zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl) ) 
     334                  zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) ) 
     335                  zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) ) 
     336                  zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) ) 
     337                  zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) ) 
     338                  zs0a  (ji,jj,jl) = MAX( 0._wp, zs0a  (ji,jj,jl) ) 
     339                  zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) ) 
    342340                  zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl) 
    343341               END DO 
     
    346344 
    347345         !--------------------------------------------------------- 
    348          ! 5.2) Snow thickness, Ice thickness, Ice concentrations 
     346         ! 5.2) Update and mask variables 
    349347         !--------------------------------------------------------- 
    350          DO jj = 1, jpj 
    351             DO ji = 1, jpi 
    352                zindb        = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - epsi10) ) 
    353                zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 
    354                ato_i(ji,jj) = zs0ow(ji,jj) 
    355             END DO 
    356          END DO 
    357  
    358          DO jl = 1, jpl         ! Remove very small areas  
     348         DO jl = 1, jpl           
    359349            DO jj = 1, jpj 
    360350               DO ji = 1, jpi 
    361                   zvi = zs0ice(ji,jj,jl) 
    362                   zvs = zs0sn(ji,jj,jl) 
     351                  zindb= MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 
     352 
     353                  zvi  = zs0ice(ji,jj,jl) 
     354                  zvs  = zs0sn (ji,jj,jl) 
     355                  zes  = zs0c0 (ji,jj,jl)       
     356                  zsmv = zs0sm (ji,jj,jl) 
    363357                  ! 
    364                   zindb         = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - epsi10) ) 
    365                   ! 
    366                   v_s(ji,jj,jl)  = zindb * zs0sn (ji,jj,jl)  
    367                   v_i(ji,jj,jl)  = zindb * zs0ice(ji,jj,jl) 
    368                   ! 
    369                   zindsn         = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
    370                   zindic         = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    371                   zindb          = MAX( zindsn, zindic ) 
    372                   ! 
    373                   zs0a(ji,jj,jl) = zindb  * zs0a(ji,jj,jl) !ice concentration 
    374                   a_i (ji,jj,jl) = zs0a(ji,jj,jl) 
    375                   v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 
    376                   v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 
    377                   ! 
    378                   ! Update mass fluxes (clem) 
    379                   rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic  
    380                   rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn  
     358                  ! Remove very small areas 
     359                  v_s(ji,jj,jl)   = zindb * zs0sn (ji,jj,jl)  
     360                  v_i(ji,jj,jl)   = zindb * zs0ice(ji,jj,jl) 
     361                  a_i(ji,jj,jl)   = zindb * zs0a  (ji,jj,jl) 
     362                  e_s(ji,jj,1,jl) = zindb * zs0c0 (ji,jj,jl)       
     363                  ! Ice salinity and age 
     364                  IF(  num_sal == 2  ) THEN 
     365                     smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 
     366                  ENDIF 
     367                  oa_i(ji,jj,jl) = MAX( zindb * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl) 
     368 
     369                 ! Update fluxes 
     370                  wfx_res(ji,jj) = wfx_res(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice  
     371                  wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
     372                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
     373                  hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    381374              END DO 
    382375            END DO 
    383376         END DO 
     377 
     378         DO jl = 1, jpl 
     379            DO jk = 1, nlay_i 
     380               DO jj = 1, jpj 
     381                  DO ji = 1, jpi 
     382                     zindb            = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 
     383                     zei              = zs0e(ji,jj,jk,jl)       
     384                     e_i(ji,jj,jk,jl) = zindb * MAX( 0._wp, zs0e(ji,jj,jk,jl) ) 
     385                     ! Update fluxes 
     386                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
     387                  END DO !ji 
     388               END DO ! jj 
     389            END DO ! jk 
     390         END DO ! jl 
    384391 
    385392         !--- Thickness correction in case too high (clem) -------------------------------------------------------- 
     
    390397 
    391398                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
    392                      zvi = v_i(ji,jj,jl) 
    393                      zvs = v_s(ji,jj,jl) 
    394                      zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
     399                     zvi  = v_i  (ji,jj,jl) 
     400                     zvs  = v_s  (ji,jj,jl) 
     401                     zsmv = smv_i(ji,jj,jl) 
     402                     zes  = e_s  (ji,jj,1,jl) 
     403                     zei  = SUM( e_i(ji,jj,:,jl) ) 
     404                     zdv  = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
    395405                     !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)    
    396406                      
     
    399409                        & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                           
    400410                        ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 
    401                         zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
    402                         a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
     411                        zindh   =  MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 
     412                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 
    403413                     ELSE 
    404414                        ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 
    405                         zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
    406                         a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
     415                        zindh   =  MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 
     416                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 
    407417                     ENDIF 
    408418 
    409419                     ! small correction due to *zindh for a_i 
    410                      v_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) 
    411                      v_s(ji,jj,jl) = zindh * v_s(ji,jj,jl) 
     420                     v_i  (ji,jj,jl) = zindh * v_i  (ji,jj,jl) 
     421                     v_s  (ji,jj,jl) = zindh * v_s  (ji,jj,jl) 
     422                     smv_i(ji,jj,jl) = zindh * smv_i(ji,jj,jl) 
     423                     e_s(ji,jj,1,jl) = zindh * e_s(ji,jj,1,jl) 
     424                     e_i(ji,jj,:,jl) = zindh * e_i(ji,jj,:,jl) 
    412425 
    413426                     ! Update mass fluxes 
    414                      rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 
    415                      rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 
     427                     wfx_res(ji,jj) = wfx_res(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 
     428                     wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
     429                     sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
     430                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
     431                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,:,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    416432 
    417433                  ENDIF 
    418434 
    419435                  diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 
    420  
    421                END DO 
    422             END DO 
    423          END DO 
    424  
    425          ! --- 
     436                  diag_trp_vs(ji,jj) = diag_trp_vs(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * r1_rdtice 
     437 
     438               END DO 
     439            END DO 
     440         END DO 
     441         ! ------------------------------------------------- 
     442 
     443         ! --- diags --- 
    426444         DO jj = 1, jpj 
    427445            DO ji = 1, jpi 
    428                zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) ! clem@useless?? 
    429             END DO 
    430          END DO 
    431  
    432          !---------------------- 
    433          ! 5.3) Ice properties 
    434          !---------------------- 
    435  
    436          zbigval = 1.e+13 
    437  
     446               diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 
     447               diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 
     448            END DO 
     449         END DO 
     450 
     451         ! --- agglomerate variables (clem) ----------------- 
     452         vt_i (:,:) = 0._wp 
     453         vt_s (:,:) = 0._wp 
     454         at_i (:,:) = 0._wp 
     455         ! 
    438456         DO jl = 1, jpl 
    439457            DO jj = 1, jpj 
    440458               DO ji = 1, jpi 
    441                   zsmv = zs0sm(ji,jj,jl) 
    442  
    443                   ! Switches and dummy variables 
    444                   zusvosn         = 1.0/MAX( v_s(ji,jj,jl) , epsi10 ) 
    445                   zusvoic         = 1.0/MAX( v_i(ji,jj,jl) , epsi10 ) 
    446                   zindsn          = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
    447                   zindic          = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    448                   zindb           = MAX( zindsn, zindic ) 
    449  
    450                   ! Ice salinity and age 
    451                   !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 
    452                   IF(  num_sal == 2  ) THEN 
    453                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 
    454                   ENDIF 
    455  
    456                   zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) ), 0._wp  ) * a_i(ji,jj,jl) 
    457                   oa_i (ji,jj,jl)  = zindic * zage  
    458  
    459                   ! Snow heat content 
    460                   ze              =  MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval ) 
    461                   e_s(ji,jj,1,jl) = zindsn * ze       
    462  
    463                   ! Update salt fluxes (clem) 
    464                   sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
    465                END DO !ji 
    466             END DO !jj 
    467          END DO ! jl 
    468  
    469          DO jl = 1, jpl 
    470             DO jk = 1, nlay_i 
    471                DO jj = 1, jpj 
    472                   DO ji = 1, jpi 
    473                      ! Ice heat content 
    474                      zindic          =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    475                      ze              =  MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval ) 
    476                      e_i(ji,jj,jk,jl) = zindic * ze 
    477                   END DO !ji 
    478                END DO ! jj 
    479             END DO ! jk 
    480          END DO ! jl 
    481  
    482  
    483       ! --- agglomerate variables (clem) ----------------- 
    484       vt_i (:,:) = 0._wp 
    485       vt_s (:,:) = 0._wp 
    486       at_i (:,:) = 0._wp 
    487       ! 
    488       DO jl = 1, jpl 
     459                  ! 
     460                  vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
     461                  vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
     462                  at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
     463               END DO 
     464            END DO 
     465         END DO 
     466         ! ------------------------------------------------- 
     467 
     468         ! open water 
    489469         DO jj = 1, jpj 
    490470            DO ji = 1, jpi 
    491                ! 
    492                vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
    493                vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
    494                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    495                ! 
    496                zinda = MAX( rzero , SIGN( rone , at_i(ji,jj) - epsi10 ) ) 
    497                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness 
    498             END DO 
    499          END DO 
    500       END DO 
    501       ! ------------------------------------------------- 
    502  
    503  
     471               ! open water = 1 if at_i=0 
     472               zindb        = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 
     473               ato_i(ji,jj) = zindb + (1._wp - zindb ) * zs0ow(ji,jj) 
     474            END DO 
     475         END DO       
    504476 
    505477      ENDIF 
     
    539511      !- check conservation (C Rousset) 
    540512      IF( ln_limdiahsb ) THEN 
    541          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    542          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     513         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     514         zchk_fw  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     515         zchk_ft  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 
    543516  
    544          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
    545          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
     517         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw  
     518         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
     519         zchk_e_i =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 
    546520 
    547521         zchk_vmin = glob_min(v_i) 
     
    551525 
    552526         IF(lwp) THEN 
    553             IF ( ABS( zchk_v_i   ) >  1.e-5 ) THEN 
    554                WRITE(numout,*) 'violation volume [m3/day]     (limtrp) = ',(zchk_v_i * rday) 
     527            IF ( ABS( zchk_v_i   ) >  1.e-4 ) THEN 
     528               WRITE(numout,*) 'violation volume [kg/day]     (limtrp) = ',(zchk_v_i * rday) 
    555529               WRITE(numout,*) 'u_ice max [m/s]               (limtrp) = ',zchk_umax 
    556530               WRITE(numout,*) 'number of time steps          (limtrp) =',kt 
    557531            ENDIF 
    558532            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday) 
     533            IF ( ABS( zchk_e_i   ) >  1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (limtrp) = ',(zchk_e_i) 
    559534            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limtrp) = ',(zchk_vmin * 1.e-3) 
    560535            IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limtrp) = ',zchk_amin 
     
    564539      ! ------------------------------- 
    565540      ! 
    566       CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
     541      CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 
    567542      CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    568543      CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e ) 
    569544 
    570       CALL wrk_dealloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
     545      CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax )   ! clem 
    571546      ! 
    572547      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r4332 r4634  
    3232   USE par_ice 
    3333   USE limitd_th 
     34   USE limitd_me 
    3435   USE limvar 
    3536   USE prtctl           ! Print control 
     
    4950 
    5051      REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
    51       REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    52       REAL(wp)  ::   rone   = 1._wp       !    -       - 
    5352          
    5453   !! * Substitutions 
     
    8079      INTEGER ::   jbnd1, jbnd2 
    8180      INTEGER ::   i_ice_switch 
    82       INTEGER ::   ind_im, layer      ! indices for internal melt 
    83       REAL(wp) ::   zweight, zesum, z_da_i, zhimax 
    8481      REAL(wp) ::   zinda, zindb, zindsn, zindic 
    85       REAL(wp) ::   zindg, zh, zdvres, zviold2 
    86       REAL(wp) ::   zbigvalue, zvsold2, z_da_ex 
    87       REAL(wp) ::   z_prescr_hi, zat_i_old, ztmelts, ze_s 
    88  
    89       REAL(wp), POINTER, DIMENSION(:) ::   zthick0, zqm0      ! thickness of the layers and heat contents for 
    90       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     82      REAL(wp) ::   zh, zdvres, zsal 
     83      REAL(wp) ::   zat_i_old, ztmelts 
     84 
     85      REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b ! Check conservation (C Rousset) 
    9186      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    92       ! mass and salt flux (clem) 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
    9487      !!------------------------------------------------------------------- 
    9588      IF( nn_timing == 1 )  CALL timing_start('limupdate1') 
    96  
    97       CALL wrk_alloc( jkmax, zthick0, zqm0 ) 
    98  
    99       CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    10089 
    10190      !------------------------------------------------------------------------------ 
     
    10695      !  Trend terms 
    10796      !----------------- 
    108       d_u_ice_dyn(:,:)     = u_ice(:,:)     - old_u_ice(:,:) 
    109       d_v_ice_dyn(:,:)     = v_ice(:,:)     - old_v_ice(:,:) 
    110       d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - old_a_i  (:,:,:) 
    111       d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - old_v_s  (:,:,:)   
    112       d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - old_v_i  (:,:,:)    
    113       d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - old_e_s  (:,:,:,:)   
    114       d_e_i_trp  (:,:,:,:) = e_i  (:,:,:,:) - old_e_i  (:,:,:,:) 
    115       d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - old_oa_i (:,:,:) 
    116       d_smv_i_trp(:,:,:)   = 0._wp 
    117       IF(  num_sal == 2  )   d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:) 
    118  
    119       ! mass and salt flux init (clem) 
    120       zviold(:,:,:) = v_i(:,:,:) 
    121       zvsold(:,:,:) = v_s(:,:,:) 
    122       zsmvold(:,:,:) = smv_i(:,:,:) 
    12397 
    12498      ! ------------------------------- 
    12599      !- check conservation (C Rousset) 
    126100      IF (ln_limdiahsb) THEN 
    127          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     101         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 
    128102         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    129          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    130          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     103         zchk_e_i_b = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 
     104         zchk_fw_b  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 
     105         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 
     106         zchk_ft_b  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 
    131107      ENDIF 
    132108      !- check conservation (C Rousset) 
    133109      ! ------------------------------- 
    134110 
     111      ! zap small values 
     112      !----------------- 
     113      CALL lim_itd_me_zapsmall 
     114 
    135115      CALL lim_var_glo2eqv 
    136  
    137       !-------------------------------------- 
    138       ! 2. Review of all pathological cases 
    139       !-------------------------------------- 
    140  
    141 ! clem: useless now 
    142       !------------------------------------------- 
    143       ! 2.1) Advection of ice in an ice-free cell 
    144       !------------------------------------------- 
    145       ! should be removed since it is treated after dynamics now 
    146 !      zhimax = 5._wp 
    147 !      ! first category 
    148 !      DO jj = 1, jpj 
    149 !         DO ji = 1, jpi 
    150 !            !--- the thickness of such an ice is often out of bounds 
    151 !            !--- thus we recompute a new area while conserving ice volume 
    152 !            zat_i_old = SUM( old_a_i(ji,jj,:) ) 
    153 !            zindb     = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_trp(ji,jj,1) ) - epsi10 ) )  
    154 !            IF( ( ABS( d_v_i_trp(ji,jj,1) ) / MAX( ABS( d_a_i_trp(ji,jj,1) ), epsi10 ) * zindb .GT. zhimax ) & 
    155 !              &   .AND.( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) & 
    156 !              &   .AND.( zat_i_old .LT. 1.e-6 ) )  THEN ! new line 
    157 !               ht_i(ji,jj,1) = hi_max(1) * 0.5_wp 
    158 !               a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1) 
    159 !            ENDIF 
    160 !         END DO 
    161 !      END DO 
    162 ! 
    163 !      zhimax = 20._wp 
    164 !      ! other categories 
    165 !      DO jl = 2, jpl 
    166 !         jm = ice_types(jl) 
    167 !         DO jj = 1, jpj 
    168 !            DO ji = 1, jpi 
    169 !               zindb =  MAX( rzero, SIGN( rone, ABS( d_a_i_trp(ji,jj,jl) ) - epsi10 ) )  
    170 !               ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
    171 !               ! it makes problems when the advected volume and concentration do not seem to be  
    172 !               ! related with each other 
    173 !               ! the new thickness is sometimes very big! 
    174 !               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
    175 !               ! which of course is plausible 
    176 !               ! but fuck! it fucks everything up :) 
    177 !               IF ( ( ABS( d_v_i_trp(ji,jj,jl) ) / MAX( ABS( d_a_i_trp(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) & 
    178 !                  &  .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN 
    179 !                  ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp 
    180 !                  a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl) 
    181 !               ENDIF 
    182 !            END DO ! ji 
    183 !         END DO !jj 
    184 !      END DO !jl 
    185116      
    186117      at_i(:,:) = 0._wp 
     
    203134      END DO 
    204135 
    205       zbigvalue      = 1.0e+20 
    206  
    207       DO jl = 1, jpl 
    208          DO jj = 1, jpj  
     136      !--- 2.13 ice concentration should not exceed amax  
     137      !----------------------------------------------------- 
     138      DO jl  = 1, jpl 
     139         DO jj = 1, jpj 
    209140            DO ji = 1, jpi 
    210  
    211                !switches 
    212                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    213                !switch = 1 if a_i > 1e-06 and 0 if not 
    214                zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 
    215                zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 
    216                ! bug fix 25 avril 2007 
    217                zindb         = zindb*zindic 
    218  
    219                !--- 2.3 Correction to ice age  
    220                !------------------------------ 
    221                !                IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 
    222                !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 
    223                !                ENDIF 
    224                IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    225                   oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 
     141               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     142                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 
     143                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    226144               ENDIF 
    227                oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
    228  
    229                !--- 2.4 Correction to snow thickness 
    230                !------------------------------------- 
    231                !          ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0 
    232                !             v_s(ji,jj,jl)  = MAX( zindb * v_s(ji,jj,jl), 0.0)  
    233                ! snow thickness cannot be smaller than 1e-6 
    234                zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 
    235                v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 
    236  
    237                !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 
    238   
    239                !--- 2.5 Correction to ice thickness 
    240                !------------------------------------- 
    241                zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 
    242                v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 
    243  
    244                !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 
    245                !sfx_res(ji,jj)  = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    246  
    247                !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
    248                !---------------------------------------------------------------------------- 
    249                zindg          = tms(ji,jj) *  MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    250                zdvres         = zindg * rhosn * v_s(ji,jj,jl) / rau0 
    251                v_i(ji,jj,jl)  = v_i(ji,jj,jl)  + zdvres 
    252  
    253                zdvres         = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 
    254                v_s(ji,jj,jl)  = v_s(ji,jj,jl)  + zdvres 
    255  
    256                !--- 2.7 Correction to ice concentrations  
    257                !-------------------------------------------- 
    258                ! if greater than 0, ice concentration cannot be smaller than 1e-10 
    259                a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 
    260  
    261                !------------------------- 
    262                ! 2.8) Snow heat content 
    263                !------------------------- 
    264                e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0._wp, e_s(ji,jj,1,jl) ), zbigvalue ) ) 
    265  
    266             END DO ! ji 
    267          END DO ! jj 
    268       END DO ! jl 
    269  
    270       !------------------------ 
    271       ! 2.9) Ice heat content  
    272       !------------------------ 
    273  
    274       DO jl = 1, jpl 
    275          DO jk = 1, nlay_i 
    276             DO jj = 1, jpj  
    277                DO ji = 1, jpi 
    278                   zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    279                   e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 
    280                END DO ! ji 
    281             END DO ! jj 
    282          END DO !jk 
    283       END DO !jl 
    284   
    285       at_i(:,:) = 0._wp 
     145            END DO 
     146         END DO 
     147      END DO 
     148 
     149      at_i(:,:) = 0.0 
    286150      DO jl = 1, jpl 
    287151         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    288152      END DO 
    289  
    290       !--- 2.13 ice concentration should not exceed amax  
    291       !         (it should not be the case)  
    292       !----------------------------------------------------- 
    293       DO jj = 1, jpj 
    294          DO ji = 1, jpi 
    295             z_da_ex =  MAX( at_i(ji,jj) - amax , 0.0 )         
    296             zindb   =  MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) )  
    297             DO jl  = 1, jpl 
    298                z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 
    299                a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 
    300                ! 
    301                zinda   =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    302                ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 
    303                !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 
    304             END DO 
    305          END DO 
    306       END DO 
    307       at_i(:,:) = a_i(:,:,1) 
    308       DO jl = 2, jpl 
    309          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    310       END DO 
    311  
    312  
     153   
     154   
    313155      ! Final thickness distribution rebinning 
    314156      ! -------------------------------------- 
     
    322164 
    323165 
     166      ! zap small values 
     167      !----------------- 
     168      CALL lim_itd_me_zapsmall 
     169 
    324170      !--------------------- 
    325171      ! 2.11) Ice salinity 
    326172      !--------------------- 
    327       ! clem correct bug on smv_i 
    328       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    329  
    330       IF (  num_sal == 2  ) THEN ! general case 
     173      IF (  num_sal == 2  ) THEN  
    331174         DO jl = 1, jpl 
    332             !DO jk = 1, nlay_i 
    333                DO jj = 1, jpj  
    334                   DO ji = 1, jpi 
    335                      ! salinity stays in bounds 
    336                      !clem smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) ) 
    337                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
    338                      i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    339                      smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
    340                   END DO ! ji 
    341                END DO ! jj 
    342             !END DO !jk 
     175            DO jj = 1, jpj  
     176               DO ji = 1, jpi 
     177                  zsal            = smv_i(ji,jj,jl) 
     178                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
     179                  ! salinity stays in bounds 
     180                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     181                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
     182                  ! associated salt flux 
     183                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     184               END DO ! ji 
     185            END DO ! jj 
    343186         END DO !jl 
    344187      ENDIF 
    345188 
     189      ! ------------------- 
    346190      at_i(:,:) = a_i(:,:,1) 
    347191      DO jl = 2, jpl 
    348192         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    349193      END DO 
    350  
    351  
    352       !-------------------------------- 
    353       ! Update mass/salt fluxes (clem) 
    354       !-------------------------------- 
    355       DO jl = 1, jpl 
    356          DO jj = 1, jpj  
    357             DO ji = 1, jpi 
    358                diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice  
    359                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    360                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    361                sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice  
    362             END DO 
    363          END DO 
    364       END DO 
    365194   
     195 
     196      ! ------------------------------------------------- 
     197      ! Diagnostics 
     198      ! ------------------------------------------------- 
     199      d_u_ice_dyn(:,:)     = u_ice(:,:)     - old_u_ice(:,:) 
     200      d_v_ice_dyn(:,:)     = v_ice(:,:)     - old_v_ice(:,:) 
     201      d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - old_a_i  (:,:,:) 
     202      d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - old_v_s  (:,:,:)   
     203      d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - old_v_i  (:,:,:)    
     204      d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - old_e_s  (:,:,:,:)   
     205      d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - old_e_i(:,:,1:nlay_i,:) 
     206      d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - old_oa_i (:,:,:) 
     207      d_smv_i_trp(:,:,:)   = 0._wp 
     208      IF(  num_sal == 2  )   d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:) 
     209 
    366210      ! ------------------------------- 
    367211      !- check conservation (C Rousset) 
    368       IF (ln_limdiahsb) THEN 
    369  
    370          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    371          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     212      IF( ln_limdiahsb ) THEN 
     213         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     214         zchk_fw  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     215         zchk_ft  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 
    372216  
    373          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
     217         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw  
    374218         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
     219         zchk_e_i =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 
    375220 
    376221         zchk_vmin = glob_min(v_i) 
    377222         zchk_amax = glob_max(SUM(a_i,dim=3)) 
    378223         zchk_amin = glob_min(a_i) 
    379         
     224 
    380225         IF(lwp) THEN 
    381             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limupdate1) = ',(zchk_v_i * rday) 
     226            IF ( ABS( zchk_v_i   ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (limupdate1) = ',(zchk_v_i * rday) 
    382227            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate1) = ',(zchk_smv * rday) 
     228            IF ( ABS( zchk_e_i   ) >  1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (limupdate1) = ',(zchk_e_i) 
    383229            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limupdate1) = ',(zchk_vmin * 1.e-3) 
    384230            IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limupdate1) = ',zchk_amax 
    385231            IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limupdate1) = ',zchk_amin 
    386232         ENDIF 
    387       ENDIF 
     233       ENDIF 
    388234      !- check conservation (C Rousset) 
    389235      ! ------------------------------- 
     
    446292         CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    447293         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    448          CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update1 : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    449294         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update1 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    450          CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update1 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 
    451295 
    452296         CALL prt_ctl_info(' ') 
     
    458302      ENDIF 
    459303    
    460  
    461       CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 
    462  
    463       CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    464  
    465304      IF( nn_timing == 1 )  CALL timing_stop('limupdate1') 
    466305   END SUBROUTINE lim_update1 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r4332 r4634  
    4545   PUBLIC   lim_update2   ! routine called by ice_step 
    4646 
    47       REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
    48       REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    49       REAL(wp)  ::   rone   = 1._wp       !    -       - 
    50           
     47   REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
     48   REAL(wp)  ::   epsi20 = 1.e-20_wp    
     49       
    5150   !! * Substitutions 
    5251#  include "vectopt_loop_substitute.h90" 
     
    7776      INTEGER ::   jbnd1, jbnd2 
    7877      INTEGER ::   i_ice_switch 
    79       INTEGER ::   ind_im, layer      ! indices for internal melt 
    80       REAL(wp) ::   zweight, zesum, zhimax, z_da_i 
    81       REAL(wp) ::   zinda, zindb, zindsn, zindic 
    82       REAL(wp) ::   zindg, zh, zdvres, zviold2 
    83       REAL(wp) ::   zbigvalue, zvsold2, z_da_ex 
    84       REAL(wp) ::   z_prescr_hi, zat_i_old, ztmelts, ze_s 
    85  
    86       INTEGER , POINTER, DIMENSION(:,:,:) ::  internal_melt 
    87       REAL(wp), POINTER, DIMENSION(:) ::   zthick0, zqm0      ! thickness of the layers and heat contents for 
    88       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     78      REAL(wp) ::   zindb, zindsn, zindic 
     79      REAL(wp) ::   zh, zdvres, zsal 
     80 
     81      REAL(wp) ::   zEs          ! specific enthalpy of snow (J/kg) 
     82      REAL(wp) ::   zEi          ! specific enthalpy of ice (J/kg) 
     83      REAL(wp) ::   zEw          ! specific enthalpy of exchanged water (J/kg) 
     84      REAL(wp) ::   zdE          ! specific enthalpy difference (J/kg) 
     85      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean 
     86 
     87      REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b ! Check conservation (C Rousset) 
    8988      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    90       ! mass and salt flux (clem) 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
    9289      !!------------------------------------------------------------------- 
    9390      IF( nn_timing == 1 )  CALL timing_start('limupdate2') 
    94  
    95       CALL wrk_alloc( jpi,jpj,jpl, internal_melt )   ! integer 
    96       CALL wrk_alloc( jkmax, zthick0, zqm0 ) 
    97  
    98       CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    9991 
    10092      !---------------------------------------------------------------------------------------- 
    10193      ! 1. Computation of trend terms       
    10294      !---------------------------------------------------------------------------------------- 
    103       !- Trend terms 
    104       d_a_i_thd(:,:,:)   = a_i(:,:,:)   - old_a_i(:,:,:)  
    105       d_v_s_thd(:,:,:)   = v_s(:,:,:)   - old_v_s(:,:,:) 
    106       d_v_i_thd(:,:,:)   = v_i(:,:,:)   - old_v_i(:,:,:)   
    107       d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)  
    108       d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 
    109       !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - old_oa_i (:,:,:) 
    110       d_smv_i_thd(:,:,:) = 0._wp 
    111       IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
    112       ! diag only (clem) 
    113       dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    114  
    115       ! mass and salt flux init (clem) 
    116       zviold(:,:,:) = v_i(:,:,:) 
    117       zvsold(:,:,:) = v_s(:,:,:) 
    118       zsmvold(:,:,:) = smv_i(:,:,:) 
    11995 
    12096      ! ------------------------------- 
    12197      !- check conservation (C Rousset) 
    12298      IF (ln_limdiahsb) THEN 
    123          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     99         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 
    124100         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    125          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    126          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     101         zchk_e_i_b = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 
     102         zchk_fw_b  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 
     103         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 
     104         zchk_ft_b  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 
    127105      ENDIF 
    128106      !- check conservation (C Rousset) 
    129107      ! ------------------------------- 
    130108 
     109      ! zap small values 
     110      !----------------- 
     111      CALL lim_itd_me_zapsmall 
     112 
    131113      CALL lim_var_glo2eqv 
    132114 
     
    134116      ! 2. Review of all pathological cases 
    135117      !-------------------------------------- 
    136  
    137 ! clem: useless now 
    138       !------------------------------------------- 
    139       ! 2.1) Advection of ice in an ice-free cell 
    140       !------------------------------------------- 
    141       ! should be removed since it is treated after dynamics now 
    142 !      zhimax = 5._wp 
    143 !      ! first category 
    144 !      DO jj = 1, jpj 
    145 !         DO ji = 1, jpi 
    146 !            !--- the thickness of such an ice is often out of bounds 
    147 !            !--- thus we recompute a new area while conserving ice volume 
    148 !            zat_i_old = SUM( old_a_i(ji,jj,:) ) 
    149 !            zindb     = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_thd(ji,jj,1) ) - epsi10 ) )  
    150 !            IF ( ( ABS( d_v_i_thd(ji,jj,1) ) / MAX( ABS( d_a_i_thd(ji,jj,1) ),epsi10 ) * zindb .GT. zhimax ) & 
    151 !               &  .AND. ( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) & 
    152 !               &  .AND. ( zat_i_old .LT. 1.e-6 ) )  THEN ! new line 
    153 !               ht_i(ji,jj,1) = hi_max(1) * 0.5_wp 
    154 !               a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1) 
    155 !            ENDIF 
    156 !         END DO 
    157 !      END DO 
    158  
    159 !      zhimax = 20._wp 
    160 !      ! other categories 
    161 !      DO jl = 2, jpl 
    162 !         jm = ice_types(jl) 
    163 !         DO jj = 1, jpj 
    164 !            DO ji = 1, jpi 
    165 !               zindb =  MAX( rzero, SIGN( rone, ABS( d_a_i_thd(ji,jj,jl)) - epsi10 ) )  
    166 !              ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
    167 !               ! it makes problems when the advected volume and concentration do not seem to be  
    168 !               ! related with each other 
    169 !               ! the new thickness is sometimes very big! 
    170 !               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
    171 !               ! which of course is plausible 
    172 !               ! but fuck! it fucks everything up :) 
    173 !               IF ( ( ABS( d_v_i_thd(ji,jj,jl) ) / MAX( ABS( d_a_i_thd(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) & 
    174 !                  &  .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN 
    175 !                  ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp 
    176 !                  a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl) 
    177 !               ENDIF 
    178 !            END DO ! ji 
    179 !         END DO !jj 
    180 !      END DO !jl 
    181       
    182118      at_i(:,:) = 0._wp 
    183119      DO jl = 1, jpl 
     
    194130      END DO 
    195131 
    196       !--------------------------------- 
    197       ! 2.3) Melt of an internal layer 
    198       !--------------------------------- 
    199       internal_melt(:,:,:) = 0 
    200  
    201       DO jl = 1, jpl 
    202          DO jk = 1, nlay_i 
    203             DO jj = 1, jpj  
    204                DO ji = 1, jpi 
    205                   ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    206                   IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) & 
    207                     & .AND. ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
    208                      internal_melt(ji,jj,jl) = 1 
    209                   ENDIF 
    210                END DO ! ji 
    211             END DO ! jj 
    212          END DO !jk 
    213       END DO !jl 
    214  
    215       DO jl = 1, jpl 
    216          DO jj = 1, jpj  
    217             DO ji = 1, jpi 
    218                IF( internal_melt(ji,jj,jl) == 1 ) THEN 
    219                   ! initial ice thickness 
    220                   !----------------------- 
    221                   ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    222  
    223                   ! reduce ice thickness 
    224                   !----------------------- 
    225                   ind_im = 0 
    226                   zesum = 0.0 
    227                   DO jk = 1, nlay_i 
    228                      ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    229                      IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) ind_im = ind_im + 1 
    230                      zesum = zesum + e_i(ji,jj,jk,jl) 
    231                   END DO 
    232                   ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) 
    233                   v_i(ji,jj,jl)  = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 
    234  
    235                   !CLEM 
    236                   zdvres = REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) * a_i(ji,jj,jl) 
    237                   !rdm_ice(ji,jj) = rdm_ice(ji,jj) - zdvres * rhoic 
    238                   !sfx_res(ji,jj)  = sfx_res(ji,jj) + sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    239  
    240                   ! redistribute heat 
    241                   !----------------------- 
    242                   ! old thicknesses and enthalpies 
    243                   ind_im = 0 
    244                   DO jk = 1, nlay_i 
    245                      ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    246                      IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND.  &  
    247                         ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN 
    248                         ind_im = ind_im + 1 
    249                         zthick0(ind_im) = ht_i(ji,jj,jl) * REAL(ind_im / nlay_i) 
    250                         zqm0   (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 ) 
    251                      ENDIF 
    252                   END DO 
    253  
    254                   ! Redistributing energy on the new grid 
    255                   IF ( ind_im .GT. 0 ) THEN 
    256  
    257                      DO jk = 1, nlay_i 
    258                         e_i(ji,jj,jk,jl) = 0.0 
    259                         DO layer = 1, ind_im 
    260                            zweight         = MAX (  & 
    261                               MIN( ht_i(ji,jj,jl) * REAL(layer/ind_im) , ht_i(ji,jj,jl) * REAL(jk / nlay_i) ) -       & 
    262                               MAX( ht_i(ji,jj,jl) * REAL((layer-1)/ind_im) , ht_i(ji,jj,jl) * REAL((jk-1) / nlay_i) ) , 0.0 ) & 
    263                               /  ( ht_i(ji,jj,jl) / REAL(ind_im) ) 
    264  
    265                            e_i(ji,jj,jk,jl) =  e_i(ji,jj,jk,jl) + zweight*zqm0(layer) 
    266                         END DO !layer 
    267                      END DO ! jk 
    268  
    269                      zesum = 0.0 
    270                      DO jk = 1, nlay_i 
    271                         zesum = zesum + e_i(ji,jj,jk,jl) 
    272                      END DO 
    273  
    274                   ELSE ! ind_im .EQ. 0, total melt 
    275                      e_i(ji,jj,jk,jl) = 0.0 
    276                   ENDIF 
    277  
    278                ENDIF ! internal_melt 
    279  
    280             END DO ! ji 
    281          END DO !jj 
    282       END DO !jl 
    283  
    284       internal_melt(:,:,:) = 0 
    285  
    286  
    287       ! Melt of snow 
    288       !-------------- 
    289       DO jl = 1, jpl 
    290          DO jj = 1, jpj  
    291             DO ji = 1, jpi 
    292                ! snow energy of melting 
    293                zinda   =  MAX( 0._wp, SIGN( 1._wp, v_s(ji,jj,jl) - epsi10 ) ) 
    294                ze_s = zinda * e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) / MAX( v_s(ji,jj,jl), epsi10 )  ! snow energy of melting 
    295  
    296                ! If snow energy of melting smaller then Lf 
    297                ! Then all snow melts and meltwater, heat go to the ocean 
    298                IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = 1 
    299  
    300             END DO 
    301          END DO 
    302       END DO 
    303  
    304       DO jl = 1, jpl 
    305          DO jj = 1, jpj  
    306             DO ji = 1, jpi 
    307                IF ( internal_melt(ji,jj,jl) == 1 ) THEN 
    308                   zdvres = v_s(ji,jj,jl) 
    309                   ! release heat 
    310                   fheat_res(ji,jj) = fheat_res(ji,jj) + ze_s * zdvres / rdt_ice 
    311                   ! release mass 
    312                   !rdm_snw(ji,jj) =  rdm_snw(ji,jj) - zdvres * rhosn 
    313                   ! 
    314                   v_s(ji,jj,jl)   = 0.0 
    315                   e_s(ji,jj,1,jl) = 0.0 
    316                  ENDIF 
    317             END DO 
    318          END DO 
    319       END DO 
    320  
    321       zbigvalue      = 1.0e+20 
    322       DO jl = 1, jpl 
    323          DO jj = 1, jpj  
    324             DO ji = 1, jpi 
    325  
    326                !switches 
    327                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    328                !switch = 1 if a_i > 1e-06 and 0 if not 
    329                zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 
    330                zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 
    331                ! bug fix 25 avril 2007 
    332                zindb         = zindb*zindic 
    333  
    334                !--- 2.3 Correction to ice age  
    335                !------------------------------ 
    336                !                IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 
    337                !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 
    338                !                ENDIF 
    339                IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    340                   oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 
    341                ENDIF 
    342                oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
    343  
    344                !--- 2.4 Correction to snow thickness 
    345                !------------------------------------- 
    346                zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 
    347                v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 
    348  
    349                !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 
    350   
    351                !--- 2.5 Correction to ice thickness 
    352                !------------------------------------- 
    353                zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 
    354                v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 
    355  
    356                !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 
    357                !sfx_res(ji,jj)  = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    358  
    359                !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
    360                !---------------------------------------------------------------------------- 
    361                zindg          = tms(ji,jj) *  MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    362                zdvres         = zindg * rhosn * v_s(ji,jj,jl) / rau0 
    363                v_i(ji,jj,jl)  = v_i(ji,jj,jl)  + zdvres 
    364  
    365                zdvres         = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 
    366                v_s(ji,jj,jl)  = v_s(ji,jj,jl)  + zdvres 
    367  
    368                !--- 2.7 Correction to ice concentrations  
    369                !-------------------------------------------- 
    370                a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 
    371  
    372                !------------------------- 
    373                ! 2.8) Snow heat content 
    374                !------------------------- 
    375                e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) ) 
    376  
    377             END DO ! ji 
    378          END DO ! jj 
    379       END DO ! jl 
    380  
    381       !------------------------ 
    382       ! 2.9) Ice heat content  
    383       !------------------------ 
    384  
    385       DO jl = 1, jpl 
    386          DO jk = 1, nlay_i 
    387             DO jj = 1, jpj  
    388                DO ji = 1, jpi 
    389                   zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    390                   e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 
    391                END DO ! ji 
    392             END DO ! jj 
    393          END DO !jk 
    394       END DO !jl 
    395  
    396  
     132 
     133!clem debug: it is done in limthd_dh now 
     134!      ! Melt of snow 
     135!      !-------------- 
     136!      DO jl = 1, jpl 
     137!         DO jj = 1, jpj  
     138!            DO ji = 1, jpi 
     139!               IF( v_s(ji,jj,jl) >= epsi20 ) THEN 
     140!                  ! If snow energy of melting smaller then Lf 
     141!                  ! Then all snow melts and heat go to the ocean 
     142!                  !IF ( zEs <= lfus ) THEN  
     143!                  IF( t_s(ji,jj,1,jl) >= rtt ) THEN 
     144!                     zdvres = - v_s(ji,jj,jl) 
     145!                     zEs    = - e_s(ji,jj,1,jl) * unit_fac / ( area(ji,jj) * MAX( v_s(ji,jj,jl), epsi20 ) )  ! snow energy of melting (J.m-3) 
     146!                     ! Contribution to heat flux to the ocean [W.m-2], < 0   
     147!                     hfx_res(ji,jj) = hfx_res(ji,jj) - zEs * zdvres * r1_rdtice 
     148!                     ! Contribution to mass flux 
     149!                     wfx_snw(ji,jj) =  wfx_snw(ji,jj) + rhosn * zdvres * r1_rdtice 
     150!                     ! updates 
     151!                     v_s (ji,jj,jl)   = 0._wp 
     152!                     ht_s(ji,jj,jl)   = 0._wp 
     153!                     e_s (ji,jj,1,jl) = 0._wp 
     154!                     t_s (ji,jj,1,jl) = rtt 
     155!                  ENDIF 
     156!               ENDIF 
     157!            END DO 
     158!         END DO 
     159!      END DO 
     160!clem debug 
     161 
     162      !--- 2.12 Constrain the thickness of the smallest category above 10 cm 
     163      !---------------------------------------------------------------------- 
    397164      DO jm = 1, jpm 
    398165         DO jj = 1, jpj  
    399166            DO ji = 1, jpi 
    400167               jl = ice_cat_bounds(jm,1) 
    401                !--- 2.12 Constrain the thickness of the smallest category above 5 cm 
    402                !---------------------------------------------------------------------- 
    403                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    404                ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi10) 
    405                zh            = MAX( rone , zindb * hiclim  / MAX( ht_i(ji,jj,jl) , epsi10 ) ) 
    406                ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh 
    407                ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh 
    408                a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh 
    409                !CLEM 
    410                v_i (ji,jj,jl) = a_i(ji,jj,jl) * ht_i(ji,jj,jl) 
    411                v_s (ji,jj,jl) = a_i(ji,jj,jl) * ht_s(ji,jj,jl) 
     168               IF( v_i(ji,jj,jl) > 0._wp .AND. ht_i(ji,jj,jl) < hiclim ) THEN 
     169                  zh             = hiclim / ht_i(ji,jj,jl) 
     170                  ht_s(ji,jj,jl) = ht_s(ji,jj,jl) * zh 
     171                  ht_i(ji,jj,jl) = ht_i(ji,jj,jl) * zh 
     172                  a_i (ji,jj,jl) = a_i(ji,jj,jl)  / zh 
     173               ENDIF 
    412174            END DO !ji 
    413175         END DO !jj 
    414176      END DO !jm 
    415  
     177       
     178      !--- 2.13 ice concentration should not exceed amax  
     179      !----------------------------------------------------- 
    416180      at_i(:,:) = 0.0 
    417181      DO jl = 1, jpl 
    418182         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    419183      END DO 
    420        
    421       !--- 2.13 ice concentration should not exceed amax  
    422       !         (it should not be the case)  
    423       !----------------------------------------------------- 
    424       DO jj = 1, jpj 
    425          DO ji = 1, jpi 
    426             z_da_ex =  MAX( at_i(ji,jj) - amax , 0.0 )         
    427             zindb   =  MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) )  
    428             DO jl  = 1, jpl 
    429                z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 
    430                a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 
    431                ! 
    432                zinda   =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    433                ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 
    434                !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 
     184 
     185      DO jl  = 1, jpl 
     186         DO jj = 1, jpj 
     187            DO ji = 1, jpi 
     188               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     189                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 
     190                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     191               ENDIF 
    435192            END DO 
    436193         END DO 
    437194      END DO 
     195 
    438196      at_i(:,:) = 0.0 
    439197      DO jl = 1, jpl 
     
    451209      END DO 
    452210 
     211      ! zap small values 
     212      !----------------- 
     213      CALL lim_itd_me_zapsmall 
     214 
    453215      !--------------------- 
    454216      ! 2.11) Ice salinity 
    455217      !--------------------- 
    456       ! clem correct bug on smv_i 
    457       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    458  
    459       IF (  num_sal == 2  ) THEN ! general case 
     218      IF (  num_sal == 2  ) THEN  
    460219         DO jl = 1, jpl 
    461             !DO jk = 1, nlay_i 
    462                DO jj = 1, jpj  
    463                   DO ji = 1, jpi 
    464                      ! salinity stays in bounds 
    465                      !clem smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) ) 
    466                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
    467                      i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    468                      smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
    469                   END DO ! ji 
    470                END DO ! jj 
    471             !END DO !jk 
     220            DO jj = 1, jpj  
     221               DO ji = 1, jpi 
     222                  zsal            = smv_i(ji,jj,jl) 
     223                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
     224                  ! salinity stays in bounds 
     225                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     226                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
     227                  ! associated salt flux 
     228                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     229               END DO ! ji 
     230            END DO ! jj 
    472231         END DO !jl 
    473232      ENDIF 
     233 
    474234 
    475235      ! ------------------- 
     
    501261      v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
    502262  
    503       !-------------------------------- 
    504       ! Update mass/salt fluxes (clem) 
    505       !-------------------------------- 
    506       DO jl = 1, jpl 
    507          DO jj = 1, jpj  
    508             DO ji = 1, jpi 
    509                diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice  
    510                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    511                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    512                sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice  
    513             END DO 
    514          END DO 
    515       END DO 
     263 
     264      ! ------------------------------------------------- 
     265      ! Diagnostics 
     266      ! ------------------------------------------------- 
     267      d_a_i_thd(:,:,:)   = a_i(:,:,:)   - old_a_i(:,:,:)  
     268      d_v_s_thd(:,:,:)   = v_s(:,:,:)   - old_v_s(:,:,:) 
     269      d_v_i_thd(:,:,:)   = v_i(:,:,:)   - old_v_i(:,:,:)   
     270      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)  
     271      d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - old_e_i(:,:,1:nlay_i,:) 
     272      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - old_oa_i (:,:,:) 
     273      d_smv_i_thd(:,:,:) = 0._wp 
     274      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
     275      ! diag only (clem) 
     276      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    516277 
    517278      ! ------------------------------- 
    518279      !- check conservation (C Rousset) 
    519       IF (ln_limdiahsb) THEN 
    520  
    521          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    522          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     280      IF( ln_limdiahsb ) THEN 
     281         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     282         zchk_fw  = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     283         zchk_ft  = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 
    523284  
    524          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
     285         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw  
    525286         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
     287         zchk_e_i =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 
    526288 
    527289         zchk_vmin = glob_min(v_i) 
     
    530292 
    531293         IF(lwp) THEN 
    532             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limupdate2) = ',(zchk_v_i * rday) 
     294            IF ( ABS( zchk_v_i   ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (limupdate2) = ',(zchk_v_i * rday) 
    533295            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate2) = ',(zchk_smv * rday) 
     296            IF ( ABS( zchk_e_i   ) >  1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (limupdate2) = ',(zchk_e_i) 
    534297            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limupdate2) = ',(zchk_vmin * 1.e-3) 
    535298            IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limupdate2) = ',zchk_amax 
    536299            IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limupdate2) = ',zchk_amin 
    537300         ENDIF 
    538       ENDIF 
     301       ENDIF 
    539302      !- check conservation (C Rousset) 
    540303      ! ------------------------------- 
     
    596359         CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    597360         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    598          CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update2 : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    599361         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update2 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    600          CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update2 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 
    601362 
    602363         CALL prt_ctl_info(' ') 
     
    608369      ENDIF 
    609370    
    610       CALL wrk_dealloc( jpi,jpj,jpl, internal_melt )   ! integer 
    611       CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 
    612  
    613       CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    614  
    615371      IF( nn_timing == 1 )  CALL timing_stop('limupdate2') 
    616372   END SUBROUTINE lim_update2 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r4332 r4634  
    6767 
    6868   REAL(wp) ::   epsi10 = 1.e-10_wp   !    -       - 
    69    REAL(wp) ::   zzero = 0.e0        !    -       - 
    70    REAL(wp) ::   zone  = 1.e0        !    -       - 
    7169 
    7270   !!---------------------------------------------------------------------- 
     
    113111               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    114112               ! 
    115                zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi10 ) )  
     113               zinda = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
    116114               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness 
    117115            END DO 
     
    134132            DO jj = 1, jpj 
    135133               DO ji = 1, jpi 
    136                   zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - epsi10 ) )  
    137                   zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi10 ) )  
     134                  zinda = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )  
     135                  zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
    138136                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content 
    139137                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda   ! ice salinity 
     
    205203               DO ji = 1, jpi 
    206204                  !                                                              ! Energy of melting q(S,T) [J.m-3] 
    207                   zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
    208205                  zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    209                   zq_i    = zq_i * unit_fac * zindb                              !convert units 
     206                  zq_i    = zindb * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
     207                  zq_i    = zq_i * unit_fac                             !convert units 
    210208                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature 
    211209                  ! 
     
    231229               DO ji = 1, jpi 
    232230                  !Energy of melting q(S,T) [J.m-3] 
    233                   zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
    234231                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    235                   zq_s  = zq_s * unit_fac * zindb                                    ! convert units 
     232                  zq_s  = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
     233                  zq_s  = zq_s * unit_fac                                    ! convert units 
    236234                  ! 
    237235                  t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) 
     
    320318            DO jj = 1, jpj 
    321319               DO ji = 1, jpi 
    322                   z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01 , ht_i(ji,jj,jl) ) 
     320                  z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) ) 
    323321               END DO 
    324322            END DO 
     
    475473         ! 
    476474         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero 
    477             z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( 0.01 , ht_i_b(ji) ) 
     475            z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( epsi10 , ht_i_b(ji) ) 
    478476         END DO 
    479477 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

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

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

    r4045 r4634  
    4949   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion) 
    5050 
    51    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qldif_1d      !: <==> the 2D  qldif 
    52    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcmif_1d      !: <==> the 2D  qcmif 
    53    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fstbif_1d     !: <==> the 2D  fstric 
    54    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fltbif_1d     !: <==> the 2D  ffltbif 
    55    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fscbq_1d      !: <==> the 2D  fscmcbq 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      !: <==> the 2D  qlead 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d    !: <==> the 2D  ftr_ice 
    5653   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d    !: <==> the 2D  qsr_ice 
    5754   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d     !: <==> the 2D  fr1_i0 
    5855   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d     !: <==> the 2D  fr2_i0 
    59    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qnsr_ice_1d   !: <==> the 2D  qns_ice 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qfvbq_1d      !: <==> the 2D  qfvbq 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d    !: <==> the 2D  qns_ice 
    6157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_b        !: <==> the 2D  t_bo 
     58 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_tot_1d 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_thd_1d 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_spr_1d 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d 
     63   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sub_1d 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_res_1d 
     65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
     67 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_ice_1d    !: <==> the 2D  wfx_ice 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_1d    !: <==> the 2D  wfx_snw 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d    !: <==> the 2D  wfx_sub 
     71 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d    !: <==> the 2D  wfx_ice 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d    !: <==> the 2D  wfx_ice 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d    !: <==> the 2D  wfx_ice 
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d    !: <==> the 2D  wfx_ice 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d    !: <==> the 2D  wfx_ice 
     77 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d    !: <==> the 2D sfx_bri 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d    !:  
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d    !:  
     81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d    !:  
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d    !:  
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d    !: 
    6284 
    6385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip 
    6486   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld 
    6587   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_b        !: <==> the 2D  frld 
    66    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fbif_1d       !: <==> the 2D  fbif 
    67    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_ice_1d    !: <==> the 2D  rdm_ice 
    68    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_snw_1d    !: <==> the 2D  rdm_snw 
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlbbq_1d      !: <==> the 2D  qlbsbq 
    70    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dmgwi_1d      !: <==> the 2D  dmgwi 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvsbq_1d      !: <==> the 2D  rdvosif 
    72    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvbbq_1d      !: <==> the 2D  rdvobif 
    73    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvlbq_1d      !: <==> the 2D  rdvolif 
    74    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvnbq_1d      !: <==> the 2D  rdvolif 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d       !: <==> the 2D  fhtur 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld 
    7590   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice 
    7691   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice 
     
    7893   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice 
    7994   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics 
    80    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsup          !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m 
    81    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   focea         !: Remaining energy in case of total ablation 
    8295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
    83    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_i_b    !: Ice thickness at the beginnning of the time step [m] 
    84    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_s_b    !: Snow thickness at the beginning of the time step [m] 
    85    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d    !: <==> the 2D sfx_bri 
    86    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhbri_1d      !: Heat flux due to brine drainage 
    87    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_thd_1d    !: <==> the 2D sfx_thd 
    8896   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing 
    8997   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage 
     
    104112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_b      !: Ice bulk salinity [ppt] 
    105113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new     !: Salinity of new ice at the bottom 
    106    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_snowice   !: Salinity of new snow ice on top of the ice 
    107    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_b       !: Ice age                        [days] 
    108114 
    109115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
     
    116122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_b   !:    Snow enthalpy per unit volume 
    117123 
    118    ! Clean the following ... 
    119    ! These variables are coded for conservation checks 
    120    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_in                  !: ice energy summed over categories (initial) 
    121    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_fin                 !: ice energy summed over categories (final) 
    122    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_s_in, qt_s_fin        !: snow energy summed over categories 
    123    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i, sum_fluxq          !: increment of energy, sum of fluxes 
    124    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fatm, foce               !: atmospheric, oceanic, heat flux 
    125    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cons_error, surf_error   !: conservation, surface error 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dq_i   !: variation of ice enthalpy (debug) 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dq_s   !: variation of snw enthalpy (debug) 
    126126 
    127    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_in        !: goes to trash 
    128    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_fin       !: goes to trash 
    129    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i_layer, radab   !: goes to trash 
     127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qh_i_old  !: ice heat content (q*h, J.m-2) 
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old   !: ice thickness layer (m) 
    130129 
    131    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_in    !: initial total heat flux 
    132    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_fin   !: final total heat flux 
    133  
    134    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_s 
    135    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_i 
    136    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_s_lay 
    137    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_i_lay 
    138     
    139130   INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point 
    140131 
     
    151142      !!---------------------------------------------------------------------! 
    152143      INTEGER ::   thd_ice_alloc   ! return value 
    153       INTEGER ::   ierr(4) 
     144      INTEGER ::   ierr(3) 
    154145      !!---------------------------------------------------------------------! 
    155146 
    156147      ALLOCATE( npb      (jpij) , npac     (jpij),                          & 
    157148         !                                                                  ! 
    158          &      qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d  (jpij) ,     & 
    159          &      fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) ,     & 
    160          &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) ,     & 
    161          &      qfvbq_1d (jpij) , t_bo_b   (jpij) , iatte_1d   (jpij) ,     & 
    162          &      oatte_1d (jpij)                                       , STAT=ierr(1) ) 
     149         &      qlead_1d (jpij) , ftr_ice_1d  (jpij) ,     & 
     150         &      qsr_ice_1d (jpij) ,     & 
     151         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     & 
     152         &      t_bo_b   (jpij) , iatte_1d   (jpij) ,     & 
     153         &      oatte_1d (jpij) , hfx_tot_1d(jpij), hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 
     154         &      hfx_snw_1d(jpij), hfx_sub_1d(jpij), hfx_err_1d(jpij) , hfx_res_1d(jpij) , hfx_err_rem_1d(jpij),       STAT=ierr(1) ) 
    163155      ! 
    164156      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     & 
    165          &      fbif_1d    (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) ,     & 
    166          &      qlbbq_1d   (jpij) , dmgwi_1d   (jpij) , dvsbq_1d   (jpij) ,     & 
    167          &      dvbbq_1d   (jpij) , dvlbq_1d   (jpij) , dvnbq_1d   (jpij) ,     & 
     157         &      fhtur_1d   (jpij) , wfx_ice_1d (jpij) , wfx_snw_1d (jpij) ,     & 
     158         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) ,  & 
    168159         &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     & 
    169          &      tatm_ice_1d(jpij) , fsup       (jpij) , focea      (jpij) ,     &    
    170          &      i0         (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,     &   
    171          &      sfx_bri_1d (jpij) , fhbri_1d   (jpij) , sfx_thd_1d (jpij) ,    & 
     160         &      tatm_ice_1d(jpij) ,      &    
     161         &      i0         (jpij) ,     &   
     162         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , & 
    172163         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &      
    173164         &      dsm_i_si_1d(jpij) , hicol_b    (jpij)                     , STAT=ierr(2) ) 
     
    176167         &      ht_s_b    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
    177168         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &     
    178          &      dh_snowice(jpij) , sm_i_b   (jpij) , s_i_new  (jpij) ,    &     
    179          &      s_snowice (jpij) , o_i_b    (jpij)                   ,    & 
    180          !                                                                ! 
    181          &      t_s_b(jpij,nlay_s),                                       & 
    182          !                                                                ! 
     169         &      dh_snowice(jpij) , sm_i_b   (jpij) , s_i_new  (jpij) ,    & 
     170         &      dq_i      (jpij) , dq_s     (jpij),  t_s_b(jpij,nlay_s),  & 
    183171         &      t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                ,     &             
    184          &      q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                , STAT=ierr(3)) 
     172         &      q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                ,     & 
     173         &      qh_i_old(jpij,0:jkmax), h_i_old(jpij,0:jkmax) , STAT=ierr(3)) 
    185174      ! 
    186       ALLOCATE( qt_i_in   (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in   (jpij,jpl) ,     & 
    187          &      qt_s_fin  (jpij,jpl) , dq_i    (jpij,jpl) , sum_fluxq (jpij,jpl) ,     & 
    188          &      fatm      (jpij,jpl) , foce    (jpij,jpl) , cons_error(jpij,jpl) ,     & 
    189          &      surf_error(jpij,jpl)                                             ,     & 
    190          !                                                                             ! 
    191          &      q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax)             ,     & 
    192          &      dq_i_layer  (jpij,jkmax) , radab        (jpij,jkmax)             ,     & 
    193          !                                                                             ! 
    194          &      ftotal_in(jpij), ftotal_fin(jpij)                                ,     & 
    195          !                                                                             ! 
    196          &      fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s)                      ,     & 
    197          &      fc_i(jpij,0:jkmax)  , de_i_lay(jpij,jkmax)                       , STAT=ierr(4) ) 
    198  
    199175      thd_ice_alloc = MAXVAL( ierr ) 
    200176 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r3294 r4634  
    468468#else 
    469469      DO jh = 1, nb_ana 
    470       CALL iom_put( TRIM(tname(jh))//'x_v', out_u(:,:,jh) ) 
    471       CALL iom_put( TRIM(tname(jh))//'y_v', out_u(:,:,nb_ana+jh) ) 
     470      CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh) ) 
     471      CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,nb_ana+jh) ) 
    472472      END DO 
    473473#endif 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4045 r4634  
    1212   !!                 ! 1999-02  (E. Guilyardi)  name of netCDF files + variables 
    1313   !!            8.2  ! 2000-06  (M. Imbard)  Original code (diabort.F) 
    14    !!   NEMO     1.0  ! 2002-06  (A.Bozec, E. Durand)  Original code (diainit.F) 
     14   !!   NEMO     1.0  ! 2002-06  (RUN025_CTL_DIAGA.Bozec, E. Durand)  Original code (diainit.F) 
    1515   !!             -   ! 2002-09  (G. Madec)  F90: Free form and module 
    1616   !!             -   ! 2002-12  (G. Madec)  merge of diabort and diainit, F90 
     
    129129      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !  
    130130      !! 
    131       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d       ! 2D workspace 
     131      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace 
     132      REAL(wp), POINTER, DIMENSION(:,:)   :: z2ds     ! 2D workspace 
    132133      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace 
    133134      !!---------------------------------------------------------------------- 
     
    135136      IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    136137      !  
    137       CALL wrk_alloc( jpi , jpj      , z2d ) 
     138      CALL wrk_alloc( jpi , jpj      , z2d , z2ds ) 
    138139      CALL wrk_alloc( jpi , jpj, jpk , z3d ) 
    139140      ! 
     
    176177      CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    177178 
     179      ! clem: heat and salt content 
     180      z2d(:,:)  = 0._wp  
     181      z2ds(:,:) = 0._wp  
     182      DO jk = 1, jpkm1 
     183         DO jj = 2, jpjm1 
     184            DO ji = fs_2, fs_jpim1   ! vector opt. 
     185               z2d(ji,jj) = z2d(ji,jj) + rau0 * rcp * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     186               z2ds(ji,jj) = z2ds(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     187            END DO 
     188         END DO 
     189      END DO 
     190      CALL lbc_lnk( z2d, 'T', 1. ) 
     191      CALL lbc_lnk( z2ds, 'T', 1. ) 
     192      CALL iom_put( "heatc", z2d )    ! vertically integrated heat content (J/m2) 
     193      CALL iom_put( "saltc", z2ds )   ! vertically integrated salt content (PSU*kg/m2) 
     194       
     195 
    178196      IF( lk_diaar5 ) THEN 
    179197         z3d(:,:,jpk) = 0.e0 
    180198         DO jk = 1, jpkm1 
    181             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 
     199            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
    182200         END DO 
    183201         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
     202 
    184203         zztmp = 0.5 * rcp 
    185204         z2d(:,:) = 0.e0  
     205         z2ds(:,:) = 0.e0  
    186206         DO jk = 1, jpkm1 
    187207            DO jj = 2, jpjm1 
    188208               DO ji = fs_2, fs_jpim1   ! vector opt. 
    189209                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     210                  z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    190211               END DO 
    191212            END DO 
    192213         END DO 
    193214         CALL lbc_lnk( z2d, 'U', -1. ) 
     215         CALL lbc_lnk( z2ds, 'U', -1. ) 
    194216         CALL iom_put( "u_heattr", z2d )                  ! heat transport in i-direction 
     217         CALL iom_put( "u_salttr", z2ds )                 ! salt transport in i-direction 
     218 
     219         z3d(:,:,jpk) = 0.e0 
    195220         DO jk = 1, jpkm1 
    196             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 
     221            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
    197222         END DO 
    198223         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
     224 
    199225         z2d(:,:) = 0.e0  
     226         z2ds(:,:) = 0.e0  
    200227         DO jk = 1, jpkm1 
    201228            DO jj = 2, jpjm1 
    202229               DO ji = fs_2, fs_jpim1   ! vector opt. 
    203230                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     231                  z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
    204232               END DO 
    205233            END DO 
    206234         END DO 
    207235         CALL lbc_lnk( z2d, 'V', -1. ) 
    208          CALL iom_put( "v_heattr", z2d )                  !  heat transport in i-direction 
    209       ENDIF 
    210       ! 
    211       CALL wrk_dealloc( jpi , jpj      , z2d ) 
     236         CALL lbc_lnk( z2ds, 'V', -1. ) 
     237         CALL iom_put( "v_heattr", z2d )                  !  heat transport in j-direction 
     238         CALL iom_put( "v_salttr", z2ds )                 !  salt transport in j-direction 
     239      ENDIF 
     240      ! 
     241      CALL wrk_dealloc( jpi , jpj      , z2d , z2ds ) 
    212242      CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 
    213243      ! 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r3625 r4634  
    5454   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg] 
    5555   REAL(wp), PUBLIC ::   rauw     = 1000._wp         !: volumic mass of pure water    [m3/kg] 
    56    REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/Kelvin] 
    57    REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
     56   REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/kg/K] 
     57   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [kg.K/J] 
    5858   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
    5959 
     
    6969#if defined key_lim3 || defined key_cice 
    7070   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
    71    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
    72    REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
    73    REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     71   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K] 
     72   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K]  
     73   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice                                 [J/kg/K] 
    7474   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
    7575   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
    76    REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity 
     76   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity          [degC/ppt] 
    7777   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3] 
    7878#else 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r4345 r4634  
    3232   USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
    3333   USE icb_oce, ONLY :   class_num       !  !: iceberg classes 
     34   USE par_ice 
    3435   USE domngb          ! ocean space and time domain 
    3536   USE phycst          ! physical constants 
     
    131132      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 
    132133# endif 
     134      CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
    133135      CALL iom_set_axis_attr( "icbcla", class_num ) 
    134136       
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r3625 r4634  
    599599               zdqlw = 4.0 * emic * stefan * ztice3 
    600600               zdqsb = zrhovacshi 
    601                zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )    
     601                
     602               ! MV 2014 we must cap derivative also 
     603               IF ( p_qla(ji,jj,jl) .GT. 0.0 ) THEN 
     604                  zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )    
     605               ELSE 
     606                  zdqla = 0.0 
     607               ENDIF 
    602608               ! 
    603609               p_dqla(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4332 r4634  
    7070   REAL(wp), PARAMETER ::   Ls   =    2.839e6     ! latent heat of sublimation 
    7171   REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant 
    72    REAL(wp), PARAMETER ::   Cice =    1.4e-3      ! iovi 1.63e-3     ! transfer coefficient over ice 
     72   REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! MV Drag, water, and heat transfer coefficient in CORE formulation 
    7373   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be constant 
    7474 
     
    494494      zcoef_dqsb   = rhoa * cpa * Cice 
    495495      zcoef_frca   = 1.0  - 0.3 
     496      ! MV 2014 the proper cloud fraction (mean summer months from the CLIO climato, NH+SH) is 0.19 
     497      zcoef_frca   = 1.0  - 0.19 
    496498 
    497499!!gm brutal.... 
     
    579581               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    580582               ! Long  Wave (lw) 
     583               ! MV come back to the original CORE forcing 
    581584               ! iovino 
    582                IF( ff(ji,jj) .GT. 0._wp ) THEN 
    583                   z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    584                ELSE 
    585                   z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    586                ENDIF 
     585               ! IF( ff(ji,jj) .GT. 0._wp ) THEN 
     586               !   z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     587               ! ELSE 
     588               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     589               ! ENDIF 
    587590               ! lw sensitivity 
    588591               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
     
    599602                  &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    600603               ! Latent heat sensitivity for ice (Dqla/Dt) 
    601                p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     604               ! MV we also have to cap the sensitivity if the flux is zero 
     605               IF ( p_qla(ji,jj,jl) .GT. 0.0 ) THEN 
     606                  p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     607               ELSE 
     608                  p_dqla(ji,jj,jl) = 0.0 
     609               ENDIF 
     610                              
    602611               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    603612               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r4345 r4634  
    5959   USE prtctl          ! Print control 
    6060   USE lib_fortran     !  
     61   USE cpl_oasis3, ONLY : lk_cpl 
    6162 
    6263#if defined key_bdy  
     
    133134      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    134135      !! 
    135       INTEGER  ::   jl      ! dummy loop index 
     136      INTEGER  ::   ji, jj, jl, jk      ! dummy loop index 
    136137      REAL(wp) ::   zcoef   ! local scalar 
    137138      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice_os, zalb_ice_cs  ! albedo of the ice under overcast/clear sky 
    138       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice      ! mean albedo of ice (for coupled) 
     139      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice      ! mean albedo of ice  
    139140 
    140141      REAL(wp), POINTER, DIMENSION(:,:) :: zalb_ice_all    ! Mean albedo over all categories 
     
    146147      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all  ! Mean d(qns)/dT over all categories 
    147148      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all  ! Mean d(qla)/dT over all categories 
     149      REAL(wp) ::   ztmelts         ! clem 2014: for HC diags 
     150      REAL(wp)  ::   epsi20 = 1.e-20   ! 
    148151      !!---------------------------------------------------------------------- 
    149152 
     
    152155      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
    153156 
    154       CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    155  
    156 #if defined key_coupled 
    157       IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_alloc( jpi,jpj,jpl, zalb_ice) 
    158       IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    159          &   CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    160 #endif 
     157      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
     158 
     159      IF( lk_cpl ) THEN 
     160         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
     161            &   CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
     162      ENDIF 
    161163 
    162164      IF( kt == nit000 ) THEN 
     
    168170         ! 
    169171         IF( ln_nicep ) THEN      ! control print at a given point 
    170             jiindx = 177   ;   jjindx = 112 
     172            jiindx = 3    ;   jjindx =  49 
    171173            IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 
    172174         ENDIF 
     
    176178      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  ! 
    177179         !                                     !----------------------! 
    178          !                                           !  Bulk Formulea ! 
     180         !                                           !  Bulk Formulae ! 
    179181         !                                           !----------------! 
    180182         ! 
     
    192194         IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) ) 
    193195          
    194 #if defined key_coupled 
    195          IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    196             ! 
    197             ! Compute mean albedo and temperature 
    198             zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) )  
    199             ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) )  
    200             ! 
     196         IF( lk_cpl ) THEN 
     197            IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
     198               ! 
     199               ! Compute mean albedo and temperature 
     200               zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) )  
     201               ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) )  
     202               ! 
     203            ENDIF 
    201204         ENDIF 
    202 #endif 
    203205                                               ! Bulk formulea - provides the following fields: 
    204206         ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2] 
     
    218220            !          
    219221         CASE( 4 )                                       ! CORE bulk formulation 
    220             CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice_cs,               & 
     222            ! MV 2014 
     223            ! We must account for cloud fraction in the computation of the albedo 
     224            ! The present ref just uses the clear sky value 
     225            ! The overcast sky value is 0.06 higher, and polar skies are mostly overcast 
     226            ! CORE has no cloud fraction, hence we must prescribe it 
     227            ! Mean summer cloud fraction computed from CLIO = 0.81 
     228            zalb_ice(:,:,:) = 0.19 * zalb_ice_cs(:,:,:) + 0.81 * zalb_ice_os(:,:,:) 
     229            ! Following line, we replace zalb_ice_cs by simply zalb_ice 
     230            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               & 
    221231               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
    222232               &                      qla_ice   , dqns_ice  , dqla_ice   ,               & 
     
    239249 
    240250         ! Average over all categories 
    241 #if defined key_coupled 
     251         IF( lk_cpl ) THEN 
    242252         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    243253 
     
    269279            END IF 
    270280         END IF 
    271 #endif 
     281         ENDIF 
    272282         !                                           !----------------------! 
    273283         !                                           ! LIM-3  time-stepping ! 
     
    285295         old_smv_i(:,:,:)   = smv_i(:,:,:)     ! salt content 
    286296         old_oa_i (:,:,:)   = oa_i (:,:,:)     ! areal age content 
    287          ! 
    288          old_u_ice(:,:) = u_ice(:,:) 
    289          old_v_ice(:,:) = v_ice(:,:) 
    290          !                                           ! intialisation to zero    !!gm is it truly necessary ??? 
     297         old_u_ice(:,:)     = u_ice(:,:) 
     298         old_v_ice(:,:)     = v_ice(:,:) 
     299 
     300         ! trends    !!gm is it truly necessary ??? 
    291301         d_a_i_thd  (:,:,:)   = 0._wp   ;   d_a_i_trp  (:,:,:)   = 0._wp 
    292302         d_v_i_thd  (:,:,:)   = 0._wp   ;   d_v_i_trp  (:,:,:)   = 0._wp 
     
    296306         d_smv_i_thd(:,:,:)   = 0._wp   ;   d_smv_i_trp(:,:,:)   = 0._wp 
    297307         d_oa_i_thd (:,:,:)   = 0._wp   ;   d_oa_i_trp (:,:,:)   = 0._wp 
    298          ! 
    299          d_u_ice_dyn(:,:) = 0._wp 
    300          d_v_ice_dyn(:,:) = 0._wp 
    301          ! 
    302          sfx    (:,:) = 0._wp   ;   sfx_thd  (:,:) = 0._wp 
    303          sfx_bri(:,:) = 0._wp   ;   sfx_mec  (:,:) = 0._wp   ;   sfx_res  (:,:) = 0._wp 
    304          fhbri  (:,:) = 0._wp   ;   fheat_mec(:,:) = 0._wp   ;   fheat_res(:,:) = 0._wp 
    305          fhmec  (:,:) = 0._wp   ;    
    306          fmmec  (:,:) = 0._wp 
    307          fmmflx (:,:) = 0._wp      
    308          focea2D(:,:) = 0._wp 
    309          fsup2D (:,:) = 0._wp 
    310  
    311          ! used in limthd.F90 
    312          rdvosif(:,:) = 0._wp   ! variation of ice volume at surface 
    313          rdvobif(:,:) = 0._wp   ! variation of ice volume at bottom 
    314          fdvolif(:,:) = 0._wp   ! total variation of ice volume 
    315          rdvonif(:,:) = 0._wp   ! lateral variation of ice volume 
    316          fstric (:,:) = 0._wp   ! part of solar radiation transmitted through the ice 
    317          ffltbif(:,:) = 0._wp   ! linked with fstric 
    318          qfvbq  (:,:) = 0._wp   ! linked with fstric 
    319          rdm_snw(:,:) = 0._wp   ! variation of snow mass per unit area 
    320          rdm_ice(:,:) = 0._wp   ! variation of ice mass per unit area 
    321          hicifp (:,:) = 0._wp   ! daily thermodynamic ice production.  
    322          ! 
    323          diag_sni_gr(:,:) = 0._wp   ;   diag_lat_gr(:,:) = 0._wp 
    324          diag_bot_gr(:,:) = 0._wp   ;   diag_dyn_gr(:,:) = 0._wp 
    325          diag_bot_me(:,:) = 0._wp   ;   diag_sur_me(:,:) = 0._wp 
    326          diag_res_pr(:,:) = 0._wp   ;   diag_trp_vi(:,:) = 0._wp 
     308         d_u_ice_dyn(:,:)     = 0._wp   ;   d_v_ice_dyn(:,:)     = 0._wp 
     309 
     310         ! salt, heat and mass fluxes 
     311         sfx    (:,:) = 0._wp   ; 
     312         sfx_bri(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp   ;   sfx_res(:,:) = 0._wp 
     313         sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
     314         sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
     315         sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
     316 
     317         hfx_thd(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp   ;   hfx_snw(:,:) = 0._wp 
     318         hfx_tot(:,:) = 0._wp   ;   hfx_spr(:,:) = 0._wp   ;   hfx_res(:,:) = 0._wp 
     319         hfx_sub(:,:) = 0._wp   ;   hfx_err(:,:) = 0._wp   ;   hfx_in (:,:) = 0._wp   ;   hfx_out(:,:) = 0._wp 
     320         hfx_err_rem(:,:) = 0._wp 
     321 
     322         wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
     323         wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp 
     324         wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp 
     325         wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
     326         wfx_res(:,:) = 0._wp   ;    
     327         ! 
     328         fhld  (:,:) = 0._wp  
     329         fmmflx(:,:) = 0._wp      
     330         ftr_ice(:,:,:) = 0._wp   ! part of solar radiation transmitted through the ice 
     331 
     332         ! diags 
     333         diag_trp_vi(:,:) = 0._wp  ; diag_trp_vs(:,:) = 0._wp  ;  diag_trp_ei(:,:) = 0._wp  ;  diag_trp_es(:,:) = 0._wp  ;  
     334         diag_heat_dhc1(:,:) = 0._wp   ;    
     335 
    327336         ! dynamical invariants 
    328337         delta_i(:,:) = 0._wp       ;   divu_i(:,:) = 0._wp       ;   shear_i(:,:) = 0._wp 
     
    375384                          zcoef = rdt_ice /rday           !  Ice natural aging 
    376385                          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 
    377                           CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin) 
     386         !clem                 CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin) 
    378387         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print 
    379388                          CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  ! 
     
    391400         !                                           ! Diagnostics and outputs  
    392401         IF (ln_limdiaout) CALL lim_diahsb 
    393 !clem # if ! defined key_iomput 
     402 
    394403                          CALL lim_wri( 1  )              ! Ice outputs  
    395 !clem # endif 
     404 
    396405         IF( kt == nit000 .AND. ln_rstart )   & 
    397406            &             CALL iom_close( numrir )        ! clem: close input ice restart file 
     
    413422       
    414423!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    415       ! 
    416       CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    417  
    418 #if defined key_coupled 
    419       IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice) 
    420       IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    421          &    CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    422 #endif 
     424      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
     425 
     426      IF( lk_cpl ) THEN 
     427         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
     428            &    CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
     429      ENDIF 
    423430      ! 
    424431      IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim') 
     
    534541!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    535542!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    536 !                 WRITE(numout,*) ' s_i_newice           : ', s_i_newice(ji,jj,1:jpl) 
    537543!                 WRITE(numout,*)  
    538544                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     
    591597               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj) 
    592598               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj) 
    593                !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) 
    594                !WRITE(numout,*) ' qldif     : ', qldif(ji,jj) 
    595                !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) / rdt_ice 
    596                !WRITE(numout,*) ' qldif     : ', qldif(ji,jj) / rdt_ice 
    597                !WRITE(numout,*) ' qfvbq     : ', qfvbq(ji,jj) 
    598                !WRITE(numout,*) ' qdtcn     : ', qdtcn(ji,jj) 
    599                !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice 
    600                !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice 
    601                !WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj)  
    602                !WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj)  
    603                !WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj)  
    604                !WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)  
    605                !WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj)  
    606599               ! 
    607600               !CALL lim_prt_state( kt, ji, jj, 2, '   ') 
     
    790783               WRITE(numout,*) ' - Heat / FW fluxes ' 
    791784               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ ' 
    792                WRITE(numout,*) ' emp        : ', emp      (ji,jj) 
    793                WRITE(numout,*) ' sfx        : ', sfx      (ji,jj) 
    794                WRITE(numout,*) ' sfx_thd    : ', sfx_thd(ji,jj) 
    795                WRITE(numout,*) ' sfx_bri    : ', sfx_bri  (ji,jj) 
    796                WRITE(numout,*) ' sfx_mec    : ', sfx_mec  (ji,jj) 
    797                WRITE(numout,*) ' sfx_res    : ', sfx_res(ji,jj) 
    798                WRITE(numout,*) ' fmmec      : ', fmmec    (ji,jj) 
    799                WRITE(numout,*) ' fhmec      : ', fhmec    (ji,jj) 
    800                WRITE(numout,*) ' fhbri      : ', fhbri    (ji,jj) 
    801                WRITE(numout,*) ' fheat_mec  : ', fheat_mec(ji,jj) 
     785               WRITE(numout,*) ' - Heat fluxes in and out the ice ***' 
     786               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( old_a_i(ji,jj,:) * qsr_ice(ji,jj,:) ) 
     787               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( old_a_i(ji,jj,:) * qns_ice(ji,jj,:) ) 
     788               WRITE(numout,*) 
    802789               WRITE(numout,*)  
    803790               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)   
     
    829816               WRITE(numout,*) ' qsr       : ', qsr(ji,jj) 
    830817               WRITE(numout,*) ' qns       : ', qns(ji,jj) 
    831                WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj) 
    832                WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) * r1_rdtice 
    833                WRITE(numout,*) ' qldif     : ', qldif(ji,jj) * r1_rdtice 
     818               WRITE(numout,*) 
     819               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 
     820               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj) 
     821               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj) 
     822               WRITE(numout,*) ' hfx_tot      : ', hfx_tot(ji,jj) 
     823               WRITE(numout,*) ' dhc          : ', diag_heat_dhc1(ji,jj)               
     824               WRITE(numout,*) 
     825               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj) 
     826               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj) 
     827               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj) 
     828               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj)  
     829               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice 
    834830               WRITE(numout,*) 
    835831               WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 
    836832               WRITE(numout,*) ' emp       : ', emp    (ji,jj) 
    837                WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj) 
    838833               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj) 
    839834               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj) 
    840                WRITE(numout,*) ' sfx_mec   : ', sfx_mec(ji,jj) 
    841                WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 
    842                WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 
     835               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj) 
     836               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj) 
    843837               WRITE(numout,*) 
    844838               WRITE(numout,*) ' - Momentum fluxes ' 
    845839               WRITE(numout,*) ' utau      : ', utau(ji,jj)  
    846840               WRITE(numout,*) ' vtau      : ', vtau(ji,jj) 
    847             ENDIF 
     841            ENDIF  
    848842            WRITE(numout,*) ' ' 
    849843            ! 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4332 r4634  
    155155         nkrnf         = 0 
    156156         rnf     (:,:) = 0.0_wp 
     157         rnf_b   (:,:) = 0.0_wp 
    157158         rnfmsk  (:,:) = 0.0_wp 
    158159         rnfmsk_z(:)   = 0.0_wp 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r4220 r4634  
    2222   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s] 
    2323   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s] 
     24   ! bg jchanut tschanges 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ua_bak   ,  va_bak     !: Saved trends for mod. ts     [m/s2] 
     26   ! end jchanut tschanges 
    2427   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s] 
    2528   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rotb ,  rotn           !: relative vorticity           [s-1] 
     
    7376      ! 
    7477      ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     & 
    75          &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &       
     78         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &  
     79      ! bg jchanut tschanges 
     80#if defined key_dynspg_ts   
     81      ! These temporary arrays are used to save tendencies computed before the time stepping of tracers. 
     82      ! These could be suppressed if ua and va would not have been used as temporary arrays  
     83      ! during tracers' update 
     84         &      ua_bak(jpi,jpj,jpk)     , va_bak(jpi,jpj,jpk)     ,                             & 
     85#endif 
     86      ! end jchanut tschanges 
    7687         &      wn   (jpi,jpj,jpk)      ,                                                       & 
    7788         &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &    
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r3294 r4634  
    8686   !!--------------------------------------------------------------------- 
    8787#             include "par_AMM_12km.h90" 
     88#elif defined key_spitz_r025 
     89   !!--------------------------------------------------------------------- 
     90   !!   'key_spitz_r025' :                 regional basin : SPITZBERGEN025 
     91   !!--------------------------------------------------------------------- 
     92#             include "par_SPITZ_R025.h90" 
     93#elif defined key_spitz_r005 
     94   !!--------------------------------------------------------------------- 
     95   !!   'key_spitz_r005' :                 regional basin : SPITZBERGEN005 
     96   !!--------------------------------------------------------------------- 
     97#             include "par_SPITZ_R005.h90" 
     98#elif defined key_spitz_r001 
     99   !!--------------------------------------------------------------------- 
     100   !!   'key_spitz_r005' :                 regional basin : SPITZBERGEN002 
     101   !!--------------------------------------------------------------------- 
     102#             include "par_SPITZ_R001.h90" 
    88103#else 
    89104   !!--------------------------------------------------------------------- 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4345 r4634  
    109109      ! 
    110110      !  VERTICAL PHYSICS 
     111      ! bg jchanut tschanges 
     112      ! One need bottom friction parameter in ssh_wzv routine with time splitting. 
     113      ! The idea could be to move the call below before ssh_wzv. However, "now" scale factors 
     114      ! at U-V points (which are set thanks to sshu_n, sshv_n) are actually available in sshwzv. 
     115      ! These are needed for log bottom friction... 
     116#if ! defined key_dynspg_ts 
    111117                         CALL zdf_bfr( kstp )         ! bottom friction 
     118#endif 
     119      ! end jchanut tschanges 
    112120 
    113121      !                                               ! Vertical eddy viscosity and diffusivity coefficients 
     
    207215            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
    208216 
    209       ELSE                                                  ! centered hpg  (eos then time stepping) 
     217      ELSE    
     218                                               ! centered hpg  (eos then time stepping) 
     219      ! bg jchanut tschanges 
     220#if ! defined key_dynspg_ts 
     221      ! eos already called 
    210222                             CALL eos    ( tsn, rhd, rhop )      ! now in situ density for hpg computation 
    211223         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative 
    212224            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
     225#endif 
     226      ! end jchanut tschanges 
    213227         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    214228                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
     
    218232      ! Dynamics                                    (tsa used as workspace) 
    219233      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     234      ! bg jchanut tschanges 
     235#if defined key_dynspg_ts       
     236! revert to previously computed tendencies: 
     237! (not using ua, va as temporary arrays during tracers' update could avoid that) 
     238                               ua(:,:,:) = ua_bak(:,:,:)             
     239                               va(:,:,:) = va_bak(:,:,:) 
     240                               CALL dyn_bfr( kstp )         ! bottom friction 
     241                               CALL dyn_zdf( kstp )         ! vertical diffusion 
     242#else 
     243      ! end jchanut tschanges 
    220244                               ua(:,:,:) = 0.e0             ! set dynamics trends to zero 
    221245                               va(:,:,:) = 0.e0 
     
    237261                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    238262                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient 
     263      ! bg jchanut tschanges 
     264#endif 
     265      ! end jchanut tschanges 
    239266                               CALL dyn_nxt( kstp )         ! lateral velocity at next time step 
    240267 
  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r3770 r4634  
    271271      ! 
    272272      ! Level of light extinction 
     273!cr      pjl = jpkm1 
     274!cr      DO jk = jpkm1, 1, -1 
     275!cr         zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) ) 
     276!cr         IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr 
     277!cr      END DO 
    273278      pjl = jpkm1 
    274279      DO jk = jpkm1, 1, -1 
    275          zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) ) 
    276          IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr 
     280         IF(SUM(tmask(:,:,jk)) > 0 ) THEN 
     281            zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) ) 
     282            IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr 
     283         ELSE 
     284            pjl = jk                                            ! or regional sea-bed depth  
     285         ENDIF 
    277286      END DO 
    278287      ! 
Note: See TracChangeset for help on using the changeset viewer.