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

Changeset 4161 for branches/2013


Ignore:
Timestamp:
2013-11-07T11:01:27+01:00 (10 years ago)
Author:
cetlod
Message:

dev_LOCEAN_2013 : merge in the 3rd dev branch dev_r4028_CNRS_LIM3, see ticket #1169

Location:
branches/2013/dev_LOCEAN_2013/NEMOGCM
Files:
9 added
8 deleted
49 edited
6 copied

Legend:

Unmodified
Added
Removed

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_default.xml

    r4153 r4161  
    2626 
    2727      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files --> 
     28 
    2829      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files --> 
     30 
    2931      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->      
     32 
    3033      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files --> 
    31       <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files --> 
    32       
    33       <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files --> 
     34 
     35      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->      
     36 
     37      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE." > <!-- 1d files --> 
    3438 
    3539   <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" > 
    … …  
    3741     <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          /> 
    3842     <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                /> 
    39    </file> 
    40  
    41    <file id="file2" name_suffix="_grid_U" description="ocean U grid variables" > 
    42      <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    /> 
    43    </file> 
    44     
    45    <file id="file3" name_suffix="_grid_V" description="ocean V grid variables" > 
    46      <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    /> 
    47    </file> 
    48     
    49       </file_group> 
    50  
    51       <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->     
    52  
    53       <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->    
    54  
    55    <file id="file4" name_suffix="_grid_T" description="ocean T grid variables" > 
    5643     <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               /> 
    5744     <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            /> 
    58      <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       /> 
    5945     <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             /> 
    60      <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          /> 
    61      <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                /> 
    6246     <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"      /> 
     47     <field field_ref="mldkz5"       /> 
     48     <field field_ref="mldr10_1"     /> 
     49   </file> 
     50 
     51   <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 
    6352     <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     /> 
    6453     <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           /> 
    6554     <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          /> 
    66      <field field_ref="taum"         /> 
    67      <field field_ref="mldkz5"       /> 
    68      <field field_ref="mldr10_1"     /> 
    69    </file> 
    70     
    71    <file id="file5" name_suffix="_grid_U" description="ocean U grid variables" > 
     55     <field field_ref="saltflx"      name="sosflxdo"  /> 
     56     <field field_ref="taum"         name="taum" /> 
     57     <field field_ref="wspd"         name="sowindsp"  /> 
     58          <field field_ref="precip"       name="soprecip" /> 
     59     <!-- ice and snow --> 
     60     <field field_ref="snowpre"      /> 
     61          <field field_ref="qsr_io"           name="iicesflx" /> 
     62          <field field_ref="qns_io"           name="iicenflx" /> 
     63          <field field_ref="utau_ice"         name="iicestru" /> 
     64          <field field_ref="vtau_ice"         name="iicestrv" /> 
     65 
     66   </file> 
     67 
     68   <file id="file3" name_suffix="_grid_U" description="ocean U grid variables" > 
     69     <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    /> 
    7270     <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      /> 
    73      <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    /> 
    7471     <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" /> 
    75    </file> 
    76     
    77    <file id="file6" name_suffix="_grid_V" description="ocean V grid variables" > 
     72          <!-- available with key_diaar5 --> 
     73     <field field_ref="u_masstr"     name="vozomatr"  /> 
     74     <field field_ref="u_heattr"     name="sozohetr"  /> 
     75   </file> 
     76    
     77   <file id="file4" name_suffix="_grid_V" description="ocean V grid variables" > 
     78     <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    /> 
    7879     <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      /> 
    79      <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    /> 
    8080     <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" /> 
    81    </file> 
    82     
    83    <file id="file7" name_suffix="_grid_W" description="ocean W grid variables" > 
     81          <!-- available with key_diaar5 --> 
     82     <field field_ref="v_masstr"     name="vomematr"  /> 
     83     <field field_ref="v_heattr"     name="somehetr"  /> 
     84   </file> 
     85    
     86   <file id="file5" name_suffix="_grid_W" description="ocean W grid variables" > 
    8487     <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         /> 
    8588     <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" /> 
    86    </file> 
    87     
    88    <file id="file8" name_suffix="_icemod" description="ice variables" > 
    89      <field field_ref="ice_pres"                     /> 
     89     <field field_ref="w_masstr"     name="vovematr"  /> 
     90   </file> 
     91 
     92   <file id="file6" name_suffix="_icemod" description="ice variables" > 
    9093     <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   /> 
    9194     <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        /> 
    92      <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        /> 
    93      <field field_ref="ist_ipa"      /> 
    94      <field field_ref="ioceflxb"     /> 
    95      <field field_ref="uice_ipa"     /> 
    96      <field field_ref="vice_ipa"     /> 
    97      <field field_ref="utau_ice"     /> 
    98      <field field_ref="vtau_ice"     /> 
    99      <field field_ref="qsr_io_cea"   /> 
    100      <field field_ref="qns_io_cea"   /> 
    101      <field field_ref="snowpre"      /> 
    102    </file> 
    103     
     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" /> 
     128   </file> 
     129 
     130 
     131   <file id="file7" name_suffix="_scalar" description="scalar variables" > 
     132          <field field_ref="voltot"       name="scvoltot"  /> 
     133          <field field_ref="sshtot"       name="scsshtot"  /> 
     134          <field field_ref="sshsteric"    name="scsshste"  /> 
     135          <field field_ref="sshthster"    name="scsshtst"  /> 
     136          <field field_ref="masstot"      name="scmastot"  /> 
     137          <field field_ref="temptot"      name="sctemtot"  /> 
     138          <field field_ref="saltot"       name="scsaltot"  /> 
     139    
     140          <!-- available with ln_diahsb --> 
     141     <field field_ref="bgtemper"     name="bgtemper"    /> 
     142     <field field_ref="bgsaline"     name="bgsaline"    /> 
     143     <field field_ref="bgheatco"     name="bgheatco"    /> 
     144     <field field_ref="bgsaltco"     name="bgsaltco"    /> 
     145     <field field_ref="bgvolssh"     name="bgvolssh"    /> 
     146     <field field_ref="bgvoltot"     name="bgvoltot"    /> 
     147     <field field_ref="bgsshtot"     name="bgsshtot"    /> 
     148     <field field_ref="bgfrcvol"     name="bgfrcvol"    /> 
     149     <field field_ref="bgfrctem"     name="bgfrctem"    /> 
     150     <field field_ref="bgfrcsal"     name="bgfrcsal"    /> 
     151     <!-- available with ln_limdiahsb --> 
     152     <field field_ref="ibgvoltot"    name="ibgvoltot"   /> 
     153     <field field_ref="sbgvoltot"    name="sbgvoltot"   /> 
     154     <field field_ref="ibgarea"      name="ibgarea"     /> 
     155     <field field_ref="ibgsaline"    name="ibgsaline"   /> 
     156     <field field_ref="ibgtemper"    name="ibgtemper"   /> 
     157     <field field_ref="ibgheatco"    name="ibgheatco"   /> 
     158     <field field_ref="ibgsaltco"    name="ibgsaltco"   /> 
     159     <field field_ref="sbgheatco"    name="sbgheatco"   /> 
     160     <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  /> 
     161     <field field_ref="ibgfrcemp"    name="ibgfrcemp"   /> 
     162     <field field_ref="ibgsfx"       name="ibgsfx"     /> 
     163     <field field_ref="ibgemp"       name="ibgemp"      /> 
     164     <field field_ref="ibgsfxbri"    name="ibgsfxbri"    /> 
     165     <field field_ref="ibgsfxthd"    name="ibgsfxthd"    /> 
     166     <field field_ref="ibgsfxres"    name="ibgsfxres" /> 
     167     <field field_ref="ibgsfxmec"    name="ibgsfxmec" /> 
     168     <field field_ref="ibggrpme"     name="ibggrpme"    /> 
     169 
     170   </file> 
     171 
     172   <!-- 
     173   <file id="file8" name_suffix="_Tides" description="tidal harmonics" > 
     174     <field field_ref="M2x"          name="M2x"      long_name="M2 Elevation harmonic real part"                       /> 
     175     <field field_ref="M2y"          name="M2y"      long_name="M2 Elevation harmonic imaginary part"                  /> 
     176     <field field_ref="M2x_u"        name="M2x_u"    long_name="M2 current barotrope along i-axis harmonic real part "       /> 
     177     <field field_ref="M2y_u"        name="M2y_u"    long_name="M2 current barotrope along i-axis harmonic imaginary part "  /> 
     178     <field field_ref="M2x_v"        name="M2x_v"    long_name="M2 current barotrope along j-axis harmonic real part "       /> 
     179     <field field_ref="M2y_v"        name="M2y_v"    long_name="M2 current barotrope along j-axis harmonic imaginary part "  /> 
     180   </file> 
     181   --> 
     182 
    104183      </file_group> 
    105184 
     185      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->     
     186      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->    
     187 
    106188      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 
     189 
     190 
    107191      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 
    108192      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> 
    … …  
    154238        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size) 
    155239--> 
    156      <variable id="buffer_size"               type="integer">25000000</variable> 
     240     <variable id="buffer_size"               type="integer">5000000</variable> 
    157241     <variable id="buffer_server_factor_size" type="integer">2</variable> 
    158242     <variable id="info_level"                type="integer">0</variable> 
    159      <variable id="using_server"              type="boolean">false</variable> 
     243     <variable id="using_server"              type="boolean">true</variable> 
    160244     <variable id="using_oasis"               type="boolean">false</variable> 
    161245     <variable id="oasis_codes_id"            type="string" >oceanx</variable> 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm

    r4099 r4161  
    1  bld::tool::fppkeys key_trabbl key_orca_r2 key_lim3 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_trabbl key_lim3 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/CONFIG/SHARED/1_namelist_ref

    r4153 r4161  
    281281   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    282282   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
     283   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
     284   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
     285                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 
    283286/ 
    284287!----------------------------------------------------------------------- 
    … …  
    350353   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction 
    351354   rn_si1      =   23.0    !  2 bands: longest depth of extinction 
     355   ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3 
    352356/ 
    353357!----------------------------------------------------------------------- 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/CONFIG/SHARED/field_def.xml

    r4153 r4161  
    1515      <!-- T grid --> 
    1616       
    17      <field_group id="grid_T" grid_ref="grid_T_2D"> 
     17     <field_group id="grid_T" grid_ref="grid_T_2D" > 
    1818         <field id="toce"         long_name="temperature"                               unit="degC" grid_ref="grid_T_3D"/> 
    1919         <field id="soce"         long_name="salinity"                                  unit="psu"  grid_ref="grid_T_3D"/> 
    … …  
    5050     </field_group> 
    5151 
     52     <field_group id="Tides_T" grid_ref="grid_T_2D" operation="once" > 
     53    <!-- tidal composante --> 
     54    <field id="M2x"          long_name="M2 Elevation harmonic real part "                             unit="m"        /> 
     55    <field id="M2y"          long_name="M2 Elevation harmonic imaginary part"                         unit="m"        /> 
     56    <field id="S2x"          long_name="S2 Elevation harmonic real part "                             unit="m"        /> 
     57    <field id="S2y"          long_name="S2 Elevation harmonic imaginary part"                         unit="m"        /> 
     58    <field id="N2x"          long_name="N2 Elevation harmonic real part "                             unit="m"        /> 
     59    <field id="N2y"          long_name="N2 Elevation harmonic imaginary part"                         unit="m"        /> 
     60    <field id="K1x"          long_name="K1 Elevation harmonic real part "                             unit="m"        /> 
     61    <field id="K1y"          long_name="K1 Elevation harmonic imaginary part"                         unit="m"        /> 
     62    <field id="O1x"          long_name="O1 Elevation harmonic real part "                             unit="m"        /> 
     63    <field id="O1y"          long_name="O1 Elevation harmonic imaginary part"                         unit="m"        /> 
     64    <field id="Q1x"          long_name="Q1 Elevation harmonic real part "                             unit="m"        /> 
     65    <field id="Q1y"          long_name="Q1 Elevation harmonic imaginary part"                         unit="m"        /> 
     66    <field id="M4x"          long_name="M4 Elevation harmonic real part "                             unit="m"        /> 
     67    <field id="M4y"          long_name="M4 Elevation harmonic imaginary part"                         unit="m"        /> 
     68    <field id="K2x"          long_name="K2 Elevation harmonic real part "                             unit="m"        /> 
     69    <field id="K2y"          long_name="K2 Elevation harmonic imaginary part"                         unit="m"        /> 
     70    <field id="P1x"          long_name="P1 Elevation harmonic real part "                             unit="m"        /> 
     71    <field id="P1y"          long_name="P1 Elevation harmonic imaginary part"                         unit="m"        /> 
     72    <field id="Mfx"          long_name="Mf Elevation harmonic real part "                             unit="m"        /> 
     73    <field id="Mfy"          long_name="Mf Elevation harmonic imaginary part"                         unit="m"        /> 
     74    <field id="Mmx"          long_name="Mm Elevation harmonic real part "                             unit="m"        /> 
     75    <field id="Mmy"          long_name="Mm Elevation harmonic imaginary part"                         unit="m"        /> 
     76     </field_group> 
     77     
     78     <field_group id="Tides_U" grid_ref="grid_U_2D" operation="once" > 
     79    <field id="M2x_u"          long_name="M2 current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     80    <field id="M2y_u"          long_name="M2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     81    <field id="S2x_u"          long_name="S2 current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     82    <field id="S2y_u"          long_name="S2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     83    <field id="N2x_u"          long_name="N2 current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     84    <field id="N2y_u"          long_name="N2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     85    <field id="K1x_u"          long_name="K1 current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     86    <field id="K1y_u"          long_name="K1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     87    <field id="O1x_u"          long_name="O1 current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     88    <field id="O1y_u"          long_name="O1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     89    <field id="Q1x_u"          long_name="Q1 current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     90    <field id="Q1y_u"          long_name="Q1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     91    <field id="M4x_u"          long_name="M4 current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     92    <field id="M4y_u"          long_name="M4 current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     93    <field id="K2x_u"          long_name="K2 current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     94    <field id="K2y_u"          long_name="K2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     95    <field id="P1x_u"          long_name="P1 current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     96    <field id="P1y_u"          long_name="P1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     97    <field id="Mfx_u"          long_name="Mf current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     98    <field id="Mfy_u"          long_name="Mf current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     99    <field id="Mmx_u"          long_name="Mm current barotrope along i-axis harmonic real part "      unit="m/s"        /> 
     100    <field id="Mmy_u"          long_name="Mm current barotrope along i-axis harmonic imaginary part " unit="m/s"        /> 
     101     </field_group> 
     102     
     103     <field_group id="Tides_V" grid_ref="grid_V_2D" operation="once" > 
     104    <field id="M2x_v"          long_name="M2 current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     105    <field id="M2y_v"          long_name="M2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     106    <field id="S2x_v"          long_name="S2 current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     107    <field id="S2y_v"          long_name="S2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     108    <field id="N2x_v"          long_name="N2 current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     109    <field id="N2y_v"          long_name="N2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     110    <field id="K1x_v"          long_name="K1 current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     111    <field id="K1y_v"          long_name="K1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     112    <field id="O1x_v"          long_name="O1 current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     113    <field id="O1y_v"          long_name="O1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     114    <field id="Q1x_v"          long_name="Q1 current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     115    <field id="Q1y_v"          long_name="Q1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     116    <field id="M4x_v"          long_name="M4 current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     117    <field id="M4y_v"          long_name="M4 current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     118    <field id="K2x_v"          long_name="K2 current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     119    <field id="K2y_v"          long_name="K2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     120    <field id="P1x_v"          long_name="P1 current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     121    <field id="P1y_v"          long_name="P1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     122    <field id="Mfx_v"          long_name="Mf current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     123    <field id="Mfy_v"          long_name="Mf current barotrope along j-axis harmonic imaginary part " unit="m/s"        /> 
     124    <field id="Mmx_v"          long_name="Mm current barotrope along j-axis harmonic real part "      unit="m/s"        /> 
     125    <field id="Mmy_v"          long_name="Mm current barotrope along j-axis harmonic imaginary part " unit="m/s"        />   
     126     </field_group> 
     127 
     128 
    52129      <!-- SBC --> 
    53130       
    … …  
    59136         <field id="snowpre"      long_name="Snow precipitation"                                           unit="kg/m2/s"  /> 
    60137         <field id="runoffs"      long_name="River Runoffs"                                                unit="Kg/m2/s"  /> 
     138         <field id="precip"       long_name="Total precipitation"                                           unit="kg/m2/s"  /> 
     139 
    61140 
    62141         <field id="qt"           long_name="Net Downward Heat Flux"                                       unit="W/m2"     /> 
    … …  
    79158         <field id="qhc_oce"      long_name="Downward Heat Content of E-P over open ocean"                 unit="W/m2"     /> 
    80159         <field id="taum_oce"     long_name="wind stress module over open ocean"                           unit="N/m2"     /> 
    81  
    82          <field id="ice_cover"    long_name="Ice fraction"                                                 unit="1"        /> 
    83  
    84          <field id="ioceflxb"     long_name="Oceanic flux at the ice base"                                 unit="W/m2"     /> 
    85          <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     /> 
    86          <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     /> 
    87          <field id="qla_ai_cea"   long_name="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     /> 
    88           
    89          <field id="qsr_io_cea"   long_name="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     /> 
    90          <field id="qns_io_cea"   long_name="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     /> 
    91           
    92          <field id="snowthic_cea" long_name="Snow thickness (cell average)"                                unit="m"        /> 
    93          <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 unit="m"        /> 
    94          <field id="iceprod_cea"  long_name="Ice production (cell average)"                                unit="m/s"      /> 
    95           
    96          <field id="ice_pres"     long_name="Ice presence"                                                 unit="-"        /> 
    97          <field id="ist_cea"      long_name="Ice surface temperature (cell average)"                       unit="degC"     /> 
    98          <field id="ist_ipa"      long_name="Ice surface temperature (ice presence average)"               unit="degC"     />       
    99          <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />       
    100          <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />       
    101           
    102          <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     /> 
    103          <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     /> 
    104           
    105          <field id="u_imasstr"    long_name="Sea-ice mass transport along i-axis"                          unit="kg/s"     /> 
    106          <field id="v_imasstr"    long_name="Sea-ice mass transport along j-axis"                          unit="kg/s"     /> 
    107          <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                           unit="kgC/m2/s" /> 
    108          <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                         unit="kgPSU/m2/s" /> 
    109160 
    110161         <!-- available key_coupled --> 
    … …  
    132183         <field id="sntoice_cea"   long_name="Snow-Ice Formation Rate (cell average)"                      unit="kg/m2/s"  /> 
    133184         <field id="ticemel_cea"      long_name="Rate of Melt at Upper Surface of Sea Ice (cell average)"     unit="kg/m2/s"  /> 
     185 
     186    <!-- ice fields --> 
     187 
     188         <field id="ice_cover"    long_name="Ice fraction"                                                 unit="1"        /> 
     189 
     190         <field id="ioceflxb"     long_name="Oceanic flux at the ice base"                                 unit="W/m2"     /> 
     191         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     /> 
     192         <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     /> 
     193         <field id="qla_ai_cea"   long_name="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     /> 
     194          
     195         <field id="qsr_io_cea"   long_name="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     /> 
     196         <field id="qns_io_cea"   long_name="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     /> 
     197          
     198         <field id="snowthic_cea" long_name="Snow thickness (cell average)"                                unit="m"        /> 
     199         <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 unit="m"        /> 
     200         <field id="iceprod_cea"  long_name="Ice production (cell average)"                                unit="m/s"      /> 
     201          
     202         <field id="ice_pres"     long_name="Ice presence"                                                 unit="-"        /> 
     203         <field id="ist_cea"      long_name="Ice surface temperature (cell average)"                       unit="degC"     /> 
     204         <field id="ist_ipa"      long_name="Ice surface temperature (ice presence average)"               unit="degC"     />       
     205         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />       
     206         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />       
     207          
     208         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     /> 
     209         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     /> 
     210          
     211         <field id="u_imasstr"    long_name="Sea-ice mass transport along i-axis"                          unit="kg/s"     /> 
     212         <field id="v_imasstr"    long_name="Sea-ice mass transport along j-axis"                          unit="kg/s"     /> 
     213         <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                           unit="kgC/m2/s" /> 
     214         <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                         unit="kgPSU/m2/s" />         
     215          
     216          
     217         <field id="iceconc"      long_name="ice concentration"                                            unit="%"        /> 
     218         <field id="icebopr"      long_name="daily bottom thermo ice prod."                                unit="km3/day"   /> 
     219         <field id="icedypr"      long_name="daily  dynamic ice prod."                                     unit="km3/day"   /> 
     220    <field id="ioceflxb"     long_name="Oceanic flux at the ice base"                                 unit="W/m2"     /> 
     221         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      /> 
     222         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      /> 
     223          <field id="isst"         long_name="sea surface temperature"                                      unit="degC"     /> 
     224         <field id="isss"         long_name="sea surface salinity"                                         unit="psu"      />  
     225         <field id="qt_oce"       long_name="total flux at ocean surface"                                  unit="W/m2"     /> 
     226         <field id="qsr_oce"      long_name="solar heat flux at ocean surface"                             unit="W/m2"     /> 
     227         <field id="qns_oce"      long_name="non-solar heat flux at ocean surface"                         unit="W/m2"     /> 
     228         <field id="hfbri"        long_name="heat flux due to brine release"                               unit="W/m2"     /> 
     229         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     /> 
     230         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     /> 
     231    <field id="qsr_io"       long_name="Ice-Oce downward solar heat flux"                             unit="W/m2"     /> 
     232    <field id="qns_io"       long_name="Ice-Oce downward non-solar heat flux"                         unit="W/m2"     /> 
     233         <field id="micesalt"     long_name="Mean ice salinity"                                            unit="psu"      /> 
     234         <field id="miceage"      long_name="Mean ice age"                                                 unit="years"    /> 
     235         <field id="icelapr"      long_name="daily lateral thermo ice prod."                               unit="km3/day"   /> 
     236         <field id="icesipr"      long_name="daily snowice ice prod."                                      unit="km3/day"   /> 
     237         <field id="micet"        long_name="Mean ice temperature"                                         unit="degC"     /> 
     238         <field id="icehc"        long_name="ice total heat content"                                       unit="10^9 J"   />  
     239         <field id="isnowhc"      long_name="snow total heat content"                                      unit="10^9J"    /> 
     240         <field id="icest"        long_name="ice surface temperature"                                      unit="degC"     /> 
     241         <field id="sfxbri"       long_name="brine salt flux"                                              unit="psu*kg/m2/day" /> 
     242         <field id="sfxthd"       long_name="equivalent FW salt flux"                                      unit="psu*kg/m2/day" /> 
     243         <field id="ibrinv"       long_name="brine volume"                                                 unit="%"        /> 
     244         <field id="icecolf"      long_name="frazil ice collection thickness"                              unit="m"        /> 
     245         <field id="icestr"       long_name="ice strength"                                                 unit="N/m"      /> 
     246         <field id="icevel"       long_name="ice velocity"                                                 unit="m/s"      /> 
     247         <field id="isume"        long_name="surface melt"                                                 unit="km3/day"   /> 
     248         <field id="ibome"        long_name="bottom melt"                                                  unit="km3/day"   /> 
     249         <field id="idive"        long_name="divergence"                                                   unit="10-8s-1"  /> 
     250         <field id="ishear"       long_name="shear"                                                        unit="10-8s-1"  /> 
     251         <field id="icerepr"      long_name="daily resultant ice prod./melting from limupdate"             unit="km3/day"   /> 
     252         <field id="icevolu"      long_name="ice volume"                                                   unit="km3"      /> 
     253         <field id="snowvol"      long_name="snow volume"                                                  unit="km3"      /> 
     254         <field id="sfxmec"       long_name="salt flux from ridging rafting"                               unit="psu*kg/m2/day" /> 
     255         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="psu*kg/m2/day" /> 
     256         <field id="icetrp"       long_name="ice volume transport"                                         unit="km3/day"   /> 
     257 
    134258 
    135259      </field_group> 
    … …  
    214338         <field id="saltot"     long_name="global mean salinity"                       unit="psu"  /> 
    215339         <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
     340       <!-- available with ln_diahsb --> 
     341    <field id="bgtemper"     long_name="global mean temperature"                  unit="degC"   /> 
     342    <field id="bgsaline"     long_name="global mean salinity"                     unit="psu"    /> 
     343    <field id="bgheatco"     long_name="global mean heat content"                 unit="10^9J"  /> 
     344    <field id="bgsaltco"     long_name="global mean salt content"                 unit="psu*m3" /> 
     345    <field id="bgvolssh"     long_name="global mean ssh volume"                   unit="km3"     /> 
     346    <field id="bgvoltot"     long_name="global mean volume"                       unit="km3"     /> 
     347    <field id="bgsshtot"     long_name="global mean ssh"                          unit="m"      /> 
     348    <field id="bgfrcvol"     long_name="global mean volume from forcing"          unit="km3"     /> 
     349    <field id="bgfrctem"     long_name="global mean heat content from forcing"    unit="10^9J"  /> 
     350    <field id="bgfrcsal"     long_name="global mean salt content from forcing"    unit="psu*km3" /> 
     351      </field_group> 
     352 
     353      <field_group id="SBC_scalar"  domain_ref="1point" > 
     354         <!-- available with ln_limdiahsb --> 
     355    <field id="ibgvoltot"    long_name="global mean ice volume"                   unit="km3"   /> 
     356    <field id="sbgvoltot"    long_name="global mean snow volume"                  unit="km3"   /> 
     357    <field id="ibgarea"      long_name="global mean ice area"                     unit="km2"   /> 
     358    <field id="ibgsaline"    long_name="global mean ice salinity"                 unit="psu"   /> 
     359    <field id="ibgtemper"    long_name="global mean ice temperature"              unit="degC"   /> 
     360    <field id="ibgheatco"    long_name="global mean ice heat content"             unit="10^9J"   /> 
     361    <field id="ibgsaltco"    long_name="global mean ice salt content"             unit="psu*km3"   /> 
     362    <field id="sbgheatco"    long_name="global mean snow heat content"            unit="10^9J"   /> 
     363    <field id="ibgfrcsfx"    long_name="global mean salt content from sfx"        unit="psu*km3"   /> 
     364    <field id="ibgfrcemp"    long_name="global mean volume from emp"              unit="km3"      /> 
     365    <field id="ibgsfx"       long_name="global mean emps"                         unit="psu*kg/m2/day"   /> 
     366    <field id="ibgemp"       long_name="global mean emp"                          unit="kg/m2/day"   /> 
     367    <field id="ibgsfxbri"    long_name="global mean ice sfx_bri"                  unit="psu*kg/m2/day"   /> 
     368    <field id="ibgsfxthd"    long_name="global mean ice sfx_thd"                  unit="psu*kg/m2/day"   /> 
     369    <field id="ibgsfxres"    long_name="global mean ice sfx_res"                  unit="psu*kg/m2/day"   /> 
     370    <field id="ibgsfxmec"    long_name="global mean ice fsalt_rpo"                unit="psu*kg/m2/day"   /> 
     371    <field id="ibggrpme"     long_name="global mean ice growth+melt volume"       unit="km3"      /> 
    216372      </field_group> 
    217373   

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref

    r4148 r4161  
    5454   telast      =   9600    !  timescale for EVP elastic waves 
    5555   alphaevp    =   1.0     !  coefficient for the solution of EVP int. stresses 
     56   hminrhg     =   0.05     !  ice thickness (m) below which ice velocity equal ocean velocity 
    5657/ 
    5758!----------------------------------------------------------------------- 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref

    r4147 r4161  
    1414&namicerun     !   Share parameters for dynamics/advection/thermo 
    1515!----------------------------------------------------------------------- 
    16    cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input) 
     16   cn_icerst_in  = "restart_ice"   !  suffix of ice restart name (input) 
    1717   cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output) 
    1818   ln_limdyn   = .true.    !  ice dynamics (T) or thermodynamics only (F) 
    19    acrit       =  1.0e-02 , 1.0e-02  !  minimum fraction for leads in the Northern (Southern) Hemisphere 
    20    hsndif      =  0.0      !  computation of temperature in snow (=0.0) or not 
    21    hicdif      =  0.0      !  computation of temperature in ice  (=0.0) or not (=9999.0) 
     19   amax        = 0.999      !  maximum ice concentration 
    2220   cai         =  1.40e-3  !  atmospheric drag over sea ice 
    2321   cao         =  1.00e-3  !  atmospheric drag over ocean 
    2422   ln_nicep    = .false.   !  Ice points output for debug (yes or no) 
     23   ln_limdiahsb  = .false.    !  check the heat and salt budgets (T) or not (F) 
     24   ln_limdiaout  = .false.    !  output the heat and salt budgets (T) or not (F) 
    2525/ 
    2626!----------------------------------------------------------------------- 
    … …  
    3030   hninn       =  0.3      !  initial snow thickness in the north 
    3131   hnins       =  0.1      !        "            "          south 
    32    hginn_u     =  3.50     !  initial undeformed ice thickness in the north 
    33    hgins_u     =  1.0      !        "            "              "     south 
    34    aginn_u     =  0.95     !  initial undeformed ice concentration in the north 
    35    agins_u     =  0.9      !        "            "              "         south 
    36    hginn_d     =  0.0      !  initial  deformed  ice thickness     in the north 
    37    hgins_d     =  0.0      !   
    38    aginn_d     =  0.00     !  initial  deformed  ice concentration in the north 
    39    agins_d     =  0.00     !        "            "              "         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 
    4036   sinn        =  6.301    !  initial salinity in the north 
    4137   sins        =  6.301    !        "            "    south 
    … …  
    6258   telast      =9600.0     !  timescale for elastic waves, SB, 720.0 
    6359   alphaevp    =   1.0     !  coefficient for the solution of internal ice stresses 
     60   hminrhg     =   0.05     !  ice thickness (m) below which ice velocity equal ocean velocity 
    6461/ 
    6562!----------------------------------------------------------------------- 
    … …  
    8077   hicmin      = 0.2       !  ice thickness corr. to max. energy stored in brine pocket 
    8178   hiclim      = 0.10      !  minimum ice thickness 
    82    amax        = 0.999     !  maximum lead fraction 
    8379   sbeta       = 1.        !  numerical caracteritic of the scheme for diffusion in ice 
    8480                           !        Cranck-Nicholson (=0.5), implicit (=1), explicit (=0) 
    … …  
    145141   ninfo       = 1         !  frequency of ouputs on file ice_evolu in case of averaging 
    146142/ 
     143!!----------------------------------------------------------------------- 
     144!&namicehsb       !  Heat and salt budgets  
     145!!----------------------------------------------------------------------- 
     146! 
     147!/ 
    147148!----------------------------------------------------------------------- 
    148149&namiceout     !   parameters for outputs 
    149150!----------------------------------------------------------------------- 
    150    noumef      =   37      !  number of fields 
     151   noumef      =   43      !  number of fields 
    151152   add_diag_swi=    1      !  1 -> diagnose distribution in thickness space 
    152153                           !  0 -> only simple diagnostics 
    … …  
    157158   field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0 
    158159   field_3  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0 
    159    field_4  = 'Daily bottom thermo ice production ', 'iicebopr', 'cm/day  ',    1   , 100.     ,    0.0 
    160    field_5  = 'Daily dynamic ice production       ', 'iicedypr', 'cm/day  ',    1   , 100.     ,    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 
    161162   field_6  = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0 
    162163   field_7  = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0 
    … …  
    172173   field_17 = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    173174   field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    174    field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/day ',    1   ,  1.0     ,    0.0 
     175   field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    175176   field_20 = 'Mean ice salinity                  ', 'iicesali', 'psu     ',    1   ,  1.0     ,    0.0 
    176177   field_21 = 'Mean ice age                       ', 'iiceages', 'years   ',    1   ,  0.002739,    0.0 
    177    field_22 = 'Daily lateral thermo ice prod.     ', 'iicelapr', 'cm/day  ',    1   ,100.      ,    0.0 
    178    field_23 = 'Daily snowice ice production       ', 'iicesipr', 'cm/day  ',    1   ,100.      ,    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 
    179180   field_24 = 'Mean ice temperature               ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15 
    180181   field_25 = 'Ice total heat content             ', 'iiceheco', '10^9 J  ',    1   ,  1.0     ,    0.0 
    181182   field_26 = 'Ice surface temperature            ', 'iicesurt', 'C       ',    1   ,  1.0     , -273.15 
    182183   field_27 = 'Snow temperature                   ', 'isnotem2', 'C       ',    1   ,  1.0     , -273.15 
    183    field_28 = 'Fsbri - brine salt flux            ', 'iicfsbri', 'kg/m2/s ',    1   ,  1.0     ,    0.0 
    184    field_29 = 'Fseqv - equivalent FW salt flux    ', 'iicfseqv', 'kg/m2/s ',    1   ,  1.0     ,    0.0 
     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 
    185186   field_30 = 'Brine volume                       ', 'ibrinvol', '%       ',    1   ,  100.0   ,    0.0 
    186187   field_31 = 'Frazil ice collection thickness    ', 'iicecolf', 'm       ',    1   ,  1.0     ,    0.0 
    187188   field_32 = 'Ice strength                       ', 'iicestre', 'N/m     ',    1   ,  0.001   ,    0.0 
    188189   field_33 = 'Ice velocity                       ', 'iicevelo', 'm/s     ',    1   ,  1.0     ,    0.0 
    189    field_34 = 'Surface melt                       ', 'iicesume', 'cm/day  ',    1   ,100.      ,    0.0 
    190    field_35 = 'Bottom melt                        ', 'iicebome', 'cm/day  ',    1   ,100.      ,    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 
    191192   field_36 = 'Divergence                         ', 'iicedive', '10-8s-1 ',    1   ,  1.0e8   ,    0.0 
    192193   field_37 = 'Shear                              ', 'iiceshea', '10-8s-1 ',    1   ,  1.0e8   ,    0.0 
    193 /       
     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 
     200/  
     201 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/CONFIG/SHARED/namelist_ref

    r4152 r4161  
    283283   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    284284   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
     285   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
     286   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
     287                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 
    285288/ 
    286289!----------------------------------------------------------------------- 
    … …  
    352355   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction 
    353356   rn_si1      =   23.0    !  2 bands: longest depth of extinction 
     357   ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3 
    354358/ 
    355359!----------------------------------------------------------------------- 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/CONFIG/cfg.txt

    r4159 r4161  
    1 ORCA2_LIM3 OPA_SRC LIM_SRC_3 
     1GYRE OPA_SRC 
    22GYRE_BFM OPA_SRC TOP_SRC 
    3 GYRE OPA_SRC 
     3GYRE_PISCES OPA_SRC TOP_SRC 
    44AMM12 OPA_SRC 
     5ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
     6ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
     7ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
     8ORCA2_LIM_CFC_C14b OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    59ORCA2_SAS_LIM OPA_SRC SAS_SRC LIM_SRC_2 NST_SRC 
    6 ORCA2_LIM_CFC_C14b OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    7 GYRE_PISCES OPA_SRC TOP_SRC 
    8 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    910ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r4147 r4161  
    5151   REAL(wp), PUBLIC ::   ahi0        !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    5252   REAL(wp), PUBLIC ::   alphaevp    !: coefficient for the solution of EVP int. stresses 
     53   REAL(wp), PUBLIC ::   hminrhg = 0.001_wp    !: clem : ice volume (a*h in m) below which ice velocity is set to ocean velocity 
    5354 
    5455   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( ecc * ecc ) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90

    r4147 r4161  
    228228         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   & 
    229229         &                c_rhg, etamn, creepl, ecc, ahi0,                  & 
    230          &                nevp, telast,alphaevp 
     230         &                nevp, telast, alphaevp, hminrhg 
    231231      !!------------------------------------------------------------------- 
    232232                     
    … …  
    262262         WRITE(numout,*) '       timescale for elastic waves telast = ', telast 
    263263         WRITE(numout,*) '       coefficient for the solution of int. stresses alphaevp = ', alphaevp 
     264         WRITE(numout,*) '       min ice thickness for rheology calculations     hminrhg = ', hminrhg 
    264265      ENDIF 
    265266      ! 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90

    r3625 r4161  
    3131 
    3232   !!---------------------------------------------------------------------- 
    33    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     33   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    3434   !! $Id$ 
    3535   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4147 r4161  
    188188   REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses !SB 
    189189   REAL(wp), PUBLIC ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
     190   REAL(wp), PUBLIC ::   hminrhg = 0.001_wp    !: clem : ice volume (a*h, in m) below which ice velocity is set to ocean velocity 
    190191 
    191192   !                                     !!** ice-salinity namelist (namicesal) ** 
    … …  
    405406   !!-------------------------------------------------------------------------- 
    406407   !! Check if everything down here is necessary 
     408   LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
     409   LOGICAL , PUBLIC                                      ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
    407410   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   v_newice   !: volume of ice formed in the leads 
    408411   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd  !: thermodynamic growth rates  
    … …  
    414417   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_me   ! vertical bottom melt  
    415418   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sur_me   ! vertical surface melt 
     419   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_res_pr   ! production (growth+melt) due to limupdate 
     420   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   ! transport of ice volume 
    416421   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    417422 
    418423   !!---------------------------------------------------------------------- 
    419    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 
     424   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
    420425   !! $Id$ 
    421426   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    527532         &      izero    (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) ,     & 
    528533         &      fstroc   (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) ,     & 
    529          &      fhbricat (jpi,jpj,jpl) , v_newice   (jpi,jpj)                        , STAT=ierr(ii) ) 
     534         &      fhbricat (jpi,jpj,jpl) , diag_res_pr(jpi,jpj) , diag_trp_vi(jpi,jpj) , v_newice(jpi,jpj) , STAT=ierr(ii) ) 
    530535 
    531536      ice_alloc = MAXVAL( ierr(:) ) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90

    r4147 r4161  
    4040 
    4141   !!---------------------------------------------------------------------- 
    42    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     42   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    4343   !! $Id$ 
    4444   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    128128      !! ** input   :   Namelist namicerun 
    129129      !!------------------------------------------------------------------- 
    130       NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, acrit, hsndif, hicdif, cai, cao, ln_nicep 
     130      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, amax, cai, cao, ln_nicep, ln_limdiahsb, ln_limdiaout 
    131131      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    132132      !!------------------------------------------------------------------- 
    … …  
    144144         ln_nicep = .FALSE. 
    145145         CALL ctl_warn( 'ice_run : specific control print for LIM3 desactivated with MPI' ) 
    146       ENDIF        
     146      ENDIF 
    147147      ! 
    148148      IF(lwp) THEN                        ! control print 
    … …  
    151151         WRITE(numout,*) ' ~~~~~~' 
    152152         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn 
    153          WRITE(numout,*) '   minimum fraction for leads in the NH (SH)  acrit(1/2)   = ', acrit(:) 
    154          WRITE(numout,*) '   computation of temp. in snow (=0) or not (=9999) hsndif = ', hsndif 
    155          WRITE(numout,*) '   computation of temp. in ice  (=0) or not (=9999) hicdif = ', hicdif 
     153         WRITE(numout,*) '   maximum ice concentration                               = ', amax  
    156154         WRITE(numout,*) '   atmospheric drag over sea ice                           = ', cai 
    157155         WRITE(numout,*) '   atmospheric drag over ocean                             = ', cao 
    158156         WRITE(numout,*) '   Several ice points in the ice or not in ocean.output    = ', ln_nicep 
     157         WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb 
     158         WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout 
    159159      ENDIF 
    160160      ! 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r3764 r4161  
    1515   !!   lim_adv_y  : advection of sea ice on y axis 
    1616   !!---------------------------------------------------------------------- 
    17    USE dom_oce        ! ocean domain 
    18    USE ice            ! LIM-3 variables 
    19    USE dom_ice        ! LIM-3 domain 
    20    USE lbclnk         ! lateral boundary condition - MPP exchanges 
    21    USE in_out_manager ! I/O manager 
    22    USE prtctl         ! Print control 
    23    USE lib_mpp        ! MPP library 
    24    USE wrk_nemo       ! work arrays 
    25    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    26    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     17   USE dom_oce          ! ocean domain 
     18   USE dom_ice          ! LIM-3 domain 
     19   USE ice              ! LIM-3 variables 
     20   USE lbclnk           ! lateral boundary condition - MPP exchanges 
     21   USE in_out_manager   ! I/O manager 
     22   USE prtctl           ! Print control 
     23   USE lib_mpp          ! MPP library 
     24   USE wrk_nemo         ! work arrays 
     25   USE lib_fortran      ! to use key_nosignedzero 
    2726 
    2827   IMPLICIT NONE 
    … …  
    3938#  include "vectopt_loop_substitute.h90" 
    4039   !!---------------------------------------------------------------------- 
    41    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     40   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    4241   !! $Id$ 
    4342   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r3625 r4161  
    3030 
    3131   !!---------------------------------------------------------------------- 
    32    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     32   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    3333   !! $Id$ 
    3434   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4147 r4161  
    1515   !!    lim_dyn_init : initialization and namelist read 
    1616   !!---------------------------------------------------------------------- 
    17    USE phycst         ! physical constants 
    18    USE dom_oce        ! ocean space and time domain 
    19    USE sbc_oce        ! Surface boundary condition: ocean fields 
    20    USE sbc_ice        ! Surface boundary condition: ice   fields 
    21    USE ice            ! LIM-3 variables 
    22    USE par_ice        ! LIM-3 parameters 
    23    USE dom_ice        ! LIM-3 domain 
    24    USE limrhg         ! LIM-3 rheology 
    25    USE lbclnk         ! lateral boundary conditions - MPP exchanges 
    26    USE lib_mpp        ! MPP library 
    27    USE wrk_nemo       ! work arrays 
    28    USE in_out_manager ! I/O manager 
    29    USE prtctl         ! Print control 
    30    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     17   USE phycst           ! physical constants 
     18   USE dom_oce          ! ocean space and time domain 
     19   USE sbc_oce          ! Surface boundary condition: ocean fields 
     20   USE sbc_ice          ! Surface boundary condition: ice   fields 
     21   USE ice              ! LIM-3 variables 
     22   USE par_ice          ! LIM-3 parameters 
     23   USE dom_ice          ! LIM-3 domain 
     24   USE limrhg           ! LIM-3 rheology 
     25   USE lbclnk           ! lateral boundary conditions - MPP exchanges 
     26   USE lib_mpp          ! MPP library 
     27   USE wrk_nemo         ! work arrays 
     28   USE in_out_manager   ! I/O manager 
     29   USE prtctl           ! Print control 
     30   USE lib_fortran      ! glob_sum 
     31   USE timing          ! Timing 
    3132 
    3233   IMPLICIT NONE 
    … …  
    3839#  include "vectopt_loop_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    40    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     41   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    4142   !! $Id$ 
    4243   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6566      REAL(wp), POINTER, DIMENSION(:)   ::   zmsk           ! i-averaged of tmask 
    6667      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io   ! ice-ocean velocity 
    67       !!--------------------------------------------------------------------- 
     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) 
     69      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     70     !!--------------------------------------------------------------------- 
     71 
     72      IF( nn_timing == 1 )  CALL timing_start('limdyn') 
    6873 
    6974      CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 
    7075      CALL wrk_alloc( jpj, zind, zmsk ) 
     76 
     77      ! ------------------------------- 
     78      !- check conservation (C Rousset) 
     79      IF (ln_limdiahsb) THEN 
     80         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     81         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(:,:) ) 
     84      ENDIF 
     85      !- check conservation (C Rousset) 
     86      ! ------------------------------- 
    7187 
    7288      IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    … …  
    208224      ENDIF 
    209225      ! 
     226      ! ------------------------------- 
     227      !- check conservation (C Rousset) 
     228      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 
     231  
     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 ) 
     234 
     235         zchk_vmin = glob_min(v_i) 
     236         zchk_amax = glob_max(SUM(a_i,dim=3)) 
     237         zchk_amin = glob_min(a_i) 
     238 
     239         IF(lwp) THEN 
     240            IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limdyn) = ',(zchk_v_i * rday) 
     241            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limdyn) = ',(zchk_smv * rday) 
     242            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limdyn) = ',(zchk_vmin * 1.e-3) 
     243            !IF ( zchk_amax >  amax+1.e-10   ) WRITE(numout,*) 'violation a_i>amax            (limdyn) = ',zchk_amax 
     244            IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limdyn) = ',zchk_amin 
     245         ENDIF 
     246      ENDIF 
     247      !- check conservation (C Rousset) 
     248      ! ------------------------------- 
     249 
    210250      CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 
    211251      CALL wrk_dealloc( jpj, zind, zmsk ) 
    212252      ! 
     253      IF( nn_timing == 1 )  CALL timing_stop('limdyn') 
     254 
    213255   END SUBROUTINE lim_dyn 
    214256 
    … …  
    230272         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   & 
    231273         &                c_rhg, etamn, creepl, ecc, ahi0, & 
    232          &                nevp, telast, alphaevp 
     274         &                nevp, telast, alphaevp, hminrhg 
    233275      !!------------------------------------------------------------------- 
    234276 
    … …  
    264306         WRITE(numout,*) '   timescale for elastic waves                      telast = ', telast 
    265307         WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp 
     308         WRITE(numout,*) '   min ice thickness for rheology calculations     hminrhg = ', hminrhg 
    266309      ENDIF 
    267310      ! 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r3625 r4161  
    3535#  include "vectopt_loop_substitute.h90" 
    3636   !!---------------------------------------------------------------------- 
    37    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 
     37   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
    3838   !! $Id$ 
    3939   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    137137      END DO                                       ! end of sub-time step loop 
    138138 
     139      ! ----------------------- 
     140      !!! final step (clem) !!! 
     141      DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
     142         DO ji = 1 , fs_jpim1   ! vector opt. 
     143            zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
     144            zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
     145         END DO 
     146      END DO 
     147      ! 
     148      DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
     149         DO ji = fs_2 , fs_jpim1   ! vector opt.  
     150            zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   & 
     151                 &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) ) 
     152            ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 
     153         END DO 
     154      END DO 
     155      CALL lbc_lnk( ptab, 'T', 1. )                   ! lateral boundary condition 
     156      !!! final step (clem) !!! 
     157      ! ----------------------- 
     158 
    139159      IF(ln_ctl)   THEN 
    140160         zrlx(:,:) = ptab(:,:) - ztab0(:,:) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4147 r4161  
    55   !!====================================================================== 
    66   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code 
    7    !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
     7   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     8   !!             -   ! 2012    (C. Rousset) add par_oce (for jp_sal)...bug? 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_lim3 
    … …  
    1819   USE dom_oce          ! ocean domain 
    1920   USE sbc_oce          ! Surface boundary condition: ocean fields 
     21   USE sbc_ice          ! Surface boundary condition: ice fields 
    2022   USE eosbn2           ! equation of state 
    2123   USE ice              ! sea-ice variables 
    2224   USE par_ice          ! ice parameters 
     25   USE par_oce          ! ocean parameters 
    2326   USE dom_ice          ! sea-ice domain 
    2427   USE in_out_manager   ! I/O manager 
    2528   USE lbclnk           ! lateral boundary condition - MPP exchanges 
    2629   USE lib_mpp          ! MPP library 
     30   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2731   USE wrk_nemo         ! work arrays 
    28    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2932 
    3033   IMPLICIT NONE 
    … …  
    4952 
    5053   !!---------------------------------------------------------------------- 
    51    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     54   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
    5255   !! $Id$ 
    53    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    54    !!---------------------------------------------------------------------- 
     56   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     57   !!---------------------------------------------------------------------- 
     58 
    5559CONTAINS 
    5660 
    … …  
    6165      !! ** Purpose :   defined the sea-ice initial state 
    6266      !! 
    63       !! ** Method  :   restart from a state defined in a binary file 
    64       !!                or from arbitrary sea-ice conditions 
    65       !!------------------------------------------------------------------- 
    66       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    67       REAL(wp) ::   zeps6, zeps, ztmelts, epsi06   ! local scalars 
    68       REAL(wp) ::   zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs  
    69       REAL(wp), POINTER, DIMENSION(:)   ::   zgfactorn, zhin  
    70       REAL(wp), POINTER, DIMENSION(:)   ::   zgfactors, zhis 
    71       REAL(wp), POINTER, DIMENSION(:,:) ::   zidto      ! ice indicator 
    72       !-------------------------------------------------------------------- 
    73  
    74       CALL wrk_alloc( jpm, zgfactorn, zgfactors, zhin, zhis ) 
     67      !! ** Method  :    
     68      !!                This routine will put some ice where ocean 
     69      !!                is at the freezing point, then fill in ice  
     70      !!                state variables using prescribed initial  
     71      !!                values in the namelist             
     72      !! 
     73      !! ** Steps   :    
     74      !!                1) Read namelist 
     75      !!                2) Basal temperature; ice and hemisphere masks 
     76      !!                3) Fill in the ice thickness distribution using gaussian 
     77      !!                4) Fill in space-dependent arrays for state variables 
     78      !!                5) Diagnostic arrays 
     79      !!                6) Lateral boundary conditions 
     80      !! 
     81      !! History : 
     82      !!   2.0  !  01-04  (C. Ethe, G. Madec)  Original code 
     83      !!   3.0  !  2007   (M. Vancoppenolle)   Rewrite for ice cats 
     84      !!   4.0  !  09-11  (M. Vancoppenolle)   Enhanced version for ice cats 
     85      !!-------------------------------------------------------------------- 
     86 
     87      !! * Local variables 
     88      INTEGER    :: ji, jj, jk, jl             ! dummy loop indices 
     89      REAL(wp)   :: epsi06, epsi20, ztmelts 
     90      INTEGER    :: i_hemis, i_fill, jl0   
     91      REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 
     92      REAL(wp), POINTER, DIMENSION(:)     :: 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 
     95      INTEGER,  POINTER, DIMENSION(:,:)   :: zhemis   ! hemispheric index 
     96      !-------------------------------------------------------------------- 
     97 
    7598      CALL wrk_alloc( jpi, jpj, zidto ) 
    76  
    77       !-------------------------------------------------------------------- 
    78       ! 1) Preliminary things  
    79       !-------------------------------------------------------------------- 
    80       epsi06 = 1.e-6_wp 
     99      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      epsi06   = 1.0e-6 
     104      epsi20   = 1.0e-20 
     105      IF(lwp) WRITE(numout,*) 
     106      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
     107      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
     108 
     109      !-------------------------------------------------------------------- 
     110      ! 1) Read namelist 
     111      !-------------------------------------------------------------------- 
    81112 
    82113      CALL lim_istate_init     !  reading the initials parameters of the ice 
    … …  
    87118 
    88119      !-------------------------------------------------------------------- 
    89       ! 2) Ice initialization (hi,hs,frld,t_su,sm_i,t_i,t_s)              |  
    90       !-------------------------------------------------------------------- 
    91  
    92       IF(lwp) WRITE(numout,*) 
    93       IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
    94       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
    95  
     120      ! 2) Basal temperature, ice mask and hemispheric index 
     121      !-------------------------------------------------------------------- 
     122 
     123      ! Basal temperature is set to the freezing point of seawater in Celsius 
    96124      t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    97125 
    98126      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    99127         DO ji = 1, jpi 
    100             IF( tsn(ji,jj,1,jp_tem)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0.e0      ! no ice 
    101             ELSE                                                     ;   zidto(ji,jj) = 1.e0      !    ice 
     128            IF( tsn(ji,jj,1,jp_tem)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0._wp      ! no ice 
     129            ELSE                                                     ;   zidto(ji,jj) = 1._wp      !    ice 
    102130            ENDIF 
    103131         END DO 
    104132      END DO 
    105133 
    106       t_bo(:,:) = t_bo(:,:) + rt0                          ! t_bo converted from Celsius to Kelvin (rt0 over land) 
    107  
    108       ! constants for heat contents 
    109       zeps   = 1.e-20_wp 
    110       zeps6  = 1.e-06_wp 
    111  
    112       ! zgfactor for initial ice distribution 
    113       zgfactorn(:) = 0._wp 
    114       zgfactors(:) = 0._wp 
    115  
    116       ! first ice type 
    117       DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
    118          zhin (1)     = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp 
    119          zgfactorn(1) = zgfactorn(1) + exp(-(zhin(1)-hginn_u)*(zhin(1)-hginn_u) * 0.5_wp ) 
    120          zhis (1)     = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp 
    121          zgfactors(1) = zgfactors(1) + exp(-(zhis(1)-hgins_u)*(zhis(1)-hgins_u) * 0.5_wp ) 
    122       END DO ! jl 
    123       zgfactorn(1) = aginn_u / zgfactorn(1) 
    124       zgfactors(1) = agins_u / zgfactors(1) 
    125  
    126       ! ------------- 
    127       ! new distribution, polynom of second order, conserving area and volume 
    128       zh1 = 0._wp 
    129       zh2 = 0._wp 
    130       zh3 = 0._wp 
    131       DO jl = 1, jpl 
    132          zh = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp 
    133          zh1 = zh1 + zh 
    134          zh2 = zh2 + zh * zh 
    135          zh3 = zh3 + zh * zh * zh 
    136       END DO 
    137       IF(lwp) WRITE(numout,*) ' zh1 : ', zh1 
    138       IF(lwp) WRITE(numout,*) ' zh2 : ', zh2 
    139       IF(lwp) WRITE(numout,*) ' zh3 : ', zh3 
    140  
    141       zvol = aginn_u * hginn_u 
    142       zare = aginn_u 
    143       IF( jpl >= 2 ) THEN 
    144          zbn = ( zvol*zh2 - zare*zh3 ) / ( zh2*zh2 - zh1*zh3) 
    145          zan = ( zare - zbn*zh1 ) / zh2 
    146       ENDIF 
    147  
    148       IF(lwp) WRITE(numout,*) ' zvol: ', zvol 
    149       IF(lwp) WRITE(numout,*) ' zare: ', zare 
    150       IF(lwp) WRITE(numout,*) ' zbn : ', zbn  
    151       IF(lwp) WRITE(numout,*) ' zan : ', zan  
    152  
    153       zvol = agins_u * hgins_u 
    154       zare = agins_u 
    155       IF( jpl >= 2 ) THEN 
    156          zbs = ( zvol*zh2 - zare*zh3 ) / ( zh2*zh2 - zh1*zh3) 
    157          zas = ( zare - zbs*zh1 ) / zh2 
    158       ENDIF 
    159  
    160       IF(lwp) WRITE(numout,*) ' zvol: ', zvol 
    161       IF(lwp) WRITE(numout,*) ' zare: ', zare 
    162       IF(lwp) WRITE(numout,*) ' zbn : ', zbn  
    163       IF(lwp) WRITE(numout,*) ' zan : ', zan  
    164  
    165       !end of new lines 
    166       ! ------------- 
    167 !!! 
    168       ! retour a LIMA_MEC 
    169       !     ! second ice type 
    170       !     zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
    171       !     hi_max(ice_cat_bounds(2,1)-1) = 0.0 
    172  
    173       !     ! here to change !!!! 
    174       !     jm = 2 
    175       !     DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    176       !        zhin (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    177       !        zhin (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + & 
    178       !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0 
    179       !        zgfactorn(2) = zgfactorn(2) + exp(-(zhin(2)-hginn_d)*(zhin(2)-hginn_d)/2.0) 
    180       !        zhis (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    181       !        zhis (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + & 
    182       !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0 
    183       !        zgfactors(2) = zgfactors(2) + exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0) 
    184       !     END DO ! jl 
    185       !     zgfactorn(2) = aginn_d / zgfactorn(2) 
    186       !     zgfactors(2) = agins_d / zgfactors(2) 
    187       !     hi_max(ice_cat_bounds(2,1)-1) = zdummy 
    188       ! END retour a LIMA_MEC 
    189 !!! 
    190  
    191 !!gm  optimisation :  loop over the ice categories inside the ji, jj loop !!! 
    192  
     134      t_bo(:,:) = t_bo(:,:) + rt0                          ! conversion to Kelvin 
     135 
     136      ! Hemispheric index 
     137      ! MV 2011 new initialization 
    193138      DO jj = 1, jpj 
    194139         DO ji = 1, jpi 
    195  
    196             !--- Northern hemisphere 
    197             !---------------------------------------------------------------- 
    198140            IF( fcor(ji,jj) >= 0._wp ) THEN     
    199  
    200                !----------------------- 
    201                ! Ice area / thickness 
    202                !----------------------- 
    203  
    204                IF ( jpl .EQ. 1) THEN ! one category 
    205  
    206                   DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) ! loop over ice thickness categories 
    207                      a_i(ji,jj,jl)    = zidto(ji,jj) * aginn_u 
    208                      ht_i(ji,jj,jl)   = zidto(ji,jj) * hginn_u 
    209                      v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    210                   END DO 
    211  
    212                ELSE ! several categories 
    213  
    214                   DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) ! loop over ice thickness categories 
    215                      zhin(1)          = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    216                      a_i(ji,jj,jl)    = zidto(ji,jj) * MAX( zgfactorn(1) * exp(-(zhin(1)-hginn_u)* &  
    217                         (zhin(1)-hginn_u)/2.0) , epsi06) 
    218                      ! new line 
    219                      a_i(ji,jj,jl)    = zidto(ji,jj) * ( zan * zhin(1) * zhin(1) + zbn * zhin(1) ) 
    220                      ht_i(ji,jj,jl)   = zidto(ji,jj) * zhin(1)  
    221                      v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    222                   END DO 
    223  
    224                ENDIF 
    225  
    226  
    227 !!! 
    228                ! retour a LIMA_MEC 
    229                !              !ridged ice 
    230                !              zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
    231                !              hi_max(ice_cat_bounds(2,1)-1) = 0.0 
    232                !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) ! loop over ice thickness categories 
    233                !                 zhin(2)          = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    234                !                 a_i(ji,jj,jl)    = zidto(ji,jj) * MAX( zgfactorn(2) * exp(-(zhin(2)-hginn_d)* & 
    235                !                                    (zhin(2)-hginn_d)/2.0) , epsi06) 
    236                !                 ht_i(ji,jj,jl)   = zidto(ji,jj) * zhin(2)  
    237                !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    238                !              END DO 
    239                !              hi_max(ice_cat_bounds(2,1)-1) = zdummy 
    240  
    241                !              !rafted ice 
    242                !              jl = 6 
    243                !              a_i(ji,jj,jl)       = 0.0 
    244                !              ht_i(ji,jj,jl)      = 0.0 
    245                !              v_i(ji,jj,jl)       = 0.0 
    246                ! END retour a LIMA_MEC 
    247 !!! 
    248  
    249                DO jl = 1, jpl 
    250  
    251                   !------------- 
    252                   ! Snow depth 
    253                   !------------- 
    254                   ht_s(ji,jj,jl)   = zidto(ji,jj) * hninn 
    255                   v_s(ji,jj,jl)    = ht_s(ji,jj,jl)*a_i(ji,jj,jl) 
    256  
    257                   !--------------- 
    258                   ! Ice salinity 
    259                   !--------------- 
    260                   sm_i(ji,jj,jl)   = zidto(ji,jj) * sinn  + ( 1.0 - zidto(ji,jj) ) * 0.1 
    261                   smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    262  
    263                   !---------- 
    264                   ! Ice age 
    265                   !---------- 
    266                   o_i(ji,jj,jl)    = zidto(ji,jj) * 1.0   + ( 1.0 - zidto(ji,jj) ) 
    267                   oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl) 
    268  
    269                   !------------------------------ 
    270                   ! Sea ice surface temperature 
    271                   !------------------------------ 
    272  
    273                   t_su(ji,jj,jl)   = zidto(ji,jj) * 270.0 + ( 1.0 - zidto(ji,jj) ) * t_bo(ji,jj) 
    274  
    275                   !------------------------------------ 
    276                   ! Snow temperature and heat content 
    277                   !------------------------------------ 
    278  
    279                   DO jk = 1, nlay_s 
    280                      t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1.0 - zidto(ji,jj) ) * rtt 
    281                      ! Snow energy of melting 
    282                      e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    283                      ! Change dimensions 
    284                      e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    285                      ! Multiply by volume, so that heat content in 10^9 Joules 
    286                      e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * & 
    287                         v_s(ji,jj,jl)  / nlay_s 
    288                   END DO !jk 
    289  
    290                   !----------------------------------------------- 
    291                   ! Ice salinities, temperature and heat content  
    292                   !----------------------------------------------- 
    293  
    294                   DO jk = 1, nlay_i 
    295                      t_i(ji,jj,jk,jl) = zidto(ji,jj)*270.00 + ( 1.0 - zidto(ji,jj) ) * rtt  
    296                      s_i(ji,jj,jk,jl) = zidto(ji,jj) * sinn + ( 1.0 - zidto(ji,jj) ) * 0.1 
    297                      ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    298  
    299                      ! heat content per unit volume 
    300                      e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * & 
    301                         (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    302                         +   lfus    * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) & 
    303                         - rcp      * ( ztmelts - rtt ) & 
    304                         ) 
    305  
    306                      ! Correct dimensions to avoid big values 
    307                      e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    308  
    309                      ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    310                      e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * &  
    311                         area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / & 
    312                         nlay_i 
    313                   END DO ! jk 
    314  
    315                END DO ! jl  
    316  
    317             ELSE ! on fcor  
    318  
    319                !--- Southern hemisphere 
    320                !---------------------------------------------------------------- 
    321  
    322                !----------------------- 
    323                ! Ice area / thickness 
    324                !----------------------- 
    325  
    326                IF ( jpl .EQ. 1) THEN ! one category 
    327  
    328                   DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) ! loop over ice thickness categories 
    329                      a_i(ji,jj,jl)    = zidto(ji,jj) * agins_u 
    330                      ht_i(ji,jj,jl)   = zidto(ji,jj) * hgins_u 
    331                      v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    332                   END DO 
    333  
    334                ELSE ! several categories 
    335  
    336                   !level ice 
    337                   DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) !over thickness categories 
    338  
    339                      zhis(1)       = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    340                      a_i(ji,jj,jl) = zidto(ji,jj) * MAX( zgfactors(1) * exp(-(zhis(1)-hgins_u) * &  
    341                         (zhis(1)-hgins_u)/2.0) , epsi06 ) 
    342                      ! new line square distribution volume conserving 
    343                      a_i(ji,jj,jl)    = zidto(ji,jj) * ( zas * zhis(1) * zhis(1) + zbs * zhis(1) ) 
    344                      ht_i(ji,jj,jl)   = zidto(ji,jj) * zhis(1)  
    345                      v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    346  
    347                   END DO ! jl 
    348  
    349                ENDIF 
    350  
    351 !!! 
    352                ! retour a LIMA_MEC 
    353                !              !ridged ice 
    354                !              zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
    355                !              hi_max(ice_cat_bounds(2,1)-1) = 0.0 
    356                !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) !over thickness categories 
    357                !                 zhis(2)       = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    358                !                 a_i(ji,jj,jl) = zidto(ji,jj)*MAX( zgfactors(2)   & 
    359                !                    &          * exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0), epsi06 ) 
    360                !                 ht_i(ji,jj,jl)   = zidto(ji,jj) * zhis(2)  
    361                !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    362                !              END DO 
    363                !              hi_max(ice_cat_bounds(2,1)-1) = zdummy 
    364  
    365                !              !rafted ice 
    366                !              jl = 6 
    367                !              a_i(ji,jj,jl)       = 0.0 
    368                !              ht_i(ji,jj,jl)      = 0.0 
    369                !              v_i(ji,jj,jl)       = 0.0 
    370                ! END retour a LIMA_MEC 
    371 !!! 
    372  
    373                DO jl = 1, jpl !over thickness categories 
    374  
    375                   !--------------- 
    376                   ! Snow depth 
    377                   !--------------- 
    378  
    379                   ht_s(ji,jj,jl)   = zidto(ji,jj) * hnins 
    380                   v_s(ji,jj,jl)    = ht_s(ji,jj,jl)*a_i(ji,jj,jl) 
    381  
    382                   !--------------- 
    383                   ! Ice salinity 
    384                   !--------------- 
    385  
    386                   sm_i(ji,jj,jl)   = zidto(ji,jj) * sins  + ( 1.0 - zidto(ji,jj) ) * 0.1 
    387                   smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    388  
    389                   !---------- 
    390                   ! Ice age 
    391                   !---------- 
    392  
    393                   o_i(ji,jj,jl)    = zidto(ji,jj) * 1.0   + ( 1.0 - zidto(ji,jj) ) 
    394                   oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl) 
    395  
    396                   !------------------------------ 
    397                   ! Sea ice surface temperature 
    398                   !------------------------------ 
    399  
    400                   t_su(ji,jj,jl)   = zidto(ji,jj) * 270.0 + ( 1.0 - zidto(ji,jj) ) * t_bo(ji,jj) 
    401  
    402                   !---------------------------------- 
    403                   ! Snow temperature / heat content 
    404                   !---------------------------------- 
    405  
    406                   DO jk = 1, nlay_s 
    407                      t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1.0 - zidto(ji,jj) ) * rtt 
    408                      ! Snow energy of melting 
    409                      e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    410                      ! Change dimensions 
    411                      e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    412                      ! Multiply by volume, so that heat content in 10^9 Joules 
    413                      e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * & 
    414                         v_s(ji,jj,jl)  / nlay_s 
    415                   END DO 
    416  
    417                   !--------------------------------------------- 
    418                   ! Ice temperature, salinity and heat content 
    419                   !--------------------------------------------- 
    420  
    421                   DO jk = 1, nlay_i 
    422                      t_i(ji,jj,jk,jl) = zidto(ji,jj)*270.00 + ( 1.0 - zidto(ji,jj) ) * rtt  
    423                      s_i(ji,jj,jk,jl) = zidto(ji,jj) * sins + ( 1.0 - zidto(ji,jj) ) * 0.1 
    424                      ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    425  
    426                      ! heat content per unit volume 
    427                      e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * & 
    428                         (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    429                         +   lfus  * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) & 
    430                         - rcp      * ( ztmelts - rtt ) & 
    431                         ) 
    432  
    433                      ! Correct dimensions to avoid big values 
    434                      e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    435  
    436                      ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    437                      e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * &  
    438                         area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / & 
    439                         nlay_i 
    440                   END DO !jk 
    441  
    442                END DO ! jl  
    443  
    444             ENDIF ! on fcor 
    445  
     141               zhemis(ji,jj) = 1 ! Northern hemisphere 
     142            ELSE 
     143               zhemis(ji,jj) = 2 ! Southern hemisphere 
     144            ENDIF 
    446145         END DO 
    447146      END DO 
    448  
    449       !-------------------------------------------------------------------- 
    450       ! 3) Global ice variables for output diagnostics                    |  
    451       !-------------------------------------------------------------------- 
    452  
    453       fsbbq (:,:)     = 0.e0 
    454       u_ice (:,:)     = 0.e0 
    455       v_ice (:,:)     = 0.e0 
    456       stress1_i(:,:)  = 0.0 
    457       stress2_i(:,:)  = 0.0 
    458       stress12_i(:,:) = 0.0 
    459  
    460       !-------------------------------------------------------------------- 
    461       ! 4) Moments for advection 
    462       !-------------------------------------------------------------------- 
    463  
    464       sxopw (:,:) = 0.e0  
    465       syopw (:,:) = 0.e0  
    466       sxxopw(:,:) = 0.e0  
    467       syyopw(:,:) = 0.e0  
    468       sxyopw(:,:) = 0.e0 
    469  
    470       sxice (:,:,:)  = 0.e0   ;   sxsn (:,:,:)  = 0.e0   ;   sxa  (:,:,:)  = 0.e0 
    471       syice (:,:,:)  = 0.e0   ;   sysn (:,:,:)  = 0.e0   ;   sya  (:,:,:)  = 0.e0 
    472       sxxice(:,:,:)  = 0.e0   ;   sxxsn(:,:,:)  = 0.e0   ;   sxxa (:,:,:)  = 0.e0 
    473       syyice(:,:,:)  = 0.e0   ;   syysn(:,:,:)  = 0.e0   ;   syya (:,:,:)  = 0.e0 
    474       sxyice(:,:,:)  = 0.e0   ;   sxysn(:,:,:)  = 0.e0   ;   sxya (:,:,:)  = 0.e0 
    475  
    476       sxc0  (:,:,:)  = 0.e0   ;   sxe  (:,:,:,:)= 0.e0    
    477       syc0  (:,:,:)  = 0.e0   ;   sye  (:,:,:,:)= 0.e0    
    478       sxxc0 (:,:,:)  = 0.e0   ;   sxxe (:,:,:,:)= 0.e0    
    479       syyc0 (:,:,:)  = 0.e0   ;   syye (:,:,:,:)= 0.e0    
    480       sxyc0 (:,:,:)  = 0.e0   ;   sxye (:,:,:,:)= 0.e0    
    481  
    482       sxsal  (:,:,:)  = 0.e0 
    483       sysal  (:,:,:)  = 0.e0 
    484       sxxsal (:,:,:)  = 0.e0 
    485       syysal (:,:,:)  = 0.e0 
    486       sxysal (:,:,:)  = 0.e0 
    487  
    488       !-------------------------------------------------------------------- 
    489       ! 5) Lateral boundary conditions                                    |  
     147      ! END MV 2011 new initialization 
     148 
     149      !-------------------------------------------------------------------- 
     150      ! 3) Initialization of sea ice state variables 
     151      !-------------------------------------------------------------------- 
     152 
     153      !----------------------------- 
     154      ! 3.1) Hemisphere-dependent arrays 
     155      !----------------------------- 
     156      ! assign initial thickness, concentration, snow depth and salinity to 
     157      ! an hemisphere-dependent array 
     158      zhm_i_ini(1) = hginn ; zhm_i_ini(2) = hgins  ! ice thickness 
     159      zat_i_ini(1) = aginn ; zat_i_ini(2) = agins  ! ice concentration 
     160      zvt_i_ini(:) = zhm_i_ini(:) * zat_i_ini(:)   ! ice volume 
     161      zhm_s_ini(1) = hninn ; zhm_s_ini(2) = hnins  ! snow depth 
     162      zsm_i_ini(1) = sinn  ; zsm_i_ini(2) = sins   ! bulk ice salinity 
     163 
     164      !--------------------------------------------------------------------- 
     165      ! 3.2) Distribute ice concentration and thickness into the categories 
     166      !--------------------------------------------------------------------- 
     167      ! a gaussian distribution for ice concentration is used 
     168      ! then we check whether the distribution fullfills 
     169      ! volume and area conservation, positivity and ice categories bounds 
     170      DO i_hemis = 1, 2 
     171 
     172      ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0 
     173 
     174      ! note for the great nemo engineers:  
     175      ! only very few of the WRITE statements are necessary for the reference version 
     176      ! they were one day useful, but now i personally doubt of their 
     177      ! potential for bringing anything useful 
     178 
     179      DO i_fill = jpl, 1, -1 
     180         IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN 
     181            !---------------------------- 
     182            ! fill the i_fill categories 
     183            !---------------------------- 
     184            ! *** 1 category to fill 
     185            IF ( i_fill .EQ. 1 ) THEN 
     186               zht_i_ini(1,i_hemis)       = zhm_i_ini(i_hemis) 
     187               za_i_ini(1,i_hemis)        = zat_i_ini(i_hemis) 
     188               zht_i_ini(2:jpl,i_hemis)   = 0._wp 
     189               za_i_ini(2:jpl,i_hemis)    = 0._wp 
     190            ELSE 
     191 
     192            ! *** >1 categores to fill 
     193            !--- Ice thicknesses in the i_fill - 1 first categories 
     194               DO jl = 1, i_fill - 1 
     195                  zht_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
     196               END DO 
     197 
     198            !--- jl0: most likely index where cc will be maximum 
     199               DO jl = 1, jpl 
     200                  IF ( ( zhm_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
     201                       ( zhm_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
     202                     jl0 = jl 
     203                  ENDIF 
     204               END DO 
     205               jl0 = MIN(jl0, i_fill) 
     206 
     207            !--- Concentrations 
     208               za_i_ini(jl0,i_hemis)      = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 
     209               DO jl = 1, i_fill - 1 
     210                  IF ( jl .NE. jl0 ) THEN 
     211                     zsigma               = 0.5 * zhm_i_ini(i_hemis) 
     212                     zarg                 = ( zht_i_ini(jl,i_hemis) - zhm_i_ini(i_hemis) ) / zsigma 
     213                     za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 
     214                  ENDIF 
     215               END DO  
     216 
     217               zA = 0. ! sum of the areas in the jpl categories  
     218               DO jl = 1, i_fill - 1 
     219                 zA = zA + za_i_ini(jl,i_hemis) 
     220               END DO 
     221               za_i_ini(i_fill,i_hemis)   = zat_i_ini(i_hemis) - zA ! ice conc in the last category 
     222               IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
     223          
     224            !--- Ice thickness in the last category 
     225               zV = 0. ! sum of the volumes of the N-1 categories 
     226               DO jl = 1, i_fill - 1 
     227                  zV = zV + za_i_ini(jl,i_hemis)*zht_i_ini(jl,i_hemis) 
     228               END DO 
     229               zht_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
     230               IF ( i_fill .LT. jpl ) zht_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
     231 
     232            !--- volumes 
     233               zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zht_i_ini(:,i_hemis) 
     234               IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
     235 
     236            ENDIF ! i_fill 
     237 
     238            !--------------------- 
     239            ! Compatibility tests 
     240            !--------------------- 
     241            ! Test 1: area conservation 
     242            zA_cons = SUM(za_i_ini(:,i_hemis)) ; zconv = ABS(zat_i_ini(i_hemis) - zA_cons ) 
     243            IF ( zconv .LT. 1.0e-6 ) THEN 
     244               ztest_1 = 1 
     245            ELSE  
     246              ! this write is useful 
     247              IF(lwp)  WRITE(numout,*) ' * TEST1 AREA NOT CONSERVED *** zA_cons = ', zA_cons,' zat_i_ini = ',zat_i_ini(i_hemis)  
     248               ztest_1 = 0 
     249            ENDIF 
     250 
     251            ! Test 2: volume conservation 
     252            zV_cons = SUM(zv_i_ini(:,i_hemis)) 
     253            zconv = ABS(zvt_i_ini(i_hemis) - zV_cons) 
     254 
     255            IF ( zconv .LT. 1.0e-6 ) THEN 
     256               ztest_2 = 1 
     257            ELSE 
     258              ! this write is useful 
     259              IF(lwp)  WRITE(numout,*) ' * TEST2 VOLUME NOT CONSERVED *** zV_cons = ', zV_cons, & 
     260                            ' zvt_i_ini = ', zvt_i_ini(i_hemis) 
     261               ztest_2 = 0 
     262            ENDIF 
     263 
     264            ! Test 3: thickness of the last category is in-bounds ? 
     265            IF ( zht_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
     266               ztest_3 = 1 
     267            ELSE 
     268               ! this write is useful 
     269               IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zht_i_ini(i_fill,i_hemis) = ', & 
     270               zht_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
     271               ztest_3 = 0 
     272            ENDIF 
     273 
     274            ! Test 4: positivity of ice concentrations 
     275            ztest_4 = 1 
     276            DO jl = 1, jpl 
     277               IF ( za_i_ini(jl,i_hemis) .LT. 0._wp ) THEN  
     278                  ! this write is useful 
     279                  IF(lwp) WRITE(numout,*) ' * TEST 4 POSITIVITY NOT OK FOR CAT ', jl, ' WITH A = ', za_i_ini(jl,i_hemis) 
     280                  ztest_4 = 0 
     281               ENDIF 
     282            END DO 
     283 
     284         ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4 
     285  
     286         ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 
     287 
     288      END DO ! i_fill 
     289 
     290      IF(lwp) THEN  
     291         WRITE(numout,*), ' ztests : ', ztests 
     292         IF ( ztests .NE. 4 ) THEN 
     293            WRITE(numout,*) 
     294            WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
     295            WRITE(numout,*), ' !!!! RED ALERT                  !!! ' 
     296            WRITE(numout,*), ' !!!! BIIIIP BIIIP BIIIIP BIIIIP !!!' 
     297            WRITE(numout,*), ' !!!! Something is wrong in the LIM3 initialization procedure ' 
     298            WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
     299            WRITE(numout,*) 
     300            WRITE(numout,*), ' *** ztests is not equal to 4 ' 
     301            WRITE(numout,*), ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
     302            WRITE(numout,*), ' zat_i_ini : ', zat_i_ini(i_hemis) 
     303            WRITE(numout,*), ' zhm_i_ini : ', zhm_i_ini(i_hemis) 
     304         ENDIF ! ztests .NE. 4 
     305      ENDIF 
     306       
     307      END DO ! i_hemis 
     308 
     309      !--------------------------------------------------------------------- 
     310      ! 3.3) Space-dependent arrays for ice state variables 
     311      !--------------------------------------------------------------------- 
     312 
     313      ! Ice concentration, thickness and volume, snow depth, ice 
     314      ! salinity, ice age, surface temperature 
     315      DO jl = 1, jpl ! loop over categories 
     316         DO jj = 1, jpj 
     317            DO ji = 1, jpi 
     318               a_i(ji,jj,jl)   = zidto(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
     319               ht_i(ji,jj,jl)  = zidto(ji,jj) * zht_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
     320               ht_s(ji,jj,jl)  = zidto(ji,jj) * zhm_s_ini(zhemis(ji,jj))     ! snow depth 
     321               sm_i(ji,jj,jl)  = zidto(ji,jj) * zsm_i_ini(zhemis(ji,jj))     ! salinity 
     322               o_i(ji,jj,jl)   = zidto(ji,jj) * 1._wp + ( 1._wp - zidto(ji,jj) ) ! age 
     323               t_su(ji,jj,jl)  = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * t_bo(ji,jj) ! surf temp 
     324  
     325               ! ice volume, snow volume, salt content, age content 
     326               v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume 
     327               v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume 
     328               smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 
     329               oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content 
     330            END DO ! ji 
     331         END DO ! jj 
     332      END DO ! jl 
     333 
     334      ! Snow temperature and heat content 
     335      DO jk = 1, nlay_s 
     336         DO jl = 1, jpl ! loop over categories 
     337            DO jj = 1, jpj 
     338               DO ji = 1, jpi 
     339                   t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * rtt 
     340                   ! Snow energy of melting 
     341                   e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
     342                   ! Change dimensions 
     343                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
     344                   ! Multiply by volume, so that heat content in 10^9 Joules 
     345                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
     346               END DO ! ji 
     347            END DO ! jj 
     348         END DO ! jl 
     349      END DO ! jk 
     350 
     351      ! Ice salinity, temperature and heat content 
     352      DO jk = 1, nlay_i 
     353         DO jl = 1, jpl ! loop over categories 
     354            DO jj = 1, jpj 
     355               DO ji = 1, jpi 
     356                   t_i(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1._wp - zidto(ji,jj) ) * rtt  
     357                   s_i(ji,jj,jk,jl) = zidto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min 
     358                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
     359 
     360                   ! heat content per unit volume 
     361                   e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     362                      +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
     363                      -   rcp     * ( ztmelts - rtt ) ) 
     364 
     365                   ! Correct dimensions to avoid big values 
     366                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
     367 
     368                   ! Mutliply by ice volume, and divide by number of layers  
     369                   ! to get heat content in 10^9 J 
     370                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 
     371               END DO ! ji 
     372            END DO ! jj 
     373         END DO ! jl 
     374      END DO ! jk 
     375 
     376      !-------------------------------------------------------------------- 
     377      ! 4) Global ice variables for output diagnostics                    |  
     378      !-------------------------------------------------------------------- 
     379      fsbbq (:,:)     = 0._wp 
     380      u_ice (:,:)     = 0._wp 
     381      v_ice (:,:)     = 0._wp 
     382      stress1_i(:,:)  = 0._wp 
     383      stress2_i(:,:)  = 0._wp 
     384      stress12_i(:,:) = 0._wp 
     385 
     386# if defined key_coupled 
     387      albege(:,:)   = 0.8 * tms(:,:) 
     388# endif 
     389 
     390      !-------------------------------------------------------------------- 
     391      ! 5) Moments for advection 
     392      !-------------------------------------------------------------------- 
     393 
     394      sxopw (:,:) = 0._wp  
     395      syopw (:,:) = 0._wp  
     396      sxxopw(:,:) = 0._wp  
     397      syyopw(:,:) = 0._wp  
     398      sxyopw(:,:) = 0._wp 
     399 
     400      sxice (:,:,:)  = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:)  = 0._wp 
     401      syice (:,:,:)  = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:)  = 0._wp 
     402      sxxice(:,:,:)  = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:)  = 0._wp 
     403      syyice(:,:,:)  = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:)  = 0._wp 
     404      sxyice(:,:,:)  = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:)  = 0._wp 
     405 
     406      sxc0  (:,:,:)  = 0._wp   ;   sxe  (:,:,:,:)= 0._wp    
     407      syc0  (:,:,:)  = 0._wp   ;   sye  (:,:,:,:)= 0._wp    
     408      sxxc0 (:,:,:)  = 0._wp   ;   sxxe (:,:,:,:)= 0._wp    
     409      syyc0 (:,:,:)  = 0._wp   ;   syye (:,:,:,:)= 0._wp    
     410      sxyc0 (:,:,:)  = 0._wp   ;   sxye (:,:,:,:)= 0._wp    
     411 
     412      sxsal  (:,:,:)  = 0._wp 
     413      sysal  (:,:,:)  = 0._wp 
     414      sxxsal (:,:,:)  = 0._wp 
     415      syysal (:,:,:)  = 0._wp 
     416      sxysal (:,:,:)  = 0._wp 
     417 
     418      !-------------------------------------------------------------------- 
     419      ! 6) Lateral boundary conditions                                    |  
    490420      !-------------------------------------------------------------------- 
    491421 
    492422      DO jl = 1, jpl 
     423 
    493424         CALL lbc_lnk( a_i(:,:,jl)  , 'T', 1. ) 
    494425         CALL lbc_lnk( v_i(:,:,jl)  , 'T', 1. ) 
    … …  
    496427         CALL lbc_lnk( smv_i(:,:,jl), 'T', 1. ) 
    497428         CALL lbc_lnk( oa_i(:,:,jl) , 'T', 1. ) 
    498          ! 
     429 
    499430         CALL lbc_lnk( ht_i(:,:,jl) , 'T', 1. ) 
    500431         CALL lbc_lnk( ht_s(:,:,jl) , 'T', 1. ) 
    … …  
    513444         a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl) 
    514445      END DO 
     446       
     447      at_i (:,:) = 0.0_wp 
     448      DO jl = 1, jpl 
     449         at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
     450      END DO 
    515451 
    516452      CALL lbc_lnk( at_i , 'T', 1. ) 
    … …  
    519455      CALL lbc_lnk( fsbbq  , 'T', 1. ) 
    520456      ! 
    521       CALL wrk_dealloc( jpm, zgfactorn, zgfactors, zhin, zhis ) 
     457      !-------------------------------------------------------------------- 
     458      ! 6) ????                                                           |  
     459      !-------------------------------------------------------------------- 
     460      tn_ice (:,:,:) = t_su (:,:,:) 
     461 
    522462      CALL wrk_dealloc( jpi, jpj, zidto ) 
    523       ! 
     463      CALL wrk_dealloc( jpi, jpj, zhemis ) 
     464      CALL wrk_dealloc( jpl,   2, zht_i_ini,  za_i_ini,  zv_i_ini ) 
     465      CALL wrk_dealloc(   2,      zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 
     466 
    524467   END SUBROUTINE lim_istate 
    525  
    526468 
    527469   SUBROUTINE lim_istate_init 
    … …  
    531473      !! ** Purpose : Definition of initial state of the ice  
    532474      !! 
    533       !! ** Method :   Read the namiceini namelist and check the parameter  
    534       !!             values called at the first timestep (nit000) 
    535       !! 
    536       !! ** input  :   namelist namiceini 
     475      !! ** Method : Read the namiceini namelist and check the parameter  
     476      !!       values called at the first timestep (nit000) 
     477      !! 
     478      !! ** input :  
     479      !!        Namelist namiceini 
     480      !! 
     481      !! history : 
     482      !!  8.5  ! 03-08 (C. Ethe) original code  
     483      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    537484      !!----------------------------------------------------------------------------- 
     485<<<<<<< .courant 
    538486      INTEGER :: ios                 ! Local integer output status for namelist read 
    539487      NAMELIST/namiceini/ ttest, hninn, hginn_u, aginn_u, hginn_d, aginn_d, hnins,   & 
    540488         &                hgins_u, agins_u, hgins_d, agins_d, sinn, sins 
     489======= 
     490      NAMELIST/namiceini/ ttest, hninn, hnins, hginn, hgins, aginn, agins, sinn, sins 
     491>>>>>>> .fusion-droit.r4160 
    541492      !!----------------------------------------------------------------------------- 
     493<<<<<<< .courant 
    542494      ! 
    543495      REWIND( numnam_ice_ref )              ! Namelist namiceini in reference namelist : Ice initial state 
    … …  
    549501902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in configuration namelist', lwp ) 
    550502      WRITE ( numoni, namiceini ) 
    551       ! 
    552       IF(lwp) THEN                        ! control print 
     503======= 
     504 
     505      ! Define the initial parameters 
     506      ! ------------------------- 
     507 
     508      ! Read Namelist namiceini  
     509      REWIND ( numnam_ice ) 
     510      READ   ( numnam_ice , namiceini ) 
     511>>>>>>> .fusion-droit.r4160 
     512      IF(lwp) THEN 
    553513         WRITE(numout,*) 
    554514         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    … …  
    556516         WRITE(numout,*) '   threshold water temp. for initial sea-ice    ttest      = ', ttest 
    557517         WRITE(numout,*) '   initial snow thickness in the north          hninn      = ', hninn 
    558          WRITE(numout,*) '   initial undef ice thickness in the north     hginn_u    = ', hginn_u 
    559          WRITE(numout,*) '   initial undef ice concentr. in the north     aginn_u    = ', aginn_u           
    560          WRITE(numout,*) '   initial  def  ice thickness in the north     hginn_d    = ', hginn_d 
    561          WRITE(numout,*) '   initial  def  ice concentr. in the north     aginn_d    = ', aginn_d           
    562518         WRITE(numout,*) '   initial snow thickness in the south          hnins      = ', hnins  
    563          WRITE(numout,*) '   initial undef ice thickness in the north     hgins_u    = ', hgins_u 
    564          WRITE(numout,*) '   initial undef ice concentr. in the north     agins_u    = ', agins_u           
    565          WRITE(numout,*) '   initial  def  ice thickness in the north     hgins_d    = ', hgins_d 
    566          WRITE(numout,*) '   initial  def  ice concentr. in the north     agins_d    = ', agins_d           
    567          WRITE(numout,*) '   initial  ice salinity       in the north     sinn       = ', sinn 
    568          WRITE(numout,*) '   initial  ice salinity       in the south     sins       = ', sins 
     519         WRITE(numout,*) '   initial ice thickness  in the north          hginn      = ', hginn 
     520         WRITE(numout,*) '   initial ice thickness  in the south          hgins      = ', hgins 
     521         WRITE(numout,*) '   initial ice concentr.  in the north          aginn      = ', aginn 
     522         WRITE(numout,*) '   initial ice concentr.  in the north          agins      = ', agins 
     523         WRITE(numout,*) '   initial  ice salinity  in the north          sinn       = ', sinn 
     524         WRITE(numout,*) '   initial  ice salinity  in the south          sins       = ', sins 
    569525      ENDIF 
    570       ! 
     526 
    571527   END SUBROUTINE lim_istate_init 
    572528 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4147 r4161  
    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 & fsalt_rpo 
     7   !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_mec 
    88   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
    99   !!---------------------------------------------------------------------- 
    … …  
    1212   !!   'key_lim3'                                      LIM-3 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    USE par_oce        ! ocean parameters 
    15    USE dom_oce        ! ocean domain 
    16    USE phycst         ! physical constants (ocean directory)  
    17    USE sbc_oce        ! surface boundary condition: ocean fields 
    18    USE thd_ice        ! LIM thermodynamics 
    19    USE ice            ! LIM variables 
    20    USE par_ice        ! LIM parameters 
    21    USE dom_ice        ! LIM domain 
    22    USE limthd_lac     ! LIM 
    23    USE limvar         ! LIM 
    24    USE limcons        ! LIM 
    25    USE in_out_manager ! I/O manager 
    26    USE lbclnk         ! lateral boundary condition - MPP exchanges 
    27    USE lib_mpp        ! MPP library 
    28    USE wrk_nemo       ! work arrays 
    29    USE prtctl         ! Print control 
    30    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    31    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     14   USE par_oce          ! ocean parameters 
     15   USE dom_oce          ! ocean domain 
     16   USE phycst           ! physical constants (ocean directory)  
     17   USE sbc_oce          ! surface boundary condition: ocean fields 
     18   USE thd_ice          ! LIM thermodynamics 
     19   USE ice              ! LIM variables 
     20   USE par_ice          ! LIM parameters 
     21   USE dom_ice          ! LIM domain 
     22   USE limthd_lac       ! LIM 
     23   USE limvar           ! LIM 
     24   USE limcons          ! LIM 
     25   USE in_out_manager   ! I/O manager 
     26   USE lbclnk           ! lateral boundary condition - MPP exchanges 
     27   USE lib_mpp          ! MPP library 
     28   USE wrk_nemo         ! work arrays 
     29   USE prtctl           ! Print control 
     30  ! Check budget (Rousset) 
     31   USE iom              ! I/O manager 
     32   USE lib_fortran     ! glob_sum 
     33   USE limdiahsb 
     34   USE timing          ! Timing 
    3235 
    3336   IMPLICIT NONE 
    … …  
    6265   REAL(wp), PARAMETER ::   krdgmin = 1.1_wp    ! min ridge thickness multiplier 
    6366   REAL(wp), PARAMETER ::   kraft   = 2.0_wp    ! rafting multipliyer 
     67   REAL(wp), PARAMETER ::   kamax   = 1.0 
    6468 
    6569   REAL(wp) ::   Cp                             !  
    … …  
    141145      REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    142146      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
     147      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) 
     148      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     149      ! mass and salt flux (clem) 
     150      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
    143151      !!----------------------------------------------------------------------------- 
     152      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    144153 
    145154      CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
     155 
     156      CALL wrk_alloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    146157 
    147158      IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only) 
    … …  
    151162         CALL prt_ctl(tab2d_1=divu_i, clinfo1=' lim_itd_me: divu_i : ', tab2d_2=delta_i, clinfo2=' delta_i : ') 
    152163      ENDIF 
     164 
     165      IF( ln_limdyn ) THEN          !   Start ridging and rafting   ! 
     166      ! ------------------------------- 
     167      !- check conservation (C Rousset) 
     168      IF (ln_limdiahsb) THEN 
     169         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     170         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     171         zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
     172         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     173      ENDIF 
     174      !- check conservation (C Rousset) 
     175      ! ------------------------------- 
     176 
     177      ! mass and salt flux init (clem) 
     178      zviold(:,:,:) = v_i(:,:,:) 
     179      zvsold(:,:,:) = v_s(:,:,:) 
     180      zsmvold(:,:,:) = smv_i(:,:,:) 
    153181 
    154182      !-----------------------------------------------------------------------------! 
    … …  
    204232            ! to give asum = 1.0 after ridging. 
    205233 
    206             divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice  ! asum found in ridgeprep 
     234            divu_adv(ji,jj) = ( kamax - asum(ji,jj) ) * r1_rdtice  ! asum found in ridgeprep 
    207235 
    208236            IF( divu_adv(ji,jj) < 0._wp )   closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) ) 
    … …  
    288316         DO jj = 1, jpj 
    289317            DO ji = 1, jpi 
    290                IF (ABS(asum(ji,jj) - 1.0) .LT. epsi11) THEN 
     318               IF (ABS(asum(ji,jj) - kamax ) .LT. epsi11) THEN 
    291319                  closing_net(ji,jj) = 0._wp 
    292320                  opning     (ji,jj) = 0._wp 
    293321               ELSE 
    294322                  iterate_ridging    = 1 
    295                   divu_adv   (ji,jj) = (1._wp - asum(ji,jj)) * r1_rdtice 
     323                  divu_adv   (ji,jj) = ( kamax - asum(ji,jj) ) * r1_rdtice 
    296324                  closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) ) 
    297325                  opning     (ji,jj) = MAX( 0._wp,  divu_adv(ji,jj) ) 
    … …  
    330358         DO ji = 1, jpi 
    331359 
    332             IF( ABS( asum(ji,jj) - 1.0 ) > epsi11 )  asum_error = .true. 
     360            IF(ABS(asum(ji,jj) - kamax) > epsi11 ) asum_error = .true. 
    333361 
    334362            dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice 
    … …  
    349377      DO jj = 1, jpj 
    350378         DO ji = 1, jpi 
    351             IF( ABS( asum(ji,jj) - 1._wp )  >  epsi11 ) THEN   ! there is a bug 
     379            IF( ABS( asum(ji,jj) - kamax)  >  epsi11 ) THEN   ! there is a bug 
    352380               WRITE(numout,*) ' ' 
    353381               WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj) 
    … …  
    377405      CALL lim_var_glo2eqv 
    378406      CALL lim_itd_me_zapsmall 
     407 
     408      !-------------------------------- 
     409      ! Update mass/salt fluxes (clem) 
     410      !-------------------------------- 
     411      DO jl = 1, jpl 
     412         DO jj = 1, jpj  
     413            DO ji = 1, jpi 
     414               diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 
     415               rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
     416               rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
     417               sfx_mec(ji,jj) = sfx_mec(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic * r1_rdtice  
     418            END DO 
     419         END DO 
     420      END DO 
    379421 
    380422      !----------------- 
    … …  
    425467      ENDIF 
    426468 
     469      ! ------------------------------- 
     470      !- check conservation (C Rousset) 
     471      IF (ln_limdiahsb) THEN 
     472         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     473         zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     474  
     475         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
     476         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
     477 
     478         zchk_vmin = glob_min(v_i) 
     479         zchk_amax = glob_max(SUM(a_i,dim=3)) 
     480         zchk_amin = glob_min(a_i) 
     481        
     482         IF(lwp) THEN 
     483            IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_me) = ',(zchk_v_i * rday) 
     484            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_me) = ',(zchk_smv * rday) 
     485            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_me) = ',(zchk_vmin * 1.e-3) 
     486            IF ( zchk_amax >  kamax+epsi10  ) WRITE(numout,*) 'violation a_i>amax            (limitd_me) = ',zchk_amax 
     487            IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limitd_me) = ',zchk_amin 
     488         ENDIF 
     489      ENDIF 
     490      !- check conservation (C Rousset) 
     491      ! ------------------------------- 
     492 
    427493      !-------------------------! 
    428494      ! Back to initial values 
    … …  
    448514 
    449515      ! heat content has to be corrected before ice volume 
    450       DO jl = 1, jpl 
    451          DO jk = 1, nlay_i 
    452             DO jj = 1, jpj 
    453                DO ji = 1, jpi 
    454                   IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. & 
    455                      ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN 
    456                      old_e_i(ji,jj,jk,jl)   = d_e_i_trp(ji,jj,jk,jl) 
    457                      d_e_i_trp(ji,jj,jk,jl) = 0._wp 
    458                   ENDIF 
    459                END DO 
    460             END DO 
    461          END DO 
    462       END DO 
    463  
    464       DO jl = 1, jpl 
    465          DO jj = 1, jpj 
    466             DO ji = 1, jpi 
    467                IF(  old_v_i  (ji,jj,jl) < epsi06  .AND. & 
    468                     d_v_i_trp(ji,jj,jl) > epsi06    ) THEN 
    469                   old_v_i   (ji,jj,jl)   = d_v_i_trp(ji,jj,jl) 
    470                   d_v_i_trp (ji,jj,jl)   = 0._wp 
    471                   old_a_i   (ji,jj,jl)   = d_a_i_trp(ji,jj,jl) 
    472                   d_a_i_trp (ji,jj,jl)   = 0._wp 
    473                   old_v_s   (ji,jj,jl)   = d_v_s_trp(ji,jj,jl) 
    474                   d_v_s_trp (ji,jj,jl)   = 0._wp 
    475                   old_e_s   (ji,jj,1,jl) = d_e_s_trp(ji,jj,1,jl) 
    476                   d_e_s_trp (ji,jj,1,jl) = 0._wp 
    477                   old_oa_i  (ji,jj,jl)   = d_oa_i_trp(ji,jj,jl) 
    478                   d_oa_i_trp(ji,jj,jl)   = 0._wp 
    479                   IF(  num_sal == 2  )   old_smv_i(ji,jj,jl) = d_smv_i_trp(ji,jj,jl) 
    480                   d_smv_i_trp(ji,jj,jl)  = 0._wp 
    481                ENDIF 
    482             END DO 
    483          END DO 
    484       END DO 
     516!clem@order 
     517!      DO jl = 1, jpl 
     518!         DO jk = 1, nlay_i 
     519!            DO jj = 1, jpj 
     520!               DO ji = 1, jpi 
     521!                  IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. & 
     522!                     ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN 
     523!                     old_e_i(ji,jj,jk,jl)   = d_e_i_trp(ji,jj,jk,jl) 
     524!                     d_e_i_trp(ji,jj,jk,jl) = 0._wp 
     525!                  ENDIF 
     526!               END DO 
     527!            END DO 
     528!         END DO 
     529!      END DO 
     530! 
     531!      DO jl = 1, jpl 
     532!         DO jj = 1, jpj 
     533!            DO ji = 1, jpi 
     534!               IF(  old_v_i  (ji,jj,jl) < epsi06  .AND. & 
     535!                    d_v_i_trp(ji,jj,jl) > epsi06    ) THEN 
     536!                  old_v_i   (ji,jj,jl)   = d_v_i_trp(ji,jj,jl) 
     537!                  d_v_i_trp (ji,jj,jl)   = 0._wp 
     538!                  old_a_i   (ji,jj,jl)   = d_a_i_trp(ji,jj,jl) 
     539!                  d_a_i_trp (ji,jj,jl)   = 0._wp 
     540!                  old_v_s   (ji,jj,jl)   = d_v_s_trp(ji,jj,jl) 
     541!                  d_v_s_trp (ji,jj,jl)   = 0._wp 
     542!                  old_e_s   (ji,jj,1,jl) = d_e_s_trp(ji,jj,1,jl) 
     543!                  d_e_s_trp (ji,jj,1,jl) = 0._wp 
     544!                  old_oa_i  (ji,jj,jl)   = d_oa_i_trp(ji,jj,jl) 
     545!                  d_oa_i_trp(ji,jj,jl)   = 0._wp 
     546!                  IF(  num_sal == 2  )   old_smv_i(ji,jj,jl) = d_smv_i_trp(ji,jj,jl) 
     547!                  d_smv_i_trp(ji,jj,jl)  = 0._wp 
     548!               ENDIF 
     549!            END DO 
     550!         END DO 
     551!      END DO 
     552!clem@order 
     553      ENDIF  ! ln_limdyn=.true. 
    485554      ! 
    486555      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    487556      ! 
     557      CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
     558      ! 
     559      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
    488560   END SUBROUTINE lim_itd_me 
    489561 
    … …  
    10861158            afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 
    10871159 
    1088             IF (afrac(ji,jj) > 1.0 + epsi11) THEN  !riging 
     1160            IF (afrac(ji,jj) > kamax + epsi11) THEN  !riging 
    10891161               large_afrac = .true. 
    1090             ELSEIF (afrac(ji,jj) > 1.0) THEN  ! roundoff error 
    1091                afrac(ji,jj) = 1.0 
     1162            ELSEIF (afrac(ji,jj) > kamax) THEN  ! roundoff error 
     1163               afrac(ji,jj) = kamax 
    10921164            ENDIF 
    1093             IF (afrft(ji,jj) > 1.0 + epsi11) THEN !rafting 
     1165            IF (afrft(ji,jj) > kamax + epsi11) THEN !rafting 
    10941166               large_afrft = .true. 
    1095             ELSEIF (afrft(ji,jj) > 1.0) THEN  ! roundoff error 
    1096                afrft(ji,jj) = 1.0 
     1167            ELSEIF (afrft(ji,jj) > kamax) THEN  ! roundoff error 
     1168               afrft(ji,jj) = kamax 
    10971169            ENDIF 
    10981170 
    … …  
    11371209             
    11381210            !                                                             ! excess of salt is flushed into the ocean 
    1139             sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 
    1140  
    1141             rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic / rau0   ! increase in ice volume du to seawater frozen in voids 
    1142              
     1211            !sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 
     1212 
     1213            !rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic    ! gurvan: increase in ice volume du to seawater frozen in voids              
     1214 
    11431215            !------------------------------------             
    11441216            ! 3.6 Increment ridging diagnostics 
    … …  
    11501222            dardg1dt   (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj) 
    11511223            dardg2dt   (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj) 
    1152             diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) * r1_rdtice 
     1224            !clem diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) * r1_rdtice 
    11531225            opening    (ji,jj) = opening (ji,jj) + opning(ji,jj) * rdt_ice 
    11541226 
    … …  
    12171289 
    12181290               ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    1219                ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / nlay_i 
     1291               ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / REAL( nlay_i ) 
    12201292 
    12211293               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
    … …  
    12401312               ji = indxi(ij) 
    12411313               jj = indxj(ij) 
    1242                IF( afrac(ji,jj) > 1.0 + epsi11 ) THEN  
     1314               IF( afrac(ji,jj) > kamax + epsi11 ) THEN  
    12431315                  WRITE(numout,*) '' 
    12441316                  WRITE(numout,*) ' ardg > a_i' 
    … …  
    12521324               ji = indxi(ij) 
    12531325               jj = indxj(ij) 
    1254                IF( afrft(ji,jj) > 1.0 + epsi11 ) THEN  
     1326               IF( afrft(ji,jj) > kamax + epsi11 ) THEN  
    12551327                  WRITE(numout,*) '' 
    12561328                  WRITE(numout,*) ' arft > a_i' 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r3764 r4161  
    1919   !!   lim_itd_shiftice : 
    2020   !!---------------------------------------------------------------------- 
    21    USE par_oce        ! ocean parameters 
    22    USE dom_oce        ! ocean domain 
    23    USE phycst         ! physical constants (ocean directory)  
    24    USE ice            ! LIM-3 variables 
    25    USE par_ice        ! LIM-3 parameters 
    26    USE dom_ice        ! LIM-3 domain 
    27    USE thd_ice        ! LIM-3 thermodynamic variables 
    28    USE limthd_lac     ! LIM-3 lateral accretion 
    29    USE limvar         ! LIM-3 variables 
    30    USE limcons        ! LIM-3 conservation 
    31    USE prtctl         ! Print control 
    32    USE in_out_manager ! I/O manager 
    33    USE lib_mpp        ! MPP library 
    34    USE wrk_nemo       ! work arrays 
    35    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    36    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     21   USE dom_ice          ! LIM-3 domain 
     22   USE par_oce          ! ocean parameters 
     23   USE dom_oce          ! ocean domain 
     24   USE phycst           ! physical constants (ocean directory)  
     25   USE thd_ice          ! LIM-3 thermodynamic variables 
     26   USE ice              ! LIM-3 variables 
     27   USE par_ice          ! LIM-3 parameters 
     28   USE limthd_lac       ! LIM-3 lateral accretion 
     29   USE limvar           ! LIM-3 variables 
     30   USE limcons          ! LIM-3 conservation 
     31   USE prtctl           ! Print control 
     32   USE in_out_manager   ! I/O manager 
     33   USE lib_mpp          ! MPP library 
     34   USE wrk_nemo         ! work arrays 
     35   USE lib_fortran      ! to use key_nosignedzero 
     36   USE timing          ! Timing 
    3737 
    3838   IMPLICIT NONE 
    … …  
    4545   PUBLIC   lim_itd_shiftice 
    4646 
    47    REAL(wp) ::   epsi20 = 1e-20_wp   ! constant values 
    48    REAL(wp) ::   epsi13 = 1e-13_wp   ! 
    49    REAL(wp) ::   epsi10 = 1e-10_wp   ! 
     47   REAL(wp) ::   epsi20 = 1.e-20_wp   ! constant values 
     48   REAL(wp) ::   epsi13 = 1.e-13_wp   ! 
     49   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    5050 
    5151   !!---------------------------------------------------------------------- 
    52    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 
     52   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
    5353   !! $Id$ 
    5454   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6767      ! 
    6868      INTEGER ::   jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index          
    69  
    70       !!------------------------------------------------------------------ 
     69      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) 
     70      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     71      !!------------------------------------------------------------------ 
     72      IF( nn_timing == 1 )  CALL timing_start('limitd_th') 
     73 
     74      ! ------------------------------- 
     75      !- check conservation (C Rousset) 
     76      IF (ln_limdiahsb) THEN 
     77         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     78         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     79         zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
     80         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     81       ENDIF 
     82      !- check conservation (C Rousset) 
     83      ! ------------------------------- 
    7184 
    7285      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    107120      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)  
    108121      d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 
    109  
     122      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - old_oa_i (:,:,:) 
    110123      d_smv_i_thd(:,:,:) = 0._wp 
    111       IF( num_sal == 2  )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
     124      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
     125 
     126      ! diag only (clem) 
     127      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    112128 
    113129      IF(ln_ctl) THEN   ! Control print 
    … …  
    142158         END DO 
    143159      ENDIF 
    144  
     160      ! 
     161      ! ------------------------------- 
     162      !- check conservation (C Rousset) 
     163      IF( ln_limdiahsb ) THEN 
     164         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     165         zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     166  
     167         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
     168         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
     169 
     170         zchk_vmin = glob_min(v_i) 
     171         zchk_amax = glob_max(SUM(a_i,dim=3)) 
     172         zchk_amin = glob_min(a_i) 
     173 
     174         IF(lwp) THEN 
     175            IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_th) = ',(zchk_v_i * rday) 
     176            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_th) = ',(zchk_smv * rday) 
     177            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_th) = ',(zchk_vmin * 1.e-3) 
     178            IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limitd_th) = ',zchk_amax 
     179            IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limitd_th) = ',zchk_amin 
     180         ENDIF 
     181       ENDIF 
     182      !- check conservation (C Rousset) 
     183      ! ------------------------------- 
     184      ! 
    145185      !- Recover Old values 
    146       a_i(:,:,:)   = old_a_i(:,:,:) 
    147       v_s(:,:,:)   = old_v_s(:,:,:) 
    148       v_i(:,:,:)   = old_v_i(:,:,:) 
    149       e_s(:,:,:,:) = old_e_s(:,:,:,:) 
    150       e_i(:,:,:,:) = old_e_i(:,:,:,:) 
    151       ! 
     186      a_i(:,:,:)   = old_a_i (:,:,:) 
     187      v_s(:,:,:)   = old_v_s (:,:,:) 
     188      v_i(:,:,:)   = old_v_i (:,:,:) 
     189      e_s(:,:,:,:) = old_e_s (:,:,:,:) 
     190      e_i(:,:,:,:) = old_e_i (:,:,:,:) 
     191      !?? oa_i(:,:,:)  = old_oa_i(:,:,:) 
    152192      IF( num_sal == 2 )   smv_i(:,:,:) = old_smv_i(:,:,:) 
    153193      ! 
     194      IF( nn_timing == 1 )  CALL timing_stop('limitd_th') 
    154195   END SUBROUTINE lim_itd_th 
    155196   ! 
    … …  
    172213      ! 
    173214      INTEGER  ::   ji, jj, jl     ! dummy loop index 
    174       INTEGER  ::   zji, zjj, nd   ! local integer 
     215      INTEGER  ::   ii, ij         ! 2D corresponding indices to ji 
     216      INTEGER  ::   nd             ! local integer 
    175217      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars 
    176       REAL(wp) ::   zx2, zwk2, zda0, zetamax, zhimin   !   -      - 
     218      REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      - 
    177219      REAL(wp) ::   zx3,             zareamin, zindb   !   -      - 
    178220      CHARACTER (len = 15) :: fieldid 
    … …  
    210252      CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 
    211253 
    212       zhimin   = 0.1      !minimum ice thickness tolerated by the model 
    213254      zareamin = epsi10   !minimum area in thickness categories tolerated by the conceptors of the model 
    214255 
    … …  
    240281         DO jj = 1, jpj 
    241282            DO ji = 1, jpi 
    242                zindb             = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl)))     !0 if no ice and 1 if yes 
     283               zindb             = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl)+epsi10))     !0 if no ice and 1 if yes 
    243284               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX(a_i(ji,jj,jl),epsi10) * zindb 
    244                zindb             = 1.0-MAX(0.0,SIGN(1.0,-old_a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
     285               zindb             = 1.0-MAX(0.0,SIGN(1.0,-old_a_i(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes 
    245286               zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX(old_a_i(ji,jj,jl),epsi10) * zindb 
    246287               IF( a_i(ji,jj,jl) > 1e-6 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
    … …  
    285326      DO jl = klbnd, kubnd - 1 
    286327         DO ji = 1, nbrem 
    287             zji = nind_i(ji) 
    288             zjj = nind_j(ji) 
     328            ii = nind_i(ji) 
     329            ij = nind_j(ji) 
    289330            ! 
    290             IF ( ( zht_i_o(zji,zjj,jl)  .GT.epsi10 ) .AND. &  
    291                ( zht_i_o(zji,zjj,jl+1).GT.epsi10 ) ) THEN 
     331            IF ( ( zht_i_o(ii,ij,jl)  .GT.epsi10 ) .AND. &  
     332               ( zht_i_o(ii,ij,jl+1).GT.epsi10 ) ) THEN 
    292333               !interpolate between adjacent category growth rates 
    293                zslope = ( zdhice(zji,zjj,jl+1)     - zdhice(zji,zjj,jl) ) / & 
    294                   ( zht_i_o   (zji,zjj,jl+1) - zht_i_o   (zji,zjj,jl) ) 
    295                zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl) + & 
    296                   zslope * ( hi_max(jl) - zht_i_o(zji,zjj,jl) ) 
    297             ELSEIF (zht_i_o(zji,zjj,jl).gt.epsi10) THEN 
    298                zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl) 
    299             ELSEIF (zht_i_o(zji,zjj,jl+1).gt.epsi10) THEN 
    300                zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl+1) 
     334               zslope = ( zdhice(ii,ij,jl+1)     - zdhice(ii,ij,jl) ) / & 
     335                  ( zht_i_o   (ii,ij,jl+1) - zht_i_o   (ii,ij,jl) ) 
     336               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + & 
     337                  zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 
     338            ELSEIF (zht_i_o(ii,ij,jl).gt.epsi10) THEN 
     339               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 
     340            ELSEIF (zht_i_o(ii,ij,jl+1).gt.epsi10) THEN 
     341               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 
    301342            ELSE 
    302                zhbnew(zji,zjj,jl) = hi_max(jl) 
     343               zhbnew(ii,ij,jl) = hi_max(jl) 
    303344            ENDIF 
    304345         END DO 
    … …  
    307348         DO ji = 1, nbrem 
    308349            ! jl, ji 
    309             zji = nind_i(ji) 
    310             zjj = nind_j(ji) 
     350            ii = nind_i(ji) 
     351            ij = nind_j(ji) 
    311352            ! jl, ji 
    312             IF ( ( a_i(zji,zjj,jl) .GT.epsi10) .AND. &  
    313                ( ht_i(zji,zjj,jl).GE. zhbnew(zji,zjj,jl) ) & 
     353            IF ( ( a_i(ii,ij,jl) .GT.epsi10) .AND. &  
     354               ( ht_i(ii,ij,jl).GE. zhbnew(ii,ij,jl) ) & 
    314355               ) THEN 
    315                zremap_flag(zji,zjj) = 0 
    316             ELSEIF ( ( a_i(zji,zjj,jl+1) .GT. epsi10 ) .AND. & 
    317                ( ht_i(zji,zjj,jl+1).LE. zhbnew(zji,zjj,jl) ) & 
     356               zremap_flag(ii,ij) = 0 
     357            ELSEIF ( ( a_i(ii,ij,jl+1) .GT. epsi10 ) .AND. & 
     358               ( ht_i(ii,ij,jl+1).LE. zhbnew(ii,ij,jl) ) & 
    318359               ) THEN 
    319                zremap_flag(zji,zjj) = 0 
     360               zremap_flag(ii,ij) = 0 
    320361            ENDIF 
    321362 
    322363            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max   
    323364            ! jl, ji 
    324             IF (zhbnew(zji,zjj,jl).gt.hi_max(jl+1)) THEN 
    325                zremap_flag(zji,zjj) = 0 
     365            IF (zhbnew(ii,ij,jl).gt.hi_max(jl+1)) THEN 
     366               zremap_flag(ii,ij) = 0 
    326367            ENDIF 
    327368            ! jl, ji 
    328             IF (zhbnew(zji,zjj,jl).lt.hi_max(jl-1)) THEN 
    329                zremap_flag(zji,zjj) = 0 
     369            IF (zhbnew(ii,ij,jl).lt.hi_max(jl-1)) THEN 
     370               zremap_flag(ii,ij) = 0 
    330371            ENDIF 
    331372            ! jl, ji 
    … …  
    379420      !- 7.2 Area lost due to melting of thin ice (first category,  klbnd) 
    380421      DO ji = 1, nbrem 
    381          zji = nind_i(ji)  
    382          zjj = nind_j(ji)  
     422         ii = nind_i(ji)  
     423         ij = nind_j(ji)  
    383424 
    384425         !ji 
    385          IF (a_i(zji,zjj,klbnd) .gt. epsi10) THEN 
    386             zdh0 = zdhice(zji,zjj,klbnd) !decrease of ice thickness in the lower category 
     426         IF (a_i(ii,ij,klbnd) .gt. epsi10) THEN 
     427            zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category 
    387428            ! ji, a_i > epsi10 
    388429            IF (zdh0 .lt. 0.0) THEN !remove area from category 1 
    … …  
    391432 
    392433               !Integrate g(1) from 0 to dh0 to estimate area melted 
    393                zetamax = MIN(zdh0,hR(zji,zjj,klbnd)) - hL(zji,zjj,klbnd) 
     434               zetamax = MIN(zdh0,hR(ii,ij,klbnd)) - hL(ii,ij,klbnd) 
    394435               IF (zetamax.gt.0.0) THEN 
    395436                  zx1  = zetamax 
    396437                  zx2  = 0.5 * zetamax*zetamax  
    397                   zda0 = g1(zji,zjj,klbnd) * zx2 + g0(zji,zjj,klbnd) * zx1 !ice area removed 
     438                  zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed 
    398439                  ! Constrain new thickness <= ht_i 
    399                   zdamax = a_i(zji,zjj,klbnd) * &  
    400                      (1.0 - ht_i(zji,zjj,klbnd)/zht_i_o(zji,zjj,klbnd)) ! zdamax > 0 
     440                  zdamax = a_i(ii,ij,klbnd) * &  
     441                     (1.0 - ht_i(ii,ij,klbnd)/zht_i_o(ii,ij,klbnd)) ! zdamax > 0 
    401442                  !ice area lost due to melting of thin ice 
    402443                  zda0   = MIN(zda0, zdamax) 
    403444 
    404445                  ! Remove area, conserving volume 
    405                   ht_i(zji,zjj,klbnd) = ht_i(zji,zjj,klbnd) &  
    406                      * a_i(zji,zjj,klbnd) / ( a_i(zji,zjj,klbnd) - zda0 ) 
    407                   a_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd) - zda0 
    408                   v_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd)*ht_i(zji,zjj,klbnd) 
     446                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) &  
     447                     * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) 
     448                  a_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) - zda0 
     449                  v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd)*ht_i(ii,ij,klbnd) ! clem@useless ? 
    409450               ENDIF     ! zetamax > 0 
    410451               ! ji, a_i > epsi10 
    … …  
    412453            ELSE ! if ice accretion 
    413454               ! ji, a_i > epsi10; zdh0 > 0 
    414                IF ( ntyp .EQ. 1 ) zhbnew(zji,zjj,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
     455               IF ( ntyp .EQ. 1 ) zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
    415456               ! zhbnew was 0, and is shifted to the right to account for thin ice 
    416457               ! growth in openwater (F0 = f1) 
    417                IF ( ntyp .NE. 1 ) zhbnew(zji,zjj,0) = 0  
     458               IF ( ntyp .NE. 1 ) zhbnew(ii,ij,0) = 0  
    418459               ! in other types there is 
    419460               ! no open water growth (F0 = 0) 
    … …  
    446487 
    447488         DO ji = 1, nbrem 
    448             zji = nind_i(ji) 
    449             zjj = nind_j(ji) 
    450  
    451             IF (zhbnew(zji,zjj,jl) .gt. hi_max(jl)) THEN ! transfer from jl to jl+1 
     489            ii = nind_i(ji) 
     490            ij = nind_j(ji) 
     491 
     492            IF (zhbnew(ii,ij,jl) .gt. hi_max(jl)) THEN ! transfer from jl to jl+1 
    452493 
    453494               ! left and right integration limits in eta space 
    454                zvetamin(ji) = MAX(hi_max(jl), hL(zji,zjj,jl)) - hL(zji,zjj,jl) 
    455                zvetamax(ji) = MIN(zhbnew(zji,zjj,jl), hR(zji,zjj,jl)) - hL(zji,zjj,jl) 
    456                zdonor(zji,zjj,jl) = jl 
     495               zvetamin(ji) = MAX(hi_max(jl), hL(ii,ij,jl)) - hL(ii,ij,jl) 
     496               zvetamax(ji) = MIN(zhbnew(ii,ij,jl), hR(ii,ij,jl)) - hL(ii,ij,jl) 
     497               zdonor(ii,ij,jl) = jl 
    457498 
    458499            ELSE  ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    … …  
    460501               ! left and right integration limits in eta space 
    461502               zvetamin(ji) = 0.0 
    462                zvetamax(ji) = MIN(hi_max(jl), hR(zji,zjj,jl+1)) - hL(zji,zjj,jl+1) 
    463                zdonor(zji,zjj,jl) = jl + 1 
     503               zvetamax(ji) = MIN(hi_max(jl), hR(ii,ij,jl+1)) - hL(ii,ij,jl+1) 
     504               zdonor(ii,ij,jl) = jl + 1 
    464505 
    465506            ENDIF  ! zhbnew(jl) > hi_max(jl) 
    … …  
    475516            zwk2 = zwk2 * zetamax 
    476517            zx3  = 1.0/3.0 * (zwk2 - zwk1) 
    477             nd   = zdonor(zji,zjj,jl) 
    478             zdaice(zji,zjj,jl) = g1(zji,zjj,nd)*zx2 + g0(zji,zjj,nd)*zx1 
    479             zdvice(zji,zjj,jl) = g1(zji,zjj,nd)*zx3 + g0(zji,zjj,nd)*zx2 + & 
    480                zdaice(zji,zjj,jl)*hL(zji,zjj,nd) 
     518            nd   = zdonor(ii,ij,jl) 
     519            zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 
     520            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + & 
     521               zdaice(ii,ij,jl)*hL(ii,ij,nd) 
    481522 
    482523         END DO ! ji 
    … …  
    493534 
    494535      DO ji = 1, nbrem 
    495          zji = nind_i(ji) 
    496          zjj = nind_j(ji) 
    497          IF ( ( zhimin .GT. 0.0 ) .AND. &  
    498             ( ( a_i(zji,zjj,1) .GT. epsi10 ) .AND. ( ht_i(zji,zjj,1) .LT. zhimin ) ) & 
    499             ) THEN 
    500             a_i(zji,zjj,1)  = a_i(zji,zjj,1) * ht_i(zji,zjj,1) / zhimin  
    501             ht_i(zji,zjj,1) = zhimin 
    502             v_i(zji,zjj,1)  = a_i(zji,zjj,1)*ht_i(zji,zjj,1) 
     536         ii = nind_i(ji) 
     537         ij = nind_j(ji) 
     538         IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim ) ) THEN 
     539            a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim  
     540            ht_i(ii,ij,1) = hiclim 
     541            v_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem@useless 
    503542         ENDIF 
    504543      END DO !ji 
    … …  
    625664 
    626665      INTEGER ::   ji, jj, jl, jl2, jl1, jk   ! dummy loop indices 
    627       INTEGER ::   zji, zjj          ! indices when changing from 2D-1D is done 
     666      INTEGER ::   ii, ij          ! indices when changing from 2D-1D is done 
    628667 
    629668      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn 
    … …  
    759798 
    760799         DO ji = 1, nbrem  
    761             zji = nind_i(ji) 
    762             zjj = nind_j(ji) 
    763  
    764             jl1 = zdonor(zji,zjj,jl) 
    765             zindb             = MAX( 0.0 , SIGN( 1.0 , v_i(zji,zjj,jl1) - epsi10 ) ) 
    766             zworka(zji,zjj)   = zdvice(zji,zjj,jl) / MAX(v_i(zji,zjj,jl1),epsi10) * zindb 
     800            ii = nind_i(ji) 
     801            ij = nind_j(ji) 
     802 
     803            jl1 = zdonor(ii,ij,jl) 
     804            zindb             = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) ) 
     805            zworka(ii,ij)   = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * zindb 
    767806            IF( jl1 == jl) THEN   ;   jl2 = jl1+1 
    768807            ELSE                    ;   jl2 = jl  
    … …  
    773812            !-------------- 
    774813 
    775             a_i(zji,zjj,jl1) = a_i(zji,zjj,jl1) - zdaice(zji,zjj,jl) 
    776             a_i(zji,zjj,jl2) = a_i(zji,zjj,jl2) + zdaice(zji,zjj,jl) 
     814            a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl) 
     815            a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl) 
    777816 
    778817            !-------------- 
    … …  
    780819            !-------------- 
    781820 
    782             v_i(zji,zjj,jl1) = v_i(zji,zjj,jl1) - zdvice(zji,zjj,jl)  
    783             v_i(zji,zjj,jl2) = v_i(zji,zjj,jl2) + zdvice(zji,zjj,jl) 
     821            v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl)  
     822            v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl) 
    784823 
    785824            !-------------- 
    … …  
    787826            !-------------- 
    788827 
    789             zdvsnow          = v_s(zji,zjj,jl1) * zworka(zji,zjj) 
    790             v_s(zji,zjj,jl1) = v_s(zji,zjj,jl1) - zdvsnow 
    791             v_s(zji,zjj,jl2) = v_s(zji,zjj,jl2) + zdvsnow  
     828            zdvsnow          = v_s(ii,ij,jl1) * zworka(ii,ij) 
     829            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 
     830            v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow  
    792831 
    793832            !-------------------- 
    … …  
    795834            !-------------------- 
    796835 
    797             zdesnow              = e_s(zji,zjj,1,jl1) * zworka(zji,zjj) 
    798             e_s(zji,zjj,1,jl1)   = e_s(zji,zjj,1,jl1) - zdesnow 
    799             e_s(zji,zjj,1,jl2)   = e_s(zji,zjj,1,jl2) + zdesnow 
     836            zdesnow              = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
     837            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow 
     838            e_s(ii,ij,1,jl2)   = e_s(ii,ij,1,jl2) + zdesnow 
    800839 
    801840            !-------------- 
    … …  
    803842            !-------------- 
    804843 
    805             zdo_aice             = oa_i(zji,zjj,jl1) * zdaice(zji,zjj,jl) 
    806             oa_i(zji,zjj,jl1)    = oa_i(zji,zjj,jl1) - zdo_aice 
    807             oa_i(zji,zjj,jl2)    = oa_i(zji,zjj,jl2) + zdo_aice 
     844            zdo_aice             = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
     845            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice 
     846            oa_i(ii,ij,jl2)    = oa_i(ii,ij,jl2) + zdo_aice 
    808847 
    809848            !-------------- 
    … …  
    811850            !-------------- 
    812851 
    813             zdsm_vice            = smv_i(zji,zjj,jl1) * zworka(zji,zjj) 
    814             smv_i(zji,zjj,jl1)   = smv_i(zji,zjj,jl1) - zdsm_vice 
    815             smv_i(zji,zjj,jl2)   = smv_i(zji,zjj,jl2) + zdsm_vice 
     852            zdsm_vice            = smv_i(ii,ij,jl1) * zworka(ii,ij) 
     853            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice 
     854            smv_i(ii,ij,jl2)   = smv_i(ii,ij,jl2) + zdsm_vice 
    816855 
    817856            !--------------------- 
    … …  
    819858            !--------------------- 
    820859 
    821             zdaTsf               = t_su(zji,zjj,jl1) * zdaice(zji,zjj,jl) 
    822             zaTsfn(zji,zjj,jl1)  = zaTsfn(zji,zjj,jl1) - zdaTsf 
    823             zaTsfn(zji,zjj,jl2)  = zaTsfn(zji,zjj,jl2) + zdaTsf  
     860            zdaTsf               = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
     861            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf 
     862            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf  
    824863 
    825864         END DO                 ! ji 
    … …  
    832871!CDIR NODEP 
    833872            DO ji = 1, nbrem 
    834                zji = nind_i(ji) 
    835                zjj = nind_j(ji) 
    836  
    837                jl1 = zdonor(zji,zjj,jl) 
     873               ii = nind_i(ji) 
     874               ij = nind_j(ji) 
     875 
     876               jl1 = zdonor(ii,ij,jl) 
    838877               IF (jl1 .EQ. jl) THEN 
    839878                  jl2 = jl+1 
    … …  
    842881               ENDIF 
    843882 
    844                zdeice = e_i(zji,zjj,jk,jl1) * zworka(zji,zjj) 
    845                e_i(zji,zjj,jk,jl1) =  e_i(zji,zjj,jk,jl1) - zdeice 
    846                e_i(zji,zjj,jk,jl2) =  e_i(zji,zjj,jk,jl2) + zdeice  
     883               zdeice = e_i(ii,ij,jk,jl1) * zworka(ii,ij) 
     884               e_i(ii,ij,jk,jl1) =  e_i(ii,ij,jk,jl1) - zdeice 
     885               e_i(ii,ij,jk,jl2) =  e_i(ii,ij,jk,jl2) + zdeice  
    847886            END DO              ! ji 
    848887         END DO                 ! jk 
    … …  
    860899                  ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl)  
    861900                  t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl)  
    862                   zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl))) !0 if no ice and 1 if yes 
     901                  zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes 
    863902               ELSE 
    864903                  ht_i(ji,jj,jl)  = 0._wp 
    … …  
    9671006                  zshiftflag        = 1 
    9681007                  zdonor(ji,jj,jl)  = jl  
    969                   zdaice(ji,jj,jl)  = a_i(ji,jj,jl) 
    970                   zdvice(ji,jj,jl)  = v_i(ji,jj,jl) 
     1008                  ! begin TECLIM change 
     1009                  !zdaice(ji,jj,jl)  = a_i(ji,jj,jl) 
     1010                  !zdvice(ji,jj,jl)  = v_i(ji,jj,jl) 
     1011                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl)/2 
     1012                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1))/2 
     1013                  ! end TECLIM change  
    9711014               ENDIF 
    9721015            END DO                 ! ji 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90

    r3625 r4161  
    2626 
    2727   !!---------------------------------------------------------------------- 
    28    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     28   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    2929   !! $Id$ 
    3030   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r3791 r4161  
    4141   USE agrif_lim2_interp 
    4242#endif 
     43#if defined key_bdy 
     44   USE bdyice_lim 
     45#endif 
    4346 
    4447   IMPLICIT NONE 
    … …  
    5356#  include "vectopt_loop_substitute.h90" 
    5457   !!---------------------------------------------------------------------- 
    55    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     58   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    5659   !! $Id$ 
    5760   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    413416 
    414417               delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zzdst*zzdst ) * usecc2 )   
    415                deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 + (zdt(ji,jj)**2 + zzdst**2)*usecc2), creepl ) 
    416 !!gm faster to replace the line above with simply: 
    417 !!                deltat(ji,jj) = MAX( delta, creepl ) 
    418 !!gm end  
    419  
     418               ! MV rewriting 
     419               ! deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 + (zdt(ji,jj)**2 + zzdst**2)*usecc2), creepl ) 
     420               !!gm faster to replace the line above with simply: 
     421               !!                deltat(ji,jj) = MAX( delta, creepl ) 
     422               !!gm end   
     423               deltat(ji,jj) = delta + creepl 
     424               ! END MV 
    420425               !-Calculate stress tensor components zs1 and zs2  
    421426               !-at centre of grid cells (see section 3.5 of CICE user's guide). 
    … …  
    472477 
    473478         CALL lbc_lnk( zs12(:,:), 'F', 1. ) 
     479 
     480!#if defined key_bdy 
     481!         ! clem: change zs1, zs2, zs12 at the boundary for each iteration 
     482!         CALL bdy_ice_lim_dyn( 2, zs1, zs2, zs12 ) 
     483!         CALL lbc_lnk( zs1 (:,:), 'T', 1. ) 
     484!         CALL lbc_lnk( zs2 (:,:), 'T', 1. ) 
     485!         CALL lbc_lnk( zs12(:,:), 'F', 1. ) 
     486!#endif          
    474487 
    475488         ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 
    … …  
    520533 
    521534            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    522 #if defined key_agrif 
     535#if defined key_agrif && defined key_lim2 
    523536            CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
    524537#endif 
    … …  
    548561 
    549562            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    550 #if defined key_agrif 
     563#if defined key_agrif && defined key_lim2 
    551564            CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
    552565#endif 
    … …  
    577590 
    578591            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    579 #if defined key_agrif 
     592#if defined key_agrif && defined key_lim2 
    580593            CALL agrif_rhg_lim2( jter, nevp , 'V' ) 
    581594#endif 
    … …  
    608621 
    609622            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    610 #if defined key_agrif 
     623#if defined key_agrif && defined key_lim2 
    611624            CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
    612625#endif 
    613626 
    614627         ENDIF 
     628          
     629!#if defined key_bdy 
     630!         ! clem: change u_ice and v_ice at the boundary for each iteration 
     631!         CALL bdy_ice_lim_dyn( 1 ) 
     632!#endif          
    615633 
    616634         IF(ln_ctl) THEN 
    … …  
    624642         ENDIF 
    625643 
    626          !                                                   ! ==================== ! 
     644         !                                                ! ==================== ! 
    627645      END DO                                              !  end loop over jter  ! 
    628646      !                                                   ! ==================== ! 
    629  
    630647      ! 
    631648      !------------------------------------------------------------------------------! 
    632649      ! 4) Prevent ice velocities when the ice is thin 
    633650      !------------------------------------------------------------------------------! 
    634       ! 
    635       ! If the ice thickness is below 1cm then ice velocity should equal the 
     651      !clem : add hminrhg in the namelist 
     652      ! 
     653      ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 
    636654      ! ocean velocity,  
    637655      ! This prevents high velocity when ice is thin 
    … …  
    641659         DO ji = fs_2, fs_jpim1 
    642660            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) )  
    643             zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    644             IF ( zdummy .LE. 5.0e-2 ) THEN 
     661            !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
     662            zdummy = vt_i(ji,jj) 
     663            IF ( zdummy .LE. hminrhg ) THEN 
    645664               u_ice(ji,jj) = u_oce(ji,jj) 
    646665               v_ice(ji,jj) = v_oce(ji,jj) 
    … …  
    651670      CALL lbc_lnk( u_ice(:,:), 'U', -1. )  
    652671      CALL lbc_lnk( v_ice(:,:), 'V', -1. )  
    653 #if defined key_agrif 
     672#if defined key_agrif && defined key_lim2 
    654673      CALL agrif_rhg_lim2( nevp , nevp, 'U' ) 
    655674      CALL agrif_rhg_lim2( nevp , nevp, 'V' ) 
    656675#endif 
     676#if defined key_bdy 
     677      ! clem: change u_ice and v_ice at the boundary 
     678      CALL bdy_ice_lim_dyn( 1 ) 
     679#endif          
    657680 
    658681      DO jj = k_j1+1, k_jpj-1  
    659682         DO ji = fs_2, fs_jpim1 
    660683            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) )  
    661             zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    662             IF ( zdummy .LE. 5.0e-2 ) THEN 
     684            !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
     685            zdummy = vt_i(ji,jj) 
     686            IF ( zdummy .LE. hminrhg ) THEN 
    663687               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    664688                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    … …  
    683707            !- zds(:,:): shear on northeast corner of grid cells 
    684708            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) )  
    685             zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    686  
    687             IF ( zdummy .LE. 5.0e-2 ) THEN 
     709            !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
     710            zdummy = vt_i(ji,jj) 
     711            IF ( zdummy .LE. hminrhg ) THEN 
    688712 
    689713               zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    … …  
    719743                  &           - e1v( ji  , jj-1 ) * u_ice2(ji  ,jj-1)  ) / area(ji,jj) 
    720744 
    721                deltat(ji,jj) = SQRT(    zdd(ji,jj)*zdd(ji,jj)   &  
    722                   &                 + ( zdt(ji,jj)*zdt(ji,jj) + zdst(ji,jj)*zdst(ji,jj) ) * usecc2 &  
    723                   &                          ) + creepl 
    724  
     745!              deltat(ji,jj) = SQRT(    zdd(ji,jj)*zdd(ji,jj)   &  
     746!                  &                 + ( zdt(ji,jj)*zdt(ji,jj) + zdst(ji,jj)*zdst(ji,jj) ) * usecc2 &  
     747!                  &                          ) + creepl 
     748               ! MV rewriting 
     749               delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst(ji,jj)*zdst(ji,jj) ) * usecc2 )   
     750               deltat(ji,jj) = delta + creepl 
     751               ! END MV 
     752             
    725753            ENDIF ! zdummy 
    726754 
    … …  
    738766            divu_i (ji,jj) = zdd   (ji,jj) 
    739767            delta_i(ji,jj) = deltat(ji,jj) 
     768            ! begin TECLIM change  
     769            zdst(ji,jj)= (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &    
     770               &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         &    
     771               &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           &    
     772               &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) / area(ji,jj)  
    740773            shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst(ji,jj) * zdst(ji,jj) ) 
     774            ! end TECLIM change 
    741775         END DO 
    742776      END DO 
    743       CALL lbc_lnk( divu_i (:,:), 'T', 1. )      ! Lateral boundary condition 
     777 
     778      ! Lateral boundary condition 
     779      CALL lbc_lnk( divu_i (:,:), 'T', 1. ) 
    744780      CALL lbc_lnk( delta_i(:,:), 'T', 1. ) 
     781      ! CALL lbc_lnk( shear_i(:,:), 'F', 1. ) 
    745782      CALL lbc_lnk( shear_i(:,:), 'T', 1. ) 
    746783 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r3625 r4161  
    3838 
    3939   !!---------------------------------------------------------------------- 
    40    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     40   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    4141   !! $Id$ 
    4242   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    162162      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'     , v_ice      ) 
    163163      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'     , fsbbq      ) 
     164      CALL iom_rstput( iter, nitrst, numriw, 'iatte'     , iatte      ) ! clem modif 
     165      CALL iom_rstput( iter, nitrst, numriw, 'oatte'     , oatte      ) ! clem modif 
    164166      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  ) 
    165167      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i  ) 
    … …  
    340342      !Control of date 
    341343 
    342       IF( ( nit000 - INT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
     344      IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
    343345         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  & 
    344346         &                   '   verify the file or rerun with the value 0 for the',        & 
    345347         &                   '   control of time parameter  nrstdt' ) 
    346       IF( INT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
     348      IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
    347349         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nn_fsbc in ice restart',  & 
    348350         &                   '   verify the file or rerun with the value 0 for the',         & 
    … …  
    369371         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    370372         t_su(:,:,jl) = z2d(:,:) 
     373         tn_ice (:,:,:) = t_su (:,:,:) 
    371374      END DO 
    372375 
    … …  
    437440      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      ) 
    438441      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      ) 
     442      CALL iom_get( numrir, jpdom_autoglo, 'iatte'     , iatte      ) ! clem modif 
     443      CALL iom_get( numrir, jpdom_autoglo, 'oatte'     , oatte      ) ! clem modif 
    439444      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  ) 
    440445      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  ) 
    … …  
    563568      END DO 
    564569      ! 
    565       CALL iom_close( numrir ) 
     570      !clem CALL iom_close( numrir ) 
    566571      ! 
    567572      CALL wrk_dealloc( nlay_i, zs_zero ) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4148 r4161  
    1010   !!                 !                  + simplification of the ice-ocean stress calculation 
    1111   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
     12   !!             -   ! 2012    (D. Iovino) salt flux change 
     13   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux 
    1214   !!            3.5  ! 2012-10 (A. Coward, G. Madec) salt fluxes ; ice+snow mass 
    1315   !!---------------------------------------------------------------------- 
    … …  
    3537   USE prtctl           ! Print control 
    3638   USE cpl_oasis3, ONLY : lk_cpl 
     39   USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget 
    3740   USE oce,        ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass, sshu_b, sshv_b, sshu_n, sshv_n, sshf_n 
    3841   USE dom_ice,    ONLY : tms 
    … …  
    5760#  include "vectopt_loop_substitute.h90" 
    5861   !!---------------------------------------------------------------------- 
    59    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     62   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    6063   !! $Id$ 
    6164   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    99102      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    100103      ! 
    101       INTEGER  ::   ji, jj           ! dummy loop indices 
     104      INTEGER  ::   ji, jj, jl           ! dummy loop indices 
    102105      INTEGER  ::   ierr, ifvt, i1mfr, idfr           ! local integer 
    103106      INTEGER  ::   iflt, ial , iadv , ifral, ifrdv   !   -      - 
    … …  
    106109      REAL(wp) ::   zfcm1 , zfcm2                     !   -      - 
    107110      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
     111      REAL(wp) ::   zzfcm1, zfscmbq ! clem: for light penetration 
    108112      !!--------------------------------------------------------------------- 
    109113       
    … …  
    119123         DO ji = 1, jpi 
    120124            zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    121             ifvt    = zinda  *  MAX( rzero , SIGN( rone, -phicif  (ji,jj) ) )  !subscripts are bad here 
    122             i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - ( at_i(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) ) ) 
    123127            idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 
    124128            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt ) 
    … …  
    141145 
    142146            !   computation the solar flux at ocean surface 
    143             zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) 
     147            IF (lk_cpl) THEN ! be carfeful: not being tested yet 
     148               ! 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) ) 
     152               DO jl = 1, jpl 
     153                  zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 
     154               END DO 
     155            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) ) 
     158            ENDIF 
    144159            ! fstric     Solar flux transmitted trough the ice 
    145160            ! qsr        Net short wave heat flux on free ocean 
    146161            ! new line 
    147             fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 
     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) 
    148167 
    149168            !  computation the non solar heat flux at ocean surface 
    150             zfcm2 = - zfcm1                                                                     & ! ??? 
    151                &    + iflt    * fscmbq(ji,jj)                                                   & ! total ablation: heat given to the ocean 
     169            zfcm2 = - zzfcm1                                                                    & ! 
     170               &    + iflt    * zfscmbq                                                         & ! total ablation: heat given to the ocean 
    152171               &    + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   & 
    153172               &    + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice   & 
    … …  
    170189            !                           ! fdtcn : turbulent oceanic heat flux 
    171190 
    172 !!gm   this IF prevents the vertorisation of the whole loop 
    173             IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 
    174                WRITE(numout,*) ' lim_sbc : heat fluxes ' 
    175                WRITE(numout,*) ' qsr       : ', qsr(jiindx,jjindx) 
    176                WRITE(numout,*) ' pfrld     : ', pfrld(jiindx,jjindx) 
    177                WRITE(numout,*) ' fstric    : ', fstric (jiindx,jjindx) 
    178                WRITE(numout,*) 
    179                WRITE(numout,*) ' qns       : ', qns(jiindx,jjindx) 
    180                WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
    181                WRITE(numout,*) ' ifral     : ', ifral 
    182                WRITE(numout,*) ' ial       : ', ial   
    183                WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx) 
    184                WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx) 
    185                WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) * r1_rdtice 
    186                WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) * r1_rdtice 
    187                WRITE(numout,*) ' ifrdv     : ', ifrdv 
    188                WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindx,jjindx) 
    189                WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindx,jjindx) 
    190                WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) * r1_rdtice 
    191                WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) * r1_rdtice 
    192                WRITE(numout,*) ' ' 
    193                WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
    194                WRITE(numout,*) ' fhmec     : ', fhmec(jiindx,jjindx) 
    195                WRITE(numout,*) ' fheat_mec : ', fheat_mec(jiindx,jjindx) 
    196                WRITE(numout,*) ' fhbri     : ', fhbri(jiindx,jjindx) 
    197                WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 
    198             ENDIF 
    199 !!gm   end 
     191            !!gm   this IF prevents the vertorisation of the whole loop 
     192          !  IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 
     193          !     WRITE(numout,*) ' lim_sbc : heat fluxes ' 
     194          !     WRITE(numout,*) ' qsr       : ', qsr(jiindx,jjindx) 
     195          !     WRITE(numout,*) ' pfrld     : ', pfrld(jiindx,jjindx) 
     196          !     WRITE(numout,*) ' fstric    : ', fstric (jiindx,jjindx) 
     197          !     WRITE(numout,*) 
     198          !     WRITE(numout,*) ' qns       : ', qns(jiindx,jjindx) 
     199          !     WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
     200          !     WRITE(numout,*) ' ifral     : ', ifral 
     201          !     WRITE(numout,*) ' ial       : ', ial   
     202          !     WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx) 
     203          !     WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx) 
     204          !     !WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) * r1_rdtice 
     205          !     !WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) * r1_rdtice 
     206          !     WRITE(numout,*) ' ifrdv     : ', ifrdv 
     207          !     WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindx,jjindx) 
     208          !     WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindx,jjindx) 
     209          !     !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) * r1_rdtice 
     210          !     !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) * r1_rdtice 
     211          !     WRITE(numout,*) ' ' 
     212          !     WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
     213          !     WRITE(numout,*) ' fhmec     : ', fhmec(jiindx,jjindx) 
     214          !     WRITE(numout,*) ' fheat_mec : ', fheat_mec(jiindx,jjindx) 
     215          !     WRITE(numout,*) ' fhbri     : ', fhbri(jiindx,jjindx) 
     216          !     WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 
     217          !  ENDIF 
     218            !!gm   end 
    200219         END DO 
    201220      END DO 
    … …  
    218237 
    219238            !  computing freshwater exchanges at the ice/ocean interface 
    220             zemp =   emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
    221                &   - tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
    222                &   + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
    223                &   - fmmec(ji,jj)                                         ! snow falling when ridging 
     239            IF (lk_cpl) THEN  
     240               zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
     241                  &   - rdm_snw(ji,jj) / rdt_ice 
     242            ELSE 
     243               zemp =   emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
     244                  &   - tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
     245                  &   + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
     246                  &   - fmmec(ji,jj)                                         ! snow falling when ridging 
     247            ENDIF 
    224248 
    225249            ! mass flux at the ocean/ice interface (sea ice fraction) 
    … …  
    370394      !! ** input   : Namelist namicedia 
    371395      !!------------------------------------------------------------------- 
     396      REAL(wp) :: zsum, zarea 
    372397      ! 
    373398      INTEGER  ::   ji, jj                          ! dummy loop indices 
    … …  
    390415         END WHERE 
    391416      ENDIF 
     417      ! clem modif 
     418      iatte(:,:) = 1._wp 
     419      oatte(:,:) = 1._wp 
     420      ! 
    392421      !                                      ! embedded sea ice 
    393422      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    … …  
    435464      ENDIF 
    436465      ! 
     466!!?      IF( .NOT. ln_rstart ) THEN           ! delete the initial ssh below sea-ice area 
     467!!?         ! 
     468!!?         zarea     = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
     469!!?         zsum      = glob_sum( e1e2t(:,:) * ( snwice_mass(:,:) ) ) / zarea * r1_rau0 
     470!!?         sshn(:,:) = sshn(:,:) - zsum  
     471!!?         sshb(:,:) = sshb(:,:) - zsum 
     472!!?      ENDIF 
     473      ! 
     474 
    437475   END SUBROUTINE lim_sbc_init 
    438476 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90

    r3625 r4161  
    2020 
    2121   !!---------------------------------------------------------------------- 
    22    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 
     22   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
    2323   !! $Id$ 
    2424   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4147 r4161  
    1111   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 
    1212   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     13   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux 
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_lim3 
    … …  
    4041   USE prtctl         ! Print control 
    4142   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     43   USE timing         ! Timing 
    4244 
    4345   IMPLICIT NONE 
    … …  
    9294      REAL(wp) ::   zfntlat, zpareff, zareamin, zcoef   !    -         - 
    9395      REAL(wp), POINTER, DIMENSION(:,:) ::   zqlbsbq   ! link with lead energy budget qldif 
     96      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) 
     97      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    9498      !!------------------------------------------------------------------- 
     99      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    95100 
    96101      CALL wrk_alloc( jpi, jpj, zqlbsbq ) 
    97102    
     103      ! ------------------------------- 
     104      !- check conservation (C Rousset) 
     105      IF (ln_limdiahsb) THEN 
     106         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     107         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     108         zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
     109         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     110      ENDIF 
     111      !- check conservation (C Rousset) 
     112      ! ------------------------------- 
     113 
    98114      !------------------------------------------------------------------------------! 
    99115      ! 1) Initialization of diagnostic variables                                    ! 
    … …  
    109125               DO ji = 1, jpi 
    110126                  !Energy of melting q(S,T) [J.m-3] 
    111                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi06 ) ) * nlay_i 
     127                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi06 ) ) * REAL( nlay_i ) 
    112128                  !0 if no ice and 1 if yes 
    113129                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - ht_i(ji,jj,jl) )  )  
    … …  
    121137               DO ji = 1, jpi 
    122138                  !Energy of melting q(S,T) [J.m-3] 
    123                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi06 ) ) * nlay_s 
     139                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi06 ) ) * REAL( nlay_s ) 
    124140                  !0 if no ice and 1 if yes 
    125141                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - ht_s(ji,jj,jl) )  )  
    … …  
    134150      ! 1.3) Set some dummies to 0 
    135151      !----------------------------- 
    136       rdvosif(:,:) = 0.e0   ! variation of ice volume at surface 
    137       rdvobif(:,:) = 0.e0   ! variation of ice volume at bottom 
    138       fdvolif(:,:) = 0.e0   ! total variation of ice volume 
    139       rdvonif(:,:) = 0.e0   ! lateral variation of ice volume 
    140       fstric (:,:) = 0.e0   ! part of solar radiation transmitted through the ice 
    141       ffltbif(:,:) = 0.e0   ! linked with fstric 
    142       qfvbq  (:,:) = 0.e0   ! linked with fstric 
    143       rdm_snw(:,:) = 0.e0   ! variation of snow mass per unit area 
    144       rdm_ice(:,:) = 0.e0   ! variation of ice mass per unit area 
    145       hicifp (:,:) = 0.e0   ! daily thermodynamic ice production.  
    146       sfx_bri(:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean 
    147       fhbri  (:,:) = 0.e0   ! brine flux contribution to heat flux to the ocean 
    148       sfx_thd(:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay 
     152      !clem rdvosif(:,:) = 0.e0   ! variation of ice volume at surface 
     153      !clem rdvobif(:,:) = 0.e0   ! variation of ice volume at bottom 
     154      !clem fdvolif(:,:) = 0.e0   ! total variation of ice volume 
     155      !clem rdvonif(:,:) = 0.e0   ! lateral variation of ice volume 
     156      !clem fstric (:,:) = 0.e0   ! part of solar radiation transmitted through the ice 
     157      !clem ffltbif(:,:) = 0.e0   ! linked with fstric 
     158      !clem qfvbq  (:,:) = 0.e0   ! linked with fstric 
     159      !clem rdm_snw(:,:) = 0.e0   ! variation of snow mass per unit area 
     160      !clem rdm_ice(:,:) = 0.e0   ! variation of ice mass per unit area 
     161      !clem hicifp (:,:) = 0.e0   ! daily thermodynamic ice production.  
     162      !clem sfx_bri(:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean 
     163      !clem fhbri  (:,:) = 0.e0   ! brine flux contribution to heat flux to the ocean 
     164      !clem sfx_thd(:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay 
    149165 
    150166      !----------------------------------- 
    … …  
    165181!CDIR NOVERRCHK 
    166182         DO ji = 1, jpi 
    167             zthsnice       = SUM( ht_s(ji,jj,1:jpl) ) + SUM( ht_i(ji,jj,1:jpl) ) 
    168             zindb          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - zthsnice ) ) )  
    169183            phicif(ji,jj)  = vt_i(ji,jj) 
    170184            pfrld(ji,jj)   = 1.0 - at_i(ji,jj) 
    171             zinda          = 1.0 - MAX( zzero , SIGN( zone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
     185            zinda          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) ) ) ) 
    172186            ! 
    173187            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
    … …  
    180194 
    181195            ! here the drag will depend on ice thickness and type (0.006) 
    182             fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( (sst_m(ji,jj) + rt0) - t_bo(ji,jj) )  
     196            fdtcn(ji,jj)  = zinda * rau0 * rcp * 0.006  * zfric_u * ( (sst_m(ji,jj) + rt0) - t_bo(ji,jj) )  
    183197            ! also category dependent 
    184198            !           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead  
    185             qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * (1.0 - at_i(ji,jj)) * rdt_ice 
     199            qdtcn(ji,jj)  = zinda * fdtcn(ji,jj) * (1.0 - at_i(ji,jj)) * rdt_ice 
    186200            !                        
    187201            !           !-- Lead heat budget, qldif (part 1, next one is in limthd_dh)  
    188202            !           !   caution: exponent betas used as more snow can fallinto leads 
    189203            qldif(ji,jj) =  tms(ji,jj) * rdt_ice  * (                             & 
    190                &   pfrld(ji,jj)        * (  qsr(ji,jj)                            &   ! solar heat 
     204               &   pfrld(ji,jj)        * (  qsr(ji,jj) * oatte(ji,jj)             &   ! solar heat + clem modif 
    191205               &                            + qns(ji,jj)                          &   ! non solar heat 
    192206               &                            + fdtcn(ji,jj)                        &   ! turbulent ice-ocean heat 
    193                &                            + fsbbq(ji,jj) * ( 1.0 - zindb )  )   &   ! residual heat from previous step 
     207               &                            + fsbbq(ji,jj) * ( 1.0 - zinda )  )   &   ! residual heat from previous step 
    194208               & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus                    )   ! latent heat of sprecip melting 
    195209            ! 
    … …  
    206220            ! 
    207221            ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx) 
    208             qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - (sst_m(ji,jj) + rt0) ) * ( 1. - zinda ) 
     222            qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - (sst_m(ji,jj) + rt0) ) 
    209223            ! 
    210224            ! oceanic heat flux (limthd_dh) 
    211             fbif   (ji,jj) = zindb * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi20 ) + fdtcn(ji,jj) ) 
     225            fbif   (ji,jj) = zinda * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi20 ) + fdtcn(ji,jj) ) 
    212226            ! 
    213227         END DO 
    … …  
    294308            CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq           , jpi, jpj, npb(1:nbpb) ) 
    295309 
     310            CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) ) ! clem modif 
     311            CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) ) ! clem modif 
    296312            !-------------------------------- 
    297313            ! 4.3) Thermodynamic processes 
    … …  
    411427      ! 5.4) Diagnostic thermodynamic growth rates 
    412428      !-------------------------------------------- 
    413       d_v_i_thd(:,:,:) = v_i      (:,:,:) - old_v_i(:,:,:)    ! ice volumes  
    414       dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
     429!clem@useless      d_v_i_thd(:,:,:) = v_i      (:,:,:) - old_v_i(:,:,:)    ! ice volumes  
     430!clem@mv-to-itd    dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    415431 
    416432      IF( con_i )   fbif(:,:) = fbif(:,:) + zqlbsbq(:,:) 
    … …  
    448464      ENDIF 
    449465      ! 
     466      ! ------------------------------- 
     467      !- check conservation (C Rousset) 
     468      IF (ln_limdiahsb) THEN 
     469         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     470         zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     471  
     472         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
     473         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
     474 
     475         zchk_vmin = glob_min(v_i) 
     476         zchk_amax = glob_max(SUM(a_i,dim=3)) 
     477         zchk_amin = glob_min(a_i) 
     478        
     479         IF(lwp) THEN 
     480            IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limthd) = ',(zchk_v_i * rday) 
     481            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limthd) = ',(zchk_smv * rday) 
     482            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limthd) = ',(zchk_vmin * 1.e-3) 
     483            IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limthd) = ',zchk_amax 
     484            IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limthd) = ',zchk_amin 
     485         ENDIF 
     486      ENDIF 
     487      !- check conservation (C Rousset) 
     488      ! ------------------------------- 
     489      ! 
    450490      CALL wrk_dealloc( jpi, jpj, zqlbsbq ) 
    451491      ! 
     492      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
    452493   END SUBROUTINE lim_thd 
    453494 
    … …  
    472513      DO jk = 1, nlay_i                ! total q over all layers, ice [J.m-2] 
    473514         DO ji = kideb, kiut 
    474             etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 
     515            etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 
    475516            eti     (ji,jl) = eti(ji,jl) + etilayer(ji,jk)  
    476517         END DO 
    477518      END DO 
    478519      DO ji = kideb, kiut              ! total q over all layers, snow [J.m-2] 
    479          ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / nlay_s 
     520         ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / REAL( nlay_s ) 
    480521      END DO 
    481522      ! 
    … …  
    498539 
    499540      INTEGER  ::   ji, jk         ! loop indices 
    500       INTEGER  ::   zji, zjj 
     541      INTEGER  ::   ii, ij 
    501542      INTEGER  ::   numce          ! number of points for which conservation is violated 
    502543      REAL(wp) ::   meance         ! mean conservation error 
    … …  
    521562      !---------------------------------------- 
    522563      DO ji = kideb, kiut 
    523          zji = MOD( npb(ji) - 1 , jpi ) + 1 
    524          zjj =    ( npb(ji) - 1 ) / jpi + 1 
     564         ii = MOD( npb(ji) - 1 , jpi ) + 1 
     565         ij =    ( npb(ji) - 1 ) / jpi + 1 
    525566         fatm     (ji,jl) = qnsr_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) 
    526          sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(zji,zjj,jl) 
     567         sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(ii,ij,jl) 
    527568      END DO 
    528569 
    … …  
    579620         IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. & 
    580621            ( cons_error(ji,jl) .GT. max_cons_err  ) ) THEN 
    581             zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    582             zjj                 = ( npb(ji) - 1 ) / jpi + 1 
     622            ii                 = MOD( npb(ji) - 1, jpi ) + 1 
     623            ij                 = ( npb(ji) - 1 ) / jpi + 1 
    583624            ! 
    584625            WRITE(numout,*) ' alerte 1     ' 
    … …  
    586627            WRITE(numout,*) ' heat diffusion in the ice ' 
    587628            WRITE(numout,*) ' Category   : ', jl 
    588             WRITE(numout,*) ' zji , zjj  : ', zji, zjj 
    589             WRITE(numout,*) ' lat, lon   : ', gphit(zji,zjj), glamt(zji,zjj) 
     629            WRITE(numout,*) ' ii , ij  : ', ii, ij 
     630            WRITE(numout,*) ' lat, lon   : ', gphit(ii,ij), glamt(ii,ij) 
    590631            WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    591632            WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 
    … …  
    615656            WRITE(numout,*) ' fc_bo      : ', - fc_bo_i  (ji) 
    616657            WRITE(numout,*) ' foc        : ', fbif_1d(ji) 
    617             WRITE(numout,*) ' fstroc     : ', fstroc   (zji,zjj,jl) 
     658            WRITE(numout,*) ' fstroc     : ', fstroc   (ii,ij,jl) 
    618659            WRITE(numout,*) ' i0         : ', i0(ji) 
    619660            WRITE(numout,*) ' qsr_ice    : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
    … …  
    651692      ! 
    652693      INTEGER  ::   ji                ! loop indices 
    653       INTEGER  ::   zji, zjj, numce         ! local integers 
     694      INTEGER  ::   ii, ij, numce         ! local integers 
    654695      REAL(wp) ::   meance, max_cons_err    !local scalar 
    655696      !!--------------------------------------------------------------------- 
    … …  
    669710      !---------------------------------------- 
    670711      DO ji = kideb, kiut 
    671          zji = MOD( npb(ji) - 1 , jpi ) + 1 
    672          zjj =    ( npb(ji) - 1 ) / jpi + 1 
     712         ii = MOD( npb(ji) - 1 , jpi ) + 1 
     713         ij =    ( npb(ji) - 1 ) / jpi + 1 
    673714 
    674715         fatm      (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji)                       ! total heat flux 
    675          sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(zji,zjj,jl)  
     716         sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(ii,ij,jl)  
    676717         cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    677718      END DO 
    … …  
    706747      DO ji = kideb, kiut 
    707748         IF ( cons_error(ji,jl) .GT. max_cons_err  ) THEN 
    708             zji = MOD( npb(ji) - 1, jpi ) + 1 
    709             zjj =    ( npb(ji) - 1 ) / jpi + 1 
     749            ii = MOD( npb(ji) - 1, jpi ) + 1 
     750            ij =    ( npb(ji) - 1 ) / jpi + 1 
    710751            ! 
    711752            WRITE(numout,*) ' alerte 1 - category : ', jl 
    712753            WRITE(numout,*) ' Untolerated conservation error after limthd_ent ' 
    713             WRITE(numout,*) ' zji , zjj  : ', zji, zjj 
    714             WRITE(numout,*) ' lat, lon   : ', gphit(zji,zjj), glamt(zji,zjj) 
     754            WRITE(numout,*) ' ii , ij  : ', ii, ij 
     755            WRITE(numout,*) ' lat, lon   : ', gphit(ii,ij), glamt(ii,ij) 
    715756            WRITE(numout,*) ' * ' 
    716757            WRITE(numout,*) ' Ftotal     : ', sum_fluxq(ji,jl) 
    … …  
    724765            WRITE(numout,*) ' foce       : ', fbif_1d(ji) 
    725766            WRITE(numout,*) ' fres       : ', ftotal_fin(ji) 
    726             WRITE(numout,*) ' fhbri      : ', fhbricat(zji,zjj,jl) 
     767            WRITE(numout,*) ' fhbri      : ', fhbricat(ii,ij,jl) 
    727768            WRITE(numout,*) ' * ' 
    728769            WRITE(numout,*) ' Heat contents --- : ' 
    … …  
    793834      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    794835      NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   & 
    795          &                hicmin, hiclim, amax  ,                                & 
     836         &                hicmin, hiclim,                                        & 
    796837         &                sbeta  , parlat, hakspl, hibspl, exld,                 & 
    797838         &                hakdif, hnzst  , thth  , parsub, alphs, betas,         &  
    … …  
    825866         WRITE(numout,*)'      ice thick. corr. to max. energy stored in brine pocket  hicmin       = ', hicmin   
    826867         WRITE(numout,*)'      minimum ice thickness                                   hiclim       = ', hiclim  
    827          WRITE(numout,*)'      maximum lead fraction                                   amax         = ', amax  
    828868         WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice ' 
    829869         WRITE(numout,*)'      Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)   sbeta        = ', sbeta 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r3808 r4161  
    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 rdmsnif & rdmicif 
     8   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw & rdm_ice 
    99   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
    1010   !!            3.5  ! 2012-10 (G. Madec & co) salt flux + bug fixes  
    … …  
    3939 
    4040   !!---------------------------------------------------------------------- 
    41    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     41   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
    4242   !! $Id$ 
    4343   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7373      !!  
    7474      INTEGER  ::   ji , jk        ! dummy loop indices 
    75       INTEGER  ::   ii, ij       ! 2D corresponding indices to ji 
     75      INTEGER  ::   ii, ij         ! 2D corresponding indices to ji 
    7676      INTEGER  ::   isnow          ! switch for presence (1) or absence (0) of snow 
    7777      INTEGER  ::   isnowic        ! snow ice formation not 
    … …  
    8484      REAL(wp) ::   zdhnm, zhnnew, zhisn, zihic, zzc       ! 
    8585      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment 
    86       REAL(wp) ::   zds          ! increment of bottom ice salinity 
    8786      REAL(wp) ::   zcoeff       ! dummy argument for snowfall partitioning over ice and leads 
    8887      REAL(wp) ::   zsm_snowice  ! snow-ice salinity 
    … …  
    107106      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_pre   ! snow precipitation  
    108107      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_sub   ! snow sublimation 
    109       REAL(wp), POINTER, DIMENSION(:) ::   zsfx_melt   ! salt flux due to ice melt 
    110108 
    111109      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah 
    … …  
    120118      REAL(wp), POINTER, DIMENSION(:,:) ::   zqt_i_lay   ! total ice heat content 
    121119 
     120      ! mass and salt flux (clem) 
     121      REAL(wp) :: zdvres, zdvsur, zdvbot 
     122      REAL(wp), POINTER, DIMENSION(:) ::   zviold, zvsold   ! old ice volume... 
     123 
    122124      ! Heat conservation  
    123125      INTEGER  ::   num_iter_max, numce_dh 
    … …  
    128130 
    129131      CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 
    130       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zsfx_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
     132      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
    131133      CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i ) 
    132134      CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
    133135 
    134       zsfx_melt (:) = 0._wp 
     136      CALL wrk_alloc( jpij, zviold, zvsold ) ! clem 
     137       
    135138      ftotal_fin(:) = 0._wp 
    136139      zfdt_init (:) = 0._wp 
    137140      zfdt_final(:) = 0._wp 
    138141 
     142      dh_i_surf (:) = 0._wp 
     143      dh_i_bott (:) = 0._wp 
     144      dh_snowice(:) = 0._wp 
     145 
    139146      DO ji = kideb, kiut 
    140147         old_ht_i_b(ji) = ht_i_b(ji) 
    141148         old_ht_s_b(ji) = ht_s_b(ji) 
     149         zviold(ji) = a_i_b(ji) * ht_i_b(ji) ! clem 
     150         zvsold(ji) = a_i_b(ji) * ht_s_b(ji) ! clem 
    142151      END DO 
    143152      ! 
    … …  
    164173      ! 
    165174      DO ji = kideb, kiut     ! Layer thickness 
    166          zh_i(ji) = ht_i_b(ji) / nlay_i 
    167          zh_s(ji) = ht_s_b(ji) / nlay_s 
     175         zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
     176         zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 
    168177      END DO 
    169178      ! 
    … …  
    171180      DO jk = 1, nlay_s 
    172181         DO ji = kideb, kiut 
    173             zqt_s(ji) =  zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / nlay_s 
     182            zqt_s(ji) =  zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s ) 
    174183         END DO 
    175184      END DO 
    … …  
    178187      DO jk = 1, nlay_i 
    179188         DO ji = kideb, kiut 
    180             zzc = q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 
     189            zzc = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 
    181190            zqt_i(ji)        =  zqt_i(ji) + zzc 
    182191            zqt_i_lay(ji,jk) =              zzc 
    … …  
    244253         zhn            =  1.0 - MAX(  zzero , SIGN( zone , - zhsnew )  ) 
    245254         ht_s_b(ji)     =  MAX( zzero , zhsnew ) 
     255         ! we recompute dh_s_tot (clem)  
     256         dh_s_tot (ji)  =  ht_s_b(ji) - zhsold(ji) 
    246257         ! Volume and mass variations of snow 
    247258         dvsbq_1d  (ji) =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_pre(ji) ) 
    248259         dvsbq_1d  (ji) =  MIN( zzero, dvsbq_1d(ji) ) 
    249          rdm_snw_1d(ji) =  rdm_snw_1d(ji) + rhosn * dvsbq_1d(ji) 
     260         !clem rdm_snw_1d(ji) =  rdm_snw_1d(ji) + rhosn * dvsbq_1d(ji) 
    250261      END DO ! ji 
    251262 
    … …  
    254265      !-------------------------- 
    255266      DO ji = kideb, kiut  
    256          dh_i_surf(ji) =  0._wp 
    257267         z_f_surf (ji) =  zqfont_su(ji) * r1_rdtice   ! heat conservation test 
    258268         zdq_i    (ji) =  0._wp 
    … …  
    272282            zdq_i    (ji   ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 
    273283            ! 
    274             !                                                    ! contribution to ice-ocean salt flux  
    275             zsfx_melt(ji)  = zsfx_melt(ji) - sm_i_b(ji) * a_i_b(ji) * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice  
     284            ! clem 
     285            sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji)    & 
     286               &                              * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic / rdt_ice 
    276287         END DO 
    277288      END DO 
    … …  
    334345         DO ji = kideb,kiut 
    335346            q_s_b    (ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 
    336             zqt_dummy(ji)    =  zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / nlay_s            ! heat conservation 
     347            zqt_dummy(ji)    =  zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s )            ! heat conservation 
    337348         END DO 
    338349      END DO 
    … …  
    375386               ! Basal growth rate = - F*dt / q 
    376387               dh_i_bott(ji)       =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
     388               sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 
    377389            ENDIF 
    378390         END DO 
    … …  
    416428                  zfracs = zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   & 
    417429                     &                   + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  
    418                   zds         = zfracs * sss_m(ii,ij) - s_i_new(ji) 
     430                  zfracs = MIN( 0.5 , zfracs ) 
    419431                  s_i_new(ji) = zfracs * sss_m(ii,ij) 
    420432               ENDIF ! fc_bo_i 
    … …  
    425437         DO ji = kideb, kiut 
    426438            IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .LT. 0.0  ) THEN 
    427                ! New ice salinity must not exceed 15 psu 
     439               ! New ice salinity must not exceed 20 psu 
    428440               s_i_new(ji) = MIN( s_i_new(ji), s_i_max ) 
    429441               ! Metling point in K 
    … …  
    437449               ! Salinity update 
    438450               ! entrapment during bottom growth 
    439                dsm_i_se_1d(ji) = ( s_i_new(ji) * dh_i_bott(ji) + sm_i_b(ji) * ht_i_b(ji) )    & 
    440                   &            / MAX( ht_i_b(ji) + dh_i_bott(ji) ,epsi13 ) - sm_i_b(ji) 
     451               sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 
    441452            ENDIF ! heat budget 
    442453         END DO 
    … …  
    476487                  zdq_i    (ji   ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 
    477488               ENDIF 
    478                ! contribution to salt flux 
    479                zsfx_melt(ji) = zsfx_melt(ji) - sm_i_b(ji) * a_i_b(ji) * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice  
     489               ! clem: contribution to salt flux 
     490               sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji)    & 
     491                    &                              * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice 
    480492            ENDIF 
    481493         END DO ! ji 
    … …  
    528540         ELSE                  ;   zdhbf =              dh_i_bott(ji)  
    529541         ENDIF 
     542         zdvres        = zdhbf - dh_i_bott(ji) 
     543         dh_i_bott(ji) = zdhbf 
     544         sfx_thd_1d(ji)  = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice 
    530545         !                     ! excessive energy is sent to lateral ablation 
    531          fsup     (ji) =  rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi13 )   & 
    532             &                          * ( zdhbf - dh_i_bott(ji) ) * r1_rdtice 
    533          dh_i_bott(ji)  = zdhbf 
    534          !                     !since ice volume is only used for outputs, we keep it global for all categories 
    535          dvbbq_1d (ji) = a_i_b(ji) * dh_i_bott(ji) 
    536          !                     !new ice thickness 
    537          zhgnew   (ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 
    538          !                     ! diagnostic ( bottom ice growth ) 
    539          ii = MOD( npb(ji) - 1, jpi ) + 1 
    540          ij = ( npb(ji) - 1 ) / jpi + 1 
    541          diag_bot_gr(ii,ij) = diag_bot_gr(ii,ij) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
    542          diag_sur_me(ii,ij) = diag_sur_me(ii,ij) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) * r1_rdtice 
    543          diag_bot_me(ii,ij) = diag_bot_me(ii,ij) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
     546         fsup     (ji) =  rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi13 ) * zdvres * r1_rdtice 
    544547      END DO 
    545548 
    … …  
    552555         ! Adapt the remaining energy if too much ice melts 
    553556         !-------------------------------------------------- 
    554          zihgnew =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )   ! =1 if ice 
    555          ! 0 if no more ice 
    556          zhgnew    (ji) =         zihgnew   * zhgnew(ji)      ! ice thickness is put to 0 
    557          ! remaining heat 
     557         zdvres     = MAX( 0._wp, - ht_i_b(ji) - dh_i_surf(ji) - dh_i_bott(ji) ) 
     558         zdvsur     = MIN( 0._wp, dh_i_surf(ji) + zdvres ) - dh_i_surf(ji) ! fill the surface first 
     559         zdvbot     = MAX( 0._wp, zdvres - zdvsur ) ! then the bottom 
     560         dh_i_surf (ji) = dh_i_surf(ji) + zdvsur ! clem 
     561         dh_i_bott (ji) = dh_i_bott(ji) + zdvbot ! clem 
     562 
     563         ! new ice thickness (clem) 
     564         zhgnew(ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 
     565         zihgnew    = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice 
     566         zhgnew(ji) = zihgnew * zhgnew(ji)      ! ice thickness is put to 0 
     567  
     568         !                     !since ice volume is only used for outputs, we keep it global for all categories 
     569         dvbbq_1d (ji) = a_i_b(ji) * dh_i_bott(ji) 
     570 
     571        ! remaining heat 
    558572         zfdt_final(ji) = ( 1.0 - zihgnew ) * ( zqfont_su(ji) +  zqfont_bo(ji) )  
    559573 
    … …  
    569583         ht_s_b(ji)     =  MAX( zzero , zhnfi ) 
    570584         zqt_s(ji)      =  zqt_s(ji) * ht_s_b(ji) 
     585         ! we recompute dh_s_tot (clem) 
     586         dh_s_tot (ji)  =  ht_s_b(ji) - zhsold(ji) 
    571587 
    572588         ! Mass variations of ice and snow 
    … …  
    579595         ! 
    580596         !                                              ! mass variation cumulated over category 
    581          rdm_snw_1d(ji) = rdm_snw_1d(ji) + zzfmass_s                     ! snow  
    582          rdm_ice_1d(ji) = rdm_ice_1d(ji) + zzfmass_i                     ! ice  
     597         !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + zzfmass_s                     ! snow  
     598         !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + zzfmass_i                     ! ice  
    583599 
    584600         ! Remaining heat to the ocean  
    … …  
    586602         focea(ji)  = - zfdt_final(ji) * r1_rdtice         ! focea is in W.m-2 * dt 
    587603 
     604         ! residual salt flux (clem) 
     605         !-------------------------- 
     606         ! surface 
     607         sfx_thd_1d(ji)    = sfx_thd_1d(ji) - sm_i_b(ji)  * a_i_b(ji) * zdvsur * rhoic * r1_rdtice 
     608         ! bottom 
     609         IF ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN ! melting 
     610            sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji)  * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 
     611         ELSE                                                          ! growth 
     612            sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 
     613         ENDIF 
     614         ! 
     615         ! diagnostic ( bottom ice growth ) 
     616         ii = MOD( npb(ji) - 1, jpi ) + 1 
     617         ij = ( npb(ji) - 1 ) / jpi + 1 
     618         diag_bot_gr(ii,ij) = diag_bot_gr(ii,ij) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
     619         diag_sur_me(ii,ij) = diag_sur_me(ii,ij) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) * r1_rdtice 
     620         diag_bot_me(ii,ij) = diag_bot_me(ii,ij) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
    588621      END DO 
    589622 
    … …  
    591624 
    592625      !--------------------------- 
    593       ! Salt flux and heat fluxes                     
     626      ! heat fluxes                     
    594627      !--------------------------- 
    595628      DO ji = kideb, kiut 
    596629         zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )   ! =1 if ice 
    597          ! 
    598          ! Salt flux 
    599          sfx_thd_1d(ji) = sfx_thd_1d(ji) +        zihgnew  * zsfx_melt(ji)               & 
    600             &                            - (1.0 - zihgnew) * zfmass_i (ji) * sm_i_b(ji)  * r1_rdtice 
    601630         ! 
    602631         ! Heat flux 
    … …  
    646675         dmgwi_1d  (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn 
    647676 
    648          ! All snow is thrown in the ocean, and seawater is taken to replace the volume 
    649          rdm_ice_1d(ji) = rdm_ice_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic * ( 1. - rhosn / rhoic ) 
    650          rdm_snw_1d(ji) = rdm_snw_1d(ji) + a_i_b(ji) * ( zhnnew     - ht_s_b(ji) ) * rhosn 
     677         !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic  
     678         !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + a_i_b(ji) * ( zhnnew     - ht_s_b(ji) ) * rhosn  
    651679 
    652680         !        Equivalent salt flux (1) Snow-ice formation component 
    … …  
    658686         ELSE                      ;   zsm_snowice = sm_i_b(ji)    
    659687         ENDIF 
    660          sfx_thd_1d(ji) = sfx_thd_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 
    661          ! 
    662688         ! entrapment during snow ice formation 
    663          i_ice_switch = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - ht_i_b(ji) + 1.0e-6 ) ) 
    664          isnowic      = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - dh_snowice(ji)      ) ) * i_ice_switch 
    665          IF(  num_sal == 2  )   & 
    666             dsm_i_si_1d(ji) = (  zsm_snowice * dh_snowice(ji)    & 
    667             &                  + sm_i_b(ji) * ht_i_b(ji) / MAX( ht_i_b(ji) + dh_snowice(ji), epsi13 )   & 
    668             &                  - sm_i_b(ji)  ) * isnowic      
     689         ! clem: new salinity difference stored (to be used in limthd_ent.F90) 
     690         IF (  num_sal == 2  ) THEN 
     691            i_ice_switch = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - zhgnew(ji) + epsi13 ) ) 
     692            ! salinity dif due to snow-ice formation 
     693            dsm_i_si_1d(ji) = ( zsm_snowice - sm_i_b(ji) ) * dh_snowice(ji) / MAX( zhgnew(ji), epsi13 ) * i_ice_switch      
     694            ! salinity dif due to bottom growth  
     695            IF (  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji)  < 0._wp ) THEN 
     696               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_b(ji) ) * dh_i_bott(ji) / MAX( zhgnew(ji), epsi13 ) * i_ice_switch 
     697            ENDIF 
     698         ENDIF 
    669699 
    670700         !  Actualize new snow and ice thickness. 
    … …  
    680710         diag_sni_gr(ii,ij)  = diag_sni_gr(ii,ij) + dh_snowice(ji)*a_i_b(ji) * r1_rdtice 
    681711         ! 
     712         ! salt flux 
     713         sfx_thd_1d(ji) = sfx_thd_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 
     714         !-------------------------------- 
     715         ! Update mass fluxes (clem) 
     716         !-------------------------------- 
     717         rdm_ice_1d(ji) = rdm_ice_1d(ji) + ( a_i_b(ji) * ht_i_b(ji) - zviold(ji) ) * rhoic  
     718         rdm_snw_1d(ji) = rdm_snw_1d(ji) + ( a_i_b(ji) * ht_s_b(ji) - zvsold(ji) ) * rhosn  
     719 
    682720      END DO !ji 
    683721      ! 
    684722      CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 
    685       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zsfx_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
     723      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
    686724      CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 
    687725      CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
     726      ! 
     727      CALL wrk_dealloc( jpij, zviold, zvsold ) ! clem 
    688728      ! 
    689729   END SUBROUTINE lim_thd_dh 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r3808 r4161  
    1010   !!                 ! 04-2007 (M. Vancoppenolle) Energy conservation 
    1111   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     12   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux 
    1213   !!---------------------------------------------------------------------- 
    1314#if defined key_lim3 
    … …  
    3435 
    3536   !!---------------------------------------------------------------------- 
    36    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     37   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    3738   !! $Id$ 
    3839   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    156157      DO ji = kideb , kiut 
    157158         ! is there snow or not 
    158          isnow(ji)= INT(  1._wp - MAX(  0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
     159         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
    159160         ! surface temperature of fusion 
    160161!!gm ???  ztfs(ji) = rtt !!!???? 
    161          ztfs(ji) = isnow(ji) * rtt + (1.0-isnow(ji)) * rtt 
     162         ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 
    162163         ! layer thickness 
    163          zh_i(ji) = ht_i_b(ji) / nlay_i 
    164          zh_s(ji) = ht_s_b(ji) / nlay_s 
     164         zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
     165         zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 
    165166      END DO 
    166167 
    … …  
    174175      DO layer = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
    175176         DO ji = kideb , kiut 
    176             z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / nlay_s 
     177            z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / REAL( nlay_s ) 
    177178         END DO 
    178179      END DO 
    … …  
    180181      DO layer = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
    181182         DO ji = kideb , kiut 
    182             z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / nlay_i 
     183            z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / REAL( nlay_i ) 
    183184         END DO 
    184185      END DO 
    … …  
    201202      DO ji = kideb , kiut 
    202203         ! switches 
    203          isnow(ji) = INT(  1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  )  
     204         isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  )  
    204205         ! hs > 0, isnow = 1 
    205206         zhsu (ji) = hnzst  ! threshold for the computation of i0 
    206207         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_b(ji) / zhsu(ji) ) )      
    207208 
    208          i0(ji)    = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
     209         i0(ji)    = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
    209210         !fr1_i0_1d = i0 for a thin ice surface 
    210211         !fr1_i0_2d = i0 for a thick ice surface 
    … …  
    243244 
    244245      DO ji = kideb, kiut           ! ice initialization 
    245          zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) ) 
     246         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * REAL( isnow(ji) ) + zftrice(ji) * REAL( 1 - isnow(ji) ) 
    246247      END DO 
    247248 
    … …  
    256257 
    257258      DO ji = kideb, kiut           ! Radiation transmitted below the ice 
    258          fstbif_1d(ji) = fstbif_1d(ji) + zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) 
     259         fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 
    259260      END DO 
    260261 
    … …  
    264265         ii = MOD( npb(ji) - 1 , jpi ) + 1 
    265266         ij =    ( npb(ji) - 1 ) / jpi + 1 
    266          fstroc(ii,ij,jl) = zradtr_i(ji,nlay_i) 
     267         fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 
    267268      END DO 
    268269      ! +++++ 
    … …  
    376377            zkappa_s(ji,nlay_s)   = 2.0*rcdsn*ztcond_i(ji,0)/MAX(zeps, & 
    377378               (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji))) 
    378             zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*isnow(ji) & 
    379                + zkappa_i(ji,0)*(1.0-isnow(ji)) 
     379            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*REAL( isnow(ji) ) & 
     380               + zkappa_i(ji,0)*REAL( 1 - isnow(ji) ) 
    380381         END DO 
    381382         ! 
    … …  
    658659               t_s_b(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
    659660               *  t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) & 
    660                *        MAX(0.0,SIGN(1.0,ht_s_b(ji)-zeps))  
     661               *        MAX(0.0,SIGN(1.0,ht_s_b(ji)))  
    661662 
    662663            ! surface temperature 
    663             isnow(ji)     = INT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) )  )  ) 
     664            isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) )  )  ) 
    664665            ztsuoldit(ji) = t_su_b(ji) 
    665             IF( t_su_b(ji) < ztfs(ji) )   & 
    666                t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( isnow(ji)*t_s_b(ji,1)   & 
    667                &          + (1.0-isnow(ji))*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
     666            IF( t_su_b(ji) < ztfs(ji) ) & 
     667               t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_b(ji,1)   & 
     668               &          + REAL( 1 - isnow(ji) )*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
    668669         END DO 
    669670         ! 
    … …  
    721722#endif 
    722723         !                                ! surface ice conduction flux 
    723          isnow(ji)       = INT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  ) 
    724          fc_su(ji)       =  -           isnow(ji)  * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji))   & 
    725             &               - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_b(ji,1) - t_su_b(ji)) 
     724         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  ) 
     725         fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji))   & 
     726            &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_b(ji,1) - t_su_b(ji)) 
    726727         !                                ! bottom ice conduction flux 
    727728         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    … …  
    734735         DO ji = kideb, kiut 
    735736            ! Upper snow value 
    736             fc_s(ji,0) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) )  
     737            fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) )  
    737738            ! Bott. snow value 
    738             fc_s(ji,1) = - isnow(ji)* zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) )  
     739            fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) )  
    739740         END DO 
    740741         DO ji = kideb, kiut         ! Upper ice layer 
    741             fc_i(ji,0) = - isnow(ji) * &  ! interface flux if there is snow 
     742            fc_i(ji,0) = - REAL( isnow(ji) ) * &  ! interface flux if there is snow 
    742743               ( zkappa_i(ji,0)  * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 
    743                - ( 1.0 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
     744               - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
    744745               zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 
    745746         END DO 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

    r3625 r4161  
    4444 
    4545   !!---------------------------------------------------------------------- 
    46    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     46   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    4747   !! $Id$ 
    4848   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7575 
    7676      INTEGER ::   ji,jk   !  dummy loop indices 
    77       INTEGER ::   zji, zjj       ,   &  !  dummy indices 
     77      INTEGER ::   ii, ij       ,   &  !  dummy indices 
    7878         ntop0          ,   &  !  old layer top index 
    7979         nbot1          ,   &  !  new layer bottom index 
    … …  
    145145 
    146146      DO ji = kideb, kiut 
    147          zh_i(ji) = old_ht_i_b(ji) / nlay_i  
    148          zh_s(ji) = old_ht_s_b(ji) / nlay_s 
     147         zh_i(ji) = old_ht_i_b(ji) / REAL( nlay_i )  
     148         zh_s(ji) = old_ht_s_b(ji) / REAL( nlay_s ) 
    149149      END DO 
    150150 
    … …  
    166166      DO jk = 1, nlays0 
    167167         DO ji = kideb, kiut 
    168             snind(ji)  = jk        *      INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-epsi20))) & 
    169                + snind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-epsi20)))) 
     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))))) 
    170170            zdeltah(ji)= zdeltah(ji) + zh_s(ji) 
    171171         END DO ! ji 
    … …  
    175175      !              0 if not 
    176176      DO ji = kideb, kiut 
    177          snswi(ji)     = MAX(0,INT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 
     177         snswi(ji)     = MAX(0,NINT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 
    178178      END DO ! ji 
    179179 
    … …  
    190190      DO jk = 1, nlayi0 
    191191         DO ji = kideb, kiut 
    192             icsuind(ji) = jk          *      INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-epsi20))) & 
    193                + icsuind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-epsi20)))) 
     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))))) 
    194194            zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    195195         END DO ! ji 
    … …  
    200200      !     0 if not 
    201201      DO ji = kideb, kiut 
    202          icsuswi(ji)  = MAX(0,INT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 
     202         icsuswi(ji)  = MAX(0,NINT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 
    203203      ENDDO 
    204204 
    … …  
    216216      DO jk = nlayi0, 1, -1 
    217217         DO ji = kideb, kiut 
    218             icboind(ji) = (nlayi0+1-jk) *      INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-epsi20))) & 
    219                &          + icboind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-epsi20))))  
     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)))))  
    220220            zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    221221         END DO 
    … …  
    232232      !     0 if ablation is on the way 
    233233      DO ji = kideb, kiut  
    234          icboswi(ji) = MAX(0,INT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 
     234         icboswi(ji) = MAX(0,NINT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 
    235235      END DO 
    236236 
    … …  
    248248         DO ji = kideb, kiut 
    249249            snicind(ji) = (nlays0+1-jk) & 
    250                *      INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-epsi20))) + snicind(ji)   & 
    251                * (1 - INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-epsi20)))) 
     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))))) 
    252252            zdeltah(ji) = zdeltah(ji) + zh_s(ji) 
    253253         END DO 
    … …  
    258258      !     0 if not 
    259259      DO ji = kideb, kiut 
    260          snicswi(ji)   = MAX(0,INT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 
     260         snicswi(ji)   = MAX(0,NINT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 
    261261      ENDDO 
    262262 
    … …  
    279279 
    280280      DO ji = kideb, kiut 
    281          nbot0(ji) =  nlays0  + 1 - snind(ji) + ( 1. - snicind(ji) ) * snicswi(ji) 
     281         nbot0(ji) =  nlays0  + 1 - snind(ji) + ( 1 - snicind(ji) ) * snicswi(ji) 
    282282         ! cotes of the top of the layers 
    283283         zm0(ji,0) =  0._wp 
    … …  
    291291            limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 
    292292            limsum = MIN( limsum , nlay_s ) 
    293             zm0(ji,jk) =  dh_s_tot(ji) + zh_s(ji) * limsum 
    294          END DO 
    295       END DO 
    296  
    297       DO ji = kideb, kiut 
    298          zm0(ji,nbot0(ji)) =  dh_s_tot(ji) - snicswi(ji) * dh_snowice(ji) + zh_s(ji) * nlays0 
    299          zm0(ji,1)         =  dh_s_tot(ji) * (1 -snswi(ji) ) + snswi(ji) * zm0(ji,1) 
     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) 
    300300      END DO 
    301301 
    … …  
    309309 
    310310      DO ji = kideb, kiut         ! layer heat content 
    311          qm0    (ji,1) =  rhosn * (  cpic * ( rtt - ( 1. - snswi(ji) ) * tatm_ice_1d(ji)        & 
    312             &                                            - snswi(ji)  * t_s_b      (ji,1)  )   & 
     311         qm0    (ji,1) =  rhosn * (  cpic * ( rtt - REAL( 1 - snswi(ji) ) * tatm_ice_1d(ji)        & 
     312            &                                         - REAL( snswi(ji) ) * t_s_b      (ji,1)  )   & 
    313313            &                      + lfus  ) * zthick0(ji,1) 
    314314         zqts_in(ji)   =  zqts_in(ji) + qm0(ji,1)  
    … …  
    320320            limsum      = MIN( limsum , nlay_s ) 
    321321            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, epsi20 - ht_s_b(ji) ) ) 
    323             zqts_in(ji) = zqts_in(ji) + ( 1. - snswi(ji) ) * qm0(ji,jk) * zswitch 
     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 
    324324         END DO ! jk 
    325325      END DO ! ji 
    … …  
    360360      !------------------- 
    361361      DO ji = kideb, kiut 
    362          zh_s(ji)  = ht_s_b(ji) / nlay_s 
     362         zh_s(ji)  = ht_s_b(ji) / REAL( nlay_s ) 
    363363         z_s(ji,0) =  0._wp 
    364364      ENDDO 
    … …  
    366366      DO jk = 1, nlay_s 
    367367         DO ji = kideb, kiut 
    368             z_s(ji,jk) =  zh_s(ji) * jk 
     368            z_s(ji,jk) =  zh_s(ji) * REAL( jk ) 
    369369         END DO 
    370370      END DO 
    … …  
    394394                  &                 - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1))) / MAX(zhl0(ji,layer0),epsi10))  
    395395               q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0)   & 
    396                   &                                * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+epsi20)) 
     396                  &                                * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 
    397397            END DO 
    398398         END DO 
    … …  
    410410         DO ji = kideb, kiut 
    411411            IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice  >  1.0e-6 ) THEN 
    412                zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    413                zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    414                WRITE(numout,*) ' violation of heat conservation : ',             & 
    415                   ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice 
    416                WRITE(numout,*) ' ji, jj   : ', zji, zjj 
     412               ii                 = MOD( npb(ji) - 1, jpi ) + 1 
     413               ij                 = ( npb(ji) - 1 ) / jpi + 1 
     414               WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice 
     415               WRITE(numout,*) ' ji, jj   : ', ii, ij 
    417416               WRITE(numout,*) ' ht_s_b   : ', ht_s_b(ji) 
    418417               WRITE(numout,*) ' zqts_in  : ', zqts_in (ji) * r1_rdtice 
    … …  
    441440      DO jk = 1, nlay_s 
    442441         DO ji = kideb, kiut 
    443             zswitch = MAX ( 0.0 , SIGN ( 1.0, epsi20 - ht_s_b(ji) ) ) 
     442            zswitch = MAX ( 0.0 , SIGN ( 1.0, - ht_s_b(ji) ) ) 
    444443            t_s_b(ji,jk) = rtt + ( 1.0 - zswitch ) * ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 
    445444         END DO 
    … …  
    480479            limsum    =  ( (icsuswi(ji)*(icsuind(ji)+jk-1) + &  
    481480               (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji) 
    482             zm0(ji,jk)=  icsuswi(ji)*dh_i_surf(ji) + snicswi(ji)*dh_snowice(ji) & 
    483                +  limsum * zh_i(ji) 
    484          END DO 
    485       END DO 
    486  
    487       DO ji = kideb, kiut 
    488          zm0(ji,nbot0(ji)) =  icsuswi(ji)*dh_i_surf(ji) + snicswi(ji)*dh_snowice(ji) + dh_i_bott(ji) & 
    489             +  zh_i(ji) * nlayi0 
    490          zm0(ji,1)         =  snicswi(ji)*dh_snowice(ji) + (1-snicswi(ji))*zm0(ji,1) 
     481            zm0(ji,jk)=  REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) & 
     482               +  REAL(limsum) * zh_i(ji) 
     483         END DO 
     484      END DO 
     485 
     486      DO ji = kideb, kiut 
     487         zm0(ji,nbot0(ji)) =  REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) + dh_i_bott(ji) & 
     488            +  zh_i(ji) * REAL(nlayi0) 
     489         zm0(ji,1)         =  REAL(snicswi(ji))*dh_snowice(ji) + REAL(1-snicswi(ji))*zm0(ji,1) 
    491490      END DO 
    492491 
    … …  
    521520      !---------------------------- 
    522521      DO ji = kideb, kiut         
    523          ztmelts    = ( 1.0 - icboswi(ji) ) * (-tmut * s_i_b  (ji,nlayi0) )   &   ! case of melting ice 
    524             &       +         icboswi(ji)  * (-tmut * s_i_new(ji)        )   &   ! case of forming ice 
     522         ztmelts    = REAL( 1 - icboswi(ji) ) * (-tmut * s_i_b  (ji,nlayi0) )   &   ! case of melting ice 
     523            &       +     REAL( icboswi(ji) ) * (-tmut * s_i_new(ji)        )   &   ! case of forming ice 
    525524            &       + rtt                                                         ! in Kelvin 
    526525 
    … …  
    528527         ztform = t_i_b(ji,nlay_i) 
    529528         IF(  num_sal == 2  )   ztform = t_bo_b(ji) 
    530          qm0(ji,nbot0(ji)) = ( 1.0 - icboswi(ji) )*qm0(ji,nbot0(ji))             &   ! case of melting ice 
    531             &              + icboswi(ji) * rhoic * ( cpic*(ztmelts-ztform)       &   ! case of forming ice 
     529         qm0(ji,nbot0(ji)) = REAL( 1 - icboswi(ji) )*qm0(ji,nbot0(ji))             &   ! case of melting ice 
     530            &              + REAL( icboswi(ji) ) * rhoic * ( cpic*(ztmelts-ztform)       &   ! case of forming ice 
    532531            + lfus *( 1.0-(ztmelts-rtt) / MIN ( (ztform-rtt) , - epsi10 ) )      &  
    533532            - rcp*(ztmelts-rtt) ) * zthick0(ji,nbot0(ji)  ) 
    … …  
    540539         ! energy of the flooding seawater 
    541540         zqsnic = rau0 * rcp * ( rtt - t_bo_b(ji) ) * dh_snowice(ji) * & 
    542             (rhoic - rhosn) / rhoic * snicswi(ji) ! generally positive 
     541            (rhoic - rhosn) / rhoic * REAL(snicswi(ji)) ! generally positive 
    543542         ! Heat conservation diagnostic 
    544543         qt_i_in(ji,jl) = qt_i_in(ji,jl) + zqsnic  
    … …  
    549548         ! = enthalpy of snow + enthalpy of frozen water 
    550549         zqsnic         =  zqsnow(ji) + zqsnic 
    551          qm0(ji,1)      =  snicswi(ji) * zqsnic + ( 1 - snicswi(ji) ) * qm0(ji,1) 
     550         qm0(ji,1)      =  REAL(snicswi(ji)) * zqsnic + REAL( 1 - snicswi(ji) ) * qm0(ji,1) 
    552551 
    553552      END DO ! ji 
    … …  
    556555         DO ji = kideb, kiut 
    557556            ! Heat conservation 
    558             zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi06+epsi20) ) & 
    559                &                                   * MAX( 0.0 , SIGN( 1. , nbot0(ji) - jk + epsi20 ) ) 
     557            zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi06) ) & 
     558               &                                   * MAX( 0.0 , SIGN( 1. , REAL(nbot0(ji) - jk) ) ) 
    560559         END DO 
    561560      END DO 
    … …  
    575574      !------------------ 
    576575      DO ji = kideb, kiut 
    577          zh_i(ji) = ht_i_b(ji) / nlay_i 
     576         zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
    578577      ENDDO 
    579578 
    … …  
    606605               q_i_b(ji,layer1) = q_i_b(ji,layer1) &  
    607606                  + zrl01(layer1,layer0)*qm0(ji,layer0) & 
    608                   * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi06+epsi20)) & 
    609                   * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+epsi20)) 
     607                  * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi06)) & 
     608                  * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 
    610609            END DO 
    611610         END DO 
    … …  
    622621      END DO 
    623622      ! 
    624       DO ji = kideb, kiut 
    625          IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice  >  1.0e-6 ) THEN 
    626             zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    627             zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    628             WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice 
    629             WRITE(numout,*) ' ji, jj   : ', zji, zjj 
    630             WRITE(numout,*) ' ht_i_b   : ', ht_i_b(ji) 
    631             WRITE(numout,*) ' zqti_in  : ', zqti_in (ji) * r1_rdtice 
    632             WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) * r1_rdtice 
    633             WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji) 
    634             WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji) 
    635             WRITE(numout,*) ' dh_snowice:', dh_snowice(ji) 
    636             WRITE(numout,*) ' icsuswi  : ', icsuswi(ji) 
    637             WRITE(numout,*) ' icboswi  : ', icboswi(ji) 
    638             WRITE(numout,*) ' snicswi  : ', snicswi(ji) 
    639          ENDIF 
    640       END DO 
     623      IF ( con_i ) THEN 
     624         DO ji = kideb, kiut 
     625            IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice  >  1.0e-6 ) THEN 
     626               ii                 = MOD( npb(ji) - 1, jpi ) + 1 
     627               ij                 = ( npb(ji) - 1 ) / jpi + 1 
     628               WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice 
     629               WRITE(numout,*) ' ji, jj   : ', ii, ij 
     630               WRITE(numout,*) ' ht_i_b   : ', ht_i_b(ji) 
     631               WRITE(numout,*) ' zqti_in  : ', zqti_in (ji) * r1_rdtice 
     632               WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) * r1_rdtice 
     633               WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji) 
     634               WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji) 
     635               WRITE(numout,*) ' dh_snowice:', dh_snowice(ji) 
     636               WRITE(numout,*) ' icsuswi  : ', icsuswi(ji) 
     637               WRITE(numout,*) ' icboswi  : ', icboswi(ji) 
     638               WRITE(numout,*) ' snicswi  : ', snicswi(ji) 
     639            ENDIF 
     640         END DO 
     641      ENDIF 
    641642 
    642643      !---------------------- 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r3625 r4161  
    4646 
    4747   !!---------------------------------------------------------------------- 
    48    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     48   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    4949   !! $Id$ 
    5050   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7878      !!               update ht_s_b, ht_i_b and tbif_1d(:,:)       
    7979      !!------------------------------------------------------------------------ 
    80       INTEGER  ::   ji,jj,jk,jl,jm   ! dummy loop indices 
    81       INTEGER  ::   layer, nbpac     ! local integers  
    82       INTEGER  ::   zji, zjj, iter   !   -       - 
    83       REAL(wp) ::   ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zde   ! local scalars 
     80      INTEGER ::   ji,jj,jk,jl,jm   ! dummy loop indices 
     81      INTEGER ::   layer, nbpac     ! local integers  
     82      INTEGER ::   ii, ij, iter   !   -       - 
     83      REAL(wp)  ::   ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zinda, zde  ! local scalars 
    8484      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      - 
    8585      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    86       REAL(wp) ::   zcoef                                                       !   -      - 
    8786      LOGICAL  ::   iterate_frazil   ! iterate frazil ice collection thickness 
    8887      CHARACTER (len = 15) :: fieldid 
    … …  
    160159               DO ji = 1, jpi 
    161160                  !Energy of melting q(S,T) [J.m-3] 
    162                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * nlay_i 
     161                  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 ) 
    163162                  zindb = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) )  )   !0 if no ice and 1 if yes 
    164163                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 
    … …  
    342341         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)] 
    343342            DO ji = 1, nbpac 
    344                zji =   MOD( npac(ji) - 1 , jpi ) + 1 
    345                zjj =      ( npac(ji) - 1 ) / jpi + 1 
    346                zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , s_i_max , 0.5 * sss_m(zji,zjj)  ) 
     343               ii =   MOD( npac(ji) - 1 , jpi ) + 1 
     344               ij =      ( npac(ji) - 1 ) / jpi + 1 
     345               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , s_i_max , 0.5 * sss_m(ii,ij)  ) 
    347346            END DO 
    348347         CASE ( 3 )                    ! Sice = F(z) [multiyear ice] 
    … …  
    389388         END DO 
    390389 
    391          !--------------------------------- 
    392          ! Salt flux due to new ice growth 
    393          !--------------------------------- 
    394          ! note that for constant salinity zs_newice() = bulk_sal (see top of the subroutine) 
    395          DO ji = 1, nbpac 
    396             sfx_thd_1d(ji) = sfx_thd_1d(ji) - zs_newice(ji) * rhoic * zv_newice(ji) * r1_rdtice 
    397             rdm_ice_1d(ji) = rdm_ice_1d(ji) +                 rhoic * zv_newice(ji) 
    398          END DO ! ji 
    399  
    400390         !------------------------------------ 
    401391         ! Diags for energy conservation test 
    402392         !------------------------------------ 
    403393         DO ji = 1, nbpac 
    404             zji = MOD( npac(ji) - 1 , jpi ) + 1 
    405             zjj =    ( npac(ji) - 1 ) / jpi + 1 
     394            ii = MOD( npac(ji) - 1 , jpi ) + 1 
     395            ij =    ( npac(ji) - 1 ) / jpi + 1 
    406396            ! 
    407             zde = ze_newice(ji) / unit_fac * area(zji,zjj) * zv_newice(ji) 
     397            zde = ze_newice(ji) / unit_fac * area(ii,ij) * zv_newice(ji) 
    408398            ! 
    409             vt_i_init(zji,zjj) = vt_i_init(zji,zjj) + zv_newice(ji)             ! volume 
    410             et_i_init(zji,zjj) = et_i_init(zji,zjj) + zde                       ! Energy 
     399            vt_i_init(ii,ij) = vt_i_init(ii,ij) + zv_newice(ji)             ! volume 
     400            et_i_init(ii,ij) = et_i_init(ii,ij) + zde                       ! Energy 
    411401 
    412402         END DO 
    … …  
    419409         !----------------- 
    420410         DO ji = 1, nbpac 
    421             zji = MOD( npac(ji) - 1 , jpi ) + 1 
    422             zjj =    ( npac(ji) - 1 ) / jpi + 1 
     411            ii = MOD( npac(ji) - 1 , jpi ) + 1 
     412            ij =    ( npac(ji) - 1 ) / jpi + 1 
    423413            za_newice(ji) = zv_newice(ji) / zh_newice(ji) 
    424             diag_lat_gr(zji,zjj) = zv_newice(ji) * r1_rdtice 
     414            diag_lat_gr(ii,ij) = diag_lat_gr(ii,ij) + zv_newice(ji) * r1_rdtice ! clem 
    425415         END DO !ji 
    426416 
    … …  
    441431         ! we keep the excessive volume in memory and attribute it later to bottom accretion 
    442432         DO ji = 1, nbpac 
    443             IF ( za_newice(ji)  >  ( 1._wp - zat_i_ac(ji) ) ) THEN 
    444                zda_res(ji)   = za_newice(ji) - (1.0 - zat_i_ac(ji) ) 
     433            IF ( za_newice(ji) >  ( amax - zat_i_ac(ji) ) ) THEN 
     434               zda_res(ji)   = za_newice(ji) - ( amax - zat_i_ac(ji) ) 
    445435               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji)  
    446436               za_newice(ji) = za_newice(ji) - zda_res  (ji) 
    … …  
    473463         DO ji = 1, nbpac 
    474464            jl = zcatac(ji)                                                           ! categroy in which new ice is put 
    475             zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) ) )             ! zindb=1 if ice =0 otherwise 
     465            zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) + epsi10 ) )             ! zindb=1 if ice =0 otherwise 
    476466            zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb  ! old ice thickness 
    477467            zdhex    (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) )           ! difference in thickness 
    478             zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi11 ) )   ! ice totally new in jl category 
     468            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) )   ! ice totally new in jl category 
    479469         END DO 
    480470 
    … …  
    482472            DO ji = 1, nbpac 
    483473               jl = zcatac(ji) 
    484                zqold   = ze_i_ac(ji,jk,jl)      ! [ J.m-3 ] 
    485                zalphai = MIN( zhice_old(ji,jl) *   jk       / nlay_i , zh_newice(ji) )   & 
    486                   &    - MIN( zhice_old(ji,jl) * ( jk - 1 ) / nlay_i , zh_newice(ji) ) 
     474               zqold   = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 
     475               zalphai = MIN( zhice_old(ji,jl) * REAL( jk )     / REAL( nlay_i ), zh_newice(ji) )   & 
     476                  &    - MIN( zhice_old(ji,jl) * REAL( jk - 1 ) / REAL( nlay_i ), zh_newice(ji) ) 
    487477               ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji)                                     & 
    488                   + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / nlay_i   & 
     478                  + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / REAL( nlay_i )  & 
    489479                  + za_newice(ji)  * ze_newice(ji) * zalphai                                       & 
    490                   + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / nlay_i ) / ( zv_i_ac(ji,jl) / nlay_i ) 
     480                  + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / REAL( nlay_i ) ) / ( ( zv_i_ac(ji,jl) ) / REAL( nlay_i ) ) 
    491481            END DO 
    492482         END DO 
    … …  
    513503            DO ji = 1, nbpac 
    514504               zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) ) 
    515                zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi06 ) 
     505               zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_lev(ji) - epsi06 ) )  ! clem 
     506               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) , epsi06 ) 
    516507            END DO 
    517508         END DO 
    … …  
    524515         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    525516            DO ji = 1, nbpac 
    526                zindb =  1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) ) )       ! zindb=1 if ice =0 otherwise 
     517               zindb =  1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) + epsi10 ) )       ! zindb=1 if ice =0 otherwise 
    527518               zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 
    528519               zdhicbot (ji,jl) = zdv_res(ji)    / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    & 
    … …  
    536527            DO jk = 1, nlay_i 
    537528               DO ji = 1, nbpac 
    538                   zthick0(ji,jk,jl) =  zhice_old(ji,jl) / nlay_i 
     529                  zthick0(ji,jk,jl) =  zhice_old(ji,jl) / REAL( nlay_i ) 
    539530                  zqm0   (ji,jk,jl) =  ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 
    540531               END DO 
    … …  
    555546               DO layer = 1, nlay_i + 1 
    556547                  DO ji = 1, nbpac 
    557                      zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) ) )  
     548                     zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  
    558549                     ! Redistributing energy on the new grid 
    559                      zweight = MAX (  MIN( zhice_old(ji,jl) * layer , zdummy(ji,jl) * jk )   & 
    560                         &    - MAX( zhice_old(ji,jl) * ( layer - 1 ) , zdummy(ji,jl) * ( jk - 1 ) ) , 0._wp )   & 
    561                         &    /( MAX(nlay_i * zthick0(ji,layer,jl),epsi10) ) * zindb 
     550                     zweight = MAX (  MIN( zhice_old(ji,jl) * REAL( layer ), zdummy(ji,jl) * REAL( jk ) )   & 
     551                        &    - MAX( zhice_old(ji,jl) * REAL( layer - 1 ) , zdummy(ji,jl) * REAL( jk - 1 ) ) , 0._wp )   & 
     552                        &    /( MAX(REAL(nlay_i) * zthick0(ji,layer,jl),epsi10) ) * zindb 
    562553                     ze_i_ac(ji,jk,jl) =  ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl)   
    563554                  END DO ! ji 
    … …  
    569560            DO jk = 1, nlay_i 
    570561               DO ji = 1, nbpac 
    571                   zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) )  
     562                  zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  
    572563                  ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl)   & 
    573                      &              / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * nlay_i * zindb 
     564                     &              / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * REAL( nlay_i ) * zindb 
    574565               END DO 
    575566            END DO 
    … …  
    581572         DO jl = 1, jpl 
    582573            DO ji = 1, nbpac 
    583                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes 
     574               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    584575               zoa_i_ac(ji,jl)  = za_old(ji,jl) * zoa_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    
    585576            END DO  
    … …  
    589580         ! Update salinity 
    590581         !----------------- 
    591          IF(  num_sal == 2  ) THEN      ! Sice = F(z,t) 
     582         !clem IF(  num_sal == 2  ) THEN 
    592583            DO jl = 1, jpl 
    593584               DO ji = 1, nbpac 
    594                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) )   ! 0 if no ice and 1 if yes 
     585                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    595586                  zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    596                   zsmv_i_ac(ji,jl) = ( zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) ) * zindb 
     587                  zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) * zindb ! clem modif 
    597588               END DO 
    598589            END DO    
    599          ENDIF 
     590         !clem ENDIF 
     591 
     592         !-------------------------------- 
     593         ! Update mass/salt fluxes (clem) 
     594         !-------------------------------- 
     595         DO jl = 1, jpl 
     596            DO ji = 1, nbpac 
     597               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
     598               zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
     599               rdm_ice_1d(ji) = rdm_ice_1d(ji) + zdv * rhoic * zindb 
     600               sfx_thd_1d(ji)   =   sfx_thd_1d(ji) - zdv * rhoic * zs_newice(ji) * r1_rdtice * zindb 
     601           END DO 
     602         END DO 
    600603 
    601604         !------------------------------------------------------------------------------! 
    … …  
    606609            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 
    607610            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 
    608             IF (  num_sal == 2  )   & 
     611            !clem IF (  num_sal == 2  )   & 
    609612               CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 
    610613            DO jk = 1, nlay_i 
    … …  
    622625      DO jl = 1, jpl 
    623626         DO jk = 1, nlay_i          ! heat content in 10^9 Joules 
    624             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / nlay_i / unit_fac  
     627            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / REAL( nlay_i ) / unit_fac  
    625628         END DO 
    626629      END DO 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r4147 r4161  
    3333 
    3434   !!---------------------------------------------------------------------- 
    35    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     35   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    3636   !! $Id$ 
    3737   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    8282         DO ji = kideb, kiut 
    8383            zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji) 
     84            zsiold(ji) = sm_i_b(ji) 
    8485         END DO 
    8586 
    … …  
    9091         DO jk = 1, nlay_i 
    9192            DO ji = kideb, kiut 
    92                ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 
     93               ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / REAL (nlay_i ) 
    9394            END DO 
    9495         END DO 
    … …  
    117118            ! only drainage terms ( gravity drainage and flushing ) 
    118119            ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 
    119             zsiold(ji) = sm_i_b(ji) 
    120120            sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
    121121 
    … …  
    123123            i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 
    124124            sm_i_b(ji)   = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch ) 
    125          END DO ! ji 
    126  
    127          CALL lim_var_salprof1d( kideb, kiut )         ! Salinity profile 
    128  
    129  
    130          !---------------------------- 
    131          ! Heat flux - brine drainage 
    132          !---------------------------- 
    133  
    134          DO ji = kideb, kiut 
    135 !!gm useless 
    136             ! iflush  : 1 if summer  
    137             iflush  =  MAX( 0._wp , SIGN( 1._wp , t_su_b(ji) - rtt        )  )  
    138             ! igravdr : 1 if t_su lt t_bo 
    139             igravdr =  MAX( 0._wp , SIGN( 1._wp , t_bo_b(ji) - t_su_b(ji) )  )  
    140             ! iaccrbo : 1 if bottom accretion 
    141             iaccrbo =  MAX( 0._wp , SIGN( 1._wp , dh_i_bott(ji)           )  ) 
    142 !!gm end useless 
    143             ! 
     125 
     126            !---------------------------- 
     127            ! Heat flux - brine drainage 
     128            !---------------------------- 
    144129            fhbri_1d(ji) = 0._wp 
    145          END DO ! ji 
    146  
    147          !---------------------------- 
    148          ! Salt flux - brine drainage 
    149          !---------------------------- 
    150          DO ji = kideb, kiut 
    151             i_ice_switch = 1._wp - MAX(  0._wp, SIGN( 1._wp , - ht_i_b(ji) )  ) 
    152             sfx_bri_1d(ji) = sfx_bri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji)         & 
    153                &           * ( MAX( dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji) , sm_i_b(ji) - zsiold(ji) ) ) * r1_rdtice 
    154          END DO 
     130 
     131            !---------------------------- 
     132            ! Salt flux - brine drainage 
     133            !---------------------------- 
     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 
     135 
     136         END DO 
     137 
     138         ! Salinity profile 
     139         CALL lim_var_salprof1d( kideb, kiut ) 
     140 
    155141 
    156142         ! Only necessary for conservation check since salinity is modified 
    … …  
    178164      IF(  num_sal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
    179165 
    180  
    181       !------------------------------------------------------------------------------| 
    182       ! 5) Computation of salt flux due to Bottom growth 
    183       !------------------------------------------------------------------------------| 
    184       ! note: s_i_new = bulk_sal in constant salinity case 
    185       DO ji = kideb, kiut 
    186          sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0._wp ) * r1_rdtice 
    187       END DO 
    188166      ! 
    189167      CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold ) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r3625 r4161  
    2828   USE prtctl         ! Print control 
    2929   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     30   USE limvar          ! clem for ice thickness correction 
     31   USE timing          ! Timing 
    3032 
    3133   IMPLICIT NONE 
    … …  
    3638   REAL(wp)  ::   epsi06 = 1.e-06_wp   ! constant values 
    3739   REAL(wp)  ::   epsi03 = 1.e-03_wp   
    38    REAL(wp)  ::   zeps10 = 1.e-10_wp   
     40   REAL(wp)  ::   epsi10 = 1.e-10_wp   
    3941   REAL(wp)  ::   epsi16 = 1.e-16_wp 
     42   REAL(wp)  ::   epsi20 = 1.e-20_wp 
    4043   REAL(wp)  ::   rzero  = 0._wp    
    4144   REAL(wp)  ::   rone   = 1._wp 
    … …  
    4649#  include "vectopt_loop_substitute.h90" 
    4750   !!---------------------------------------------------------------------- 
    48    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     51   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    4952   !! $Id$ 
    5053   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6972      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    7073      INTEGER  ::   ierr                    ! error status 
    71       REAL(wp) ::   zindb  , zindsn , zindic      ! local scalar 
     74      REAL(wp) ::   zindb  , zindsn , zindic, zindh, zinda      ! local scalar 
    7275      REAL(wp) ::   zusvosn, zusvoic, zbigval     !   -      - 
    7376      REAL(wp) ::   zcfl , zusnit , zrtt          !   -      - 
    … …  
    7780      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 
    7881      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e 
     82      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) 
     83      REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset) 
     84      ! mass and salt flux (clem) 
     85      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold   ! old ice volume... 
     86      ! correct ice thickness (clem) 
     87      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaiold, zhimax   ! old ice concentration and thickness 
     88      REAL(wp) :: zdv, zda, zvi, zvs, zsmv 
    7989      !!--------------------------------------------------------------------- 
     90      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
    8091 
    8192      CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
    8293      CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    8394      CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 
     95 
     96      CALL wrk_alloc( jpi,jpj,jpl,zviold )   ! clem 
     97      CALL wrk_alloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
     98 
     99      ! ------------------------------- 
     100      !- check conservation (C Rousset) 
     101      IF( ln_limdiahsb ) THEN 
     102         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     103         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     104         zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
     105         zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
     106      ENDIF 
     107      !- check conservation (C Rousset) 
     108      ! ------------------------------- 
    84109 
    85110      IF( numit == nstart .AND. lwp ) THEN 
    … …  
    96121      IF( ln_limdyn ) THEN          !   Advection of sea ice properties   ! 
    97122         !                          !-------------------------------------! 
    98          ! 
    99  
     123         ! mass and salt flux init (clem) 
     124         zviold(:,:,:)  = v_i(:,:,:) 
     125 
     126         !--- Thickness correction init. (clem) ------------------------------- 
     127         CALL lim_var_glo2eqv 
     128         zaiold(:,:,:) = a_i(:,:,:) 
     129         !--------------------------------------------------------------------- 
     130         ! Record max of the surrounding ice thicknesses for correction in limupdate 
     131         ! in case advection creates ice too thick. 
     132         !--------------------------------------------------------------------- 
     133         zhimax(:,:,:) = ht_i(:,:,:) 
     134         DO jl = 1, jpl 
     135            DO jj = 2, jpjm1 
     136               DO ji = 2, jpim1 
     137                  zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) ) 
     138                  !zhimax(ji,jj,jl) = ( ht_i(ji  ,jj  ,jl) * tmask(ji,  jj  ,1) + ht_i(ji-1,jj-1,jl) * tmask(ji-1,jj-1,1) + ht_i(ji+1,jj+1,jl) * tmask(ji+1,jj+1,1) & 
     139                  !     &             + ht_i(ji-1,jj  ,jl) * tmask(ji-1,jj  ,1) + ht_i(ji  ,jj-1,jl) * tmask(ji  ,jj-1,1) & 
     140                  !     &             + ht_i(ji+1,jj  ,jl) * tmask(ji+1,jj  ,1) + ht_i(ji  ,jj+1,jl) * tmask(ji  ,jj+1,1) & 
     141                  !     &             + ht_i(ji-1,jj+1,jl) * tmask(ji-1,jj+1,1) + ht_i(ji+1,jj-1,jl) * tmask(ji+1,jj-1,1) ) 
     142               END DO 
     143            END DO 
     144            CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 
     145         END DO 
     146          
    100147         !------------------------- 
    101148         ! transported fields                                         
    … …  
    126173!         ENDIF 
    127174!!gm end 
    128          initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
     175         initad = 1 + NINT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
    129176         zusnit = 1.0 / REAL( initad )  
    130177         IF( zcfl > 0.5 .AND. lwp )   & 
    … …  
    282329         END DO 
    283330 
    284          !----------------------------------------- 
    285          !  Remultiply everything by ice area 
    286          !----------------------------------------- 
    287          zs0ow(:,:) = MAX( rzero, zs0ow(:,:) * area(:,:) ) 
    288          DO jl = 1, jpl 
    289             zs0ice(:,:,jl) = MAX( rzero, zs0ice(:,:,jl) * area(:,:) )    !!bug:  est-ce utile 
    290             zs0sn (:,:,jl) = MAX( rzero, zs0sn (:,:,jl) * area(:,:) )    !!bug:  cf /area  juste apres 
    291             zs0sm (:,:,jl) = MAX( rzero, zs0sm (:,:,jl) * area(:,:) )    !!bug:  cf /area  juste apres 
    292             zs0oi (:,:,jl) = MAX( rzero, zs0oi (:,:,jl) * area(:,:) ) 
    293             zs0a  (:,:,jl) = MAX( rzero, zs0a  (:,:,jl) * area(:,:) )    !! suppress both change le resultat 
    294             zs0c0 (:,:,jl) = MAX( rzero, zs0c0 (:,:,jl) * area(:,:) ) 
    295             DO jk = 1, nlay_i 
    296                zs0e(:,:,jk,jl) = MAX( rzero, zs0e (:,:,jk,jl) * area(:,:) ) 
    297             END DO ! jk 
    298          END DO ! jl 
    299  
    300331         !------------------------------------------------------------------------------! 
    301332         ! 5) Update and limit ice properties after transport                            
    … …  
    305336         ! 5.1) Recover mean values over the grid squares. 
    306337         !-------------------------------------------------- 
    307  
    308          DO jl = 1, jpl 
    309             DO jk = 1, nlay_i 
    310                DO jj = 1, jpj 
    311                   DO ji = 1, jpi 
    312                      zs0e(ji,jj,jk,jl) = MAX( rzero, zs0e(ji,jj,jk,jl) / area(ji,jj) ) 
    313                   END DO 
    314                END DO 
    315             END DO 
    316          END DO 
    317  
    318          DO jj = 1, jpj 
    319             DO ji = 1, jpi 
    320                zs0ow(ji,jj) = MAX( rzero, zs0ow (ji,jj) / area(ji,jj) ) 
    321             END DO 
    322          END DO 
    323  
    324338         zs0at(:,:) = 0._wp 
    325339         DO jl = 1, jpl 
    326340            DO jj = 1, jpj 
    327341               DO ji = 1, jpi 
    328                   zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl)/area(ji,jj) ) 
    329                   zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl)/area(ji,jj) ) 
    330                   zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl)/area(ji,jj) ) 
    331                   zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl)/area(ji,jj) ) 
    332                   zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl)/area(ji,jj) ) 
    333                   zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl)/area(ji,jj) ) 
     342                  zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl) ) 
     343                  zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl) ) 
     344                  zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl) ) 
     345                  zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl) ) 
     346                  zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl) ) 
     347                  zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl) ) 
    334348                  zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl) 
    335349               END DO 
    … …  
    342356         DO jj = 1, jpj 
    343357            DO ji = 1, jpi 
    344                zindb        = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - zeps10) ) 
     358               zindb        = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - epsi10) ) 
    345359               zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 
    346360               ato_i(ji,jj) = zs0ow(ji,jj) 
    … …  
    351365            DO jj = 1, jpj 
    352366               DO ji = 1, jpi 
    353                   zindb         = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - zeps10) ) 
     367                  zvi = zs0ice(ji,jj,jl) 
     368                  zvs = zs0sn(ji,jj,jl) 
    354369                  ! 
    355                   zs0a(ji,jj,jl) = zindb * MIN( zs0a(ji,jj,jl), 0.99 ) 
     370                  zindb         = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - epsi10) ) 
     371                  ! 
    356372                  v_s(ji,jj,jl)  = zindb * zs0sn (ji,jj,jl)  
    357373                  v_i(ji,jj,jl)  = zindb * zs0ice(ji,jj,jl) 
    358374                  ! 
    359                   zindsn         = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - zeps10 ) ) 
    360                   zindic         = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) ) 
     375                  zindsn         = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
     376                  zindic         = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    361377                  zindb          = MAX( zindsn, zindic ) 
     378                  ! 
    362379                  zs0a(ji,jj,jl) = zindb  * zs0a(ji,jj,jl) !ice concentration 
    363380                  a_i (ji,jj,jl) = zs0a(ji,jj,jl) 
    364381                  v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 
    365382                  v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 
     383                  ! 
     384                  ! Update mass fluxes (clem) 
     385                  rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic  
     386                  rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn  
     387              END DO 
     388            END DO 
     389         END DO 
     390 
     391         !--- Thickness correction in case too high (clem) -------------------------------------------------------- 
     392         CALL lim_var_glo2eqv 
     393         DO jl = 1, jpl 
     394            DO jj = 1, jpj 
     395               DO ji = 1, jpi 
     396 
     397                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
     398                     zvi = v_i(ji,jj,jl) 
     399                     zvs = v_s(ji,jj,jl) 
     400                     zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
     401                     !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)    
     402                      
     403                     zindh = 1._wp 
     404                     IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. & 
     405                        & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                           
     406                        ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 
     407                        zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
     408                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
     409                     ELSE 
     410                        ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 
     411                        zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
     412                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
     413                     ENDIF 
     414 
     415                     ! small correction due to *zindh for a_i 
     416                     v_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) 
     417                     v_s(ji,jj,jl) = zindh * v_s(ji,jj,jl) 
     418 
     419                     ! Update mass fluxes 
     420                     rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 
     421                     rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 
     422 
     423                  ENDIF 
     424 
     425                  diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 
     426 
    366427               END DO 
    367428            END DO 
    368429         END DO 
    369430 
     431         ! --- 
    370432         DO jj = 1, jpj 
    371433            DO ji = 1, jpi 
    372                zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) 
     434               zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) ! clem@useless?? 
    373435            END DO 
    374436         END DO 
    … …  
    378440         !---------------------- 
    379441 
    380          zbigval = 1.d+13 
     442         zbigval = 1.e+13 
    381443 
    382444         DO jl = 1, jpl 
    383445            DO jj = 1, jpj 
    384446               DO ji = 1, jpi 
     447                  zsmv = zs0sm(ji,jj,jl) 
    385448 
    386449                  ! Switches and dummy variables 
    … …  
    388451                  zusvoic         = 1.0/MAX( v_i(ji,jj,jl) , epsi16 ) 
    389452                  zrtt            = 173.15 * rone  
    390                   zindsn          = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - zeps10 ) ) 
    391                   zindic          = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) ) 
     453                  zindsn          = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
     454                  zindic          = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    392455                  zindb           = MAX( zindsn, zindic ) 
    393456 
    394457                  ! Ice salinity and age 
    395                   zsal = MAX( MIN(  (rhoic-rhosn)/rhoic*sss_m(ji,jj) ,   & 
    396                      &              zusvoic * zs0sm(ji,jj,jl)         ) , s_i_min ) * v_i(ji,jj,jl) 
    397                   IF(  num_sal == 2  )   smv_i(ji,jj,jl) = zindic * zsal + (1.0-zindic) * 0._wp 
    398  
    399                   zage = MAX(  MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi16 ) ), 0._wp  ) * a_i(ji,jj,jl) 
     458                  !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 
     459                  IF(  num_sal == 2  ) THEN 
     460                     smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 
     461                  ENDIF 
     462 
     463                  zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi16 ) ), 0._wp  ) * a_i(ji,jj,jl) 
    400464                  oa_i (ji,jj,jl)  = zindic * zage  
    401465 
    402466                  ! Snow heat content 
    403467                  ze              =  MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval ) 
    404                   e_s(ji,jj,1,jl) = zindsn * ze + (1.0 - zindsn) * 0.0       
    405  
     468                  e_s(ji,jj,1,jl) = zindsn * ze       
     469 
     470                  ! Update salt fluxes (clem) 
     471                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
    406472               END DO !ji 
    407473            END DO !jj 
    … …  
    413479                  DO ji = 1, jpi 
    414480                     ! Ice heat content 
    415                      zindic          =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) ) 
     481                     zindic          =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    416482                     ze              =  MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval ) 
    417                      e_i(ji,jj,jk,jl) = zindic * ze    + ( 1.0 - zindic ) * 0.0 
     483                     e_i(ji,jj,jk,jl) = zindic * ze 
    418484                  END DO !ji 
    419485               END DO ! jj 
    420486            END DO ! jk 
    421487         END DO ! jl 
     488 
     489 
     490      ! --- agglomerate variables (clem) ----------------- 
     491      vt_i (:,:) = 0._wp 
     492      vt_s (:,:) = 0._wp 
     493      at_i (:,:) = 0._wp 
     494      ! 
     495      DO jl = 1, jpl 
     496         DO jj = 1, jpj 
     497            DO ji = 1, jpi 
     498               ! 
     499               vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
     500               vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
     501               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
     502               ! 
     503               zinda = MAX( rzero , SIGN( rone , at_i(ji,jj) - epsi16 ) ) 
     504               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi16 ) * zinda  ! ice thickness 
     505            END DO 
     506         END DO 
     507      END DO 
     508      ! ------------------------------------------------- 
     509 
     510 
    422511 
    423512      ENDIF 
    … …  
    454543         END DO 
    455544      ENDIF 
     545      ! ------------------------------- 
     546      !- check conservation (C Rousset) 
     547      IF( ln_limdiahsb ) THEN 
     548         zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     549         zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     550  
     551         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
     552         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
     553 
     554         zchk_vmin = glob_min(v_i) 
     555         zchk_amax = glob_max(SUM(a_i,dim=3)) 
     556         zchk_amin = glob_min(a_i) 
     557         zchk_umax = glob_max(SQRT(u_ice**2 + v_ice**2)) 
     558 
     559         IF(lwp) THEN 
     560            IF ( ABS( zchk_v_i   ) >  1.e-5 ) THEN 
     561               WRITE(numout,*) 'violation volume [m3/day]     (limtrp) = ',(zchk_v_i * rday) 
     562               WRITE(numout,*) 'u_ice max [m/s]               (limtrp) = ',zchk_umax 
     563               WRITE(numout,*) 'number of time steps          (limtrp) =',kt 
     564            ENDIF 
     565            IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday) 
     566            IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limtrp) = ',(zchk_vmin * 1.e-3) 
     567            IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limtrp) = ',zchk_amin 
     568         ENDIF 
     569      ENDIF 
     570      !- check conservation (C Rousset) 
     571      ! ------------------------------- 
    456572      ! 
    457573      CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
    458574      CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    459575      CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e ) 
     576 
     577      CALL wrk_dealloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
    460578      ! 
     579      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
    461580   END SUBROUTINE lim_trp 
    462581 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r3625 r4161  
    6262   PUBLIC   lim_var_eqv2glo      ! 
    6363   PUBLIC   lim_var_salprof      ! 
     64   PUBLIC   lim_var_icetm        ! 
    6465   PUBLIC   lim_var_bv           ! 
    6566   PUBLIC   lim_var_salprof1d    ! 
    6667 
    67    REAL(wp) ::   eps20 = 1.e-20_wp   ! module constants 
    68    REAL(wp) ::   eps16 = 1.e-16_wp   !    -       - 
    69    REAL(wp) ::   eps13 = 1.e-13_wp   !    -       - 
    70    REAL(wp) ::   eps10 = 1.e-10_wp   !    -       - 
    71    REAL(wp) ::   eps06 = 1.e-06_wp   !    -       - 
     68   REAL(wp) ::   epsi20 = 1.e-20_wp   ! module constants 
     69   REAL(wp) ::   epsi16 = 1.e-16_wp   !    -       - 
     70   REAL(wp) ::   epsi13 = 1.e-13_wp   !    -       - 
     71   REAL(wp) ::   epsi10 = 1.e-10_wp   !    -       - 
     72   REAL(wp) ::   epsi06 = 1.e-06_wp   !    -       - 
    7273   REAL(wp) ::   zzero = 0.e0        !    -       - 
    7374   REAL(wp) ::   zone  = 1.e0        !    -       - 
    7475 
    7576   !!---------------------------------------------------------------------- 
    76    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     77   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    7778   !! $Id$ 
    7879   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9798      ! 
    9899      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    99       REAL(wp) ::   zinda 
     100      REAL(wp) ::   zinda, zindb 
    100101      !!------------------------------------------------------------------ 
    101102 
    … …  
    116117               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    117118               ! 
    118                zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )  
    119                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , eps16 ) * zinda  ! ice thickness 
     119               zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi16 ) )  
     120               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi16 ) * zinda  ! ice thickness 
    120121            END DO 
    121122         END DO 
    … …  
    137138            DO jj = 1, jpj 
    138139               DO ji = 1, jpi 
     140                  zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - epsi16 ) )  
     141                  zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi16 ) )  
    139142                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content 
    140                   zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - 0.10 ) )  
    141                   smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , eps13 ) * zinda   ! ice salinity 
    142                   zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )  
    143                   ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , eps13 ) * zinda   ! ice age 
     143                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi16 ) * zinda   ! ice salinity 
     144                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi16 ) * zindb   ! ice age 
    144145               END DO 
    145146            END DO 
    … …  
    175176         DO jj = 1, jpj 
    176177            DO ji = 1, jpi 
    177                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) )   !0 if no ice and 1 if yes 
    178                ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb 
    179                ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb 
    180                o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb 
     178               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
     179               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
     180               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
     181               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
     182               a_i(ji,jj,jl) = a_i (ji,jj,jl) * zindb ! clem correction 
    181183            END DO 
    182184         END DO 
    … …  
    187189            DO jj = 1, jpj 
    188190               DO ji = 1, jpi 
    189                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) )   !0 if no ice and 1 if yes 
    190                   sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , eps10 ) * zindb 
     191                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
     192                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * zindb 
    191193               END DO 
    192194            END DO 
    … …  
    208210               DO ji = 1, jpi 
    209211                  !                                                              ! Energy of melting q(S,T) [J.m-3] 
    210                   zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , eps06 ) * REAL(nlay_i,wp)  
     212                  zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi06 ) * REAL(nlay_i,wp)  
    211213                  zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) ) )     ! zindb = 0 if no ice and 1 if yes 
    212214                  zq_i    = zq_i * unit_fac * zindb                              !convert units 
    … …  
    234236               DO ji = 1, jpi 
    235237                  !Energy of melting q(S,T) [J.m-3] 
    236                   zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , eps06 ) ) * REAL(nlay_s,wp) 
     238                  zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi06 ) ) * REAL(nlay_s,wp) 
    237239                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) ) )     ! zindb = 0 if no ice and 1 if yes 
    238240                  zq_s  = zq_s * unit_fac * zindb                                    ! convert units 
    … …  
    253255            DO jj = 1, jpj 
    254256               DO ji = 1, jpi 
    255                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , -a_i(ji,jj,jl) ) )  )   & 
    256                      &  * (  1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) ) )  ) 
    257                   tm_i(ji,jj) = tm_i(ji,jj) + t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    258                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , eps10 )  ) 
     257                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     258                  tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
     259                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    259260               END DO 
    260261            END DO 
    … …  
    337338               DO ji = 1, jpi 
    338339                  ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    339                   zind0  = MAX( 0.0   , SIGN( 1.0  , s_i_0 - sm_i(ji,jj,jl) ) )  
     340                  zind0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) )  
    340341                  ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    341                   zind01 = ( 1.0 - zind0 ) * MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i(ji,jj,jl) ) )  
     342                  zind01 = ( 1._wp - zind0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) )  
    342343                  ! If 2.sm_i GE sss_m then zindbal = 1 
    343                   zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
    344                   zalpha(ji,jj,jl) = zind0  * 1.0 + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
    345                   zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1.0 - zindbal ) 
    346                END DO 
    347             END DO 
    348          END DO 
    349          ! 
    350          dummy_fac = 1._wp / nlay_i                   ! Computation of the profile 
     344                  zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
     345                  zalpha(ji,jj,jl) = zind0  + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
     346                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zindbal ) 
     347               END DO 
     348            END DO 
     349         END DO 
     350 
     351         dummy_fac = 1._wp / REAL( nlay_i )                   ! Computation of the profile 
    351352         DO jl = 1, jpl 
    352353            DO jk = 1, nlay_i 
    … …  
    388389 
    389390 
     391   SUBROUTINE lim_var_icetm 
     392      !!------------------------------------------------------------------ 
     393      !!                ***  ROUTINE lim_var_icetm *** 
     394      !! 
     395      !! ** Purpose :   computes mean sea ice temperature 
     396      !!------------------------------------------------------------------ 
     397      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     398      REAL(wp) ::   zindb   !   -      - 
     399      !!------------------------------------------------------------------ 
     400 
     401      ! Mean sea ice temperature 
     402      tm_i(:,:) = 0._wp 
     403      DO jl = 1, jpl 
     404         DO jk = 1, nlay_i 
     405            DO jj = 1, jpj 
     406               DO ji = 1, jpi 
     407                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     408                  tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
     409                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
     410               END DO 
     411            END DO 
     412         END DO 
     413      END DO 
     414 
     415   END SUBROUTINE lim_var_icetm 
     416 
     417 
    390418   SUBROUTINE lim_var_bv 
    391419      !!------------------------------------------------------------------ 
    … …  
    399427      !!------------------------------------------------------------------ 
    400428      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    401       REAL(wp) ::   zbvi, zindb      ! local scalars 
     429      REAL(wp) ::   zbvi, zinda, zindb      ! local scalars 
    402430      !!------------------------------------------------------------------ 
    403431      ! 
    … …  
    407435            DO jj = 1, jpj 
    408436               DO ji = 1, jpi 
    409                   zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
    410                   zbvi  = - zindb * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - 273.15 , eps13 )   & 
     437                  zinda = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi16 ) )  ) 
     438                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi16 ) )  ) 
     439                  zbvi  = - zinda * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi16 )   & 
    411440                     &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp) 
    412                   bv_i(ji,jj) = bv_i(ji,jj) + zbvi  / MAX( vt_i(ji,jj) , eps13 ) 
     441                  bv_i(ji,jj) = bv_i(ji,jj) + zindb * zbvi  / MAX( vt_i(ji,jj) , epsi16 ) 
    413442               END DO 
    414443            END DO 
    … …  
    429458      ! 
    430459      INTEGER  ::   ji, jk    ! dummy loop indices 
    431       INTEGER  ::   zji, zjj  ! local integers 
     460      INTEGER  ::   ii, ij  ! local integers 
    432461      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars 
    433462      REAL(wp) ::   zalpha, zind0, zind01, zindbal, zs_zero              !   -      - 
    … …  
    463492!CDIR NOVERRCHK 
    464493            DO ji = kideb, kiut 
    465                zji =  MOD( npb(ji) - 1 , jpi ) + 1 
    466                zjj =     ( npb(ji) - 1 ) / jpi + 1 
     494               ii =  MOD( npb(ji) - 1 , jpi ) + 1 
     495               ij =     ( npb(ji) - 1 ) / jpi + 1 
    467496               ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    468497               zind0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_b(ji) ) )  
    … …  
    470499               zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_b(ji) ) )  
    471500               ! if 2.sm_i GE sss_m then zindbal = 1 
    472                zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(zji,zjj) ) ) 
     501               zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(ii,ij) ) ) 
    473502               ! 
    474503               zalpha = (  zind0 + zind01 * ( sm_i_b(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zindbal ) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r4147 r4161  
    1010   !!   lim_wri      : write of the diagnostics variables in ouput file  
    1111   !!   lim_wri_init : initialization and namelist read 
     12   !!   lim_wri_state : write for initial state or/and abandon 
    1213   !!---------------------------------------------------------------------- 
    1314   USE ioipsl 
    … …  
    2526   USE wrk_nemo        ! work arrays 
    2627   USE par_ice 
    27    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     28   USE iom 
     29   USE timing          ! Timing 
     30   USE lib_fortran     ! Fortran utilities 
    2831 
    2932   IMPLICIT NONE 
    … …  
    3134 
    3235   PUBLIC lim_wri        ! routine called by lim_step.F90 
    33  
    34    INTEGER, PARAMETER ::   jpnoumax = 40   !: maximum number of variable for ice output 
     36   PUBLIC lim_wri_state  ! called by dia_wri_state  
     37 
     38   INTEGER, PARAMETER ::   jpnoumax = 43   !: maximum number of variable for ice output 
    3539    
    3640   INTEGER  ::   noumef             ! number of fields 
    … …  
    4852   INTEGER            , DIMENSION(jpnoumax) ::   nc  , nca     ! switch for saving field ( = 1 ) or not ( = 0 ) 
    4953 
    50    REAL(wp)  ::   epsi16 = 1e-16_wp 
     54   REAL(wp)  ::   epsi06 = 1e-6_wp 
    5155   REAL(wp)  ::   zzero  = 0._wp 
    5256   REAL(wp)  ::   zone   = 1._wp       
    5357   !!---------------------------------------------------------------------- 
    54    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     58   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    5559   !! $Id$ 
    5660   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7781      INTEGER ::  ierr 
    7882      REAL(wp),DIMENSION(1) ::   zdept 
    79       REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb 
     83      REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb, zindc 
    8084      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zcmo, zcmoa 
    8185      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zfield 
    8286      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zmaskitd, zoi, zei 
    8387 
    84       CHARACTER(len = 40) ::   clhstnam, clop, clhstnama 
     88      CHARACTER(len = 60) ::   clhstnam, clop, clhstnama 
    8589 
    8690      INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid 
    … …  
    9094      !!------------------------------------------------------------------- 
    9195 
     96      IF( nn_timing == 1 )  CALL timing_start('limwri') 
     97 
    9298      CALL wrk_alloc( jpi, jpj, zfield ) 
    9399      CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 
    … …  
    116122         ! Normal file 
    117123         !------------- 
    118  
    119          zsto     = rdt_ice 
    120          IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!) 
    121          ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time) 
    122          ENDIF 
    123          zout     = nwrite * rdt_ice / nn_fsbc 
    124124         niter    = ( nit000 - 1 ) / nn_fsbc 
    125          zdept(1) = 0. 
    126  
    127125         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 
    128126         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    129          CALL dia_nam ( clhstnam, nwrite, 'icemod' ) 
    130          CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice,   & 
    131             &           nhorid, nice, domain_id=nidom, snc4chunks=snc4set ) 
    132          CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 
    133          CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    134  
    135          DO jf = 1 , noumef 
    136             IF(lwp) WRITE(numout,*) 'jf', jf 
    137             IF ( nc(jf) == 1 ) THEN 
    138                CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & 
    139                   , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    140                IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout' 
    141                IF(lwp) WRITE(numout,*)  nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout  
    142             ENDIF 
    143          END DO 
    144  
    145          CALL histend(nice, snc4set) 
    146  
     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         ! 
    147154         !----------------- 
    148155         ! ITD file output 
    … …  
    159166            nhorida,                   & ! ? linked with horizontal ... 
    160167            nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file  
    161          CALL histvert( nicea, "icethi", "L levels",               & 
    162             "m", ipl , hi_mean , nz ) 
     168         CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz ) 
    163169         DO jl = 1, jpl 
    164170            zmaskitd(:,:,jl) = tmask(:,:,1) 
    … …  
    198204      zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 
    199205 
     206      ! Ice surface temperature and some fluxes 
    200207      DO jl = 1, jpl 
    201208         DO jj = 1, jpj 
    202209            DO ji = 1, jpi 
    203                zindh  = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) ) 
    204                zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
     210               zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
    205211               zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl)  
    206212               zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl)  
    207                zcmo(ji,jj,27) = zcmo(ji,jj,27) + t_su(ji,jj,jl)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi16)*zinda 
     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)  
    208215            END DO 
    209216         END DO 
    210217      END DO 
    211218 
     219      ! Mean sea ice temperature 
     220      CALL lim_var_icetm 
     221 
     222      ! Brine volume 
    212223      CALL lim_var_bv 
    213224 
    214225      DO jj = 2 , jpjm1 
    215226         DO ji = 2 , jpim1 
    216             zindh  = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) ) 
    217             zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
    218             zindb  = zindh * zinda 
     227            zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
     228            zindb  = MAX( zzero , SIGN( zone , at_i(ji,jj) ) ) 
    219229 
    220230            zcmo(ji,jj,1)  = at_i(ji,jj) 
    221             zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda 
    222             zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda 
    223             zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * 86400.0 * zinda    ! Bottom thermodynamic ice production 
    224             zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * 86400.0 * zinda    ! Dynamic ice production (rid/raft) 
    225             zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * 86400.0 * zinda    ! Lateral thermodynamic ice production 
    226             zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * 86400.0 * zinda    ! Snow ice production ice production 
    227             zcmo(ji,jj,24) = tm_i(ji,jj) - rtt 
    228  
    229             zcmo(ji,jj,6)  = fbif  (ji,jj) 
    230             zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 
    231             zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 
     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 
    232242            zcmo(ji,jj,9)  = sst_m(ji,jj) 
    233243            zcmo(ji,jj,10) = sss_m(ji,jj) 
    … …  
    243253            zcmo(ji,jj,19) = sprecip(ji,jj) 
    244254            zcmo(ji,jj,20) = smt_i(ji,jj) 
    245             zcmo(ji,jj,21) = ot_i(ji,jj) 
    246255            zcmo(ji,jj,25) = et_i(ji,jj) 
    247256            zcmo(ji,jj,26) = et_s(ji,jj) 
    … …  
    250259 
    251260            zcmo(ji,jj,30) = bv_i(ji,jj) 
    252             zcmo(ji,jj,31) = hicol(ji,jj) 
     261            zcmo(ji,jj,31) = hicol(ji,jj) * zindb 
    253262            zcmo(ji,jj,32) = strength(ji,jj) 
    254263            zcmo(ji,jj,33) = SQRT(  zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8)  ) 
    255             zcmo(ji,jj,34) = diag_sur_me(ji,jj) * 86400.0 * zinda    ! Surface melt 
    256             zcmo(ji,jj,35) = diag_bot_me(ji,jj) * 86400.0 * zinda    ! Bottom melt 
     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 
    257266            zcmo(ji,jj,36) = divu_i(ji,jj) 
    258267            zcmo(ji,jj,37) = shear_i(ji,jj) 
    259          END DO 
     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 
    260278      END DO 
    261279 
    … …  
    264282      ! 
    265283      niter = niter + 1 
    266       DO jf = 1 , noumef 
    267          ! 
    268          zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) 
    269          ! 
    270          IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN   ;   CALL lbc_lnk( zfield, 'T', -1. ) 
    271          ELSE                                                            ;   CALL lbc_lnk( zfield, 'T',  1. ) 
    272          ENDIF 
    273          ! 
    274          IF( ln_nicep ) THEN  
    275             WRITE(numout,*) 
    276             WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim' 
    277             WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 
    278          ENDIF 
    279          IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 
    280          ! 
    281       END DO 
    282  
    283       IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 
    284          IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 
    285          CALL histclo( nice ) 
    286       ENDIF 
     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 
    287351 
    288352      !----------------------------- 
    … …  
    303367            DO jj = 1, jpj 
    304368               DO ji = 1, jpi 
    305                   zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 
    306                   zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * zinda 
     369                  zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
     370                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda 
    307371               END DO 
    308372            END DO 
    … …  
    315379               DO jj = 1, jpj 
    316380                  DO ji = 1, jpi 
    317                      zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 
     381                     zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
    318382                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 
    319                         ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), -1.0e-6 ) ) * & 
     383                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * & 
    320384                        zinda / nlay_i 
    321385                  END DO 
    … …  
    349413      CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 
    350414      CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 
     415 
     416      IF( nn_timing == 1 )  CALL timing_stop('limwri') 
    351417       
    352418   END SUBROUTINE lim_wri 
    … …  
    383449         field_25, field_26, field_27, field_28, field_29, field_30,   & 
    384450         field_31, field_32, field_33, field_34, field_35, field_36,   & 
    385          field_37 
     451         field_37, field_38, field_39, field_40, field_41, field_42, field_43 
    386452 
    387453      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield 
    … …  
    394460         field_25, field_26, field_27, field_28, field_29, field_30,   & 
    395461         field_31, field_32, field_33, field_34, field_35, field_36,   & 
    396          field_37, add_diag_swi 
     462         field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi 
    397463      !!------------------------------------------------------------------- 
    398464      REWIND( numnam_ice_ref )              ! Namelist namiceout in reference namelist : Ice outputs 
    … …  
    442508      zfield(36) = field_36 
    443509      zfield(37) = field_37 
     510      zfield(38) = field_38 
     511      zfield(39) = field_39 
     512      zfield(40) = field_40 
     513      zfield(41) = field_41 
     514      zfield(42) = field_42 
     515      zfield(43) = field_43 
    444516 
    445517      DO nf = 1, noumef 
    … …  
    467539      ! 
    468540   END SUBROUTINE lim_wri_init 
     541  
     542   SUBROUTINE lim_wri_state( kt, kid, kh_i ) 
     543      !!--------------------------------------------------------------------- 
     544      !!                 ***  ROUTINE lim_wri_state  *** 
     545      !!         
     546      !! ** Purpose :   create a NetCDF file named cdfile_name which contains  
     547      !!      the instantaneous ice state and forcing fields for ice model 
     548      !!        Used to find errors in the initial state or save the last 
     549      !!      ocean state in case of abnormal end of a simulation 
     550      !! 
     551      !! History : 
     552      !!   4.1  !  2013-06  (C. Rousset) 
     553      !!---------------------------------------------------------------------- 
     554      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index) 
     555      INTEGER, INTENT( in ) ::   kid , kh_i        
     556      !!---------------------------------------------------------------------- 
     557      !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz ) 
     558 
     559      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     560      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     561      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     562      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     563      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     564      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     565      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     566      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     567      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     568      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     569      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     570      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     571      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     572 
     573      !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     574      !CALL histdef( kid, "iice_hid", "Ice thickness by cat"    , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     575      !CALL histdef( kid, "iice_hsd", "Snow thickness by cat"   , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     576      !CALL histdef( kid, "iice_std", "Ice salinity by cat"     , "PSU"    , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     577 
     578      CALL histend( kid, snc4set )   ! end of the file definition 
     579 
     580      CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )     
     581      CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) ) 
     582      CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) ) 
     583      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) ) 
     584      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) ) 
     585      CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) ) 
     586      CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) ) 
     587      CALL histwrite( kid, "iicesflx", kt, qsr , jpi*jpj, (/1/) ) 
     588      CALL histwrite( kid, "iicenflx", kt, qns , jpi*jpj, (/1/) ) 
     589      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) ) 
     590      CALL histwrite( kid, "iicesali", kt, smt_i          , jpi*jpj, (/1/) ) 
     591      CALL histwrite( kid, "iicevolu", kt, vt_i           , jpi*jpj, (/1/) ) 
     592      CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) ) 
     593 
     594      !CALL histwrite( kid, "iice_itd", kt, a_i  , jpi*jpj*jpl, (/1/)  )   ! area 
     595      !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/)  )   ! thickness 
     596      !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/)  )   ! snow depth 
     597      !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/)  )   ! salinity 
     598 
     599    END SUBROUTINE lim_wri_state 
    469600 
    470601#else 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r4147 r4161  
    108108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_b       !: Ice age                        [days] 
    109109 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
     111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
     112 
    110113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s 
    111114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i 
    … …  
    138141 
    139142   !!---------------------------------------------------------------------- 
    140    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     143   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    141144   !! $Id$ 
    142145   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    157160         &      fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) ,     & 
    158161         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) ,     & 
    159          &      qfvbq_1d (jpij) , t_bo_b   (jpij)                     , STAT=ierr(1) ) 
     162         &      qfvbq_1d (jpij) , t_bo_b   (jpij) , iatte_1d   (jpij) ,     & 
     163         &      oatte_1d (jpij)                                       , STAT=ierr(1) ) 
    160164      ! 
    161165      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     & 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r4152 r4161  
    55   !!====================================================================== 
    66   !! History :  3.3  ! 2010-09  (M. Leclair)  Original code  
     7   !!                 ! 2012-10  (C. Rousset)  add iom_put 
    78   !!---------------------------------------------------------------------- 
    89 
    … …  
    2122   USE bdy_par         ! (for lk_bdy) 
    2223   USE timing          ! preformance summary 
    23    USE lib_fortran 
    24    USE sbcrnf 
     24   USE iom             ! I/O manager 
     25   USE lib_fortran     ! glob_sum 
     26   USE restart         ! ocean restart 
     27   USE wrk_nemo         ! work arrays 
    2528 
    2629   IMPLICIT NONE 
    … …  
    2831 
    2932   PUBLIC   dia_hsb        ! routine called by step.F90 
    30    PUBLIC   dia_hsb_init   ! routine called by opa.F90 
     33   PUBLIC   dia_hsb_init   ! routine called by nemogcm.F90 
     34   PUBLIC   dia_hsb_rst    ! routine called by step.F90 
    3135 
    3236   LOGICAL, PUBLIC ::   ln_diahsb   !: check the heat and salt budgets 
    3337 
    34    INTEGER                                 ::   numhsb                           ! 
    35    REAL(dp)                                ::   surf_tot   , vol_tot             ! 
    36    REAL(dp)                                ::   frc_t      , frc_s     , frc_v   ! global forcing trends 
    37    REAL(dp)                                ::   frc_wn_t      , frc_wn_s ! global forcing trends 
    38    REAL(dp)                                ::   fact1                            ! conversion factors 
    39    REAL(dp)                                ::   fact21    , fact22               !     -         - 
    40    REAL(dp)                                ::   fact31    , fact32               !     -         - 
    41    REAL(dp), DIMENSION(:,:)  , ALLOCATABLE ::   surf      , ssh_ini              ! 
    42    REAL(dp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  ! 
    43    REAL(dp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini 
     38   REAL(wp), SAVE                                ::   frc_t      , frc_s     , frc_v   ! global forcing trends 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ssh_ini              ! 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hc_loc_ini, sc_loc_ini, e3t_ini  ! 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hcssh_loc_ini, scssh_loc_ini     ! 
    4442 
    4543   !! * Substitutions 
    … …  
    6563      !!             - Compute the contribution of forcing and remove it from these deviations 
    6664      !! 
    67       !! ** Action : Write the results in the 'heat_salt_volume_budgets.txt' ASCII file 
    6865      !!--------------------------------------------------------------------------- 
    6966      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7067      !! 
    7168      INTEGER    ::   jk                          ! dummy loop indice 
    72       REAL(dp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations 
    73       REAL(dp)   ::   zdiff_hc1   , zdiff_sc1     ! heat and salt content variations of ssh 
    74       REAL(dp)   ::   zdiff_v1    , zdiff_v2      ! volume variation 
    75       REAL(dp)   ::   zerr_hc1    , zerr_sc1      ! Non conservation due to free surface 
    76       REAL(dp)   ::   zdeltat                     !    -     - 
    77       REAL(dp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     - 
    78       REAL(dp)   ::   z_frc_trd_v                 !    -     - 
    79       REAL(dp)   ::   z_wn_trd_t , z_wn_trd_s   !    -     - 
    80       REAL(dp)   ::   z_ssh_hc , z_ssh_sc   !    -     - 
    81       !!--------------------------------------------------------------------------- 
    82       IF( nn_timing == 1 )   CALL timing_start('dia_hsb') 
    83  
     69      REAL(wp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations 
     70      REAL(wp)   ::   zdiff_v1    , zdiff_v2      ! volume variation 
     71      REAL(wp)   ::   z_hc        , z_sc          ! heat and salt content 
     72      REAL(wp)   ::   z_v1        , z_v2          ! volume 
     73      REAL(wp)   ::   zdeltat                     !    -     - 
     74      REAL(wp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     - 
     75      REAL(wp)   ::   z_frc_trd_v                 !    -     - 
     76      REAL(wp), POINTER, DIMENSION(:,:)   ::   zsurf              ! 
     77      !!--------------------------------------------------------------------------- 
     78      IF( nn_timing == 1 )   CALL timing_start('dia_hsb')       
     79 
     80      CALL wrk_alloc( jpi, jpj, zsurf ) 
     81   
     82      zsurf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area 
     83       
    8484      ! ------------------------- ! 
    8585      ! 1 - Trends due to forcing ! 
    8686      ! ------------------------- ! 
    87       z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) )     ! volume fluxes 
    88       z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) )     ! heat fluxes 
    89       z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) )     ! salt fluxes 
    90       ! Add runoff heat & salt input 
    91       IF( ln_rnf    )   z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) ) 
    92       IF( ln_rnf_sal)   z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) ) 
     87      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) ) * zsurf(:,:) ) ! volume fluxes 
     88      z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * zsurf(:,:) )       ! heat fluxes 
     89      z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * zsurf(:,:) )       ! salt fluxes 
    9390      ! Add penetrative solar radiation 
    94       IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr     (:,:) * surf(:,:) ) 
     91      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr     (:,:) * zsurf(:,:) ) 
    9592      ! Add geothermal heat flux 
    96       IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t +  glob_sum( qgh_trd0(:,:) * surf(:,:) ) 
    97       IF( .NOT. lk_vvl ) THEN 
    98          z_wn_trd_t = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) ) 
    99          z_wn_trd_s = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) ) 
    100       ENDIF 
    101  
     93      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t +               glob_sum( qgh_trd0(:,:) * zsurf(:,:) ) 
     94      ! 
    10295      frc_v = frc_v + z_frc_trd_v * rdt 
    10396      frc_t = frc_t + z_frc_trd_t * rdt 
    10497      frc_s = frc_s + z_frc_trd_s * rdt 
    105       !                                          ! Advection flux through fixed surface (z=0) 
    106       IF( .NOT. lk_vvl ) THEN 
    107          frc_wn_t = frc_wn_t + z_wn_trd_t * rdt 
    108          frc_wn_s = frc_wn_s + z_wn_trd_s * rdt 
    109       ENDIF 
    110  
    111       ! ----------------------- ! 
    112       ! 2 -  Content variations ! 
    113       ! ----------------------- ! 
    114       zdiff_v2 = 0.d0 
    115       zdiff_hc = 0.d0 
    116       zdiff_sc = 0.d0 
    117  
     98 
     99      ! ------------------------ ! 
     100      ! 2a -  Content variations ! 
     101      ! ------------------------ ! 
     102      zdiff_v2 = 0._wp 
     103      zdiff_hc = 0._wp 
     104      zdiff_sc = 0._wp 
    118105      ! volume variation (calculated with ssh) 
    119       zdiff_v1 = glob_sum( surf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) ) 
    120  
    121       ! heat & salt content variation (associated with ssh) 
    122       IF( .NOT. lk_vvl ) THEN 
    123          z_ssh_hc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) ) 
    124          z_ssh_sc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) ) 
    125       ENDIF 
    126  
     106      zdiff_v1 = glob_sum( zsurf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) ) 
    127107      DO jk = 1, jpkm1 
    128         ! volume variation (calculated with scale factors) 
    129          zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk)   & 
    130             &                       * ( fse3t_n(:,:,jk)         & 
    131             &                           - e3t_ini(:,:,jk) ) ) 
     108         ! volume variation (calculated with scale factors) 
     109         zdiff_v2 = zdiff_v2 + glob_sum( zsurf(:,:) * tmask(:,:,jk) * ( fse3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 
    132110         ! heat content variation 
    133          zdiff_hc = zdiff_hc + glob_sum( surf(:,:) * tmask(:,:,jk)          & 
    134             &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem)   & 
     111         zdiff_hc = zdiff_hc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem)   & 
    135112            &                           - hc_loc_ini(:,:,jk) ) ) 
    136113         ! salt content variation 
    137          zdiff_sc = zdiff_sc + glob_sum( surf(:,:) * tmask(:,:,jk)          & 
    138             &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal)   & 
     114         zdiff_sc = zdiff_sc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal)   & 
    139115            &                           - sc_loc_ini(:,:,jk) ) ) 
    140116      ENDDO 
    141117 
    142118      ! Substract forcing from heat content, salt content and volume variations 
    143       zdiff_v1 = zdiff_v1 - frc_v 
    144       IF( lk_vvl )   zdiff_v2 = zdiff_v2 - frc_v 
    145       zdiff_hc = zdiff_hc - frc_t 
    146       zdiff_sc = zdiff_sc - frc_s 
    147       IF( .NOT. lk_vvl ) THEN 
    148          zdiff_hc1 = zdiff_hc + z_ssh_hc  
    149          zdiff_sc1 = zdiff_sc + z_ssh_sc 
    150          zerr_hc1  = z_ssh_hc - frc_wn_t 
    151          zerr_sc1  = z_ssh_sc - frc_wn_s 
    152       ENDIF 
     119      !frc_v = zdiff_v2 - frc_v 
     120      !frc_t = zdiff_hc - frc_t 
     121      !frc_s = zdiff_sc - frc_s 
    153122       
     123      ! add ssh if not vvl 
     124#if ! defined key_vvl 
     125     zdiff_v2 = zdiff_v2 + zdiff_v1 
     126     zdiff_hc = zdiff_hc + glob_sum( zsurf(:,:) * ( sshn(:,:) * tsn(:,:,1,jp_tem)   & 
     127            &                           - hcssh_loc_ini(:,:) ) ) 
     128     zdiff_sc = zdiff_sc + glob_sum( zsurf(:,:) * ( sshn(:,:) * tsn(:,:,1,jp_sal)   & 
     129            &                           - scssh_loc_ini(:,:) ) ) 
     130#endif  
     131      ! 
     132      ! ----------------------- ! 
     133      ! 2b -  Content           ! 
     134      ! ----------------------- ! 
     135      z_v2 = 0._wp 
     136      z_hc = 0._wp 
     137      z_sc = 0._wp 
     138      ! volume (calculated with ssh) 
     139      z_v1 = glob_sum( zsurf(:,:) * sshn(:,:) ) 
     140      DO jk = 1, jpkm1 
     141         ! volume (calculated with scale factors) 
     142         z_v2 = z_v2 + glob_sum( zsurf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) ) 
     143         ! heat content 
     144         z_hc = z_hc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) ) 
     145         ! salt content 
     146         z_sc = z_sc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) ) 
     147      ENDDO 
     148      ! add ssh if not vvl 
     149#if ! defined key_vvl 
     150     z_v2 = z_v2 + z_v1 
     151     z_hc = z_hc + glob_sum( zsurf(:,:) * sshn(:,:) * tsn(:,:,1,jp_tem) ) 
     152     z_sc = z_sc + glob_sum( zsurf(:,:) * sshn(:,:) * tsn(:,:,1,jp_sal) ) 
     153#endif  
     154 
    154155      ! ----------------------- ! 
    155156      ! 3 - Diagnostics writing ! 
    156157      ! ----------------------- ! 
    157158      zdeltat  = 1.e0 / ( ( kt - nit000 + 1 ) * rdt ) 
    158       IF( lk_vvl ) THEN 
    159          WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1  * zdeltat,                                & 
    160             &                      zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat,   & 
    161             &                      zdiff_v1           , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat,   & 
    162             &                      zdiff_v2           , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat 
    163       ELSE 
    164          WRITE(numhsb , 9030) kt , zdiff_hc1 / vol_tot , zdiff_hc1 * fact1  * zdeltat,                                & 
    165             &                      zdiff_sc1 / vol_tot , zdiff_sc1 * fact21 * zdeltat, zdiff_sc1 * fact22 * zdeltat,   & 
    166             &                      zdiff_v1            , zdiff_v1  * fact31 * zdeltat, zdiff_v1  * fact32 * zdeltat,   & 
    167             &                      zerr_hc1 / vol_tot  , zerr_sc1 / vol_tot 
    168       ENDIF 
    169  
    170       IF ( kt == nitend ) CLOSE( numhsb ) 
    171  
     159! 
     160      CALL iom_put( 'bgtemper' , z_hc / z_v2 )                      ! Temperature (C)  
     161      CALL iom_put( 'bgsaline' , z_sc / z_v2 )                      ! Salinity (psu) 
     162      CALL iom_put( 'bgheatco' , zdiff_hc * rau0 * rcp * 1.e-9_wp ) ! Heat content variation (10^9 J) 
     163      CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 )                 ! Salt content variation (psu*km3)  
     164      CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 )                    ! volume ssh (km3)   
     165      CALL iom_put( 'bgsshtot' , zdiff_v1 / glob_sum(zsurf) )          ! ssh (m)   
     166      CALL iom_put( 'bgvoltot' , zdiff_v2 * 1.e-9 )                 ! volume total (km3)  
     167      CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 )                     ! vol - surface forcing (volume)  
     168      CALL iom_put( 'bgfrctem' , frc_t * rau0 * rcp * 1.e-9_wp ) ! hc  - surface forcing (heat content)  
     169      CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 )                     ! sc  - surface forcing (salt content)  
     170      ! 
     171      CALL wrk_dealloc( jpi, jpj, zsurf ) 
     172      ! 
    172173      IF( nn_timing == 1 )   CALL timing_stop('dia_hsb') 
    173  
    174 9020  FORMAT(I5,11D15.7) 
    175 9030  FORMAT(I5,10D15.7) 
    176       ! 
     174! 
    177175   END SUBROUTINE dia_hsb 
    178176 
    … …  
    190188      !!             - Compute coefficients for conversion 
    191189      !!--------------------------------------------------------------------------- 
    192       CHARACTER (len=32) ::   cl_name  ! output file name 
    193190      INTEGER            ::   jk       ! dummy loop indice 
    194191      INTEGER            ::   ierror   ! local integer 
    195       INTEGER            ::   ios      ! Local integer output status for namelist read 
    196192      !! 
    197193      NAMELIST/namhsb/ ln_diahsb 
    198194      !!---------------------------------------------------------------------- 
    199195      ! 
    200       REWIND( numnam_ref )              ! Namelist namhsb in reference namelist : Heat & salt budget 
    201       READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 
    202 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp ) 
    203  
    204       REWIND( numnam_cfg )              ! Namelist namhsb in configuration namelist : Heat & salt budget 
    205       READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 
    206 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 
    207       WRITE ( numond, namhsb ) 
     196      REWIND ( numnam )              ! Read Namelist namhsb  
     197      READ   ( numnam, namhsb ) 
    208198      ! 
    209199      IF(lwp) THEN                   ! Control print 
    … …  
    216206 
    217207      IF( .NOT. ln_diahsb )   RETURN 
    218       IF( .NOT. lk_mpp_rep ) & 
    219         CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', & 
    220              &         ' whereas the global sum to be precise must be done in double precision ',& 
    221              &         ' please add key_mpp_rep') 
    222  
    223       ! ------------------- ! 
    224       ! 1 - Allocate memory ! 
    225       ! ------------------- ! 
    226       ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), & 
    227          &      ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj), & 
    228          &      e3t_ini(jpi,jpj,jpk)                            , & 
    229          &      surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror ) 
    230       IF( ierror > 0 ) THEN 
    231          CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
    232       ENDIF 
    233  
    234       ! ----------------------------------------------- ! 
    235       ! 2 - Time independant variables and file opening ! 
    236       ! ----------------------------------------------- ! 
    237       WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
    238       WRITE(numout,*) "~~~~~~~  output written in the 'heat_salt_volume_budgets.txt' ASCII file" 
    239       IF( lk_obc .or. lk_bdy ) THEN 
    240          CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
    241       ENDIF 
    242       cl_name    = 'heat_salt_volume_budgets.txt'                         ! name of output file 
    243       surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area 
    244       surf_tot  = glob_sum( surf(:,:) )                                       ! total ocean surface area 
    245       vol_tot   = 0.d0                                                   ! total ocean volume 
    246       DO jk = 1, jpkm1 
    247          vol_tot  = vol_tot + glob_sum( surf(:,:) * tmask(:,:,jk)     & 
    248             &                         * fse3t_n(:,:,jk)         ) 
    249       END DO 
    250  
    251       CALL ctl_opn( numhsb , cl_name , 'UNKNOWN' , 'FORMATTED' , 'SEQUENTIAL' , 1 , numout , lwp , 1 ) 
    252       IF( lk_vvl ) THEN 
    253          !                   12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 
    254          WRITE( numhsb, 9010 ) "kt   |     heat content budget     |            salt content budget             ",   & 
    255             !                                                   123456789012345678901234567890123456789012345 -> 45 
    256             &                                                  "|            volume budget (ssh)             ",   & 
    257             !                                                   678901234567890123456789012345678901234567890 -> 45 
    258             &                                                  "|            volume budget (e3t)             " 
    259          WRITE( numhsb, 9010 ) "     |      [C]         [W/m2]     |     [psu]        [mmm/s]          [SV]     ",   & 
    260             &                                                  "|     [m3]         [mmm/s]          [SV]     ",   & 
    261             &                                                  "|     [m3]         [mmm/s]          [SV]     " 
    262       ELSE 
    263          !                   12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 
    264          WRITE( numhsb, 9011 ) "kt   |     heat content budget     |            salt content budget             ",   & 
    265             !                                                   123456789012345678901234567890123456789012345 -> 45 
    266             &                                                  "|            volume budget (ssh)             ",   & 
    267             !                                                   678901234567890123456789012345678901234567890 -> 45 
    268             &                                                  "|  Non conservation due to free surface      " 
    269          WRITE( numhsb, 9011 ) "     |      [C]         [W/m2]     |     [psu]        [mmm/s]          [SV]     ",   & 
    270             &                                                  "|     [m3]         [mmm/s]          [SV]     ",   & 
    271             &                                                  "|  [heat - C]     [salt - psu]                " 
    272       ENDIF 
    273       ! --------------- ! 
    274       ! 3 - Conversions ! (factors will be multiplied by duration afterwards) 
    275       ! --------------- ! 
    276  
    277       ! heat content variation   =>   equivalent heat flux: 
    278       fact1  = rau0 * rcp / surf_tot                                         ! [C*m3]   ->  [W/m2] 
    279       ! salt content variation   =>   equivalent EMP and equivalent "flow":  
    280       fact21 = 1.e3  / ( soce * surf_tot )                                   ! [psu*m3] ->  [mm/s] 
    281       fact22 = 1.e-6 / soce                                                  ! [psu*m3] ->  [Sv] 
    282       ! volume variation         =>   equivalent EMP and equivalent "flow": 
    283       fact31 = 1.e3  / surf_tot                                              ! [m3]     ->  [mm/s] 
    284       fact32 = 1.e-6                                                         ! [m3]     ->  [SV] 
    285  
    286       ! ---------------------------------- ! 
    287       ! 4 - initial conservation variables ! 
    288       ! ---------------------------------- ! 
    289       ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
    290       DO jk = 1, jpk 
    291          e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors 
    292          hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content 
    293          sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
    294       END DO 
    295       frc_v = 0.d0                                           ! volume       trend due to forcing 
    296       frc_t = 0.d0                                           ! heat content   -    -   -    -    
    297       frc_s = 0.d0                                           ! salt content   -    -   -    -          
    298       IF( .NOT. lk_vvl ) THEN 
    299          ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * ssh_ini(:,:)   ! initial heat content associated with ssh 
    300          ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * ssh_ini(:,:)   ! initial salt content associated with ssh 
    301          frc_wn_t = 0.d0 
    302          frc_wn_s = 0.d0 
    303       ENDIF 
    304       ! 
    305 9010  FORMAT(A80,A45,A45) 
    306 9011  FORMAT(A80,A45,A45) 
     208 
     209         ! ------------------- ! 
     210         ! 1 - Allocate memory ! 
     211         ! ------------------- ! 
     212         ALLOCATE( hc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 
     213         IF( ierror > 0 ) THEN 
     214            CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
     215         ENDIF 
     216         ALLOCATE( sc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 
     217         IF( ierror > 0 ) THEN 
     218            CALL ctl_stop( 'dia_hsb: unable to allocate sc_loc_ini' )   ;   RETURN 
     219         ENDIF 
     220         ALLOCATE( hcssh_loc_ini(jpi,jpj), STAT=ierror ) 
     221         IF( ierror > 0 ) THEN 
     222            CALL ctl_stop( 'dia_hsb: unable to allocate hcssh_loc_ini' )   ;   RETURN 
     223         ENDIF 
     224         ALLOCATE( scssh_loc_ini(jpi,jpj), STAT=ierror ) 
     225         IF( ierror > 0 ) THEN 
     226            CALL ctl_stop( 'dia_hsb: unable to allocate scssh_loc_ini' )   ;   RETURN 
     227         ENDIF 
     228         ALLOCATE( e3t_ini(jpi,jpj,jpk)   , STAT=ierror ) 
     229         IF( ierror > 0 ) THEN 
     230            CALL ctl_stop( 'dia_hsb: unable to allocate e3t_ini' )      ;   RETURN 
     231         ENDIF 
     232         ALLOCATE( ssh_ini(jpi,jpj)       , STAT=ierror ) 
     233         IF( ierror > 0 ) THEN 
     234            CALL ctl_stop( 'dia_hsb: unable to allocate ssh_ini' )      ;   RETURN 
     235         ENDIF 
     236          
     237         ! ----------------------------------------------- ! 
     238         ! 2 - Time independant variables and file opening ! 
     239         ! ----------------------------------------------- ! 
     240         IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
     241         IF( lk_obc .or. lk_bdy ) THEN 
     242            CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
     243         ENDIF 
     244                                                     
     245         ! 
     246         CALL dia_hsb_rst( nit000, 'READ' )  !* read or initialize all required files 
    307247      ! 
    308248   END SUBROUTINE dia_hsb_init 
     249 
     250   SUBROUTINE dia_hsb_rst( kt, cdrw ) 
     251     !!--------------------------------------------------------------------- 
     252     !!                   ***  ROUTINE limdia_rst  *** 
     253     !!                      
     254     !! ** Purpose :   Read or write DIA file in restart file 
     255     !! 
     256     !! ** Method  :   use of IOM library 
     257     !!---------------------------------------------------------------------- 
     258     INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
     259     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
     260     ! 
     261     INTEGER ::   jk   !  
     262     INTEGER ::   id1   ! local integers 
     263     !!---------------------------------------------------------------------- 
     264     ! 
     265     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     266        IF( ln_rstart ) THEN                   !* Read the restart file 
     267           !id1 = iom_varid( numror, 'frc_vol'  , ldstop = .FALSE. ) 
     268           ! 
     269           CALL iom_get( numror, 'frc_v', frc_v ) 
     270           CALL iom_get( numror, 'frc_t', frc_t ) 
     271           CALL iom_get( numror, 'frc_s', frc_s ) 
     272 
     273           CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 
     274           CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 
     275           CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini ) 
     276           CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini ) 
     277           CALL iom_get( numror, jpdom_autoglo, 'hcssh_loc_ini', hcssh_loc_ini ) 
     278           CALL iom_get( numror, jpdom_autoglo, 'scssh_loc_ini', scssh_loc_ini ) 
     279       ELSE 
     280          ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
     281          DO jk = 1, jpk 
     282             e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors 
     283             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content 
     284             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
     285          END DO 
     286          hcssh_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
     287          scssh_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
     288          frc_v = 0._wp                                            
     289          frc_t = 0._wp                                            
     290          frc_s = 0._wp                                                   
     291       ENDIF 
     292 
     293     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
     294        !                                   ! ------------------- 
     295        IF(lwp) WRITE(numout,*) '---- dia-rst ----' 
     296        CALL iom_rstput( kt, nitrst, numrow, 'frc_v'   , frc_v     ) 
     297        CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     ) 
     298        CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     ) 
     299         
     300        CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 
     301        CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 
     302        CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 
     303        CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 
     304        CALL iom_rstput( kt, nitrst, numrow, 'hcssh_loc_ini', hcssh_loc_ini ) 
     305        CALL iom_rstput( kt, nitrst, numrow, 'scssh_loc_ini', scssh_loc_ini ) 
     306        ! 
     307     ENDIF 
     308     ! 
     309   END SUBROUTINE dia_hsb_rst 
    309310 
    310311   !!====================================================================== 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r3704 r4161  
    4848#if defined key_lim2 
    4949   USE limwri_2  
     50#elif defined key_lim3 
     51   USE limwri  
    5052#endif 
    5153   USE lib_mpp         ! MPP library 
    … …  
    842844#if defined key_lim2 
    843845      CALL lim_wri_state_2( kt, id_i, nh_i ) 
     846#elif defined key_lim3 
     847      CALL lim_wri_state( kt, id_i, nh_i ) 
    844848#else 
    845849      CALL histend( id_i, snc4chunks=snc4set ) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r4153 r4161  
    406406 
    407407 
    408    FUNCTION iom_varid ( kiomid, cdvar, kdimsz, ldstop )   
     408   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )   
    409409      !!----------------------------------------------------------------------- 
    410410      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    415415      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    416416      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
     417      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
    417418      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.) 
    418419      ! 
    … …  
    446447                  SELECT CASE (iom_file(kiomid)%iolib) 
    447448                  CASE (jpioipsl )   ;   iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz ) 
    448                   CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz ) 
     449                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz, kndims ) 
    449450                  CASE (jprstdimg)   ;   iom_varid = -1   ! all variables are listed in iom_file 
    450451                  CASE DEFAULT    
    … …  
    467468                  ENDIF 
    468469               ENDIF 
     470               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv) 
    469471            ENDIF 
    470472         ENDIF 
    … …  
    12181220      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 
    12191221      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op = cl1//'ts', freq_offset='0ts') 
     1222      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op = cl1//'ts', freq_offset='0ts') 
    12201223      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op = cl1//'ts', freq_offset='0ts') 
    12211224      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op = cl1//'ts', freq_offset='0ts') 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r2715 r4161  
    181181 
    182182 
    183    FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz )   
     183   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )   
    184184      !!----------------------------------------------------------------------- 
    185185      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    191191      INTEGER              , INTENT(in   )           ::   kiv   !  
    192192      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
     193      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
    193194      ! 
    194195      INTEGER                        ::   iom_nf90_varid   ! iom variable Id 
    … …  
    242243            ENDIF 
    243244         ENDIF 
     245         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv) 
    244246      ELSE   
    245247         iom_nf90_varid = -1   !   variable not found, return error code: -1 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r4148 r4161  
    99   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step 
    1010   !!            3.3  ! 2010-10  (J. Chanut, C. Bricaud)  add the surface pressure forcing 
     11   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model  
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    5354   ! 
    5455   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs 
    55  
     56   ! 
     57   CHARACTER (len=8), PUBLIC :: cn_iceflx = 'none' !: Flux handling over ice categories 
     58   LOGICAL, PUBLIC :: ln_iceflx_ave    = .FALSE. ! Average heat fluxes over all ice categories 
     59   LOGICAL, PUBLIC :: ln_iceflx_linear = .FALSE. ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 
     60   ! 
    5661   !!---------------------------------------------------------------------- 
    5762   !!              Ocean Surface Boundary Condition fields 
    … …  
    7681   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts 
    7782   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk 
     83   !! 
     84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   oatte, iatte      !: clem attenuation coef of the input solar flux [unitless] 
    7885   !! 
    7986   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip           !: total precipitation                          [Kg/m2/s] 
    … …  
    120127         ! 
    121128      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 
    122          &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) ) 
     129         &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,     & 
     130         &      iatte(jpi,jpj) , oatte    (jpi,jpj)                              , STAT=ierr(3) ) 
    123131         ! 
    124132      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     & 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4147 r4161  
    4242   USE sbc_ice         ! Surface boundary condition: ice fields 
    4343#endif 
     44   USE lib_fortran     ! to use key_nosignedzero 
    4445 
    4546   IMPLICIT NONE 
    … …  
    6970   REAL(wp), PARAMETER ::   Ls   =    2.839e6     ! latent heat of sublimation 
    7071   REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant 
    71    REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice 
     72   REAL(wp), PARAMETER ::   Cice =    1.4e-3      ! iovi 1.63e-3     ! transfer coefficient over ice 
    7273   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be constant 
    7374 
    … …  
    7677   LOGICAL  ::   ln_taudif   ! logical flag to use the "mean of stress module - module of mean stress" data 
    7778   REAL(wp) ::   rn_pfac     ! multiplication factor for precipitation 
     79   REAL(wp) ::   rn_efac     ! multiplication factor for evaporation (clem) 
     80   REAL(wp) ::   rn_vfac     ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem) 
    7881 
    7982   !! * Substitutions 
    … …  
    126129      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files 
    127130      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read 
    128       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr             ! informations about the fields to be read 
    129       TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif   !       -                       - 
    130       NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           & 
     131      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
     132      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 " 
     133      TYPE(FLD_N) ::   sn_tdif                                 !   "                                 " 
     134      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac, rn_efac, rn_vfac,  & 
    131135         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
    132136         &                  sn_qlw , sn_tair, sn_prec  , sn_snow, sn_tdif 
    … …  
    274278      DO jj = 2, jpjm1 
    275279         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    276             zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
    277             zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
     280            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
     281            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    278282         END DO 
    279283      END DO 
    … …  
    359363      IF( ln_2m ) THEN 
    360364         ! Values of temp. and hum. adjusted to 10m must be used instead of 2m values 
    361          zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) )   ! Evaporation 
    362          zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) ) * wndm(:,:)     ! Sensible Heat 
     365         zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) )   ! Evaporation 
     366         zqsb (:,:) =                      rhoa*cpa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) ) * wndm(:,:)     ! Sensible Heat 
    363367      ELSE 
    364368!CDIR COLLAPSE 
    365          zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation 
     369         zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation 
    366370!CDIR COLLAPSE 
    367371         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat 
    … …  
    505509               ! ... scalar wind at I-point (fld being at T-point) 
    506510               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
    507                   &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - pui(ji,jj) 
     511                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pui(ji,jj) 
    508512               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
    509                   &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - pvi(ji,jj) 
     513                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pvi(ji,jj) 
    510514               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    511515               ! ... ice stress at I-point 
    … …  
    513517               p_tauj(ji,jj) = zwnorm_f * zwndj_f 
    514518               ! ... scalar wind at T-point (fld being at T-point) 
    515                zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
    516                   &                                          + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
    517                zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
    518                   &                                          + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
     519               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
     520                  &                                                    + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
     521               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
     522                  &                                                    + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
    519523               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    520524            END DO 
    … …  
    530534         DO jj = 2, jpj 
    531535            DO ji = fs_2, jpi   ! vect. opt. 
    532                zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
    533                zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
     536               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
     537               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
    534538               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    535539            END DO 
    … …  
    541545            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    542546               p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj  ) + z_wnds_t(ji,jj) )                          & 
    543                   &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) ) 
     547                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) ) 
    544548               p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1  ) + z_wnds_t(ji,jj) )                          & 
    545                   &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) ) 
     549                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) ) 
    546550            END DO 
    547551         END DO 
    … …  
    569573               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    570574               ! Long  Wave (lw) 
    571                z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1) 
     575               ! iovino 
     576               IF( ff(ji,jj) .GT. 0._wp ) THEN 
     577                  z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     578               ELSE 
     579                  z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     580               ENDIF 
    572581               ! lw sensitivity 
    573582               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
    … …  
    581590               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
    582591               ! Latent Heat 
    583                p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                            
    584                   &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
     592               p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                            
     593                  &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    585594               ! Latent heat sensitivity for ice (Dqla/Dt) 
    586                p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     595               p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
    587596               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    588597               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
    … …  
    615624!CDIR COLLAPSE 
    616625      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    617       CALL iom_put( 'snowpre', p_spr )                  ! Snow precipitation  
     626      CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation  
     627      CALL iom_put( 'precip', p_tpr * 86400. )                   ! Total precipitation  
    618628      ! 
    619629      IF(ln_ctl) THEN 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4148 r4161  
    456456      ! Coupled case: since cloud cover is not received from atmosphere  
    457457      !               ===> defined as constant value -> definition done in sbc_cpl_init 
    458       fr1_i0(:,:) = 0.18 
    459       fr2_i0(:,:) = 0.82 
     458      IF ( ALLOCATED (fr1_i0)) fr1_i0 (:,:) = 0.18 
     459      IF ( ALLOCATED (fr2_i0)) fr2_i0 (:,:) = 0.82 
    460460      !                                                      ! ------------------------- ! 
    461461      !                                                      !      10m wind module      !    
    … …  
    916916      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    917917 
    918       IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
     918!AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 
     919      IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN   ;   itx =  jpr_itx1    
    919920      ELSE                                ;   itx =  jpr_otx1 
    920921      ENDIF 
    … …  
    923924      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN 
    924925 
    925          !                                                      ! ======================= ! 
    926          IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
    927             !                                                   ! ======================= ! 
     926         !                                                                                              ! ======================= ! 
     927!AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 
     928         IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN               !   ice stress received   ! 
     929            !                                                                                           ! ======================= ! 
    928930            !   
    929931            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r3625 r4161  
    129129                                                      ! sum over the global domain 
    130130            a_fwb   = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 
    131             a_fwb   = a_fwb * 1.e+3 / ( area * 86400. * 365. )     ! convert in Kg/m3/s = mm/s 
     131            a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s 
    132132!!gm        !                                                      !!bug 365d year  
    133133            fwfold =  a_fwb                           ! current year freshwater budget correction 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r4147 r4161  
    100100          
    101101         fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
    102 #if defined key_coupled  
     102 
     103! OM : probleme. a_i pas defini dans les cas lim3 et cice 
     104#if defined key_coupled && defined key_lim2 
    103105         a_i(:,:,1) = fr_i(:,:)          
    104106#endif 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r3625 r4161  
    1111   !!            3.3  ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step 
    1212   !!            3.4  ! 2011-01  (A Porter)  dynamical allocation 
     13   !!             -   ! 2012-10  (C. Rousset)  add lim_diahsb 
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_lim3 
    … …  
    3132   USE sbcblk_core     ! Surface boundary condition: CORE bulk 
    3233   USE sbcblk_clio     ! Surface boundary condition: CLIO bulk 
     34   USE sbccpl          ! Surface boundary condition: coupled interface 
    3335   USE albedo          ! ocean & ice albedo 
    3436 
    … …  
    4143   USE limitd_me       ! Mechanics on ice thickness distribution 
    4244   USE limsbc          ! sea surface boundary condition 
    43    USE limdia          ! Ice diagnostics 
     45   USE limdiahsb       ! Ice budget diagnostics 
    4446   USE limwri          ! Ice outputs 
    4547   USE limrst          ! Ice restarts 
    46    USE limupdate       ! update of global variables 
     48   USE limupdate1       ! update of global variables 
     49   USE limupdate2       ! update of global variables 
    4750   USE limvar          ! Ice variables switch 
    4851 
    … …  
    5154   USE lib_mpp         ! MPP library 
    5255   USE wrk_nemo        ! work arrays 
     56   USE timing          ! Timing 
    5357   USE iom             ! I/O manager library 
    5458   USE in_out_manager  ! I/O manager 
    5559   USE prtctl          ! Print control 
     60 
     61#if defined key_bdy  
     62   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine) 
     63#endif 
    5664 
    5765   IMPLICIT NONE 
    … …  
    6977   !!---------------------------------------------------------------------- 
    7078CONTAINS 
     79 
     80   FUNCTION fice_cell_ave ( ptab) 
     81      !!-------------------------------------------------------------------------- 
     82      !! * Compute average over categories, for grid cell (ice covered and free ocean) 
     83      !!-------------------------------------------------------------------------- 
     84      REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave 
     85      REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 
     86      INTEGER :: jl ! Dummy loop index 
     87       
     88      fice_cell_ave (:,:) = 0.0_wp 
     89       
     90      DO jl = 1, jpl 
     91         fice_cell_ave (:,:) = fice_cell_ave (:,:) & 
     92            &                  + a_i (:,:,jl) * ptab (:,:,jl) 
     93      END DO 
     94       
     95   END FUNCTION fice_cell_ave 
     96    
     97   FUNCTION fice_ice_ave ( ptab) 
     98      !!-------------------------------------------------------------------------- 
     99      !! * Compute average over categories, for ice covered part of grid cell 
     100      !!-------------------------------------------------------------------------- 
     101      REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave 
     102      REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab 
     103 
     104      fice_ice_ave (:,:) = 0.0_wp 
     105      WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 
     106 
     107   END FUNCTION fice_ice_ave 
     108 
     109   !!====================================================================== 
    71110 
    72111   SUBROUTINE sbc_ice_lim( kt, kblk ) 
    … …  
    96135      REAL(wp) ::   zcoef   ! local scalar 
    97136      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice_os, zalb_ice_cs  ! albedo of the ice under overcast/clear sky 
     137      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice      ! mean albedo of ice (for coupled) 
     138 
     139      REAL(wp), POINTER, DIMENSION(:,:) :: zalb_ice_all    ! Mean albedo over all categories 
     140      REAL(wp), POINTER, DIMENSION(:,:) :: ztem_ice_all    ! Mean temperature over all categories 
     141       
     142      REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_ice_all   ! Mean solar heat flux over all categories 
     143      REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_ice_all   ! Mean non solar heat flux over all categories 
     144      REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_ice_all   ! Mean latent heat flux over all categories 
     145      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all  ! Mean d(qns)/dT over all categories 
     146      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all  ! Mean d(qla)/dT over all categories 
    98147      !!---------------------------------------------------------------------- 
    99148 
     149      !- O.M. : why do we allocate all these arrays even when MOD( kt-1, nn_fsbc ) /= 0 ????? 
     150 
     151      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
     152 
    100153      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
     154 
     155      IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
     156         CALL wrk_alloc( jpi,jpj,jpl, zalb_ice) 
     157      END IF 
     158      IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
     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 
     161 
    101162 
    102163      IF( kt == nit000 ) THEN 
    … …  
    108169         ! 
    109170         IF( ln_nicep ) THEN      ! control print at a given point 
    110             jiindx = 44   ;   jjindx = 140 
     171            jiindx = 15   ;   jjindx = 46 
    111172            WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 
    112173         ENDIF 
    … …  
    129190            t_su(:,:,jl) = t_su(:,:,jl) +  rt0 * ( 1. - tmask(:,:,1) ) 
    130191         END DO 
     192 
     193         IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) ) 
     194          
     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            ! 
     201         ENDIF 
    131202                                                     ! Bulk formulea - provides the following fields: 
    132203         ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2] 
    … …  
    151222               &                      tprecip   , sprecip   ,                            & 
    152223               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  ) 
     224            ! 
     225         CASE ( 5 ) 
     226            zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) ) 
     227             
     228            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
     229 
     230            CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=tn_ice    ) 
     231 
     232            ! Latent heat flux is forced to 0 in coupled : 
     233            !  it is included in qns (non-solar heat flux) 
     234            qla_ice  (:,:,:) = 0.0e0_wp 
     235            dqla_ice (:,:,:) = 0.0e0_wp 
     236            ! 
    153237         END SELECT 
     238 
     239         ! Average over all categories 
     240         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
     241 
     242            z_qns_ice_all  (:,:) = fice_ice_ave ( qns_ice  (:,:,:) ) 
     243            z_qsr_ice_all  (:,:) = fice_ice_ave ( qsr_ice  (:,:,:) ) 
     244            z_dqns_ice_all (:,:) = fice_ice_ave ( dqns_ice (:,:,:) ) 
     245            z_qla_ice_all  (:,:) = fice_ice_ave ( qla_ice  (:,:,:) ) 
     246            z_dqla_ice_all (:,:) = fice_ice_ave ( dqla_ice (:,:,:) ) 
     247 
     248            DO jl = 1, jpl 
     249               dqns_ice (:,:,jl) = z_dqns_ice_all (:,:) 
     250               dqla_ice (:,:,jl) = z_dqla_ice_all (:,:) 
     251            END DO 
     252            ! 
     253            IF ( ln_iceflx_ave ) THEN 
     254               DO jl = 1, jpl 
     255                  qns_ice  (:,:,jl) = z_qns_ice_all  (:,:) 
     256                  qsr_ice  (:,:,jl) = z_qsr_ice_all  (:,:) 
     257                  qla_ice  (:,:,jl) = z_qla_ice_all  (:,:) 
     258               END DO 
     259            END IF 
     260            ! 
     261            IF ( ln_iceflx_linear ) THEN 
     262               DO jl = 1, jpl 
     263                  qns_ice  (:,:,jl) = z_qns_ice_all(:,:) + z_dqns_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 
     264                  qla_ice  (:,:,jl) = z_qla_ice_all(:,:) + z_dqla_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 
     265                  qsr_ice  (:,:,jl) = (1.0e0_wp-zalb_ice(:,:,jl)) / (1.0e0_wp-zalb_ice_all(:,:)) * z_qsr_ice_all(:,:) 
     266               END DO 
     267            END IF 
     268         END IF 
    154269 
    155270         !                                           !----------------------! 
    … …  
    178293         d_oa_i_thd (:,:,:)   = 0._wp   ;   d_oa_i_trp (:,:,:)   = 0._wp 
    179294         ! 
    180          sfx    (:,:) = 0._wp 
     295         sfx    (:,:) = 0._wp   ;   sfx_thd  (:,:) = 0._wp 
    181296         sfx_bri(:,:) = 0._wp   ;   sfx_mec  (:,:) = 0._wp   ;   sfx_res  (:,:) = 0._wp 
    182297         fhbri  (:,:) = 0._wp   ;   fheat_mec(:,:) = 0._wp   ;   fheat_res(:,:) = 0._wp 
    … …  
    185300         focea2D(:,:) = 0._wp 
    186301         fsup2D (:,:) = 0._wp 
    187          !  
     302 
     303         ! used in limthd.F90 
     304         rdvosif(:,:) = 0._wp   ! variation of ice volume at surface 
     305         rdvobif(:,:) = 0._wp   ! variation of ice volume at bottom 
     306         fdvolif(:,:) = 0._wp   ! total variation of ice volume 
     307         rdvonif(:,:) = 0._wp   ! lateral variation of ice volume 
     308         fstric (:,:) = 0._wp   ! part of solar radiation transmitted through the ice 
     309         ffltbif(:,:) = 0._wp   ! linked with fstric 
     310         qfvbq  (:,:) = 0._wp   ! linked with fstric 
     311         rdm_snw(:,:) = 0._wp   ! variation of snow mass per unit area 
     312         rdm_ice(:,:) = 0._wp   ! variation of ice mass per unit area 
     313         hicifp (:,:) = 0._wp   ! daily thermodynamic ice production.  
     314         ! 
    188315         diag_sni_gr(:,:) = 0._wp   ;   diag_lat_gr(:,:) = 0._wp 
    189316         diag_bot_gr(:,:) = 0._wp   ;   diag_dyn_gr(:,:) = 0._wp 
    190317         diag_bot_me(:,:) = 0._wp   ;   diag_sur_me(:,:) = 0._wp 
     318         diag_res_pr(:,:) = 0._wp   ;   diag_trp_vi(:,:) = 0._wp 
    191319         ! dynamical invariants 
    192320         delta_i(:,:) = 0._wp       ;   divu_i(:,:) = 0._wp       ;   shear_i(:,:) = 0._wp 
    … …  
    199327                          CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics ) 
    200328                          CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion ) 
    201                           CALL lim_var_agg(1)             ! aggregate categories, requested 
    202329                          CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
    203330         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx,-1, ' - ice dyn & trp - ' )   ! control print 
    204331                          CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting) 
     332                          CALL lim_var_agg( 1 )  
     333                          CALL lim_update1 
    205334         ENDIF 
     335!                         !- Change old values for new values 
     336                          old_u_ice(:,:)   = u_ice (:,:) 
     337                          old_v_ice(:,:)   = v_ice (:,:) 
     338                          old_a_i(:,:,:)   = a_i (:,:,:) 
     339                          old_v_s(:,:,:)   = v_s (:,:,:) 
     340                          old_v_i(:,:,:)   = v_i (:,:,:) 
     341                          old_e_s(:,:,:,:) = e_s (:,:,:,:) 
     342                          old_e_i(:,:,:,:) = e_i (:,:,:,:) 
     343                          old_oa_i(:,:,:)  = oa_i(:,:,:) 
     344                          old_smv_i(:,:,:) = smv_i (:,:,:) 
    206345         !                                           ! Ice thermodynamics  
    207346                          CALL lim_var_glo2eqv            ! equivalent variables 
    … …  
    217356         !                                           ! Global variables update 
    218357                          CALL lim_var_agg( 1 )           ! requested by limupdate 
    219                           CALL lim_update                 ! Global variables update 
     358                          CALL lim_update2                 ! Global variables update 
     359#if defined key_bdy 
     360                          CALL bdy_ice_lim( kt )          ! clem modif: bdy ice 
     361#endif 
    220362                          CALL lim_var_glo2eqv            ! equivalent variables (outputs) 
    221363                          CALL lim_var_agg(2)             ! aggregate ice thickness categories 
    … …  
    227369         ! 
    228370         !                                           ! Diagnostics and outputs  
    229          IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp )   & 
    230             &             CALL lim_dia  
     371         IF (ln_limdiaout) CALL lim_diahsb 
     372!clem # if ! defined key_iomput 
    231373                          CALL lim_wri( 1  )              ! Ice outputs  
     374!clem # endif 
     375         IF( kt == nit000 )   CALL iom_close( numrir )  ! clem: close input ice restart file 
    232376         IF( lrst_ice )   CALL lim_rst_write( kt )        ! Ice restart file  
    233377                          CALL lim_var_glo2eqv            ! ??? 
    … …  
    248392      ! 
    249393      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
     394      IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
     395         CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice) 
     396      END IF 
     397      IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
     398         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) 
     399      ENDIF 
     400      ! 
     401      IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim') 
    250402      ! 
    251403   END SUBROUTINE sbc_ice_lim 
    … …  
    607759!       WRITE(numout,*) ' sfx_bri    : ', sfx_bri  (ki,kj) 
    608760!       WRITE(numout,*) ' sfx        : ', sfx      (ki,kj) 
    609 !       WRITE(numout,*) ' fsalt_res  : ', fsalt_res(ki,kj) 
     761!       WRITE(numout,*) ' sfx_res  : ', sfx_res(ki,kj) 
    610762        WRITE(numout,*) ' fmmec      : ', fmmec    (ki,kj) 
    611763        WRITE(numout,*) ' fhmec      : ', fhmec    (ki,kj) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4153 r4161  
    4242   USE sbcfwb           ! surface boundary condition: freshwater budget 
    4343   USE closea           ! closed sea 
    44    USE bdy_par          ! for lk_bdy 
    45    USE bdyice_lim2      ! unstructured open boundary data  (bdy_ice_lim_2 routine) 
    4644   USE icbstp           ! Icebergs! 
    4745 
    … …  
    8684      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
    8785         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    88          &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw 
     86         &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, cn_iceflx 
    8987      INTEGER  ::   ios 
    9088      !!---------------------------------------------------------------------- 
    … …  
    126124         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    127125         WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl 
     126         WRITE(numout,*) '              Flux handling over ice categories          cn_iceflx   = ', TRIM (cn_iceflx) 
    128127         WRITE(numout,*) '           Misc. options of sbc : ' 
    129128         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn 
    … …  
    137136      ENDIF 
    138137 
     138      !   Flux handling over ice categories  
     139      SELECT CASE ( TRIM (cn_iceflx)) 
     140      CASE ('ave') 
     141         ln_iceflx_ave    = .TRUE. 
     142         ln_iceflx_linear = .FALSE. 
     143      CASE ('linear') 
     144         ln_iceflx_ave    = .FALSE. 
     145         ln_iceflx_linear = .TRUE. 
     146      CASE default 
     147         ln_iceflx_ave    = .FALSE. 
     148         ln_iceflx_linear = .FALSE. 
     149      END SELECT 
     150      IF(lwp) WRITE(numout,*) '              Fluxes averaged over all ice categories         ln_iceflx_ave    = ', ln_iceflx_ave 
     151      IF(lwp) WRITE(numout,*) '              Fluxes distributed linearly over ice categories ln_iceflx_linear = ', ln_iceflx_linear 
     152      ! 
    139153      !                              ! allocate sbc arrays 
    140154      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) 
    … …  
    175189      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
    176190         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 
     191 
     192      IF( ln_iceflx_ave .AND. ln_iceflx_linear ) & 
     193         &   CALL ctl_stop( ' ln_iceflx_ave and ln_iceflx_linear options are not compatible' ) 
     194 
     195      IF( ( nn_ice ==3 .AND. lk_cpl) .AND. .NOT. ( ln_iceflx_ave .OR. ln_iceflx_linear ) ) & 
     196         &   CALL ctl_stop( ' With lim3 coupled, either ln_iceflx_ave or ln_iceflx_linear must be set to .TRUE.' ) 
    177197       
    178198      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    … …  
    307327      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )                ! Ice-cover climatology ("Ice-if" model) 
    308328      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model 
    309               IF( lk_bdy )   CALL bdy_ice_lim_2( kt )                ! BDY boundary condition 
    310329      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
    311       CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
     330      !is it useful? 
     331      !CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
    312332      END SELECT                                               
    313333 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r4147 r4161  
    1010   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate 
    1111   !!            3.2  !  2009-04  (G. Madec & NEMO team)  
     12   !!            4.0  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
    1213   !!---------------------------------------------------------------------- 
    1314 
    … …  
    2728   USE iom             ! I/O manager 
    2829   USE fldread         ! read input fields 
     30   USE restart         ! ocean restart 
    2931   USE lib_mpp         ! MPP library 
    3032   USE wrk_nemo       ! Memory Allocation 
    … …  
    4749   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands) 
    4850   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands) 
     51   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem) 
     52 
    4953    
    5054   ! Module variables 
    … …  
    99103      REAL(wp) ::   zchl, zcoef, zfact   ! local scalars 
    100104      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         - 
     105      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         - 
    101106      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         - 
    102107      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr 
    … …  
    158163         END DO 
    159164         CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution 
     165         ! clem: store attenuation coefficient of the first ocean level 
     166         IF ( ln_qsr_ice ) THEN 
     167            DO jj = 1, jpj 
     168               DO ji = 1, jpi 
     169                  IF ( qsr(ji,jj) /= 0._wp ) THEN 
     170                     oatte(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
     171                     iatte(ji,jj) = oatte(ji,jj) 
     172                  ENDIF 
     173               END DO 
     174            END DO 
     175         ENDIF 
    160176         !                                        ! ============================================== ! 
    161177      ELSE                                        !  Ocean alone :  
    … …  
    216232                  END DO 
    217233               END DO 
     234               ! clem: store attenuation coefficient of the first ocean level 
     235               IF ( ln_qsr_ice ) THEN 
     236                  DO jj = 1, jpj 
     237                     DO ji = 1, jpi 
     238                        zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     ) 
     239                        zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 
     240                        zzc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 
     241                        zzc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 
     242                        oatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * tmask(ji,jj,2)  
     243                        iatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zcoef + zcoef ) * tmask(ji,jj,2) 
     244                     END DO 
     245                  END DO 
     246               ENDIF 
    218247               ! 
    219248               DO jk = 1, nksr                                        ! compute and add qsr trend to ta 
    … …  
    227256                  qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:) 
    228257               END DO 
    229             ENDIF 
     258               ! clem: store attenuation coefficient of the first ocean level 
     259               IF ( ln_qsr_ice ) THEN 
     260                  oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
     261                  iatte(:,:) = oatte(:,:) 
     262               ENDIF 
     263           ENDIF 
    230264 
    231265         ENDIF 
    … …  
    246280                  END DO 
    247281               END DO 
     282               ! clem: store attenuation coefficient of the first ocean level 
     283               IF ( ln_qsr_ice ) THEN 
     284                  DO jj = 1, jpj 
     285                     DO ji = 1, jpi 
     286                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 
     287                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 
     288                        oatte(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 
     289                        iatte(ji,jj) = oatte(ji,jj) 
     290                     END DO 
     291                  END DO 
     292               ENDIF 
    248293            ELSE                                               !* constant volume: coef. computed one for all 
    249294               DO jk = 1, nksr 
    … …  
    254299                  END DO 
    255300               END DO 
     301               ! clem: store attenuation coefficient of the first ocean level 
     302               IF ( ln_qsr_ice ) THEN 
     303                  oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
     304                  iatte(:,:) = oatte(:,:) 
     305               ENDIF 
    256306               ! 
    257307            ENDIF 
    … …  
    270320         ! 
    271321      ENDIF 
     322      ! clem: store attenuation coefficient of the first ocean level 
     323      !IF (ln_traqsr) THEN 
     324      !   DO jj = 1, jpj 
     325      !      DO ji = 1, jpi 
     326      !         IF ( qsr(ji,jj) /= 0._wp ) THEN 
     327      !            oatte(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 
     328      !            iatte(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 
     329      !         ENDIF 
     330      !      END DO 
     331      !   END DO 
     332      !END IF 
    272333      ! 
    273334      IF( lrst_oce ) THEN   !                  Write in the ocean restart file 
    … …  
    326387      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read 
    327388      !! 
    328       NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,   & 
     389      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  & 
    329390         &                  nn_chldta, rn_abs, rn_si0, rn_si1 
    330391      !!---------------------------------------------------------------------- 
    … …  
    332393      ! 
    333394      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init') 
     395      ! 
     396      ! clem init for oatte and iatte 
     397      oatte(:,:) = 1._wp 
     398      iatte(:,:) = 1._wp 
    334399      ! 
    335400      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )  
    … …  
    355420         WRITE(numout,*) '      2 band               light penetration   ln_qsr_2bd = ', ln_qsr_2bd 
    356421         WRITE(numout,*) '      bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio 
     422         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice 
    357423         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)    nn_chldta  = ', nn_chldta 
    358424         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs 
    359425         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
    360426         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
     427         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice     
    361428      ENDIF 
    362429 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r3764 r4161  
    55   !!====================================================================== 
    66   !! History :  3.2  !  2010-05  (M. Dunphy, R. Benshila)  Original code 
     7   !!            3.4  !  2013-06  (C. Rousset)  add glob_min, glob_max  
     8   !!                                           + 3d dim. of input is fexible (jpk, jpl...)  
    79   !!---------------------------------------------------------------------- 
    810 
    … …  
    2426   PUBLIC   glob_sum   ! used in many places 
    2527   PUBLIC   DDPDD      ! also used in closea module 
     28   PUBLIC   glob_min, glob_max 
    2629#if defined key_nosignedzero 
    2730   PUBLIC SIGN 
    … …  
    3134      MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, & 
    3235         &             glob_sum_2d_a, glob_sum_3d_a 
     36   END INTERFACE 
     37   INTERFACE glob_min 
     38      MODULE PROCEDURE glob_min_2d, glob_min_3d,glob_min_2d_a, glob_min_3d_a  
     39   END INTERFACE 
     40   INTERFACE glob_max 
     41      MODULE PROCEDURE glob_max_2d, glob_max_3d,glob_max_2d_a, glob_max_3d_a  
    3342   END INTERFACE 
    3443 
    … …  
    4958 
    5059#if ! defined key_mpp_rep 
     60   ! --- SUM --- 
     61 
    5162   FUNCTION glob_sum_1d( ptab, kdim ) 
    5263      !!----------------------------------------------------------------------- 
    … …  
    91102      !! 
    92103      INTEGER :: jk 
    93       !!----------------------------------------------------------------------- 
     104      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     105      !!----------------------------------------------------------------------- 
     106      ! 
     107      ijpk = SIZE(ptab,3) 
    94108      ! 
    95109      glob_sum_3d = 0.e0 
    96       DO jk = 1, jpk 
     110      DO jk = 1, ijpk 
    97111         glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) ) 
    98112      END DO 
    … …  
    129143      !! 
    130144      INTEGER :: jk 
    131       !!----------------------------------------------------------------------- 
     145      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     146      !!----------------------------------------------------------------------- 
     147      ! 
     148      ijpk = SIZE(ptab1,3) 
    132149      ! 
    133150      glob_sum_3d_a(:) = 0.e0 
    134       DO jk = 1, jpk 
     151      DO jk = 1, ijpk 
    135152         glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) ) 
    136153         glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) ) 
    … …  
    140157   END FUNCTION glob_sum_3d_a 
    141158 
    142 #else 
     159#else   
    143160   !!---------------------------------------------------------------------- 
    144161   !!   'key_mpp_rep'                                   MPP reproducibility 
    145162   !!---------------------------------------------------------------------- 
    146  
     163    
     164   ! --- SUM --- 
    147165   FUNCTION glob_sum_1d( ptab, kdim ) 
    148166      !!---------------------------------------------------------------------- 
    … …  
    177195      !! ** Purpose : perform a sum in calling DDPDD routine 
    178196      !!---------------------------------------------------------------------- 
    179       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab 
    180       REAL(wp)                                 ::   glob_sum_2d   ! global masked sum 
     197      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     198      REAL(wp)                             ::   glob_sum_2d   ! global masked sum 
    181199      !! 
    182200      COMPLEX(wp)::   ctmp 
    … …  
    205223      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine 
    206224      !!---------------------------------------------------------------------- 
    207       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab 
    208       REAL(wp)                                     ::   glob_sum_3d   ! global masked sum 
     225      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     226      REAL(wp)                               ::   glob_sum_3d   ! global masked sum 
    209227      !! 
    210228      COMPLEX(wp)::   ctmp 
    211229      REAL(wp)   ::   ztmp 
    212230      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    213       !!----------------------------------------------------------------------- 
     231      INTEGER    ::   ijpk ! local variables: size of ptab 
     232      !!----------------------------------------------------------------------- 
     233      ! 
     234      ijpk = SIZE(ptab,3) 
    214235      ! 
    215236      ztmp = 0.e0 
    216237      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    217       DO jk = 1, jpk 
     238      DO jk = 1, ijpk 
    218239         DO jj = 1, jpj 
    219240            DO ji =1, jpi 
    … …  
    235256      !! ** Purpose : perform a sum on two 2D arrays in calling DDPDD routine 
    236257      !!---------------------------------------------------------------------- 
    237       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab1, ptab2 
    238       REAL(wp)                                 ::   glob_sum_2d_a   ! global masked sum 
     258      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
     259      REAL(wp)                             ::   glob_sum_2d_a   ! global masked sum 
    239260      !! 
    240261      COMPLEX(wp)::   ctmp 
    … …  
    265286      !! ** Purpose : perform a sum on two 3D array in calling DDPDD routine 
    266287      !!---------------------------------------------------------------------- 
    267       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab1, ptab2 
    268       REAL(wp)                                     ::   glob_sum_3d_a   ! global masked sum 
     288      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2 
     289      REAL(wp)                               ::   glob_sum_3d_a   ! global masked sum 
    269290      !! 
    270291      COMPLEX(wp)::   ctmp 
    271292      REAL(wp)   ::   ztmp 
    272293      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    273       !!----------------------------------------------------------------------- 
     294      INTEGER    ::   ijpk ! local variables: size of ptab 
     295      !!----------------------------------------------------------------------- 
     296      ! 
     297      ijpk = SIZE(ptab1,3) 
    274298      ! 
    275299      ztmp = 0.e0 
    276300      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    277       DO jk = 1, jpk 
     301      DO jk = 1, ijpk 
    278302         DO jj = 1, jpj 
    279             DO ji =1, jpi 
    280             ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
    281             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    282             ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
    283             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     303            DO ji = 1, jpi 
     304               ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
     305               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     306               ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
     307               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    284308            END DO 
    285          END DO 
     309         END DO     
    286310      END DO 
    287311      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    288312      glob_sum_3d_a = REAL(ctmp,wp) 
    289313      ! 
    290    END FUNCTION glob_sum_3d_a 
     314   END FUNCTION glob_sum_3d_a    
    291315 
    292316#endif 
     317 
     318   ! --- MIN --- 
     319   FUNCTION glob_min_2d( ptab )  
     320      !!----------------------------------------------------------------------- 
     321      !!                  ***  FUNCTION  glob_min_2D  *** 
     322      !! 
     323      !! ** Purpose : perform a masked min on the inner global domain of a 2D array 
     324      !!----------------------------------------------------------------------- 
     325      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
     326      REAL(wp)                             ::   glob_min_2d   ! global masked min 
     327      !!----------------------------------------------------------------------- 
     328      ! 
     329      glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) ) 
     330      IF( lk_mpp )   CALL mpp_min( glob_min_2d ) 
     331      ! 
     332   END FUNCTION glob_min_2d 
     333  
     334   FUNCTION glob_min_3d( ptab )  
     335      !!----------------------------------------------------------------------- 
     336      !!                  ***  FUNCTION  glob_min_3D  *** 
     337      !! 
     338      !! ** Purpose : perform a masked min on the inner global domain of a 3D array 
     339      !!----------------------------------------------------------------------- 
     340      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
     341      REAL(wp)                               ::   glob_min_3d   ! global masked min 
     342      !! 
     343      INTEGER :: jk 
     344      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     345      !!----------------------------------------------------------------------- 
     346      ! 
     347      ijpk = SIZE(ptab,3) 
     348      ! 
     349      glob_min_3d = MINVAL( ptab(:,:,1)*tmask_i(:,:) ) 
     350      DO jk = 2, ijpk 
     351         glob_min_3d = MIN( glob_min_3d, MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 
     352      END DO 
     353      IF( lk_mpp )   CALL mpp_min( glob_min_3d ) 
     354      ! 
     355   END FUNCTION glob_min_3d 
     356 
     357 
     358   FUNCTION glob_min_2d_a( ptab1, ptab2 )  
     359      !!----------------------------------------------------------------------- 
     360      !!                  ***  FUNCTION  glob_min_2D _a *** 
     361      !! 
     362      !! ** Purpose : perform a masked min on the inner global domain of two 2D array 
     363      !!----------------------------------------------------------------------- 
     364      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
     365      REAL(wp)            , DIMENSION(2)   ::   glob_min_2d_a   ! global masked min 
     366      !!----------------------------------------------------------------------- 
     367      !              
     368      glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) ) 
     369      glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) ) 
     370      IF( lk_mpp )   CALL mpp_min( glob_min_2d_a, 2 ) 
     371      ! 
     372   END FUNCTION glob_min_2d_a 
     373  
     374  
     375   FUNCTION glob_min_3d_a( ptab1, ptab2 )  
     376      !!----------------------------------------------------------------------- 
     377      !!                  ***  FUNCTION  glob_min_3D_a *** 
     378      !! 
     379      !! ** Purpose : perform a masked min on the inner global domain of two 3D array 
     380      !!----------------------------------------------------------------------- 
     381      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
     382      REAL(wp)            , DIMENSION(2)     ::   glob_min_3d_a   ! global masked min 
     383      !! 
     384      INTEGER :: jk 
     385      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     386      !!----------------------------------------------------------------------- 
     387      ! 
     388      ijpk = SIZE(ptab1,3) 
     389      ! 
     390      glob_min_3d_a(1) = MINVAL( ptab1(:,:,1)*tmask_i(:,:) ) 
     391      glob_min_3d_a(2) = MINVAL( ptab2(:,:,1)*tmask_i(:,:) ) 
     392      DO jk = 2, ijpk 
     393         glob_min_3d_a(1) = MIN( glob_min_3d_a(1), MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) ) 
     394         glob_min_3d_a(2) = MIN( glob_min_3d_a(2), MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) ) 
     395      END DO 
     396      IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 ) 
     397      ! 
     398   END FUNCTION glob_min_3d_a 
     399 
     400   ! --- MAX --- 
     401   FUNCTION glob_max_2d( ptab )  
     402      !!----------------------------------------------------------------------- 
     403      !!                  ***  FUNCTION  glob_max_2D  *** 
     404      !! 
     405      !! ** Purpose : perform a masked max on the inner global domain of a 2D array 
     406      !!----------------------------------------------------------------------- 
     407      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
     408      REAL(wp)                             ::   glob_max_2d   ! global masked max 
     409      !!----------------------------------------------------------------------- 
     410      ! 
     411      glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) ) 
     412      IF( lk_mpp )   CALL mpp_max( glob_max_2d ) 
     413      ! 
     414   END FUNCTION glob_max_2d 
     415  
     416   FUNCTION glob_max_3d( ptab )  
     417      !!----------------------------------------------------------------------- 
     418      !!                  ***  FUNCTION  glob_max_3D  *** 
     419      !! 
     420      !! ** Purpose : perform a masked max on the inner global domain of a 3D array 
     421      !!----------------------------------------------------------------------- 
     422      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
     423      REAL(wp)                               ::   glob_max_3d   ! global masked max 
     424      !! 
     425      INTEGER :: jk 
     426      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     427      !!----------------------------------------------------------------------- 
     428      ! 
     429      ijpk = SIZE(ptab,3) 
     430      ! 
     431      glob_max_3d = MAXVAL( ptab(:,:,1)*tmask_i(:,:) ) 
     432      DO jk = 2, ijpk 
     433         glob_max_3d = MAX( glob_max_3d, MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 
     434      END DO 
     435      IF( lk_mpp )   CALL mpp_max( glob_max_3d ) 
     436      ! 
     437   END FUNCTION glob_max_3d 
     438 
     439 
     440   FUNCTION glob_max_2d_a( ptab1, ptab2 )  
     441      !!----------------------------------------------------------------------- 
     442      !!                  ***  FUNCTION  glob_max_2D _a *** 
     443      !! 
     444      !! ** Purpose : perform a masked max on the inner global domain of two 2D array 
     445      !!----------------------------------------------------------------------- 
     446      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
     447      REAL(wp)            , DIMENSION(2)   ::   glob_max_2d_a   ! global masked max 
     448      !!----------------------------------------------------------------------- 
     449      !              
     450      glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) ) 
     451      glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) ) 
     452      IF( lk_mpp )   CALL mpp_max( glob_max_2d_a, 2 ) 
     453      ! 
     454   END FUNCTION glob_max_2d_a 
     455  
     456  
     457   FUNCTION glob_max_3d_a( ptab1, ptab2 )  
     458      !!----------------------------------------------------------------------- 
     459      !!                  ***  FUNCTION  glob_max_3D_a *** 
     460      !! 
     461      !! ** Purpose : perform a masked max on the inner global domain of two 3D array 
     462      !!----------------------------------------------------------------------- 
     463      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
     464      REAL(wp)            , DIMENSION(2)     ::   glob_max_3d_a   ! global masked max 
     465      !! 
     466      INTEGER :: jk 
     467      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     468      !!----------------------------------------------------------------------- 
     469      ! 
     470      ijpk = SIZE(ptab1,3) 
     471      ! 
     472      glob_max_3d_a(1) = MAXVAL( ptab1(:,:,1)*tmask_i(:,:) ) 
     473      glob_max_3d_a(2) = MAXVAL( ptab2(:,:,1)*tmask_i(:,:) ) 
     474      DO jk = 2, ijpk 
     475         glob_max_3d_a(1) = MAX( glob_max_3d_a(1), MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) ) 
     476         glob_max_3d_a(2) = MAX( glob_max_3d_a(2), MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) ) 
     477      END DO 
     478      IF( lk_mpp )   CALL mpp_max( glob_max_3d_a, 2 ) 
     479      ! 
     480   END FUNCTION glob_max_3d_a 
     481 
    293482 
    294483   SUBROUTINE DDPDD( ydda, yddb ) 

  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4153 r4161  
    115115      ! 
    116116      !  VERTICAL PHYSICS 
     117      ! bg jchanut tschanges 
     118      ! One need bottom friction parameter in ssh_wzv routine with time splitting. 
     119      ! The idea could be to move the call below before ssh_wzv. However, "now" scale factors 
     120      ! at U-V points (which are set thanks to sshu_n, sshv_n) are actually available in sshwzv. 
     121      ! These are needed for log bottom friction... 
     122#if ! defined key_dynspg_ts 
    117123                         CALL zdf_bfr( kstp )         ! bottom friction 
     124#endif 
     125      ! end jchanut tschanges 
    118126 
    119127      !                                               ! Vertical eddy viscosity and diffusivity coefficients 
    … …  
    216224            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
    217225 
    218       ELSE                                                  ! centered hpg  (eos then time stepping) 
     226      ELSE    
     227                                               ! centered hpg  (eos then time stepping) 
     228      ! bg jchanut tschanges 
     229#if ! defined key_dynspg_ts 
     230      ! eos already called 
    219231                             CALL eos    ( tsn, rhd, rhop )      ! now in situ density for hpg computation 
    220232         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative 
    221233            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
     234#endif 
     235      ! end jchanut tschanges 
    222236         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    223237                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
    … …  
    227241      ! Dynamics                                    (tsa used as workspace) 
    228242      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     243      ! bg jchanut tschanges 
     244#if defined key_dynspg_ts       
     245! revert to previously computed tendencies: 
     246! (not using ua, va as temporary arrays during tracers' update could avoid that) 
     247                               ua(:,:,:) = ua_bak(:,:,:)             
     248                               va(:,:,:) = va_bak(:,:,:) 
     249                               CALL dyn_bfr( kstp )         ! bottom friction 
     250                               CALL dyn_zdf( kstp )         ! vertical diffusion 
     251#else 
     252      ! end jchanut tschanges 
    229253                               ua(:,:,:) = 0.e0             ! set dynamics trends to zero 
    230254                               va(:,:,:) = 0.e0 
    … …  
    246270                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    247271                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient 
     272      ! bg jchanut tschanges 
     273#endif 
     274      ! end jchanut tschanges 
    248275                               CALL dyn_nxt( kstp )         ! lateral velocity at next time step 
    249276 
    … …  
    253280      IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    254281 
     282      IF( lrst_oce .AND. ln_diahsb )   CALL dia_hsb_rst( kstp, 'WRITE' ) 
    255283      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    256284      ! Control and restarts 
Note: See TracChangeset for help on using the changeset viewer.