Changeset 4634
- Timestamp:
- 2014-05-12T22:46:18+02:00 (10 years ago)
- Location:
- branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM
- Files:
-
- 41 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/field_def.xml
r4345 r4634 29 29 <field id="mldr10_1" long_name="Mixed Layer Depth 0.01 ref.10m" unit="m" /> 30 30 <field id="rhop" long_name="potential density (sigma0)" unit="kg/m3" grid_ref="grid_T_3D"/> 31 <field id="heatc" long_name="Heat content vertically integrated" unit="J/m2" /> 32 <field id="saltc" long_name="Salt content vertically integrated" unit="PSU*kg/m2" /> 31 33 <!-- next variables available with key_diahth --> 32 34 <field id="mlddzt" long_name="Thermocline Depth (max dT/dz)" unit="m" /> … … 186 188 <field id="ice_cover" long_name="Ice fraction" unit="1" /> 187 189 188 <field id="ioceflxb" long_name="Oceanic flux at the ice base" unit="W/m2" />189 190 <field id="qsr_ai_cea" long_name="Air-Ice downward solar heat flux (cell average)" unit="W/m2" /> 190 191 <field id="qns_ai_cea" long_name="Air-Ice downward non-solar heat flux (cell average)" unit="W/m2" /> … … 214 215 215 216 <field id="iceconc" long_name="ice concentration" unit="%" /> 216 <field id="icebopr" long_name="daily bottom thermo ice prod." unit="m/day" />217 <field id="icedypr" long_name="daily dynamic ice prod." unit="m/day" />218 <field id="ioceflxb" long_name="Oceanic flux at the ice base" unit="W/m2" />219 217 <field id="uice_ipa" long_name="Ice velocity along i-axis at I-point (ice presence average)" unit="m/s" /> 220 218 <field id="vice_ipa" long_name="Ice velocity along j-axis at I-point (ice presence average)" unit="m/s" /> … … 224 222 <field id="qsr_oce" long_name="solar heat flux at ocean surface" unit="W/m2" /> 225 223 <field id="qns_oce" long_name="non-solar heat flux at ocean surface" unit="W/m2" /> 226 <field id="hfbri" long_name="heat flux due to brine release" unit="W/m2" />227 224 <field id="utau_ice" long_name="Wind stress along i-axis over the ice at i-point" unit="N/m2" /> 228 225 <field id="vtau_ice" long_name="Wind stress along j-axis over the ice at i-point" unit="N/m2" /> … … 231 228 <field id="micesalt" long_name="Mean ice salinity" unit="psu" /> 232 229 <field id="miceage" long_name="Mean ice age" unit="years" /> 233 <field id="icelapr" long_name="daily lateral thermo ice prod." unit="m/day" /> 234 <field id="icesipr" long_name="daily snowice ice prod." unit="m/day" /> 230 231 <field id="iceage_cat" long_name="Ice age for categories" unit="days" axis_ref="ncatice" /> 232 <field id="iceconc_cat" long_name="Ice concentration for categories" unit="%" axis_ref="ncatice" /> 233 <field id="icethic_cat" long_name="Ice thickness for categories" unit="m" axis_ref="ncatice" /> 234 <field id="snowthic_cat" long_name="Snow thicknessi for categories" unit="m" axis_ref="ncatice" /> 235 <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories" unit="ppt" axis_ref="ncatice" /> 236 <field id="brinevol_cat" long_name="Brine volume for categories" unit="%" axis_ref="ncatice" /> 237 235 238 <field id="micet" long_name="Mean ice temperature" unit="degC" /> 236 239 <field id="icehc" long_name="ice total heat content" unit="10^9 J" /> 237 240 <field id="isnowhc" long_name="snow total heat content" unit="10^9J" /> 238 241 <field id="icest" long_name="ice surface temperature" unit="degC" /> 239 <field id="sfxbri" long_name="brine salt flux" unit="psu*kg/m2/day" />240 <field id="sfxthd" long_name="equivalent FW salt flux" unit="psu*kg/m2/day" />241 242 <field id="ibrinv" long_name="brine volume" unit="%" /> 242 243 <field id="icecolf" long_name="frazil ice collection thickness" unit="m" /> 243 244 <field id="icestr" long_name="ice strength" unit="N/m" /> 244 245 <field id="icevel" long_name="ice velocity" unit="m/s" /> 245 <field id="isume" long_name="surface melt" unit="m/day" />246 <field id="ibome" long_name="bottom melt" unit="m/day" />247 246 <field id="idive" long_name="divergence" unit="10-8s-1" /> 248 247 <field id="ishear" long_name="shear" unit="10-8s-1" /> 249 <field id="icerepr" long_name="daily resultant ice prod./melting from limupdate" unit="m/day" />250 248 <field id="icevolu" long_name="ice volume" unit="m" /> 251 249 <field id="snowvol" long_name="snow volume" unit="m" /> 252 <field id="sfxmec" long_name="salt flux from ridging rafting" unit="psu*kg/m2/day" /> 250 251 <field id="icetrp" long_name="ice volume transport" unit="m/day" /> 252 <field id="snwtrp" long_name="snw volume transport" unit="m/day" /> 253 <field id="deitrp" long_name="advected ice enhalpy" unit="W/2" /> 254 <field id="destrp" long_name="advected snw enhalpy" unit="W/2" /> 255 256 <field id="sfxbri" long_name="brine salt flux" unit="psu*kg/m2/day" /> 257 <field id="sfxdyn" long_name="salt flux from ridging rafting" unit="psu*kg/m2/day" /> 253 258 <field id="sfxres" long_name="salt flux from lipupdate (resultant)" unit="psu*kg/m2/day" /> 254 <field id="icetrp" long_name="ice volume transport" unit="m/day" /> 255 259 <field id="sfxbog" long_name="salt flux from bot growth" unit="psu*kg/m2/day" /> 260 <field id="sfxbom" long_name="salt flux from bot melt" unit="psu*kg/m2/day" /> 261 <field id="sfxsum" long_name="salt flux from surf melt" unit="psu*kg/m2/day" /> 262 <field id="sfxsni" long_name="salt flux from snow-ice formation" unit="psu*kg/m2/day" /> 263 <field id="sfxopw" long_name="salt flux from open water ice formation" unit="psu*kg/m2/day" /> 264 <field id="sfx" long_name="salt flux total" unit="psu*kg/m2/day" /> 265 266 <field id="vfxbog" long_name="daily bottom thermo ice prod." unit="m/day" /> 267 <field id="vfxdyn" long_name="daily dynamic ice prod." unit="m/day" /> 268 <field id="vfxopw" long_name="daily lateral thermo ice prod." unit="m/day" /> 269 <field id="vfxsni" long_name="daily snowice ice prod." unit="m/day" /> 270 <field id="vfxsum" long_name="surface melt" unit="m/day" /> 271 <field id="vfxbom" long_name="bottom melt" unit="m/day" /> 272 <field id="vfxres" long_name="daily resultant ice prod./melting from limupdate" unit="m/day" /> 273 <field id="vfxice" long_name="ice melt/growth" unit="m/day" /> 274 <field id="vfxsnw" long_name="snw melt/growth" unit="m/day" /> 275 <field id="vfxsub" long_name="snw sublimation" unit="m/day" /> 276 277 <field id="hfxdhc1" long_name="Heat content variation in snow and ice" unit="W/m2" /> 278 <field id="hfxspr" long_name="Heat content of snow precip" unit="W/m2" /> 279 <field id="hfxqsr" long_name="solar fluxes given to ocean" unit="W/m2" /> 280 <field id="hfxqns" long_name="non solar fluxes given to ocean" unit="W/m2" /> 281 282 <field id="hfxthd" long_name="heat fluxes from ice-ocean exchange during thermo" unit="W/m2" /> 283 <field id="hfxdyn" long_name="heat fluxes from ice-ocean exchange during dynamic" unit="W/m2" /> 284 <field id="hfxres" long_name="heat fluxes from ice-ocean exchange during resultant" unit="W/m2" /> 285 <field id="hfxsnw" long_name="heat fluxes from snow-ocean exchange" unit="W/m2" /> 286 <field id="hfxsub" long_name="heat fluxes from sublimation" unit="W/m2" /> 287 <field id="hfxerr" long_name="heat fluxes error after heat diffusion" unit="W/m2" /> 288 <field id="hfxerr_rem" long_name="heat fluxes error after remapping" unit="W/m2" /> 289 <field id="hfxtot" long_name="heat fluxes total used by ice" unit="W/m2" /> 290 <field id="hfxout" long_name="non solar heat fluxes received by the ocean" unit="W/m2" /> 291 <field id="hfxin" long_name="total heat fluxes at the ice surface" unit="W/m2" /> 256 292 257 293 </field_group> … … 272 308 <field id="u_masstr" long_name="ocean eulerian mass transport along i-axis" unit="kg/s" grid_ref="grid_U_3D" /> 273 309 <field id="u_heattr" long_name="ocean eulerian heat transport along i-axis" unit="W" /> 310 <field id="u_salttr" long_name="ocean eulerian salt transport along i-axis" unit="PSU*kg/s" /> 274 311 <field id="ueiv_heattr" long_name="ocean bolus heat transport along i-axis" unit="W" /> 275 312 <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis" unit="W" /> … … 291 328 <field id="v_masstr" long_name="ocean eulerian mass transport along j-axis" unit="kg/s" grid_ref="grid_V_3D" /> 292 329 <field id="v_heattr" long_name="ocean eulerian heat transport along j-axis" unit="W" /> 330 <field id="v_salttr" long_name="ocean eulerian salt transport along i-axis" unit="PSU*kg/s" /> 293 331 <field id="veiv_heattr" long_name="ocean bolus heat transport along j-axis" unit="W" /> 294 332 <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis" unit="W" /> … … 324 362 325 363 <field_group id="scalar" domain_ref="1point" > 326 327 328 329 330 331 332 333 364 <field id="voltot" long_name="global mean volume" unit="m3" /> 365 <field id="sshtot" long_name="global mean ssh" unit="m" /> 366 <field id="sshsteric" long_name="global mean ssh steric" unit="m" /> 367 <field id="sshthster" long_name="global mean ssh thermosteric" unit="m" /> 368 <field id="masstot" long_name="global mean mass" unit="kg" /> 369 <field id="temptot" long_name="global mean temperature" unit="degC" /> 370 <field id="saltot" long_name="global mean salinity" unit="psu" /> 371 <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 334 372 <!-- available with ln_diahsb --> 335 373 <field id="bgtemper" long_name="global mean temperature variation" unit="degC"/> … … 357 395 <field id="ibgsaltco" long_name="global mean ice salt content" unit="psu*km3" /> 358 396 359 <field id="ibg emp" long_name="global mean volume flux (emp)" unit="m/day" />360 <field id="ibg empbog" long_name="global mean volume flux (bottom growth)" unit="m/day" />361 <field id="ibg emplag" long_name="global mean volume flux (open water growth)" unit="m/day" />362 <field id="ibg empsig" long_name="global mean volume flux (snow-ice growth)" unit="m/day" />363 <field id="ibg empdyg" long_name="global mean volume flux (dynamic growth)" unit="m/day" />364 <field id="ibg empbom" long_name="global mean volume flux (bottom melt)" unit="m/day" />365 <field id="ibg empsum" long_name="global mean volume flux (surface melt)" unit="m/day" />366 <field id="ibg empres" long_name="global mean volume flux (resultant)" unit="m/day" />397 <field id="ibgvfx" long_name="global mean volume flux (emp)" unit="m/day" /> 398 <field id="ibgvfxbog" long_name="global mean volume flux (bottom growth)" unit="m/day" /> 399 <field id="ibgvfxopw" long_name="global mean volume flux (open water growth)" unit="m/day" /> 400 <field id="ibgvfxsni" long_name="global mean volume flux (snow-ice growth)" unit="m/day" /> 401 <field id="ibgvfxdyn" long_name="global mean volume flux (dynamic growth)" unit="m/day" /> 402 <field id="ibgvfxbom" long_name="global mean volume flux (bottom melt)" unit="m/day" /> 403 <field id="ibgvfxsum" long_name="global mean volume flux (surface melt)" unit="m/day" /> 404 <field id="ibgvfxres" long_name="global mean volume flux (resultant)" unit="m/day" /> 367 405 368 406 <field id="ibgsfx" long_name="global mean salt flux (total)" unit="psu*m/day" /> 369 407 <field id="ibgsfxbri" long_name="global mean salt flux (brines)" unit="psu*m/day" /> 370 <field id="ibgsfxthd" long_name="global mean salt flux (thermo)" unit="psu*m/day" /> 371 <field id="ibgsfxmec" long_name="global mean salt flux (dynamic)" unit="psu*m/day" /> 408 <field id="ibgsfxdyn" long_name="global mean salt flux (dynamic)" unit="psu*m/day" /> 372 409 <field id="ibgsfxres" long_name="global mean salt flux (resultant)" unit="psu*m/day" /> 410 <field id="ibgsfxbog" long_name="global mean salt flux (thermo)" unit="psu*m/day" /> 411 <field id="ibgsfxopw" long_name="global mean salt flux (thermo)" unit="psu*m/day" /> 412 <field id="ibgsfxsni" long_name="global mean salt flux (thermo)" unit="psu*m/day" /> 413 <field id="ibgsfxbom" long_name="global mean salt flux (thermo)" unit="psu*m/day" /> 414 <field id="ibgsfxsum" long_name="global mean salt flux (thermo)" unit="psu*m/day" /> 415 416 417 <field id="ibghfxdhc1" long_name="Heat content variation in snow and ice" unit="W" /> 418 <field id="ibghfxspr" long_name="Heat content of snow precip" unit="W" /> 419 <field id="ibghfxqsr" long_name="solar fluxes given to ocean" unit="W" /> 420 <field id="ibghfxqns" long_name="non solar fluxes given to ocean" unit="W" /> 421 422 <field id="ibghfxthd" long_name="heat fluxes from ice-ocean exchange during thermo" unit="W" /> 423 <field id="ibghfxdyn" long_name="heat fluxes from ice-ocean exchange during dynamic" unit="W" /> 424 <field id="ibghfxres" long_name="heat fluxes from ice-ocean exchange during resultant" unit="W" /> 425 <field id="ibghfxsub" long_name="heat fluxes from sublimation" unit="W" /> 426 <field id="ibghfxsnw" long_name="heat fluxes from snow-ocean exchange" unit="W" /> 427 <field id="ibghfxtot" long_name="heat fluxes total used by ice" unit="W" /> 428 <field id="ibghfxout" long_name="non solar heat fluxes received by the ocean" unit="W" /> 429 <field id="ibghfxin" long_name="total heat fluxes at the ice surface" unit="W" /> 373 430 374 431 <field id="ibgfrcvol" long_name="global mean forcing volume (emp)" unit="km3" /> 375 432 <field id="ibgfrcsfx" long_name="global mean forcing salt (sfx)" unit="psu*km3" /> 376 <field id="ibg grme"long_name="global mean ice growth+melt volume" unit="km3" />433 <field id="ibgvolgrm" long_name="global mean ice growth+melt volume" unit="km3" /> 377 434 </field_group> 378 435 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
r4350 r4634 47 47 <field field_ref="mldkz5" /> 48 48 <field field_ref="mldr10_1" /> 49 <field field_ref="heatc" name="heatc" long_name="Heat content vertically integrated" /> 50 <field field_ref="saltc" name="saltc" long_name="Salt content vertically integrated" /> 49 51 </file> 50 52 51 53 <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 52 54 <field field_ref="empmr" name="wfo" long_name="water_flux_into_sea_water" /> 53 <field field_ref="qsr" name=" rsntds" long_name="surface_net_downward_shortwave_flux" />54 <field field_ref="qt" name=" tohfls" long_name="surface_net_downward_total_heat_flux" />55 <field field_ref="saltflx" name="s osflxdo" />55 <field field_ref="qsr" name="hfxqsr" long_name="surface_net_downward_shortwave_flux" /> 56 <field field_ref="qt" name="hfxtot" long_name="surface_net_downward_total_heat_flux" /> 57 <field field_ref="saltflx" name="sfx" /> 56 58 <field field_ref="taum" name="taum" /> 57 <field field_ref="wspd" name=" sowindsp" />58 <field field_ref="precip" name=" soprecip" />59 <field field_ref="wspd" name="windsp" /> 60 <field field_ref="precip" name="precip" /> 59 61 <!-- ice and snow --> 60 62 <field field_ref="snowpre" /> 63 <field field_ref="utau_ice" name="utau_ice" /> 64 <field field_ref="vtau_ice" name="vtau_ice" /> 65 <!-- clem 61 66 <field field_ref="qsr_io" name="iicesflx" /> 62 67 <field field_ref="qns_io" name="iicenflx" /> 63 <field field_ref="utau_ice" name="iicestru" /> 64 <field field_ref="vtau_ice" name="iicestrv" /> 68 --> 65 69 66 70 </file> … … 73 77 <field field_ref="u_masstr" name="vozomatr" /> 74 78 <field field_ref="u_heattr" name="sozohetr" /> 79 <field field_ref="u_salttr" name="sozosatr" /> 75 80 </file> 76 81 … … 82 87 <field field_ref="v_masstr" name="vomematr" /> 83 88 <field field_ref="v_heattr" name="somehetr" /> 89 <field field_ref="v_salttr" name="somesatr" /> 84 90 </file> 85 91 … … 90 96 </file> 91 97 92 <file id="file6" name_suffix="_icemod" description="ice variables" > 93 98 <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 94 99 <field field_ref="snowthic_cea" name="sndept" long_name="surface_snow_thickness" /> 95 100 <field field_ref="icethic_cea" name="sithic" long_name="sea_ice_thickness" /> … … 98 103 <field field_ref="iceconc" name="siconc" /> 99 104 100 <field field_ref="icebopr" name="sibopr" /> 101 <field field_ref="icedypr" name="sidypr" /> 102 <field field_ref="icelapr" name="silapr" /> 103 <field field_ref="icesipr" name="sisipr" /> 104 <field field_ref="isume" name="sisume" /> 105 <field field_ref="ibome" name="sibome" /> 106 <field field_ref="icerepr" name="sirepr" /> 105 <field field_ref="vfxbog" name="vfxbog" /> 106 <field field_ref="vfxdyn" name="vfxdyn" /> 107 <field field_ref="vfxopw" name="vfxopw" /> 108 <field field_ref="vfxsni" name="vfxsni" /> 109 <field field_ref="vfxsum" name="vfxsum" /> 110 <field field_ref="vfxbom" name="vfxbom" /> 111 <field field_ref="vfxres" name="vfxres" /> 112 <field field_ref="vfxice" name="vfxice" /> 113 <field field_ref="vfxsnw" name="vfxsnw" /> 114 <field field_ref="vfxsub" name="vfxsub" /> 115 116 <field field_ref="icetrp" name="sivtrp" /> 117 <field field_ref="snwtrp" name="snvtrp" /> 118 <field field_ref="deitrp" name="deitrp" /> 119 <field field_ref="destrp" name="destrp" /> 107 120 108 121 <field field_ref="sfxbri" name="sfxbri" /> 109 <field field_ref="sfxthd" name="sfxthd" /> 110 <field field_ref="sfxmec" name="sfxmec" /> 122 <field field_ref="sfxdyn" name="sfxdyn" /> 111 123 <field field_ref="sfxres" name="sfxres" /> 124 <field field_ref="sfxbog" name="sfxbog" /> 125 <field field_ref="sfxbom" name="sfxbom" /> 126 <field field_ref="sfxsum" name="sfxsum" /> 127 <field field_ref="sfxsni" name="sfxsni" /> 128 <field field_ref="sfxopw" name="sfxopw" /> 129 <field field_ref="sfx" name="sfx" /> 130 131 <field field_ref="hfxdhc1" name="hfxdhc1" /> 132 <field field_ref="hfxspr" name="hfxspr" /> 133 <field field_ref="hfxqsr" name="hfxqsr" /> 134 <field field_ref="hfxqns" name="hfxqns" /> 135 136 <field field_ref="hfxthd" name="hfxthd" /> 137 <field field_ref="hfxdyn" name="hfxdyn" /> 138 <field field_ref="hfxres" name="hfxres" /> 139 <field field_ref="hfxout" name="hfxout" /> 140 <field field_ref="hfxin" name="hfxin" /> 141 <field field_ref="hfxtot" name="hfxtot" /> 142 <field field_ref="hfxsnw" name="hfxsnw" /> 143 <field field_ref="hfxsub" name="hfxsub" /> 144 <field field_ref="hfxerr" name="hfxerr" /> 145 <field field_ref="hfxerr_rem" name="hfxerr_rem" /> 112 146 113 147 <field field_ref="isst" name="sst" /> … … 115 149 <field field_ref="micesalt" name="sisali" /> 116 150 <field field_ref="micet" name="sitemp" /> 117 <field field_ref="icest" name="sis urt" />151 <field field_ref="icest" name="sistem" /> 118 152 <field field_ref="icehc" name="siheco" /> 119 153 <field field_ref="isnowhc" name="snheco" /> 120 154 <field field_ref="miceage" name="siages" /> 121 <field field_ref="ioceflxb" name="ioceflxb" />122 155 123 156 <field field_ref="uice_ipa" name="sivelu" /> … … 126 159 <field field_ref="idive" name="sidive" /> 127 160 <field field_ref="ishear" name="sishea" /> 128 <field field_ref="icetrp" name="sivtrp" />129 161 <field field_ref="icestr" name="sistre" /> 130 162 … … 132 164 <field field_ref="icecolf" name="sicolf" /> 133 165 134 </file> 135 136 <file id="file7" name_suffix="_scalar" description="scalar variables" > 166 <field field_ref="iceage_cat" name="siagecat"/> 167 <field field_ref="iceconc_cat" name="siconcat"/> 168 <field field_ref="icethic_cat" name="sithicat"/> 169 <field field_ref="snowthic_cat" name="sndeptcat"/> 170 <field field_ref="salinity_cat" name="salincat"/> 171 <field field_ref="brinevol_cat" name="sibrincat"/> 172 173 </file> 174 175 <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." > 137 176 <field field_ref="voltot" name="scvoltot" /> 138 177 <field field_ref="sshtot" name="scsshtot" /> … … 152 191 <field field_ref="bgfrctem" name="bgfrctem" /> 153 192 <field field_ref="bgfrcsal" name="bgfrcsal" /> 193 <!-- 154 194 <field field_ref="bgmistem" name="bgmistem" /> 155 195 <field field_ref="bgmissal" name="bgmissal" /> 196 --> 156 197 </file> 157 198 158 <file id="file8" name_suffix="_SBC_scalar" description="scalar variables" >199 <file id="file8" name_suffix="_SBC_scalar" description="scalar variables" enabled=".true." > 159 200 <field field_ref="ibgvoltot" name="ibgvoltot" /> 160 201 <field field_ref="sbgvoltot" name="sbgvoltot" /> … … 166 207 <field field_ref="ibgsaltco" name="ibgsaltco" /> 167 208 168 <field field_ref="ibg emp" name="ibgemp" />169 <field field_ref="ibg empbog" name="ibgempbog" />170 <field field_ref="ibg emplag" name="ibgemplag" />171 <field field_ref="ibg empsig" name="ibgempsig" />172 <field field_ref="ibg empdyg" name="ibgempdyg" />173 <field field_ref="ibg empbom" name="ibgempbom" />174 <field field_ref="ibg empsum" name="ibgempsum" />175 <field field_ref="ibg empres" name="ibgempres" />209 <field field_ref="ibgvfx" name="ibgvfx" /> 210 <field field_ref="ibgvfxbog" name="ibgvfxbog" /> 211 <field field_ref="ibgvfxopw" name="ibgvfxopw" /> 212 <field field_ref="ibgvfxsni" name="ibgvfxsni" /> 213 <field field_ref="ibgvfxdyn" name="ibgvfxdyn" /> 214 <field field_ref="ibgvfxbom" name="ibgvfxbom" /> 215 <field field_ref="ibgvfxsum" name="ibgvfxsum" /> 216 <field field_ref="ibgvfxres" name="ibgvfxres" /> 176 217 177 218 <field field_ref="ibgsfx" name="ibgsfx" /> 178 219 <field field_ref="ibgsfxbri" name="ibgsfxbri" /> 179 <field field_ref="ibgsfxthd" name="ibgsfxthd" /> 180 <field field_ref="ibgsfxmec" name="ibgsfxmec" /> 220 <field field_ref="ibgsfxdyn" name="ibgsfxdyn" /> 181 221 <field field_ref="ibgsfxres" name="ibgsfxres" /> 222 <field field_ref="ibgsfxbog" name="ibgsfxbog" /> 223 <field field_ref="ibgsfxopw" name="ibgsfxopw" /> 224 <field field_ref="ibgsfxsni" name="ibgsfxsni" /> 225 <field field_ref="ibgsfxbom" name="ibgsfxbom" /> 226 <field field_ref="ibgsfxsum" name="ibgsfxsum" /> 227 228 <field field_ref="ibghfxdhc1" name="ibghfxdhc1" /> 229 <field field_ref="ibghfxspr" name="ibghfxspr" /> 230 <field field_ref="ibghfxqsr" name="ibghfxqsr" /> 231 <field field_ref="ibghfxqns" name="ibghfxqns" /> 232 233 <field field_ref="ibghfxres" name="ibghfxres" /> 234 <field field_ref="ibghfxsub" name="ibghfxsub" /> 235 <field field_ref="ibghfxdyn" name="ibghfxdyn" /> 236 <field field_ref="ibghfxthd" name="ibghfxthd" /> 237 <field field_ref="ibghfxout" name="ibghfxout" /> 238 <field field_ref="ibghfxin" name="ibghfxin" /> 239 <field field_ref="ibghfxtot" name="ibghfxtot" /> 240 <field field_ref="ibghfxsnw" name="ibghfxsnw" /> 182 241 183 242 <field field_ref="ibgfrcvol" name="ibgfrcvol" /> 184 243 <field field_ref="ibgfrcsfx" name="ibgfrcsfx" /> 185 <field field_ref="ibg grme" name="ibggrme" />244 <field field_ref="ibgvolgrm" name="ibgvolgrm" /> 186 245 </file> 187 246 … … 219 278 <axis id="nfloat" long_name="Float number" unit="-" /> 220 279 <axis id="icbcla" long_name="Iceberg class" unit="-" /> 280 <axis id="ncatice" long_name="Ice categories" unit="-" /> 221 281 </axis_definition> 222 282 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_default.xml
r4345 r4634 47 47 <field field_ref="mldkz5" /> 48 48 <field field_ref="mldr10_1" /> 49 <field field_ref="heatc" name="heatc" long_name="Heat content vertically integrated" /> 50 <field field_ref="saltc" name="saltc" long_name="Salt content vertically integrated" /> 49 51 </file> 50 52 51 53 <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 52 54 <field field_ref="empmr" name="wfo" long_name="water_flux_into_sea_water" /> 53 <field field_ref="qsr" name=" rsntds" long_name="surface_net_downward_shortwave_flux" />54 <field field_ref="qt" name=" tohfls" long_name="surface_net_downward_total_heat_flux" />55 <field field_ref="saltflx" name="s osflxdo" />55 <field field_ref="qsr" name="hfxqsr" long_name="surface_net_downward_shortwave_flux" /> 56 <field field_ref="qt" name="hfxtot" long_name="surface_net_downward_total_heat_flux" /> 57 <field field_ref="saltflx" name="sfx" /> 56 58 <field field_ref="taum" name="taum" /> 57 <field field_ref="wspd" name=" sowindsp" />58 <field field_ref="precip" name=" soprecip" />59 <field field_ref="wspd" name="windsp" /> 60 <field field_ref="precip" name="precip" /> 59 61 <!-- ice and snow --> 60 62 <field field_ref="snowpre" /> 63 <field field_ref="utau_ice" name="utau_ice" /> 64 <field field_ref="vtau_ice" name="vtau_ice" /> 65 <!-- clem 61 66 <field field_ref="qsr_io" name="iicesflx" /> 62 67 <field field_ref="qns_io" name="iicenflx" /> 63 <field field_ref="utau_ice" name="iicestru" /> 64 <field field_ref="vtau_ice" name="iicestrv" /> 68 --> 65 69 66 70 </file> … … 73 77 <field field_ref="u_masstr" name="vozomatr" /> 74 78 <field field_ref="u_heattr" name="sozohetr" /> 79 <field field_ref="u_salttr" name="sozosatr" /> 75 80 </file> 76 81 … … 82 87 <field field_ref="v_masstr" name="vomematr" /> 83 88 <field field_ref="v_heattr" name="somehetr" /> 89 <field field_ref="v_salttr" name="somesatr" /> 84 90 </file> 85 91 … … 90 96 </file> 91 97 92 <file id="file6" name_suffix="_icemod" description="ice variables" > 93 <field field_ref="snowthic_cea" name="snd" long_name="surface_snow_thickness" /> 94 <field field_ref="icethic_cea" name="sit" long_name="sea_ice_thickness" /> 95 <field field_ref="icevolu" name="iicevolu" /> 96 <field field_ref="snowvol" name="isnowvol" /> 97 <field field_ref="iceconc" name="iiceconc" /> 98 99 <field field_ref="icebopr" name="iicebopr" /> 100 <field field_ref="icedypr" name="iicedypr" /> 101 <field field_ref="ioceflxb" name="ioceflxb" /> 102 <field field_ref="uice_ipa" name="iicevelu" /> 103 <field field_ref="vice_ipa" name="iicevelv" /> 104 <field field_ref="isst" name="isstempe" /> 105 <field field_ref="isss" name="isssalin" /> 106 <field field_ref="micesalt" name="iicesali" /> 107 <field field_ref="miceage" name="iiceages" /> 108 <field field_ref="icelapr" name="iicelapr" /> 109 <field field_ref="icesipr" name="iicesipr" /> 110 <field field_ref="micet" name="iicetemp" /> 111 <field field_ref="icehc" name="iiceheco" /> 112 <field field_ref="isnowhc" name="isnoheco" /> 113 <field field_ref="icest" name="iicesurt" /> 114 <field field_ref="sfxbri" name="iicefsbr" /> 115 <field field_ref="sfxthd" name="iicefseq" /> 116 <field field_ref="ibrinv" name="ibrinvol" /> 117 <field field_ref="icecolf" name="iicecolf" /> 118 <field field_ref="icestr" name="iicestre" /> 119 <field field_ref="icevel" name="iicevelo" /> 120 <field field_ref="isume" name="iicesume" /> 121 <field field_ref="ibome" name="iicebome" /> 122 <field field_ref="idive" name="iicedive" /> 123 <field field_ref="ishear" name="iiceshea" /> 124 <field field_ref="icerepr" name="iicerepr" /> 125 <field field_ref="sfxmec" name="iicefsrp" /> 126 <field field_ref="sfxres" name="iicefsre" /> 127 <field field_ref="icetrp" name="iicevtrp" /> 98 <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 99 <field field_ref="snowthic_cea" name="sndept" long_name="surface_snow_thickness" /> 100 <field field_ref="icethic_cea" name="sithic" long_name="sea_ice_thickness" /> 101 <field field_ref="icevolu" name="sivolu" /> 102 <field field_ref="snowvol" name="snvolu" /> 103 <field field_ref="iceconc" name="siconc" /> 104 105 <field field_ref="vfxbog" name="vfxbog" /> 106 <field field_ref="vfxdyn" name="vfxdyn" /> 107 <field field_ref="vfxopw" name="vfxopw" /> 108 <field field_ref="vfxsni" name="vfxsni" /> 109 <field field_ref="vfxsum" name="vfxsum" /> 110 <field field_ref="vfxbom" name="vfxbom" /> 111 <field field_ref="vfxres" name="vfxres" /> 112 <field field_ref="vfxice" name="vfxice" /> 113 <field field_ref="vfxsnw" name="vfxsnw" /> 114 <field field_ref="vfxsub" name="vfxsub" /> 115 116 <field field_ref="icetrp" name="sivtrp" /> 117 <field field_ref="snwtrp" name="snvtrp" /> 118 <field field_ref="deitrp" name="deitrp" /> 119 <field field_ref="destrp" name="destrp" /> 120 121 <field field_ref="sfxbri" name="sfxbri" /> 122 <field field_ref="sfxdyn" name="sfxdyn" /> 123 <field field_ref="sfxres" name="sfxres" /> 124 <field field_ref="sfxbog" name="sfxbog" /> 125 <field field_ref="sfxbom" name="sfxbom" /> 126 <field field_ref="sfxsum" name="sfxsum" /> 127 <field field_ref="sfxsni" name="sfxsni" /> 128 <field field_ref="sfxopw" name="sfxopw" /> 129 <field field_ref="sfx" name="sfx" /> 130 131 <field field_ref="hfxdhc1" name="hfxdhc1" /> 132 <field field_ref="hfxspr" name="hfxspr" /> 133 <field field_ref="hfxqsr" name="hfxqsr" /> 134 <field field_ref="hfxqns" name="hfxqns" /> 135 136 <field field_ref="hfxthd" name="hfxthd" /> 137 <field field_ref="hfxdyn" name="hfxdyn" /> 138 <field field_ref="hfxres" name="hfxres" /> 139 <field field_ref="hfxout" name="hfxout" /> 140 <field field_ref="hfxin" name="hfxin" /> 141 <field field_ref="hfxtot" name="hfxtot" /> 142 <field field_ref="hfxsnw" name="hfxsnw" /> 143 <field field_ref="hfxsub" name="hfxsub" /> 144 <field field_ref="hfxerr" name="hfxerr" /> 145 <field field_ref="hfxerr_rem" name="hfxerr_rem" /> 146 147 <field field_ref="isst" name="sst" /> 148 <field field_ref="isss" name="sss" /> 149 <field field_ref="micesalt" name="sisali" /> 150 <field field_ref="micet" name="sitemp" /> 151 <field field_ref="icest" name="sistem" /> 152 <field field_ref="icehc" name="siheco" /> 153 <field field_ref="isnowhc" name="snheco" /> 154 <field field_ref="miceage" name="siages" /> 155 156 <field field_ref="uice_ipa" name="sivelu" /> 157 <field field_ref="vice_ipa" name="sivelv" /> 158 <field field_ref="icevel" name="sivelo" /> 159 <field field_ref="idive" name="sidive" /> 160 <field field_ref="ishear" name="sishea" /> 161 <field field_ref="icestr" name="sistre" /> 162 163 <field field_ref="ibrinv" name="sibrin" /> 164 <field field_ref="icecolf" name="sicolf" /> 165 166 <field field_ref="iceage_cat" name="siagecat"/> 167 <field field_ref="iceconc_cat" name="siconcat"/> 168 <field field_ref="icethic_cat" name="sithicat"/> 169 <field field_ref="snowthic_cat" name="sndeptcat"/> 170 <field field_ref="salinity_cat" name="salincat"/> 171 <field field_ref="brinevol_cat" name="sibrincat"/> 172 128 173 </file> 129 174 … … 146 191 <field field_ref="bgfrctem" name="bgfrctem" /> 147 192 <field field_ref="bgfrcsal" name="bgfrcsal" /> 193 <!-- 148 194 <field field_ref="bgmistem" name="bgmistem" /> 149 195 <field field_ref="bgmissal" name="bgmissal" /> 196 --> 150 197 </file> 151 198 … … 160 207 <field field_ref="ibgsaltco" name="ibgsaltco" /> 161 208 162 <field field_ref="ibg emp" name="ibgemp" />163 <field field_ref="ibg empbog" name="ibgempbog" />164 <field field_ref="ibg emplag" name="ibgemplag" />165 <field field_ref="ibg empsig" name="ibgempsig" />166 <field field_ref="ibg empdyg" name="ibgempdyg" />167 <field field_ref="ibg empbom" name="ibgempbom" />168 <field field_ref="ibg empsum" name="ibgempsum" />169 <field field_ref="ibg empres" name="ibgempres" />209 <field field_ref="ibgvfx" name="ibgvfx" /> 210 <field field_ref="ibgvfxbog" name="ibgvfxbog" /> 211 <field field_ref="ibgvfxopw" name="ibgvfxopw" /> 212 <field field_ref="ibgvfxsni" name="ibgvfxsni" /> 213 <field field_ref="ibgvfxdyn" name="ibgvfxdyn" /> 214 <field field_ref="ibgvfxbom" name="ibgvfxbom" /> 215 <field field_ref="ibgvfxsum" name="ibgvfxsum" /> 216 <field field_ref="ibgvfxres" name="ibgvfxres" /> 170 217 171 218 <field field_ref="ibgsfx" name="ibgsfx" /> 172 219 <field field_ref="ibgsfxbri" name="ibgsfxbri" /> 173 <field field_ref="ibgsfxthd" name="ibgsfxthd" /> 174 <field field_ref="ibgsfxmec" name="ibgsfxmec" /> 220 <field field_ref="ibgsfxdyn" name="ibgsfxdyn" /> 175 221 <field field_ref="ibgsfxres" name="ibgsfxres" /> 222 <field field_ref="ibgsfxbog" name="ibgsfxbog" /> 223 <field field_ref="ibgsfxopw" name="ibgsfxopw" /> 224 <field field_ref="ibgsfxsni" name="ibgsfxsni" /> 225 <field field_ref="ibgsfxbom" name="ibgsfxbom" /> 226 <field field_ref="ibgsfxsum" name="ibgsfxsum" /> 227 228 <field field_ref="ibghfxdhc1" name="ibghfxdhc1" /> 229 <field field_ref="ibghfxspr" name="ibghfxspr" /> 230 <field field_ref="ibghfxqsr" name="ibghfxqsr" /> 231 <field field_ref="ibghfxqns" name="ibghfxqns" /> 232 233 <field field_ref="ibghfxres" name="ibghfxres" /> 234 <field field_ref="ibghfxsub" name="ibghfxsub" /> 235 <field field_ref="ibghfxdyn" name="ibghfxdyn" /> 236 <field field_ref="ibghfxthd" name="ibghfxthd" /> 237 <field field_ref="ibghfxout" name="ibghfxout" /> 238 <field field_ref="ibghfxin" name="ibghfxin" /> 239 <field field_ref="ibghfxtot" name="ibghfxtot" /> 240 <field field_ref="ibghfxsnw" name="ibghfxsnw" /> 176 241 177 242 <field field_ref="ibgfrcvol" name="ibgfrcvol" /> 178 243 <field field_ref="ibgfrcsfx" name="ibgfrcsfx" /> 179 <field field_ref="ibg grme" name="ibggrme" />244 <field field_ref="ibgvolgrm" name="ibgvolgrm" /> 180 245 </file> 181 246 … … 213 278 <axis id="nfloat" long_name="Float number" unit="-" /> 214 279 <axis id="icbcla" long_name="Iceberg class" unit="-" /> 280 <axis id="ncatice" long_name="Ice categories" unit="-" /> 215 281 </axis_definition> 216 282 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice
r4345 r4634 27 27 &namiceini ! ice initialisation 28 28 !----------------------------------------------------------------------- 29 ttest = 2.0 ! threshold water temperature for initial sea ice 30 hninn = 0.3 ! initial snow thickness in the north 31 hnins = 0.1 ! " " south 32 hginn = 3.50 ! initial undeformed ice thickness in the north 33 hgins = 1.0 ! " " " south 34 aginn = 0.95 ! initial undeformed ice concentration in the north 35 agins = 0.9 ! " " " south 36 sinn = 6.301 ! initial salinity in the north 37 sins = 6.301 ! " " south 29 ln_limini = .true. ! activate ice initialization (T) or not (F) 30 thres_sst = 2.0 ! threshold water temperature for initial sea ice 31 hts_ini_n = 0.3 ! initial snow thickness in the north 32 hts_ini_s = 0.1 ! " " south 33 hti_ini_n = 3.50 ! initial ice thickness in the north 34 hti_ini_s = 1.0 ! " " south 35 ati_ini_n = 0.95 ! initial ice concentration in the north 36 ati_ini_s = 0.9 ! " " south 37 smi_ini_n = 6.301 ! initial ice salinity in the north 38 smi_ini_s = 6.301 ! " " south 39 tmi_ini_n = 270. ! initial ice/snw temp in the north 40 tmi_ini_s = 270. ! initial ice/snw temp in the south 38 41 / 39 42 !----------------------------------------------------------------------- … … 58 61 telast =9600.0 ! timescale for elastic waves, SB, 720.0 59 62 alphaevp = 1.0 ! coefficient for the solution of internal ice stresses 60 hminrhg = 0.001 ! ice thickness (m) below which ice velocity equal ocean velocity63 hminrhg = 0.001 ! ice volume (a*h in m) below which ice velocity equal ocean velocity 61 64 / 62 65 !----------------------------------------------------------------------- … … 149 152 &namiceout ! parameters for outputs 150 153 !----------------------------------------------------------------------- 151 noumef = 43 ! number of fields152 add_diag_swi= 1 ! 1 -> diagnose distribution in thickness space153 ! 0 -> only simple diagnostics154 ! noumef = 43 ! number of fields 155 !SF add_diag_swi= 1 ! 1 -> diagnose distribution in thickness space 156 !SF ! 0 -> only simple diagnostics 154 157 ! 155 158 ! ! title of the field ! name ! units ! save ! multipl. ! additive ! 156 159 ! ! ! ! ! or not ! factor ! factor ! 157 field_1 = 'Ice concentration ', 'iiceconc', '% ', 1 , 1.0 , 0.0158 field_2 = 'Ice thickness ', 'iicethic', 'm ', 1 , 1.0 , 0.0159 field_3 = 'Snow thickness ', 'isnowthi', 'm ', 1 , 1.0 , 0.0160 field_4 = 'Daily bottom thermo ice production ', 'iicebopr', 'km3/day ', 1 , 1.0e-9 , 0.0161 field_5 = 'Daily dynamic ice production ', 'iicedypr', 'km3/day ', 1 , 1.0e-9 , 0.0162 field_6 = 'Oceanic flux at the ice base ', 'ioceflxb', 'w/m2 ', 1 , 1.0 , 0.0163 field_7 = 'Ice velocity u ', 'iicevelu', 'm/s ', 1 , 1.0 , 0.0164 field_8 = 'Ice velocity v ', 'iicevelv', 'm/s ', 1 , 1.0 , 0.0165 field_9 = 'Sea surface temperature ', 'isstempe', 'C ', 1 , 1.0 , -273.15166 field_10 = 'Sea surface salinity ', 'isssalin', 'PSU ', 1 , 1.0 , 0.0167 field_11 = 'Total flux at ocean surface ', 'iocetflx', 'w/m2 ', 1 , 1.0 , 0.0168 field_12 = 'Solar flux at ocean surface ', 'iocesflx', 'w/m2 ', 1 , 1.0 , 0.0169 field_13 = 'Non-solar flux at ocean surface ', 'iocwnsfl', 'w/m2 ', 1 , 1.0 , 0.0170 field_14 = 'Heat flux due to brine release ', 'iocehebr', 'w/m2 ', 1 , 1.0 , 0.0171 field_15 = 'Wind stress u ', 'iocestru', 'Pa ', 1 , 1.0 , 0.0172 field_16 = 'Wind stress v ', 'iocestrv', 'Pa ', 1 , 1.0 , 0.0173 field_17 = 'Solar flux at ice/ocean surface ', 'iicesflx', 'w/m2 ', 1 , 1.0 , 0.0174 field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2 ', 1 , 1.0 , 0.0175 field_19 = 'Snow precipitation ', 'isnowpre', 'kg/m2/d ', 1 , 1.0 , 0.0176 field_20 = 'Mean ice salinity ', 'iicesali', 'psu ', 1 , 1.0 , 0.0177 field_21 = 'Mean ice age ', 'iiceages', 'years ', 1 , 0.002739, 0.0178 field_22 = 'Daily lateral thermo ice prod. ', 'iicelapr', 'km3/day ', 1 ,1.0e-9 , 0.0179 field_23 = 'Daily snowice ice production ', 'iicesipr', 'km3/day ', 1 ,1.0e-9 , 0.0180 field_24 = 'Mean ice temperature ', 'iicetemp', 'C ', 1 , 1.0 , -273.15181 field_25 = 'Ice total heat content ', 'iiceheco', '10^9 J ', 1 , 1.0 , 0.0182 field_26 = 'Ice surface temperature ', 'iicesurt', 'C ', 1 , 1.0 , -273.15183 field_27 = 'Snow temperature ', 'isnotem2', 'C ', 1 , 1.0 , -273.15184 field_28 = 'Fsbri - brine salt flux ', 'iicefsbr', 'kg/m2/d ', 1 , 1.0 , 0.0185 field_29 = 'Fseqv - equivalent FW salt flux ', 'iicefseq', 'kg/m2/d ', 1 , 1.0 , 0.0186 field_30 = 'Brine volume ', 'ibrinvol', '% ', 1 , 100.0 , 0.0187 field_31 = 'Frazil ice collection thickness ', 'iicecolf', 'm ', 1 , 1.0 , 0.0188 field_32 = 'Ice strength ', 'iicestre', 'N/m ', 1 , 0.001 , 0.0189 field_33 = 'Ice velocity ', 'iicevelo', 'm/s ', 1 , 1.0 , 0.0190 field_34 = 'Surface melt ', 'iicesume', 'km3/day ', 1 ,1.0e-9 , 0.0191 field_35 = 'Bottom melt ', 'iicebome', 'km3/day ', 1 ,1.0e-9 , 0.0192 field_36 = 'Divergence ', 'iicedive', '10-8s-1 ', 1 , 1.0e8 , 0.0193 field_37 = 'Shear ', 'iiceshea', '10-8s-1 ', 1 , 1.0e8 , 0.0194 field_38 = 'Daily resultant ice prod/melt ', 'iicerepr', 'km3/day ', 1 , 1.0e-9 , 0.0195 field_39 = 'Ice volume ', 'iicevolu', 'km3 ', 1 , 1.0e-9 , 0.0196 field_40 = 'Snow volume ', 'isnowvol', 'km3 ', 1 , 1.0e-9 , 0.0197 field_41 = 'Fsrpo - salt flux from ridg/raft ', 'iicefsrp', 'kg/m2/d ', 1 , 1.0 , 0.0198 field_42 = 'Fsres - salt flux from limupdate ', 'iicefsre', 'kg/m2/d ', 1 , 1.0 , 0.0199 field_43 = 'Ice volume transport ', 'iicevtrp', 'km3/day ', 1 ,1.0e-9 , 0.0200 160 / 201 161 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice_lim3
r4345 r4634 27 27 &namiceini ! ice initialisation 28 28 !----------------------------------------------------------------------- 29 ttest = 2.0 ! threshold water temperature for initial sea ice 30 hninn = 0.3 ! initial snow thickness in the north 31 hnins = 0.1 ! " " south 32 hginn = 3.50 ! initial undeformed ice thickness in the north 33 hgins = 1.0 ! " " " south 34 aginn = 0.95 ! initial undeformed ice concentration in the north 35 agins = 0.9 ! " " " south 36 sinn = 6.301 ! initial salinity in the north 37 sins = 6.301 ! " " south 29 ln_limini = .true. ! activate ice initialization (T) or not (F) 30 thres_sst = 2.0 ! threshold water temperature for initial sea ice 31 hts_ini_n = 0.3 ! initial snow thickness in the north 32 hts_ini_s = 0.1 ! " " south 33 hti_ini_n = 3.50 ! initial ice thickness in the north 34 hti_ini_s = 1.0 ! " " south 35 ati_ini_n = 0.95 ! initial ice concentration in the north 36 ati_ini_s = 0.9 ! " " south 37 smi_ini_n = 6.301 ! initial ice salinity in the north 38 smi_ini_s = 6.301 ! " " south 39 tmi_ini_n = 270. ! initial ice/snw temp in the north 40 tmi_ini_s = 270. ! initial ice/snw temp in the south 38 41 / 39 42 !----------------------------------------------------------------------- … … 149 152 &namiceout ! parameters for outputs 150 153 !----------------------------------------------------------------------- 151 noumef = 43 ! number of fields152 add_diag_swi= 1 ! 1 -> diagnose distribution in thickness space153 ! 0 -> only simple diagnostics154 ! noumef = 43 ! number of fields 155 !SF add_diag_swi= 1 ! 1 -> diagnose distribution in thickness space 156 !SF ! 0 -> only simple diagnostics 154 157 ! 155 158 ! ! title of the field ! name ! units ! save ! multipl. ! additive ! 156 159 ! ! ! ! ! or not ! factor ! factor ! 157 field_1 = 'Ice concentration ', 'iiceconc', '% ', 1 , 1.0 , 0.0158 field_2 = 'Ice thickness ', 'iicethic', 'm ', 1 , 1.0 , 0.0159 field_3 = 'Snow thickness ', 'isnowthi', 'm ', 1 , 1.0 , 0.0160 field_4 = 'Daily bottom thermo ice production ', 'iicebopr', 'km3/day ', 1 , 1.0e-9 , 0.0161 field_5 = 'Daily dynamic ice production ', 'iicedypr', 'km3/day ', 1 , 1.0e-9 , 0.0162 field_6 = 'Oceanic flux at the ice base ', 'ioceflxb', 'w/m2 ', 1 , 1.0 , 0.0163 field_7 = 'Ice velocity u ', 'iicevelu', 'm/s ', 1 , 1.0 , 0.0164 field_8 = 'Ice velocity v ', 'iicevelv', 'm/s ', 1 , 1.0 , 0.0165 field_9 = 'Sea surface temperature ', 'isstempe', 'C ', 1 , 1.0 , -273.15166 field_10 = 'Sea surface salinity ', 'isssalin', 'PSU ', 1 , 1.0 , 0.0167 field_11 = 'Total flux at ocean surface ', 'iocetflx', 'w/m2 ', 1 , 1.0 , 0.0168 field_12 = 'Solar flux at ocean surface ', 'iocesflx', 'w/m2 ', 1 , 1.0 , 0.0169 field_13 = 'Non-solar flux at ocean surface ', 'iocwnsfl', 'w/m2 ', 1 , 1.0 , 0.0170 field_14 = 'Heat flux due to brine release ', 'iocehebr', 'w/m2 ', 1 , 1.0 , 0.0171 field_15 = 'Wind stress u ', 'iocestru', 'Pa ', 1 , 1.0 , 0.0172 field_16 = 'Wind stress v ', 'iocestrv', 'Pa ', 1 , 1.0 , 0.0173 field_17 = 'Solar flux at ice/ocean surface ', 'iicesflx', 'w/m2 ', 1 , 1.0 , 0.0174 field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2 ', 1 , 1.0 , 0.0175 field_19 = 'Snow precipitation ', 'isnowpre', 'kg/m2/d ', 1 , 1.0 , 0.0176 field_20 = 'Mean ice salinity ', 'iicesali', 'psu ', 1 , 1.0 , 0.0177 field_21 = 'Mean ice age ', 'iiceages', 'years ', 1 , 0.002739, 0.0178 field_22 = 'Daily lateral thermo ice prod. ', 'iicelapr', 'km3/day ', 1 ,1.0e-9 , 0.0179 field_23 = 'Daily snowice ice production ', 'iicesipr', 'km3/day ', 1 ,1.0e-9 , 0.0180 field_24 = 'Mean ice temperature ', 'iicetemp', 'C ', 1 , 1.0 , -273.15181 field_25 = 'Ice total heat content ', 'iiceheco', '10^9 J ', 1 , 1.0 , 0.0182 field_26 = 'Ice surface temperature ', 'iicesurt', 'C ', 1 , 1.0 , -273.15183 field_27 = 'Snow temperature ', 'isnotem2', 'C ', 1 , 1.0 , -273.15184 field_28 = 'Fsbri - brine salt flux ', 'iicefsbr', 'kg/m2/d ', 1 , 1.0 , 0.0185 field_29 = 'Fseqv - equivalent FW salt flux ', 'iicefseq', 'kg/m2/d ', 1 , 1.0 , 0.0186 field_30 = 'Brine volume ', 'ibrinvol', '% ', 1 , 100.0 , 0.0187 field_31 = 'Frazil ice collection thickness ', 'iicecolf', 'm ', 1 , 1.0 , 0.0188 field_32 = 'Ice strength ', 'iicestre', 'N/m ', 1 , 0.001 , 0.0189 field_33 = 'Ice velocity ', 'iicevelo', 'm/s ', 1 , 1.0 , 0.0190 field_34 = 'Surface melt ', 'iicesume', 'km3/day ', 1 ,1.0e-9 , 0.0191 field_35 = 'Bottom melt ', 'iicebome', 'km3/day ', 1 ,1.0e-9 , 0.0192 field_36 = 'Divergence ', 'iicedive', '10-8s-1 ', 1 , 1.0e8 , 0.0193 field_37 = 'Shear ', 'iiceshea', '10-8s-1 ', 1 , 1.0e8 , 0.0194 field_38 = 'Daily resultant ice prod/melt ', 'iicerepr', 'km3/day ', 1 , 1.0e-9 , 0.0195 field_39 = 'Ice volume ', 'iicevolu', 'km3 ', 1 , 1.0e-9 , 0.0196 field_40 = 'Snow volume ', 'isnowvol', 'km3 ', 1 , 1.0e-9 , 0.0197 field_41 = 'Fsrpo - salt flux from ridg/raft ', 'iicefsrp', 'kg/m2/d ', 1 , 1.0 , 0.0198 field_42 = 'Fsres - salt flux from limupdate ', 'iicefsre', 'kg/m2/d ', 1 , 1.0 , 0.0199 field_43 = 'Ice volume transport ', 'iicevtrp', 'km3/day ', 1 ,1.0e-9 , 0.0200 160 / 201 161 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/CONFIG/cfg.txt
r4332 r4634 7 7 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 8 8 AMM12 OPA_SRC 9 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 9 10 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 10 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r4332 r4634 207 207 ! ! 3 - salinity profile, constant in time 208 208 INTEGER , PUBLIC :: sal_prof = 1 !: salinity profile or not 209 INTEGER , PUBLIC :: thcon_i_swi = 1 !: thermal conductivity: = 1 Untersteiner (1964) ; =2Pringle et al (2007)209 INTEGER , PUBLIC :: thcon_i_swi = 1 !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 210 210 211 211 ! !!** ice-mechanical redistribution namelist (namiceitdme) … … 249 249 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i !: Shear of the velocity field [s-1] 250 250 ! 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: firic !: IR flux over the ice (diag only)252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcsic !: Sensible heat flux over the ice (diag only)253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fleic !: Latent heat flux over the ice (diag only)254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlatic !: latent flux255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvosif !: Variation of volume at surface (diag only)256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvobif !: Variation of ice volume at the bottom ice (diag only)257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdvolif !: Total variation of ice volume (diag only)258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvonif !: Lateral Variation of ice volume (diag only)259 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sist !: Average Sea-Ice Surface Temperature [Kelvin] 260 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icethi !: total ice thickness (for all categories) (diag only) 261 253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicifp !: Ice production/melting==>!obsolete... can be removed263 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frld !: Leads fraction = 1 - ice fraction 264 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfrld !: Leads fraction at previous time 265 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: phicif !: Old ice thickness 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fbif !: Heat flux at the ice base 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_snw !: Variation of snow mass over 1 time step [Kg/m2] 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_snw !: Heat content associated with rdm_snw [J/m2] 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_ice !: Variation of ice mass over 1 time step [Kg/m2] 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_ice !: Heat content associated with rdm_ice [J/m2] 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qldif !: heat balance of the lead (or of the open ocean) 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qcmif !: Energy needed to bring the ocean to freezing 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdtcn !: net downward heat flux from the ice to the ocean 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qdtcn !: energy from the ice to the ocean 275 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric !: transmitted solar radiation under ice 276 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fscmbq !: associated with lead chipotage with solar flux 277 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ffltbif !: related to max heat contained in brine pockets (?) 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsbbq !: Also linked with the solar flux below the ice (?) 279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qfvbq !: store energy in case of total lateral ablation (?) 280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dmgwi !: Variation of the mass of snow ice 281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_thd !: salt flux due to ice growth/melt [PSU/m2/s] 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlead !: heat balance of the lead (or of the open ocean) 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhtur !: net downward heat flux from the ice to the ocean 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 260 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: Variation of snow mass over 1 time step [Kg/m2] 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: Variation of ice mass over 1 time step [Kg/m2] 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: Variation of snow mass over 1 time step due to sublimation [Kg/m2] 264 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni ! snow ice growth 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw ! lateral ice growth 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog ! bottom ice growth 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn ! dynamical ice growth 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom ! vertical bottom melt 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum ! vertical surface melt 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res ! production (growth+melt) due to limupdate 272 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s] 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice growth/melt [PSU/m2/s] 275 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice growth/melt [PSU/m2/s] 276 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to ice growth/melt [PSU/m2/s] 277 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to ice growth/melt [PSU/m2/s] 282 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [PSU/m2/s] 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_ mec!: salt flux due to porous ridged ice formation [PSU/m2/s]279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [PSU/m2/s] 284 280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: residual salt flux due to correction of ice thickness [PSU/m2/s] 285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhbri !: heat flux due to brine rejection 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_mec !: heat flux associated with porous ridged ice formation [???] 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_res !: residual heat flux due to correction of ice thickness 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmec !: mass flux due to snow loss during compression [Kg/m2/s] 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhmec !: heat flux due to snow loss during compression 281 282 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd !: ice-ocean heat flux from thermo processes (limthd_dh) 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn !: ice-ocean heat flux from mecanical processes (limitd_me) 284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_tot !: total heat flux lost/gained by ice 285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_spr !: heat flux of the snow precipitation 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sub !: heat flux for sublimation 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err !: heat flux error after heat diffusion 290 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping 291 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_in !: heat flux available for thermo transformations 292 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_out !: heat flux remaining at the end of thermo transformations 293 294 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 290 295 291 296 ! temporary arrays for dummy version of the code 292 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D,q_s297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh_i_surf2D, dh_i_bott2D, q_s 293 298 294 299 !!-------------------------------------------------------------------------- … … 404 409 LOGICAL , PUBLIC :: ln_limdiahsb = .FALSE. !: flag for ice diag (T) or not (F) 405 410 LOGICAL , PUBLIC :: ln_limdiaout = .FALSE. !: flag for ice diag (T) or not (F) 406 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: v_newice !: volume of ice formed in the leads407 411 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dv_dt_thd !: thermodynamic growth rates 408 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: izero, fstroc, fhbricat 409 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sni_gr ! snow ice growth 410 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_lat_gr ! lateral ice growth 411 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_bot_gr ! bottom ice growth 412 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_dyn_gr ! dynamical ice growth 413 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_bot_me ! vertical bottom melt 414 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sur_me ! vertical surface melt 415 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_res_pr ! production (growth+melt) due to limupdate 412 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: izero 416 413 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi ! transport of ice volume 414 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs ! transport of snw volume 415 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei ! transport of ice enthalpy (W/m2) 416 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es ! transport of snw enthalpy (W/m2) 417 ! 418 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat_dhc1 ! snw/ice heat content variation [W/m2] 419 ! 417 420 INTEGER , PUBLIC :: jiindx, jjindx !: indexes of the debugging point 418 421 … … 447 450 448 451 ii = ii + 1 449 ALLOCATE( firic (jpi,jpj) , fcsic (jpi,jpj) , fleic (jpi,jpj) , qlatic (jpi,jpj) , & 450 & rdvosif (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif(jpi,jpj) , rdvonif (jpi,jpj) , & 451 & sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , hicifp (jpi,jpj) , & 452 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , fbif (jpi,jpj) , & 453 & rdm_snw (jpi,jpj) , rdq_snw(jpi,jpj) , rdm_ice(jpi,jpj) , rdq_ice (jpi,jpj) , & 454 & qldif (jpi,jpj) , qcmif (jpi,jpj) , & 455 & fdtcn (jpi,jpj) , qdtcn (jpi,jpj) , fstric (jpi,jpj) , fscmbq (jpi,jpj) , & 456 & ffltbif (jpi,jpj) , fsbbq (jpi,jpj) , qfvbq (jpi,jpj) , dmgwi (jpi,jpj) , & 457 & sfx_res (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_mec(jpi,jpj) , fheat_mec(jpi,jpj) , & 458 & fhbri (jpi,jpj) , fmmec (jpi,jpj) , sfx_thd(jpi,jpj) , fhmec (jpi,jpj) , & 459 & fheat_res(jpi,jpj) , STAT=ierr(ii) ) 460 461 ii = ii + 1 462 ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , fstbif(jpi,jpj) , & 463 & fsup2D (jpi,jpj) , focea2D (jpi,jpj) , q_s (jpi,jpj) , STAT=ierr(ii) ) 452 ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , & 453 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 454 & wfx_snw (jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , & 455 & wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 456 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , qlead (jpi,jpj) , & 457 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl) , & 458 & sfx_res (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , & 459 & sfx_bog (jpi,jpj) , sfx_bom (jpi,jpj) , sfx_sum (jpi,jpj) , sfx_sni (jpi,jpj) , sfx_opw (jpi,jpj) , & 460 & hfx_res (jpi,jpj) , hfx_snw (jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj), hfx_err_rem(jpi,jpj), & 461 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) , & 462 & hfx_tot (jpi,jpj) , hfx_thd (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj), STAT=ierr(ii) ) 463 464 ii = ii + 1 465 ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) ) 464 466 465 467 ! * Ice global state variables … … 522 524 ! * Ice diagnostics 523 525 ii = ii + 1 524 ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , diag_sni_gr(jpi,jpj) , diag_lat_gr(jpi,jpj) , & 525 & izero (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) , & 526 & fstroc (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) , & 527 & fhbricat (jpi,jpj,jpl) , diag_res_pr(jpi,jpj) , diag_trp_vi(jpi,jpj) , v_newice(jpi,jpj) , STAT=ierr(ii) ) 526 ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , & 527 & izero (jpi,jpj,jpl) , diag_trp_vi(jpi,jpj) , diag_trp_vs(jpi,jpj), diag_trp_ei(jpi,jpj), diag_trp_es(jpi,jpj), & 528 & diag_heat_dhc1(jpi,jpj) , STAT=ierr(ii) ) 528 529 529 530 ice_alloc = MAXVAL( ierr(:) ) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
r4045 r4634 32 32 33 33 REAL(wp) :: epsi20 = 1.e-20_wp ! constant values 34 REAL(wp) :: rzero = 0._wp ! - -35 REAL(wp) :: rone = 1._wp ! - -36 34 37 35 !! * Substitutions … … 84 82 DO jj = 1, jpj 85 83 DO ji = 1, jpi 86 zslpmax = MAX( rzero, ps0(ji,jj) )84 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 87 85 zs1max = 1.5 * zslpmax 88 86 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 89 87 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 90 88 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) ) ) 91 zin0 = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask89 zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask 92 90 93 91 ps0 (ji,jj) = zslpmax … … 106 104 DO jj = 1, jpj ! Flux from i to i+1 WHEN u GT 0 107 105 DO ji = 1, jpi 108 zbet(ji,jj) = MAX( rzero, SIGN( rone, put(ji,jj) ) )109 zalf = MAX( rzero, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)106 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 107 zalf = MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 110 108 zalfq = zalf * zalf 111 109 zalf1 = 1.0 - zalf … … 133 131 DO jj = 1, jpjm1 ! Flux from i+1 to i when u LT 0. 134 132 DO ji = 1, fs_jpim1 135 zalf = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)133 zalf = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj) 136 134 zalg (ji,jj) = zalf 137 135 zalfq = zalf * zalf … … 269 267 DO jj = 1, jpj 270 268 DO ji = 1, jpi 271 zslpmax = MAX( rzero, ps0(ji,jj) )269 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 272 270 zs1max = 1.5 * zslpmax 273 271 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 274 272 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 275 273 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) ) ) 276 zin0 = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask274 zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask 277 275 ! 278 276 ps0 (ji,jj) = zslpmax … … 291 289 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 292 290 DO ji = 1, jpi 293 zbet(ji,jj) = MAX( rzero, SIGN( rone, pvt(ji,jj) ) )294 zalf = MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj)291 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 292 zalf = MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 295 293 zalfq = zalf * zalf 296 294 zalf1 = 1.0 - zalf … … 318 316 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 319 317 DO ji = 1, jpi 320 zalf = ( MAX( rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)318 zalf = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 321 319 zalg (ji,jj) = zalf 322 320 zalfq = zalf * zalf -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r4345 r4634 18 18 USE dom_oce ! ocean domain 19 19 USE sbc_oce ! surface boundary condition: ocean fields 20 USE sbc_ice ! Surface boundary condition: sea-ice fields 20 21 USE daymod ! model calendar 21 22 USE phycst ! physical constant … … 34 35 !!PUBLIC lim_diahsb_rst ! routine called by ice_init.F90 35 36 36 REAL( dp) :: frc_sal, frc_vol ! global forcing trends37 REAL( dp) :: bg_grme ! global ice growth+melt trends37 REAL(wp) :: frc_sal, frc_vol ! global forcing trends 38 REAL(wp) :: bg_grme ! global ice growth+melt trends 38 39 REAL(wp) :: epsi06 = 1.e-6_wp ! small number 39 REAL(wp) :: epsi03 = 1.e-3_wp ! small number40 41 40 42 41 !! * Substitutions … … 48 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 48 !!---------------------------------------------------------------------- 50 51 49 CONTAINS 52 50 … … 59 57 !!--------------------------------------------------------------------------- 60 58 !! 61 REAL(dp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 62 REAL(dp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_thd, zbg_sfx_res, zbg_sfx_mec 63 REAL(dp) :: zbg_emp, zbg_emp_bog, zbg_emp_lag, zbg_emp_sig, zbg_emp_dyg, zbg_emp_bom, zbg_emp_sum, zbg_emp_res 64 REAL(dp) :: z_frc_vol, z_frc_sal, z_bg_grme 65 REAL(dp) :: z1_area ! - - 66 REAL(dp) :: zinda, zindb 59 REAL(wp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 60 REAL(wp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn 61 REAL(wp) :: zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn, zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res 62 REAL(wp) :: zbg_hfx_dhc1, zbg_hfx_spr, zbg_hfx_qsr, zbg_hfx_qns 63 REAL(wp) :: zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_tot, zbg_hfx_out, zbg_hfx_in 64 REAL(wp) :: z_frc_vol, z_frc_sal, z_bg_grme 65 REAL(wp) :: z1_area, zcoef 66 REAL(wp) :: zinda, zindb 67 67 !!--------------------------------------------------------------------------- 68 68 IF( nn_timing == 1 ) CALL timing_start('lim_diahsb') … … 70 70 IF( numit == nstart ) CALL lim_diahsb_init 71 71 72 ! 1/area 73 z1_area = 1.d0 / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 74 75 zinda = MAX( 0.d0 , SIGN( 1.d0 , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 72 z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 73 74 zinda = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 76 75 ! ----------------------- ! 77 76 ! 1 - Content variations ! … … 80 79 zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow 81 80 zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area 82 zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )! mean salt content81 zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) ! mean salt content 83 82 zbg_tem = glob_sum( ( tm_i(:,:) - rtt ) * vt_i(:,:) * area(:,:) * tms(:,:) ) ! mean temp content 84 83 85 !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 86 !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 87 88 zbg_ihc = glob_sum( et_i(:,:) * 1.e-11 ) ! ice heat content [10^9*1.e-11 J] 89 zbg_shc = glob_sum( et_s(:,:) * 1.e-11 ) ! snow heat content [10^9*1.e-11 J] 90 91 zbg_emp = zinda * glob_sum( emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 92 zbg_emp_bog = zinda * glob_sum( diag_bot_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 93 zbg_emp_lag = zinda * glob_sum( diag_lat_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 94 zbg_emp_sig = zinda * glob_sum( diag_sni_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 95 zbg_emp_dyg = zinda * glob_sum( diag_dyn_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 96 zbg_emp_bom = zinda * glob_sum( diag_bot_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 97 zbg_emp_sum = zinda * glob_sum( diag_sur_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 98 zbg_emp_res = zinda * glob_sum( diag_res_pr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 99 100 zbg_sfx = zinda * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 101 zbg_sfx_bri = zinda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 102 zbg_sfx_thd = zinda * glob_sum( sfx_thd(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 103 zbg_sfx_res = zinda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 104 zbg_sfx_mec = zinda * glob_sum( sfx_mec(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 105 84 zcoef = zinda * z1_area * r1_rau0 * rday 85 ! Volume 86 zbg_vfx = glob_sum( emp(:,:) * area(:,:) * tms(:,:) ) * zcoef 87 zbg_vfx_bog = glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) * zcoef 88 zbg_vfx_opw = glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) * zcoef 89 zbg_vfx_sni = glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) * zcoef 90 zbg_vfx_dyn = glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) * zcoef 91 zbg_vfx_bom = glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) * zcoef 92 zbg_vfx_sum = glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) * zcoef 93 zbg_vfx_res = glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) * zcoef 94 95 ! Salt 96 zbg_sfx = glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) * zcoef 97 zbg_sfx_bri = glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * zcoef 98 zbg_sfx_res = glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * zcoef 99 zbg_sfx_dyn = glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) * zcoef 100 101 zbg_sfx_bog = glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) * zcoef 102 zbg_sfx_opw = glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) * zcoef 103 zbg_sfx_sni = glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) * zcoef 104 zbg_sfx_bom = glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) * zcoef 105 zbg_sfx_sum = glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) * zcoef 106 107 ! Heat budget 108 zbg_ihc = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content [1.e-20 J] 109 zbg_shc = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J] 110 zbg_hfx_dhc1 = glob_sum( diag_heat_dhc1(:,:) * area(:,:) * tms(:,:) ) ! [in W] 111 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 112 zbg_hfx_qsr = glob_sum( qsr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 113 zbg_hfx_qns = glob_sum( qns(:,:) * area(:,:) * tms(:,:) ) ! [in W] 114 115 zbg_hfx_thd = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W] 116 zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W] 117 zbg_hfx_res = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W] 118 zbg_hfx_sub = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W] 119 zbg_hfx_snw = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 120 zbg_hfx_tot = glob_sum( hfx_tot(:,:) * area(:,:) * tms(:,:) ) ! [in W] 121 zbg_hfx_out = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W] 122 zbg_hfx_in = glob_sum( hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W] 123 106 124 ! --------------------------------------------- ! 107 125 ! 2 - Trends due to forcing and ice growth/melt ! … … 109 127 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 110 128 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes 111 z_bg_grme = glob_sum( ( diag_bot_gr(:,:) + diag_lat_gr(:,:) + diag_sni_gr(:,:) + diag_dyn_gr(:,:) + & 112 & diag_bot_me(:,:) + diag_sur_me(:,:) + diag_res_pr(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 113 ! 114 frc_vol = frc_vol + z_frc_vol * rdt_ice 115 frc_sal = frc_sal + z_frc_sal * rdt_ice 116 bg_grme = bg_grme + z_bg_grme * rdt_ice 117 118 ! difference 119 !frc_vol = zbg_ivo - frc_vol 120 !frc_sal = zbg_sal - frc_sal 121 129 z_bg_grme = glob_sum( ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 130 & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) ) / rhoic * area(:,:) * tms(:,:) ) ! volume fluxes 131 ! 132 frc_vol = frc_vol + z_frc_vol * rdt_ice 133 frc_sal = frc_sal + z_frc_sal * rdt_ice 134 bg_grme = bg_grme + z_bg_grme * rdt_ice 135 122 136 ! ----------------------- ! 123 137 ! 3 - Diagnostics writing ! 124 138 ! ----------------------- ! 125 zindb = MAX( 0. d0 , SIGN( 1.d0, zbg_ivo - epsi06 ) )139 zindb = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 126 140 ! 127 141 CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9 ) ! ice volume (km3 equivalent liquid) … … 134 148 CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9 ) ! ice salt content (psu*km3 equivalent liquid) 135 149 136 CALL iom_put( 'ibg emp' , zbg_emp) ! volume flux emp (m/day liquid)137 CALL iom_put( 'ibg empbog' , zbg_emp_bog ) ! volume flux bottom growth -(m/day equivalent liquid)138 CALL iom_put( 'ibg emplag' , zbg_emp_lag) ! volume flux open water growth -139 CALL iom_put( 'ibg empsig' , zbg_emp_sig) ! volume flux snow ice growth -140 CALL iom_put( 'ibg empdyg' , zbg_emp_dyg) ! volume flux dynamic growth -141 CALL iom_put( 'ibg empbom' , zbg_emp_bom ) ! volume flux bottom melt -142 CALL iom_put( 'ibg empsum' , zbg_emp_sum ) ! volume flux surface melt -143 CALL iom_put( 'ibg empres' , zbg_emp_res ) ! volume flux resultant -150 CALL iom_put( 'ibgvfx' , zbg_vfx ) ! volume flux emp (m/day liquid) 151 CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog ) ! volume flux bottom growth -(m/day equivalent liquid) 152 CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw ) ! volume flux open water growth - 153 CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni ) ! volume flux snow ice growth - 154 CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn ) ! volume flux dynamic growth - 155 CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom ) ! volume flux bottom melt - 156 CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum ) ! volume flux surface melt - 157 CALL iom_put( 'ibgvfxres' , zbg_vfx_res ) ! volume flux resultant - 144 158 145 159 CALL iom_put( 'ibgsfx' , zbg_sfx ) ! salt flux -(psu*m/day equivalent liquid) 146 160 CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri ) ! salt flux brines - 147 CALL iom_put( 'ibgsfxthd' , zbg_sfx_thd ) ! salt flux thermo - 148 CALL iom_put( 'ibgsfxmec' , zbg_sfx_mec ) ! salt flux dynamic - 161 CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn ) ! salt flux dynamic - 149 162 CALL iom_put( 'ibgsfxres' , zbg_sfx_res ) ! salt flux result - 163 CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog ) ! salt flux bottom growth 164 CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw ) ! salt flux open water growth - 165 CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni ) ! salt flux snow ice growth - 166 CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom ) ! salt flux bottom melt - 167 CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum ) ! salt flux surface melt - 168 169 CALL iom_put( 'ibghfxdhc1', zbg_hfx_dhc1 ) ! Heat content variation in snow and ice [W] 170 CALL iom_put( 'ibghfxspr' , zbg_hfx_spr ) ! Heat content of snow precip [W] 171 CALL iom_put( 'ibghfxqsr' , zbg_hfx_qsr ) ! solar fluxes used by snw/ice [W] 172 CALL iom_put( 'ibghfxqns' , zbg_hfx_qns ) ! non solar fluxes used by snw/ice [W] 173 174 CALL iom_put( 'ibghfxres' , zbg_hfx_res ) ! 175 CALL iom_put( 'ibghfxsub' , zbg_hfx_sub ) ! 176 CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn ) ! 177 CALL iom_put( 'ibghfxthd' , zbg_hfx_thd ) ! 178 CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw ) ! 179 CALL iom_put( 'ibghfxtot' , zbg_hfx_tot ) ! 180 CALL iom_put( 'ibghfxout' , zbg_hfx_out ) ! 181 CALL iom_put( 'ibghfxin' , zbg_hfx_in ) ! 150 182 151 183 CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9 ) ! vol - forcing (km3 equivalent liquid) 152 184 CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9 ) ! sal - forcing (psu*km3 equivalent liquid) 153 CALL iom_put( 'ibggrme' , bg_grme * rhoic * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 185 CALL iom_put( 'ibgvolgrm' , bg_grme * rhoic * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 186 154 187 ! 155 188 IF( lrst_ice ) CALL lim_diahsb_rst( numit, 'WRITE' ) 156 189 ! 157 190 IF( nn_timing == 1 ) CALL timing_stop('lim_diahsb') 158 !191 ! 159 192 END SUBROUTINE lim_diahsb 160 193 … … 190 223 ! 2 - initial conservation variables ! 191 224 ! ---------------------------------- ! 192 !frc_vol = 0.d0 ! volume trend due to forcing193 !frc_sal = 0.d0 ! salt content - - - -194 !bg_grme = 0.d0 ! ice growth + melt volume trend195 225 ! 196 226 CALL lim_diahsb_rst( nstart, 'READ' ) !* read or initialize all required files … … 226 256 IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' 227 257 IF(lwp) WRITE(numout,*) '~~~~~~~' 228 frc_vol = 0. d0229 frc_sal = 0. d0230 bg_grme = 0. d0258 frc_vol = 0._wp 259 frc_sal = 0._wp 260 bg_grme = 0._wp 231 261 ENDIF 232 262 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r4155 r4634 80 80 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 81 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(:,:) )82 zchk_fw_b = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 83 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 84 84 ENDIF 85 85 !- check conservation (C Rousset) … … 227 227 !- check conservation (C Rousset) 228 228 IF (ln_limdiahsb) THEN 229 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_ thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b230 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b229 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 230 zchk_fw = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 231 231 232 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice233 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic )232 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - ( zchk_fw / rhoic ) 233 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 234 234 235 235 zchk_vmin = glob_min(v_i) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r4337 r4634 30 30 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 31 USE wrk_nemo ! work arrays 32 USE cpl_oasis3, ONLY : lk_cpl 32 33 33 34 IMPLICIT NONE … … 38 39 !! * Module variables 39 40 REAL(wp) :: & !!! ** init namelist (namiceini) ** 40 ttest = 2.0 , & ! threshold water temperature for initial sea ice 41 hninn = 0.5 , & ! initial snow thickness in the north 42 hnins = 0.1 , & ! initial snow thickness in the south 43 hginn = 2.5 , & ! initial ice thickness in the north 44 hgins = 1.0 , & ! initial ice thickness in the south 45 aginn = 0.7 , & ! initial leads area in the north 46 agins = 0.7 , & ! initial leads area in the south 47 sinn = 6.301 , & ! initial salinity 48 sins = 6.301 49 41 thres_sst = 2.0 , & ! threshold water temperature for initial sea ice 42 hts_ini_n = 0.5 , & ! initial snow thickness in the north 43 hts_ini_s = 0.1 , & ! initial snow thickness in the south 44 hti_ini_n = 2.5 , & ! initial ice thickness in the north 45 hti_ini_s = 1.0 , & ! initial ice thickness in the south 46 ati_ini_n = 0.7 , & ! initial leads area in the north 47 ati_ini_s = 0.7 , & ! initial leads area in the south 48 smi_ini_n = 6.301 , & ! initial salinity 49 smi_ini_s = 6.301 , & ! initial salinity 50 tmi_ini_n = 270. , & ! initial temperature 51 tmi_ini_s = 270. ! initial temperature 52 53 LOGICAL :: ln_limini = .TRUE. 50 54 !!---------------------------------------------------------------------- 51 55 !! LIM 3.0, UCL-LOCEAN-IPSL (2008) … … 90 94 INTEGER :: i_hemis, i_fill, jl0 91 95 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(:) :: zh m_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini93 REAL(wp), POINTER, DIMENSION(:,:) :: zh t_i_ini, za_i_ini, zv_i_ini94 REAL(wp), POINTER, DIMENSION(:,:) :: z idto! ice indicator96 REAL(wp), POINTER, DIMENSION(:) :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini 97 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i_ini, za_i_ini, zv_i_ini 98 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 95 99 INTEGER, POINTER, DIMENSION(:,:) :: zhemis ! hemispheric index 96 100 !-------------------------------------------------------------------- 97 101 98 CALL wrk_alloc( jpi, jpj, z idto)102 CALL wrk_alloc( jpi, jpj, zswitch ) 99 103 CALL wrk_alloc( jpi, jpj, zhemis ) 100 CALL wrk_alloc( jpl, 2, zht_i_ini, za_i_ini, zv_i_ini ) 101 CALL wrk_alloc( 2, zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 102 103 epsi20 = 1.0e-20 104 CALL wrk_alloc( jpl, 2, zh_i_ini, za_i_ini, zv_i_ini ) 105 CALL wrk_alloc( 2, zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 106 107 epsi20 = 1.e-20_wp 108 104 109 IF(lwp) WRITE(numout,*) 105 110 IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' … … 112 117 CALL lim_istate_init ! reading the initials parameters of the ice 113 118 114 !!gm in lim2 the initialisation if only done if required in the namelist : 115 !!gm IF( .NOT. ln_limini ) THEN 116 !!gm this should be added in lim3 namelist... 119 # if defined key_coupled 120 albege(:,:) = 0.8 * tms(:,:) 121 # endif 122 123 ! surface temperature 124 DO jl = 1, jpl ! loop over categories 125 t_su (:,:,jl) = rtt * tms(:,:) 126 tn_ice(:,:,jl) = rtt * tms(:,:) 127 END DO 128 ! Basal temperature is set to the freezing point of seawater in Kelvin 129 t_bo(:,:) = ( tfreez( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:) 130 131 IF( ln_limini ) THEN 117 132 118 133 !-------------------------------------------------------------------- 119 134 ! 2) Basal temperature, ice mask and hemispheric index 120 135 !-------------------------------------------------------------------- 121 122 ! Basal temperature is set to the freezing point of seawater in Celsius 123 t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1) ! freezing/melting point of sea water [Celcius] 124 125 DO jj = 1, jpj ! ice if sst <= t-freez + ttest 136 ! ice if sst <= t-freez + thres_sst 137 DO jj = 1, jpj 126 138 DO ji = 1, jpi 127 IF( tsn(ji,jj,1,jp_tem) - t_bo(ji,jj) >= ttest ) THEN ; zidto(ji,jj) = 0._wp! no ice128 ELSE ; zidto(ji,jj) = 1._wp! ice139 IF( ( tsn(ji,jj,1,jp_tem) - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN ; zswitch(ji,jj) = 0._wp * tms(ji,jj) ! no ice 140 ELSE ; zswitch(ji,jj) = 1._wp * tms(ji,jj) ! ice 129 141 ENDIF 130 142 END DO 131 143 END DO 132 144 133 t_bo(:,:) = t_bo(:,:) + rt0 ! conversion to Kelvin134 145 135 146 ! Hemispheric index … … 153 164 ! 3.1) Hemisphere-dependent arrays 154 165 !----------------------------- 155 ! assign initial thickness, concentration, snow depth and salinity to 156 ! an hemisphere-dependent array 157 zhm_i_ini(1) = hginn ; zhm_i_ini(2) = hgins ! ice thickness 158 zat_i_ini(1) = aginn ; zat_i_ini(2) = agins ! ice concentration 159 zvt_i_ini(:) = zhm_i_ini(:) * zat_i_ini(:) ! ice volume 160 zhm_s_ini(1) = hninn ; zhm_s_ini(2) = hnins ! snow depth 161 zsm_i_ini(1) = sinn ; zsm_i_ini(2) = sins ! bulk ice salinity 166 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 167 zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s ! ice thickness 168 zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s ! snow depth 169 zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s ! ice concentration 170 zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s ! bulk ice salinity 171 ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s ! temperature (ice and snow) 172 173 zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:) ! ice volume 162 174 163 175 !--------------------------------------------------------------------- … … 183 195 ! *** 1 category to fill 184 196 IF ( i_fill .EQ. 1 ) THEN 185 zh t_i_ini(1,i_hemis) = zhm_i_ini(i_hemis)186 za_i_ini(1,i_hemis) 187 zh t_i_ini(2:jpl,i_hemis) = 0._wp188 za_i_ini(2:jpl,i_hemis) 197 zh_i_ini(1,i_hemis) = zht_i_ini(i_hemis) 198 za_i_ini(1,i_hemis) = zat_i_ini(i_hemis) 199 zh_i_ini(2:jpl,i_hemis) = 0._wp 200 za_i_ini(2:jpl,i_hemis) = 0._wp 189 201 ELSE 190 202 191 ! *** >1 categores to fill192 !--- Ice thicknesses in the i_fill - 1 first categories203 ! *** >1 categores to fill 204 !--- Ice thicknesses in the i_fill - 1 first categories 193 205 DO jl = 1, i_fill - 1 194 zh t_i_ini(jl,i_hemis) = 0.5 * ( hi_max(jl) + hi_max(jl-1) )206 zh_i_ini(jl,i_hemis) = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 195 207 END DO 196 197 !--- jl0: most likely index where cc will be maximum208 209 !--- jl0: most likely index where cc will be maximum 198 210 DO jl = 1, jpl 199 IF ( ( zh m_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. &200 ( zhm_i_ini(i_hemis) .LE. hi_max(jl) ) ) THEN211 IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 212 ( zht_i_ini(i_hemis) .LE. hi_max(jl) ) ) THEN 201 213 jl0 = jl 202 214 ENDIF 203 215 END DO 204 216 jl0 = MIN(jl0, i_fill) 205 206 !--- Concentrations217 218 !--- Concentrations 207 219 za_i_ini(jl0,i_hemis) = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 208 220 DO jl = 1, i_fill - 1 209 221 IF ( jl .NE. jl0 ) THEN 210 zsigma = 0.5 * zh m_i_ini(i_hemis)211 zarg = ( zh t_i_ini(jl,i_hemis) - zhm_i_ini(i_hemis) ) / zsigma222 zsigma = 0.5 * zht_i_ini(i_hemis) 223 zarg = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma 212 224 za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 213 225 ENDIF 214 END DO 215 226 END DO 227 216 228 zA = 0. ! sum of the areas in the jpl categories 217 229 DO jl = 1, i_fill - 1 … … 221 233 IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 222 234 223 !--- Ice thickness in the last category235 !--- Ice thickness in the last category 224 236 zV = 0. ! sum of the volumes of the N-1 categories 225 237 DO jl = 1, i_fill - 1 226 zV = zV + za_i_ini(jl,i_hemis)*zh t_i_ini(jl,i_hemis)238 zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis) 227 239 END DO 228 zh t_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)229 IF ( i_fill .LT. jpl ) zh t_i_ini(i_fill+1:jpl, i_hemis) = 0._wp230 231 !--- volumes232 zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh t_i_ini(:,i_hemis)240 zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis) 241 IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 242 243 !--- volumes 244 zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis) 233 245 IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 234 246 … … 262 274 263 275 ! Test 3: thickness of the last category is in-bounds ? 264 IF ( zh t_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN276 IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 265 277 ztest_3 = 1 266 278 ELSE 267 279 ! this write is useful 268 IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh t_i_ini(i_fill,i_hemis) = ', &269 zh t_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1)280 IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 281 zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 270 282 ztest_3 = 0 271 283 ENDIF … … 291 303 IF ( ztests .NE. 4 ) THEN 292 304 WRITE(numout,*) 293 WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 294 WRITE(numout,*), ' !!!! RED ALERT !!! ' 295 WRITE(numout,*), ' !!!! BIIIIP BIIIP BIIIIP BIIIIP !!!' 305 WRITE(numout,*), ' !!!! ALERT !!! ' 296 306 WRITE(numout,*), ' !!!! Something is wrong in the LIM3 initialization procedure ' 297 WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '298 307 WRITE(numout,*) 299 308 WRITE(numout,*), ' *** ztests is not equal to 4 ' 300 309 WRITE(numout,*), ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 301 310 WRITE(numout,*), ' zat_i_ini : ', zat_i_ini(i_hemis) 302 WRITE(numout,*), ' zh m_i_ini : ', zhm_i_ini(i_hemis)311 WRITE(numout,*), ' zht_i_ini : ', zht_i_ini(i_hemis) 303 312 ENDIF ! ztests .NE. 4 304 313 ENDIF … … 314 323 DO jj = 1, jpj 315 324 DO ji = 1, jpi 316 a_i(ji,jj,jl) = z idto(ji,jj) * za_i_ini (jl,zhemis(ji,jj)) ! concentration317 ht_i(ji,jj,jl) = z idto(ji,jj) * zht_i_ini(jl,zhemis(ji,jj)) ! ice thickness318 ht_s(ji,jj,jl) = ht_i(ji,jj,jl) * ( zh m_s_ini( zhemis(ji,jj) ) / zhm_i_ini( zhemis(ji,jj) ) ) ! snow depth319 sm_i(ji,jj,jl) = z idto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min ! salinity320 o_i(ji,jj,jl) = z idto(ji,jj) * 1._wp + ( 1._wp - zidto(ji,jj) ) ! age321 t_su(ji,jj,jl) = z idto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * 270.0! surf temp325 a_i(ji,jj,jl) = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj)) ! concentration 326 ht_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj)) ! ice thickness 327 ht_s(ji,jj,jl) = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) ) ! snow depth 328 sm_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity 329 o_i(ji,jj,jl) = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 330 t_su(ji,jj,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp 322 331 323 332 ! This case below should not be used if (ht_s/ht_i) is ok in namelist … … 343 352 DO jj = 1, jpj 344 353 DO ji = 1, jpi 345 t_s(ji,jj,jk,jl) = z idto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * rtt354 t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 346 355 ! Snow energy of melting 347 e_s(ji,jj,jk,jl) = z idto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )356 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 348 357 ! Change dimensions 349 358 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 350 ! Multiply by volume, so that heat content in 10^9Joules359 ! Multiply by volume, so that heat content in Joules 351 360 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 352 361 END DO ! ji … … 360 369 DO jj = 1, jpj 361 370 DO ji = 1, jpi 362 t_i(ji,jj,jk,jl) = z idto(ji,jj) * 270.00 + ( 1._wp - zidto(ji,jj) ) * rtt363 s_i(ji,jj,jk,jl) = z idto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min371 t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 372 s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min 364 373 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 365 374 366 375 ! heat content per unit volume 367 e_i(ji,jj,jk,jl) = z idto(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) &376 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) & 368 377 + lfus * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 369 378 - rcp * ( ztmelts - rtt ) ) … … 372 381 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 373 382 374 ! Mutliply by ice volume, and divide by number of layers 375 ! to get heat content in 10^9 J 383 ! Mutliply by ice volume, and divide by number of layers to get heat content in J 376 384 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 377 385 END DO ! ji … … 380 388 END DO ! jk 381 389 382 !-------------------------------------------------------------------- 383 ! 4) Global ice variables for output diagnostics | 384 !-------------------------------------------------------------------- 385 fsbbq (:,:) = 0._wp 386 u_ice (:,:) = 0._wp 387 v_ice (:,:) = 0._wp 388 stress1_i(:,:) = 0._wp 389 stress2_i(:,:) = 0._wp 390 stress12_i(:,:) = 0._wp 391 392 # if defined key_coupled 393 albege(:,:) = 0.8 * tms(:,:) 394 # endif 395 396 !-------------------------------------------------------------------- 397 ! 5) Moments for advection 398 !-------------------------------------------------------------------- 399 400 sxopw (:,:) = 0._wp 401 syopw (:,:) = 0._wp 402 sxxopw(:,:) = 0._wp 403 syyopw(:,:) = 0._wp 404 sxyopw(:,:) = 0._wp 405 406 sxice (:,:,:) = 0._wp ; sxsn (:,:,:) = 0._wp ; sxa (:,:,:) = 0._wp 407 syice (:,:,:) = 0._wp ; sysn (:,:,:) = 0._wp ; sya (:,:,:) = 0._wp 408 sxxice(:,:,:) = 0._wp ; sxxsn(:,:,:) = 0._wp ; sxxa (:,:,:) = 0._wp 409 syyice(:,:,:) = 0._wp ; syysn(:,:,:) = 0._wp ; syya (:,:,:) = 0._wp 410 sxyice(:,:,:) = 0._wp ; sxysn(:,:,:) = 0._wp ; sxya (:,:,:) = 0._wp 411 412 sxc0 (:,:,:) = 0._wp ; sxe (:,:,:,:)= 0._wp 413 syc0 (:,:,:) = 0._wp ; sye (:,:,:,:)= 0._wp 414 sxxc0 (:,:,:) = 0._wp ; sxxe (:,:,:,:)= 0._wp 415 syyc0 (:,:,:) = 0._wp ; syye (:,:,:,:)= 0._wp 416 sxyc0 (:,:,:) = 0._wp ; sxye (:,:,:,:)= 0._wp 417 418 sxsal (:,:,:) = 0._wp 419 sysal (:,:,:) = 0._wp 420 sxxsal (:,:,:) = 0._wp 421 syysal (:,:,:) = 0._wp 422 sxysal (:,:,:) = 0._wp 423 424 sxage (:,:,:) = 0._wp 425 syage (:,:,:) = 0._wp 426 sxxage (:,:,:) = 0._wp 427 syyage (:,:,:) = 0._wp 428 sxyage (:,:,:) = 0._wp 429 430 !-------------------------------------------------------------------- 431 ! 6) Lateral boundary conditions | 432 !-------------------------------------------------------------------- 433 390 tn_ice (:,:,:) = t_su (:,:,:) 391 392 !-------------------------------------------------------------------- 393 ! 4) Lateral boundary conditions | 394 !-------------------------------------------------------------------- 434 395 DO jl = 1, jpl 435 396 … … 445 406 CALL lbc_lnk( o_i(:,:,jl) , 'T', 1. ) 446 407 CALL lbc_lnk( t_su(:,:,jl) , 'T', 1. ) 408 CALL lbc_lnk( tn_ice(:,:,jl) , 'T', 1. ) 447 409 DO jk = 1, nlay_s 448 410 CALL lbc_lnk(t_s(:,:,jk,jl), 'T', 1. ) … … 454 416 END DO 455 417 ! 456 a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl)418 ! a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl) 457 419 END DO 420 421 ELSE 422 ! if ln_limini=false 423 a_i (:,:,:) = 0._wp 424 v_i (:,:,:) = 0._wp 425 v_s (:,:,:) = 0._wp 426 smv_i(:,:,:) = 0._wp 427 oa_i (:,:,:) = 0._wp 428 ht_i (:,:,:) = 0._wp 429 ht_s (:,:,:) = 0._wp 430 sm_i (:,:,:) = 0._wp 431 o_i (:,:,:) = 0._wp 432 433 e_i(:,:,:,:) = 0._wp 434 e_s(:,:,:,:) = 0._wp 435 436 DO jl = 1, jpl 437 DO jk = 1, nlay_i 438 t_i(:,:,jk,jl) = rtt * tms(:,:) 439 END DO 440 DO jk = 1, nlay_s 441 t_s(:,:,jk,jl) = rtt * tms(:,:) 442 END DO 443 END DO 444 445 ENDIF ! ln_limini 458 446 459 447 at_i (:,:) = 0.0_wp … … 461 449 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 462 450 END DO 463 464 451 CALL lbc_lnk( at_i , 'T', 1. ) 465 at_i(:,:) = tms(:,:) * at_i(:,:) ! put 0 over land 452 ! at_i(:,:) = tms(:,:) * at_i(:,:) 466 453 ! 467 CALL lbc_lnk( fsbbq , 'T', 1. ) 468 ! 469 !-------------------------------------------------------------------- 470 ! 6) ???? | 471 !-------------------------------------------------------------------- 472 tn_ice (:,:,:) = t_su (:,:,:) 473 474 CALL wrk_dealloc( jpi, jpj, zidto ) 454 !-------------------------------------------------------------------- 455 ! 5) Global ice variables for output diagnostics | 456 !-------------------------------------------------------------------- 457 u_ice (:,:) = 0._wp 458 v_ice (:,:) = 0._wp 459 stress1_i(:,:) = 0._wp 460 stress2_i(:,:) = 0._wp 461 stress12_i(:,:) = 0._wp 462 463 !-------------------------------------------------------------------- 464 ! 6) Moments for advection 465 !-------------------------------------------------------------------- 466 467 sxopw (:,:) = 0._wp 468 syopw (:,:) = 0._wp 469 sxxopw(:,:) = 0._wp 470 syyopw(:,:) = 0._wp 471 sxyopw(:,:) = 0._wp 472 473 sxice (:,:,:) = 0._wp ; sxsn (:,:,:) = 0._wp ; sxa (:,:,:) = 0._wp 474 syice (:,:,:) = 0._wp ; sysn (:,:,:) = 0._wp ; sya (:,:,:) = 0._wp 475 sxxice(:,:,:) = 0._wp ; sxxsn(:,:,:) = 0._wp ; sxxa (:,:,:) = 0._wp 476 syyice(:,:,:) = 0._wp ; syysn(:,:,:) = 0._wp ; syya (:,:,:) = 0._wp 477 sxyice(:,:,:) = 0._wp ; sxysn(:,:,:) = 0._wp ; sxya (:,:,:) = 0._wp 478 479 sxc0 (:,:,:) = 0._wp ; sxe (:,:,:,:)= 0._wp 480 syc0 (:,:,:) = 0._wp ; sye (:,:,:,:)= 0._wp 481 sxxc0 (:,:,:) = 0._wp ; sxxe (:,:,:,:)= 0._wp 482 syyc0 (:,:,:) = 0._wp ; syye (:,:,:,:)= 0._wp 483 sxyc0 (:,:,:) = 0._wp ; sxye (:,:,:,:)= 0._wp 484 485 sxsal (:,:,:) = 0._wp 486 sysal (:,:,:) = 0._wp 487 sxxsal (:,:,:) = 0._wp 488 syysal (:,:,:) = 0._wp 489 sxysal (:,:,:) = 0._wp 490 491 sxage (:,:,:) = 0._wp 492 syage (:,:,:) = 0._wp 493 sxxage (:,:,:) = 0._wp 494 syyage (:,:,:) = 0._wp 495 sxyage (:,:,:) = 0._wp 496 497 498 CALL wrk_dealloc( jpi, jpj, zswitch ) 475 499 CALL wrk_dealloc( jpi, jpj, zhemis ) 476 CALL wrk_dealloc( jpl, 2, zh t_i_ini, za_i_ini, zv_i_ini )477 CALL wrk_dealloc( 2, zh m_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini )500 CALL wrk_dealloc( jpl, 2, zh_i_ini, za_i_ini, zv_i_ini ) 501 CALL wrk_dealloc( 2, zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 478 502 479 503 END SUBROUTINE lim_istate … … 495 519 !! 8.5 ! 07-11 (M. Vancoppenolle) rewritten initialization 496 520 !!----------------------------------------------------------------------------- 497 NAMELIST/namiceini/ ttest, hninn, hnins, hginn, hgins, aginn, agins, sinn, sins 521 NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s, & 522 & ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s 498 523 !!----------------------------------------------------------------------------- 499 524 … … 508 533 WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 509 534 WRITE(numout,*) '~~~~~~~~~~~~~~~' 510 WRITE(numout,*) ' threshold water temp. for initial sea-ice ttest = ', ttest 511 WRITE(numout,*) ' initial snow thickness in the north hninn = ', hninn 512 WRITE(numout,*) ' initial snow thickness in the south hnins = ', hnins 513 WRITE(numout,*) ' initial ice thickness in the north hginn = ', hginn 514 WRITE(numout,*) ' initial ice thickness in the south hgins = ', hgins 515 WRITE(numout,*) ' initial ice concentr. in the north aginn = ', aginn 516 WRITE(numout,*) ' initial ice concentr. in the north agins = ', agins 517 WRITE(numout,*) ' initial ice salinity in the north sinn = ', sinn 518 WRITE(numout,*) ' initial ice salinity in the south sins = ', sins 535 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_limini = ', ln_limini 536 WRITE(numout,*) ' threshold water temp. for initial sea-ice thres_sst = ', thres_sst 537 WRITE(numout,*) ' initial snow thickness in the north hts_ini_n = ', hts_ini_n 538 WRITE(numout,*) ' initial snow thickness in the south hts_ini_s = ', hts_ini_s 539 WRITE(numout,*) ' initial ice thickness in the north hti_ini_n = ', hti_ini_n 540 WRITE(numout,*) ' initial ice thickness in the south hti_ini_s = ', hti_ini_s 541 WRITE(numout,*) ' initial ice concentr. in the north ati_ini_n = ', ati_ini_n 542 WRITE(numout,*) ' initial ice concentr. in the north ati_ini_s = ', ati_ini_s 543 WRITE(numout,*) ' initial ice salinity in the north smi_ini_n = ', smi_ini_n 544 WRITE(numout,*) ' initial ice salinity in the south smi_ini_s = ', smi_ini_s 545 WRITE(numout,*) ' initial ice/snw temp in the north tmi_ini_n = ', tmi_ini_n 546 WRITE(numout,*) ' initial ice/snw temp in the south tmi_ini_s = ', tmi_ini_s 519 547 ENDIF 520 548 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r4345 r4634 5 5 !!====================================================================== 6 6 !! History : LIM ! 2006-02 (M. Vancoppenolle) Original code 7 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_ mec7 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_dyn 8 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 9 9 !!---------------------------------------------------------------------- … … 143 143 REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2) 144 144 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 145 REAL(wp) :: zchk_v_i, zchk_smv, zchk_ fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)145 REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b 146 146 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 147 ! mass and salt flux (clem)148 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume...149 147 !!----------------------------------------------------------------------------- 150 148 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 151 149 152 150 CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 153 154 CALL wrk_alloc( jpi, jpj, jpl, zviold, zvsold, zsmvold ) ! clem155 151 156 152 IF( numit == nstart ) CALL lim_itd_me_init ! Initialization (first time-step only) … … 165 161 !- check conservation (C Rousset) 166 162 IF (ln_limdiahsb) THEN 167 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) )163 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 168 164 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 169 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 170 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 165 zchk_e_i_b = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 166 zchk_fw_b = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 167 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 168 zchk_ft_b = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 171 169 ENDIF 172 170 !- check conservation (C Rousset) 173 171 ! ------------------------------- 174 175 ! mass and salt flux init (clem)176 zviold(:,:,:) = v_i(:,:,:)177 zvsold(:,:,:) = v_s(:,:,:)178 zsmvold(:,:,:) = smv_i(:,:,:)179 172 180 173 !-----------------------------------------------------------------------------! … … 362 355 ! 5) Heat, salt and freshwater fluxes 363 356 !-----------------------------------------------------------------------------! 364 fmmec(ji,jj) = fmmec(ji,jj) +msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean365 fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice ! heat sink for ocean357 wfx_snw(ji,jj) = wfx_snw(ji,jj) - msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean 358 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice ! heat sink for ocean (<0, W.m-2) 366 359 367 360 END DO … … 399 392 CALL lim_itd_me_zapsmall 400 393 401 !--------------------------------402 ! Update mass/salt fluxes (clem)403 !--------------------------------404 DO jl = 1, jpl405 DO jj = 1, jpj406 DO ji = 1, jpi407 diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice408 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic409 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn410 sfx_mec(ji,jj) = sfx_mec(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic * r1_rdtice411 END DO412 END DO413 END DO414 394 415 395 IF(ln_ctl) THEN ! Control print … … 448 428 !- check conservation (C Rousset) 449 429 IF (ln_limdiahsb) THEN 450 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 451 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 430 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 431 zchk_fw = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 432 zchk_ft = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 452 433 453 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice434 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw 454 435 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 436 zchk_e_i = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 455 437 456 438 zchk_vmin = glob_min(v_i) … … 459 441 460 442 IF(lwp) THEN 461 IF ( ABS( zchk_v_i ) > 1.e- 5 ) WRITE(numout,*) 'violation volume [m3/day] (limitd_me) = ',(zchk_v_i * rday)443 IF ( ABS( zchk_v_i ) > 1.e-2 ) WRITE(numout,*) 'violation volume [kg/day] (limitd_me) = ',(zchk_v_i * rday) 462 444 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_me) = ',(zchk_smv * rday) 445 IF ( ABS( zchk_e_i ) > 1.e-4 ) WRITE(numout,*) 'violation enthalpy [1e9 J] (limitd_me) = ',(zchk_e_i) 463 446 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limitd_me) = ',(zchk_vmin * 1.e-3) 464 447 IF ( zchk_amax > kamax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limitd_me) = ',zchk_amax … … 472 455 ! 473 456 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 474 !475 CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zsmvold ) ! clem476 457 ! 477 458 IF( nn_timing == 1 ) CALL timing_stop('limitd_me') … … 908 889 INTEGER :: ij ! horizontal index, combines i and j loops 909 890 INTEGER :: icells ! number of cells with aicen > puny 910 REAL(wp) :: zindb , zsrdg2! local scalar891 REAL(wp) :: zindb ! local scalar 911 892 REAL(wp) :: hL, hR, farea, zdummy, zdummy0, ztmelts ! left and right limits of integration 893 REAL(wp) :: zsstK ! SST in Kelvin 912 894 913 895 INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices … … 917 899 918 900 REAL(wp), POINTER, DIMENSION(:,:,:) :: aicen_init, vicen_init ! ice area & volume before ridging 919 REAL(wp), POINTER, DIMENSION(:,:,:) :: vsn on_init, esnon_init ! snow volume & energy before ridging901 REAL(wp), POINTER, DIMENSION(:,:,:) :: vsnwn_init, esnwn_init ! snow volume & energy before ridging 920 902 REAL(wp), POINTER, DIMENSION(:,:,:) :: smv_i_init, oa_i_init ! ice salinity & age before ridging 921 903 … … 952 934 CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw ) 953 935 CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 954 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsn on_init, esnon_init, smv_i_init, oa_i_init )936 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 955 937 CALL wrk_alloc( jpi, jpj, jkmax, eirft, erdg1, erdg2, ersw ) 956 938 CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init ) … … 1008 990 aicen_init(:,:,jl) = a_i(:,:,jl) 1009 991 vicen_init(:,:,jl) = v_i(:,:,jl) 1010 vsn on_init(:,:,jl) = v_s(:,:,jl)992 vsnwn_init(:,:,jl) = v_s(:,:,jl) 1011 993 ! 1012 994 smv_i_init(:,:,jl) = smv_i(:,:,jl) … … 1014 996 END DO !jl 1015 997 1016 esn on_init(:,:,:) = e_s(:,:,1,:)998 esnwn_init(:,:,:) = e_s(:,:,1,:) 1017 999 1018 1000 DO jl = 1, jpl … … 1095 1077 vsw (ji,jj) = vrdg1(ji,jj) * ridge_por 1096 1078 1097 vsrdg(ji,jj) = vsn on_init(ji,jj,jl1) * afrac(ji,jj)1098 esrdg(ji,jj) = esn on_init(ji,jj,jl1) * afrac(ji,jj)1079 vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 1080 esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 1099 1081 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 1100 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 1082 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 1101 1083 1102 1084 ! rafting volumes, heat contents ... 1103 1085 virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 1104 vsrft(ji,jj) = vsn on_init(ji,jj,jl1) * afrft(ji,jj)1105 esrft(ji,jj) = esn on_init(ji,jj,jl1) * afrft(ji,jj)1086 vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 1087 esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 1106 1088 smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 1107 1089 … … 1120 1102 ! Salinity 1121 1103 !------------- 1122 smsw(ji,jj) = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0 ! salt content of seawater frozen in voids 1123 1124 zsrdg2 = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge 1125 1126 srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity 1104 smsw(ji,jj) = vsw(ji,jj) * sss_m(ji,jj) ! salt content of seawater frozen in voids !! MV HC2014 1105 srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge 1106 1107 !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity 1127 1108 1128 ! ! excess of salt is flushed into the ocean 1129 !sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 1130 1131 !rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic ! gurvan: increase in ice volume du to seawater frozen in voids 1109 sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 1110 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) + vsw (ji,jj) * rhoic * r1_rdtice ! gurvan: increase in ice volume du to seawater frozen in voids 1111 ! MV HC 2014 this previous line seems ok, i'm not sure at this moment of the sign convention 1132 1112 1133 1113 !------------------------------------ … … 1158 1138 & + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 1159 1139 1160 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg) & !rafting included 1161 & + esrft(ji,jj)*(1.0-fsnowrft) 1140 ! in 1e-9 Joules (same as e_s) 1141 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg) & !rafting included 1142 & - esrft(ji,jj)*(1.0-fsnowrft) 1162 1143 1163 1144 !----------------------------------------------------------------- … … 1187 1168 eirft(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 1188 1169 e_i (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) 1189 ! sea water heat content 1190 ztmelts = - tmut * sss_m(ji,jj) + rtt 1191 ! heat content per unit volume 1192 zdummy0 = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 1193 1194 ! corrected sea water salinity 1195 zindb = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - epsi20 ) ) 1196 zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), epsi20 ) 1197 1198 ztmelts = - tmut * zdummy + rtt 1199 ersw(ji,jj,jk) = - rcp * ( ztmelts - rtt ) * vsw(ji,jj) 1200 1201 ! heat flux 1202 fheat_mec(ji,jj) = fheat_mec(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) * r1_rdtice 1170 1171 1172 ! enthalpy of the trapped seawater (J/m2, >0) 1173 ! clem: if sst>0, then ersw <0 (is that possible?) 1174 zsstK = sst_m(ji,jj) + rt0 1175 ersw(ji,jj,jk) = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i ) 1176 1177 ! heat flux to the ocean 1178 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice ! > 0 [W.m-2] ocean->ice flux 1203 1179 1204 1180 ! Correct dimensions to avoid big values 1205 ersw(ji,jj,jk) = ersw(ji,jj,jk) * 1.e-09 1206 1207 ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 1208 ersw (ji,jj,jk) = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / REAL( nlay_i ) 1181 ersw(ji,jj,jk) = ersw(ji,jj,jk) / unit_fac 1182 1183 ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J 1184 ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 1185 !! MV HC 2014 1186 ersw (ji,jj,jk) = ersw(ji,jj,jk) * area(ji,jj) 1209 1187 1210 1188 erdg2(ji,jj,jk) = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 1189 1211 1190 END DO ! ij 1212 1191 END DO !jk … … 1361 1340 CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw ) 1362 1341 CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 1363 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsn on_init, esnon_init, smv_i_init, oa_i_init )1342 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 1364 1343 CALL wrk_dealloc( jpi, jpj, jkmax, eirft, erdg1, erdg2, ersw ) 1365 1344 CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init ) … … 1455 1434 1456 1435 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! 2D workspace 1457 REAL(wp) :: zmask_glo 1436 REAL(wp) :: zmask_glo, zsal, zvi, zvs, zei, zes 1458 1437 !!gm REAL(wp) :: xtmp ! temporary variable 1459 1438 !!------------------------------------------------------------------- … … 1471 1450 DO jj = 1, jpj 1472 1451 DO ji = 1, jpi 1473 IF( ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) < 0._wp ) .OR. & 1474 & ( a_i(ji,jj,jl) > 0._wp .AND. a_i(ji,jj,jl) <= epsi10 ) .OR. & 1475 & ( v_i(ji,jj,jl) == 0._wp .AND. a_i(ji,jj,jl) > 0._wp ) .OR. & 1476 & ( v_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) <= epsi10 ) ) zmask(ji,jj) = 1._wp 1452 ! IF( ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) < 0._wp ) .OR. & 1453 ! & ( a_i(ji,jj,jl) > 0._wp .AND. a_i(ji,jj,jl) <= epsi10 ) .OR. & 1454 ! & ( v_i(ji,jj,jl) == 0._wp .AND. a_i(ji,jj,jl) > 0._wp ) .OR. & 1455 ! & ( v_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) <= epsi10 ) ) zmask(ji,jj) = 1._wp 1456 IF( ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) <= epsi10 ) .OR. & 1457 & ( v_i(ji,jj,jl) >= 0._wp .AND. v_i(ji,jj,jl) <= epsi10 ) ) zmask(ji,jj) = 1._wp 1477 1458 END DO 1478 1459 END DO … … 1487 1468 DO jj = 1 , jpj 1488 1469 DO ji = 1 , jpi 1489 !!gm xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) * r1_rdtice 1490 !!gm xtmp = xtmp * unit_fac 1491 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1470 zei = e_i(ji,jj,jk,jl) 1492 1471 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 1472 ! update exchanges with ocean 1473 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 1493 1474 END DO 1494 1475 END DO … … 1497 1478 DO jj = 1 , jpj 1498 1479 DO ji = 1 , jpi 1499 1480 1481 zsal = smv_i(ji,jj,jl) 1482 zvi = v_i(ji,jj,jl) 1483 zvs = v_s(ji,jj,jl) 1484 zes = e_s(ji,jj,1,jl) 1500 1485 !----------------------------------------------------------------- 1501 1486 ! Zap snow energy and use ocean heat to melt snow … … 1507 1492 ! fluxes are positive to the ocean 1508 1493 ! here the flux has to be negative for the ocean 1509 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice1510 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp1511 1512 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice !RB ???????1513 1514 1494 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 1515 1495 … … 1532 1512 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1533 1513 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1534 ! 1514 e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 1515 ! additional condition 1516 IF( v_s(ji,jj,jl) <= epsi10 ) THEN 1517 v_s(ji,jj,jl) = 0._wp 1518 e_s(ji,jj,1,jl) = 0._wp 1519 ENDIF 1520 ! update exchanges with ocean 1521 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 1522 wfx_res(ji,jj) = wfx_res(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 1523 wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 1524 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 1535 1525 END DO 1536 1526 END DO -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r4332 r4634 65 65 INTEGER, INTENT(in) :: kt ! time step index 66 66 ! 67 INTEGER :: j l, ja, jm, jbnd1, jbnd2 ! ice types dummy loop index68 REAL(wp) :: zchk_v_i, zchk_smv, zchk_ fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)67 INTEGER :: ji,jj, jk, jl, ja, jm, jbnd1, jbnd2 ! ice types dummy loop index 68 REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b ! Check conservation (C Rousset) 69 69 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 70 70 !!------------------------------------------------------------------ … … 74 74 !- check conservation (C Rousset) 75 75 IF (ln_limdiahsb) THEN 76 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) )76 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 77 77 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 78 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 79 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 78 zchk_e_i_b = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 79 zchk_fw_b = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 80 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 81 zchk_ft_b = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 80 82 ENDIF 81 83 !- check conservation (C Rousset) … … 108 110 CALL lim_thd_lac 109 111 CALL lim_var_glo2eqv ! only for info 110 111 IF(ln_ctl) THEN ! Control print112 113 IF(ln_ctl) THEN ! Control print 112 114 CALL prt_ctl_info(' ') 113 115 CALL prt_ctl_info(' - Cell values : ') … … 144 146 !- check conservation (C Rousset) 145 147 IF( ln_limdiahsb ) THEN 146 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 147 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 148 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 149 zchk_fw = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 150 zchk_ft = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 148 151 149 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice152 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw 150 153 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 154 zchk_e_i = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 151 155 152 156 zchk_vmin = glob_min(v_i) … … 155 159 156 160 IF(lwp) THEN 157 IF ( ABS( zchk_v_i ) > 1.e- 5 ) WRITE(numout,*) 'violation volume [m3/day] (limitd_th) = ',(zchk_v_i * rday)161 IF ( ABS( zchk_v_i ) > 1.e-4 ) WRITE(numout,*) 'violation volume [kg/day] (limitd_th) = ',(zchk_v_i * rday) 158 162 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_th) = ',(zchk_smv * rday) 163 IF ( ABS( zchk_e_i ) > 1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J] (limitd_th) = ',(zchk_e_i) 159 164 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limitd_th) = ',(zchk_vmin * 1.e-3) 160 165 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limitd_th) = ',zchk_amax … … 258 263 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 259 264 zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb 260 IF( a_i(ji,jj,jl) > epsi 06) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)265 IF( a_i(ji,jj,jl) > epsi10 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl) 261 266 END DO 262 267 END DO … … 302 307 ij = nind_j(ji) 303 308 ! 304 IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. &305 ( zht_i_o(ii,ij,jl+1) .GT. epsi10 )) THEN309 zhbnew(ii,ij,jl) = hi_max(jl) 310 IF ( old_a_i(ii,ij,jl) > epsi10 .AND. old_a_i(ii,ij,jl+1) > epsi10 ) THEN 306 311 !interpolate between adjacent category growth rates 307 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / & 308 ( zht_i_o (ii,ij,jl+1) - zht_i_o (ii,ij,jl) ) 309 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + & 310 zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 311 ELSEIF (zht_i_o(ii,ij,jl).gt.epsi10) THEN 312 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_o(ii,ij,jl+1) - zht_i_o(ii,ij,jl) ) 313 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 314 ELSEIF ( old_a_i(ii,ij,jl) > epsi10) THEN 312 315 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 313 ELSEIF ( zht_i_o(ii,ij,jl+1).gt.epsi10) THEN316 ELSEIF ( old_a_i(ii,ij,jl+1) > epsi10) THEN 314 317 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 315 ELSE316 zhbnew(ii,ij,jl) = hi_max(jl)317 318 ENDIF 318 319 END DO … … 320 321 !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 321 322 DO ji = 1, nbrem 322 ! jl, ji323 323 ii = nind_i(ji) 324 324 ij = nind_j(ji) 325 ! jl, ji 326 IF ( ( a_i(ii,ij,jl) .GT.epsi10) .AND. & 327 ( ht_i(ii,ij,jl).GE. zhbnew(ii,ij,jl) ) & 328 ) THEN 325 IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 329 326 zremap_flag(ii,ij) = 0 330 ELSEIF ( ( a_i(ii,ij,jl+1) .GT. epsi10 ) .AND. & 331 ( ht_i(ii,ij,jl+1).LE. zhbnew(ii,ij,jl) ) & 332 ) THEN 327 ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 333 328 zremap_flag(ii,ij) = 0 334 329 ENDIF 335 330 336 331 !- 4.3 Check that each zhbnew does not exceed maximal values hi_max 337 ! jl, ji 338 IF (zhbnew(ii,ij,jl).gt.hi_max(jl+1)) THEN 339 zremap_flag(ii,ij) = 0 340 ENDIF 341 ! jl, ji 342 IF (zhbnew(ii,ij,jl).lt.hi_max(jl-1)) THEN 343 zremap_flag(ii,ij) = 0 344 ENDIF 345 ! jl, ji 346 END DO !ji 347 ! ji 332 IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 333 IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 334 END DO 335 348 336 END DO !jl 349 337 … … 354 342 DO jj = 1, jpj 355 343 DO ji = 1, jpi 356 IF 344 IF( zremap_flag(ji,jj) == 1 ) THEN 357 345 nbrem = nbrem + 1 358 346 nind_i(nbrem) = ji 359 347 nind_j(nbrem) = jj 360 348 ENDIF 361 END DO !ji362 END DO !jj349 END DO 350 END DO 363 351 364 352 !----------------------------------------------------------------------------------------------- … … 380 368 ENDIF 381 369 382 IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) 370 IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 383 371 384 372 END DO !jj … … 444 432 DO jl = klbnd, kubnd 445 433 CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 446 g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), & 447 zremap_flag) 434 g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag) 448 435 END DO 449 436 … … 493 480 nd = zdonor(ii,ij,jl) 494 481 zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 495 zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + & 496 zdaice(ii,ij,jl)*hL(ii,ij,nd) 482 zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 497 483 498 484 END DO ! ji … … 511 497 ii = nind_i(ji) 512 498 ij = nind_j(ji) 513 IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim )) THEN499 IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN 514 500 a_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim 515 501 ht_i(ii,ij,1) = hiclim 516 v_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless517 502 ENDIF 518 503 END DO !ji … … 799 784 !-------------- 800 785 801 zdvsnow 786 zdvsnow = v_s(ii,ij,jl1) * zworka(ii,ij) 802 787 v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 803 788 v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow … … 807 792 !-------------------- 808 793 809 zdesnow 794 zdesnow = e_s(ii,ij,1,jl1) * zworka(ii,ij) 810 795 e_s(ii,ij,1,jl1) = e_s(ii,ij,1,jl1) - zdesnow 811 796 e_s(ii,ij,1,jl2) = e_s(ii,ij,1,jl2) + zdesnow … … 815 800 !-------------- 816 801 817 zdo_aice 802 zdo_aice = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 818 803 oa_i(ii,ij,jl1) = oa_i(ii,ij,jl1) - zdo_aice 819 804 oa_i(ii,ij,jl2) = oa_i(ii,ij,jl2) + zdo_aice … … 823 808 !-------------- 824 809 825 zdsm_vice 810 zdsm_vice = smv_i(ii,ij,jl1) * zworka(ii,ij) 826 811 smv_i(ii,ij,jl1) = smv_i(ii,ij,jl1) - zdsm_vice 827 812 smv_i(ii,ij,jl2) = smv_i(ii,ij,jl2) + zdsm_vice … … 831 816 !--------------------- 832 817 833 zdaTsf 818 zdaTsf = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 834 819 zaTsfn(ii,ij,jl1) = zaTsfn(ii,ij,jl1) - zdaTsf 835 820 zaTsfn(ii,ij,jl2) = zaTsfn(ii,ij,jl2) + zdaTsf … … 910 895 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 911 896 !!------------------------------------------------------------------ 897 !! clem 2014/04: be carefull, rebining does not conserve salt => the difference is taken into account in limupdate 912 898 913 899 CALL wrk_alloc( jpi,jpj,jpl, zdonor ) ! interger … … 1015 1001 1016 1002 !clem-change 1003 DO jj = 1, jpj 1004 DO ji = 1, jpi 1005 IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 1006 ! 1007 zshiftflag = 1 1008 zdonor(ji,jj,jl) = jl + 1 1009 zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 1010 zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 1011 ENDIF 1012 END DO ! ji 1013 END DO ! jj 1014 1015 IF(lk_mpp) CALL mpp_max( zshiftflag ) 1016 1017 IF( zshiftflag == 1 ) THEN ! Shift ice between categories 1018 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 1019 ! Reset shift parameters 1020 zdonor(:,:,jl) = 0 1021 zdaice(:,:,jl) = 0._wp 1022 zdvice(:,:,jl) = 0._wp 1023 ENDIF 1024 !clem-change 1025 1026 ! ! clem-change begin: why not doing that? 1017 1027 ! DO jj = 1, jpj 1018 1028 ! DO ji = 1, jpi 1019 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. & 1020 ! ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 1021 ! ! 1022 ! zshiftflag = 1 1023 ! zdonor(ji,jj,jl) = jl + 1 1024 ! zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 1025 ! zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 1029 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 1030 ! ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 1031 ! a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1) 1026 1032 ! ENDIF 1027 1033 ! END DO ! ji 1028 1034 ! END DO ! jj 1029 !1030 ! IF(lk_mpp) CALL mpp_max( zshiftflag )1031 !1032 ! IF( zshiftflag == 1 ) THEN ! Shift ice between categories1033 ! CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )1034 ! ! Reset shift parameters1035 ! zdonor(:,:,jl) = 01036 ! zdaice(:,:,jl) = 0._wp1037 ! zdvice(:,:,jl) = 0._wp1038 ! ENDIF1039 !clem-change1040 1041 ! clem-change begin: why not doing that?1042 DO jj = 1, jpj1043 DO ji = 1, jpi1044 IF( a_i(ji,jj,jl+1) > epsi10 .AND. &1045 ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN1046 ht_i(ji,jj,jl+1) = hi_max(jl) + epsi101047 a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)1048 ENDIF1049 END DO ! ji1050 END DO ! jj1051 1035 ! clem-change end 1052 1036 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r4345 r4634 51 51 52 52 REAL(wp) :: epsi10 = 1.e-10_wp ! 53 REAL(wp) :: rzero = 0._wp ! constant values54 REAL(wp) :: rone = 1._wp ! constant values55 53 56 54 !! * Substitutions … … 514 512 !CDIR NOVERRCHK 515 513 DO ji = fs_2, fs_jpim1 516 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj)514 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 517 515 zsang = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 518 516 z0 = zmass1(ji,jj)/dtevp … … 547 545 DO ji = fs_2, fs_jpim1 548 546 549 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj)547 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 550 548 zsang = SIGN(1.0,fcor(ji,jj))*sangvg 551 549 z0 = zmass2(ji,jj)/dtevp … … 579 577 !CDIR NOVERRCHK 580 578 DO ji = fs_2, fs_jpim1 581 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj)579 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 582 580 zsang = SIGN(1.0,fcor(ji,jj))*sangvg 583 581 z0 = zmass2(ji,jj)/dtevp … … 611 609 !CDIR NOVERRCHK 612 610 DO ji = fs_2, fs_jpim1 613 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj)611 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 614 612 zsang = SIGN(1.0,fcor(ji,jj))*sangvg 615 613 z0 = zmass1(ji,jj)/dtevp … … 661 659 ! 4) Prevent ice velocities when the ice is thin 662 660 !------------------------------------------------------------------------------! 663 !clem : add hminrhg in the namelist664 !665 661 ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 666 662 ! ocean velocity, -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r4220 r4634 162 162 CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice ) 163 163 CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice ) 164 CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq )165 164 CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i ) 166 165 CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i ) … … 393 392 CALL iom_get( numrir, jpdom_autoglo, 'u_ice' , u_ice ) 394 393 CALL iom_get( numrir, jpdom_autoglo, 'v_ice' , v_ice ) 395 CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq )396 394 CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i ) 397 395 CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i ) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4345 r4634 27 27 USE par_ice ! ice parameters 28 28 USE dom_oce ! ocean domain 29 USE dom_ice, ONLY : tms 29 USE dom_ice, ONLY : tms, area 30 30 USE ice ! LIM sea-ice variables 31 31 USE sbc_ice ! Surface boundary condition: sea-ice fields … … 50 50 PUBLIC lim_sbc_tau ! called by sbc_ice_lim 51 51 52 REAL(wp) :: rzero = 0._wp53 REAL(wp) :: rone = 1._wp52 REAL(wp) :: epsi10 = 1.e-10 ! 53 REAL(wp) :: epsi20 = 1.e-20 ! 54 54 55 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] … … 102 102 INTEGER, INTENT(in) :: kt ! number of iteration 103 103 ! 104 INTEGER :: ji, jj, jl ! dummy loop indices 105 INTEGER :: ierr, ifvt, i1mfr, idfr ! local integer 106 INTEGER :: iflt, ial , iadv , ifral, ifrdv ! - - 107 REAL(wp) :: zinda, zemp, zemp_snow, zfmm ! local scalars 108 REAL(wp) :: zemp_snw ! - - 109 REAL(wp) :: zfcm1 , zfcm2 ! - - 104 INTEGER :: ji, jj, jl, jk ! dummy loop indices 105 REAL(wp) :: zinda, zemp ! local scalars 110 106 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 111 REAL(wp) :: zzfcm1, zfscmbq ! clem: for light penetration 107 REAL(wp) :: ztmelts ! clem 2014: for HC diags 108 109 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 110 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 112 111 !!--------------------------------------------------------------------- 113 112 114 113 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 115 114 116 !------------------------------------------!117 ! heat flux at the ocean surface !118 !------------------------------------------!119 115 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 120 ! changed to old_frld and old ht_i121 122 116 DO jj = 1, jpj 123 117 DO ji = 1, jpi 124 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 125 ifvt = zinda * MAX( rzero , SIGN( rone, - phicif(ji,jj) ) ) !subscripts are bad here 126 i1mfr = 1.0 - MAX( rzero , SIGN( rone , - at_i(ji,jj) ) ) 127 idfr = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 128 iflt = zinda * (1 - i1mfr) * (1 - ifvt ) 129 ial = ifvt * i1mfr + ( 1 - ifvt ) * idfr 130 iadv = ( 1 - i1mfr ) * zinda 131 ifral = ( 1 - i1mfr * ( 1 - ial ) ) 132 ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 133 134 ! switch --- 1.0 ---------------- 0.0 -------------------- 135 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 136 ! zinda | if pfrld = 1 | if pfrld < 1 | 137 ! -> ifvt| if pfrld old_ht_i 138 ! i1mfr | if frld = 1 | if frld < 1 | 139 ! idfr | if frld <= pfrld | if frld > pfrld | 140 ! iflt | 141 ! ial | 142 ! iadv | 143 ! ifral 144 ! ifrdv 145 146 ! computation the solar flux at ocean surface 147 IF (lk_cpl) THEN ! be carfeful: not been tested yet 118 119 !------------------------------------------! 120 ! heat flux at the ocean surface ! 121 !------------------------------------------! 122 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice 123 124 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 125 !--------------------------------------------------- 126 IF( lk_cpl ) THEN ! be carfeful: not been tested yet 148 127 ! original line 149 !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 150 ! new line to include solar penetration (not tested) 151 zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 128 zfcm1 = qsr_tot(ji,jj) 129 !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 152 130 DO jl = 1, jpl 153 zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) *a_i(ji,jj,jl)131 zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) 154 132 END DO 155 133 ELSE 156 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 157 & ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 134 !!!zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 135 !!! & ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 136 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 137 DO jl = 1, jpl 138 zfcm1 = zfcm1 + old_a_i(ji,jj,jl) * ftr_ice(ji,jj,jl) 139 END DO 158 140 ENDIF 159 ! fstric Solar flux transmitted trough the ice 160 ! qsr Net short wave heat flux on free ocean 161 ! new line 162 fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 163 164 ! solar flux and fscmbq with light penetration (clem) 165 zzfcm1 = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 166 zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 167 168 ! computation the non solar heat flux at ocean surface 169 zfcm2 = - zzfcm1 & ! 170 & + iflt * zfscmbq & ! total ablation: heat given to the ocean 171 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 172 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice & 173 & + fhmec(ji,jj) & ! snow melt when ridging 174 & + fheat_mec(ji,jj) & ! ridge formation 175 & + fheat_res(ji,jj) ! residual heat flux 176 ! qcmif Energy needed to bring the ocean surface layer until its freezing (ok) 177 ! qldif heat balance of the lead (or of the open ocean) 178 ! qfvbq latent heat uptake/release after accretion/ablation 179 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 180 181 IF( num_sal == 2 ) zfcm2 = zfcm2 + fhbri(ji,jj) ! add contribution due to brine drainage 182 183 ! bottom radiative component is sent to the computation of the oceanic heat flux 184 fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj) 185 186 ! used to compute the oceanic heat flux at the next time step 187 qsr(ji,jj) = zfcm1 ! solar heat flux 188 qns(ji,jj) = zfcm2 - fdtcn(ji,jj) ! non solar heat flux 189 ! ! fdtcn : turbulent oceanic heat flux 190 END DO 191 END DO 192 193 !------------------------------------------! 194 ! mass flux at the ocean surface ! 195 !------------------------------------------! 196 197 !!gm optimisation: this loop have to be merged with the previous one 198 DO jj = 1, jpj 199 DO ji = 1, jpi 141 142 ! Total heat flux reaching the ocean = hfx_out (W.m-2) 143 !--------------------------------------------------- 144 zf_mass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 145 hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 146 147 ! New qsr and qns used to compute the oceanic heat flux at the next time step 148 !--------------------------------------------------- 149 qsr(ji,jj) = zfcm1 150 qns(ji,jj) = hfx_out(ji,jj) - zfcm1 151 152 !------------------------------------------! 153 ! mass flux at the ocean surface ! 154 !------------------------------------------! 200 155 ! case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 201 156 ! ------------------------------------------------------------------------------------- … … 206 161 ! Even if i see Ice melting as a FW and SALT flux 207 162 ! 208 209 163 ! computing freshwater exchanges at the ice/ocean interface 210 IF (lk_cpl) THEN 164 ! clem 2014/04: why not 1-pfrld instead of at_i here??? 165 IF( lk_cpl ) THEN 211 166 zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 212 & - rdm_snw(ji,jj) / rdt_ice167 & - wfx_snw(ji,jj) 213 168 ELSE 214 zemp = emp(ji,jj) * ( 1.0 - at_i(ji,jj) ) & ! evaporation over oceanic fraction 215 & - tprecip(ji,jj) * at_i(ji,jj) & ! all precipitation reach the ocean 216 & + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) ) & ! except solid precip intercepted by sea-ice 217 & - fmmec(ji,jj) ! snow falling when ridging 169 zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction 170 & - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! all precipitation reach the ocean 171 & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas ) ! except solid precip intercepted by sea-ice 218 172 ENDIF 219 173 220 ! mass flux at the ocean/ice interface (sea ice fraction) 221 zemp_snw = rdm_snw(ji,jj) * r1_rdtice ! snow melting = pure water that enters the ocean 222 zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus melting 223 224 fmmflx(ji,jj) = zfmm ! F/M mass flux save at least for biogeochemical model 225 226 emp(ji,jj) = zemp + zemp_snw + zfmm ! mass flux + F/M mass flux (always ice/ocean mass exchange) 174 ! mass flux from ice/ocean 175 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 176 177 ! mass flux at the ocean/ice interface 178 fmmflx(ji,jj) = wfx_ice(ji,jj) * rdt_ice ! F/M mass flux save at least for biogeochemical model 179 emp(ji,jj) = zemp + wfx_ice(ji,jj) + wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 227 180 228 ! correcting brine salt fluxes (zinda = 1 if pfrld=1 , =0 otherwise)229 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )230 sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj)231 181 END DO 232 182 END DO … … 235 185 ! salt flux at the ocean surface ! 236 186 !------------------------------------------! 237 238 IF( num_sal == 2 ) THEN ! variable ice salinity: brine drainage included in the salt flux 239 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 240 ELSE ! constant ice salinity: 241 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 242 ENDIF 243 !-----------------------------------------------! 244 ! mass of snow and ice per unit area ! 245 !-----------------------------------------------! 246 IF( nn_ice_embd /= 0 ) THEN ! embedded sea-ice (mass required) 247 snwice_mass_b(:,:) = snwice_mass(:,:) ! save mass from the previous ice time step 248 ! ! new mass per unit area 187 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 188 189 !-------------------------------------------------------------! 190 ! mass of snow and ice per unit area for embedded sea-ice ! 191 !-------------------------------------------------------------! 192 IF( nn_ice_embd /= 0 ) THEN 193 ! save mass from the previous ice time step 194 snwice_mass_b(:,:) = snwice_mass(:,:) 195 ! new mass per unit area 249 196 snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 250 ! !time evolution of snow+ice mass197 ! time evolution of snow+ice mass 251 198 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 252 199 ENDIF … … 263 210 IF( lk_cpl ) THEN ! coupled case 264 211 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) ! snow/ice albedo 265 !266 212 alb_ice(:,:,:) = 0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 267 213 ENDIF 214 215 ! ------------------------------------------------- 216 ! C. Rousset Begin Diagnostics for heat in W/m2 217 ! ------------------------------------------------- 218 DO jj = 1, jpj 219 DO ji = 1, jpi 220 diag_heat_dhc1(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) + & 221 & SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) ) ) * unit_fac * r1_rdtice / area(ji,jj) 222 END DO 223 END DO 224 ! ------------------------------------------------- 225 ! C. Rousset End Diagnostics 226 ! ------------------------------------------------- 268 227 269 228 IF(ln_ctl) THEN -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4332 r4634 8 8 !! 3.0 ! 2005-11 (M. Vancoppenolle) LIM-3 : Multi-layer thermodynamics + salinity variations 9 9 !! - ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif 10 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw10 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw 11 11 !! 3.3 ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 12 12 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation … … 43 43 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 44 USE timing ! Timing 45 USE cpl_oasis3, ONLY : lk_cpl 45 46 46 47 IMPLICIT NONE … … 51 52 52 53 REAL(wp) :: epsi10 = 1.e-10_wp ! 53 REAL(wp) :: zzero = 0._wp !54 REAL(wp) :: zone = 1._wp !55 54 56 55 !! * Substitutions … … 84 83 INTEGER, INTENT(in) :: kt ! number of iteration 85 84 !! 86 INTEGER :: 87 INTEGER :: 88 REAL(wp) :: zfric_umin = 5e-03_wp ! lower bound for the friction velocity89 REAL(wp) :: zfric_umax = 2e-02_wp ! upper bound for the friction velocity90 REAL(wp) :: zinda, zindb, zthsnice, zfric_u ! local scalar91 REAL(wp) :: zfntlat, zpareff, zareamin, zcoef ! - -92 REAL(wp) , POINTER, DIMENSION(:,:) :: zqlbsbq ! link with lead energy budget qldif93 REAL(wp) :: zchk_v_i, zchk_smv, zchk_ fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)85 INTEGER :: ji, jj, jk, jl ! dummy loop indices 86 INTEGER :: nbpb ! nb of icy pts for thermo. cal. 87 INTEGER :: ii, ij ! temporary dummy loop index 88 REAL(wp) :: zfric_umin = 5e-03_wp ! lower bound for the friction velocity 89 REAL(wp) :: zfric_umax = 2e-02_wp ! upper bound for the friction velocity 90 REAL(wp) :: zinda, zindb, zfric_u ! local scalar 91 REAL(wp) :: zareamin ! - - 92 REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b 94 93 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 94 REAL(wp) :: zqld, zqfr 95 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx, zqfx 96 REAL(wp) :: zhfx_err, ztest 95 97 !!------------------------------------------------------------------- 96 98 IF( nn_timing == 1 ) CALL timing_start('limthd') 97 99 98 CALL wrk_alloc( jpi , jpj, zqlbsbq)100 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx, zqfx ) 99 101 102 ! init debug 103 zdq(:) = 0._wp ; zq_ini(:) = 0._wp ; zhfx(:) = 0._wp ; zqfx(:) = 0._wp 104 100 105 ! ------------------------------- 101 106 !- check conservation (C Rousset) 102 107 IF (ln_limdiahsb) THEN 103 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) )108 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 104 109 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 105 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 106 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 110 zchk_e_i_b = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 111 zchk_fw_b = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 112 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 113 zchk_ft_b = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 107 114 ENDIF 108 115 !- check conservation (C Rousset) … … 121 128 DO jj = 1, jpj 122 129 DO ji = 1, jpi 123 !Energy of melting q(S,T) [J.m-3]124 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )125 130 !0 if no ice and 1 if yes 126 131 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) 127 !convert units ! very important that this line is here 128 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 132 !Energy of melting q(S,T) [J.m-3] 133 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 134 !convert units ! very important that this line is here 135 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 129 136 END DO 130 137 END DO … … 133 140 DO jj = 1, jpj 134 141 DO ji = 1, jpi 135 !Energy of melting q(S,T) [J.m-3]136 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s )137 142 !0 if no ice and 1 if yes 138 143 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 ) ) 144 !Energy of melting q(S,T) [J.m-3] 145 e_s(ji,jj,jk,jl) = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 139 146 !convert units ! very important that this line is here 140 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb147 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac 141 148 END DO 142 149 END DO 143 150 END DO 144 151 END DO 145 146 !-----------------------------------147 ! 1.4) Compute global heat content148 !-----------------------------------149 qt_i_in (:,:) = 0.e0150 qt_s_in (:,:) = 0.e0151 qt_i_fin (:,:) = 0.e0152 qt_s_fin (:,:) = 0.e0153 sum_fluxq(:,:) = 0.e0154 fatm (:,:) = 0.e0155 152 156 153 ! 2) Partial computation of forcing for the thermodynamic sea ice model. ! … … 161 158 !CDIR NOVERRCHK 162 159 DO ji = 1, jpi 163 zinda = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) + epsi10 ) ) )160 zinda = tms(ji,jj) * ( 1.0 - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 164 161 ! 165 162 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget … … 168 165 ! ! net downward heat flux from the ice to the ocean, expressed as a function of ocean 169 166 ! ! temperature and turbulent mixing (McPhee, 1992) 167 170 168 ! friction velocity 171 169 zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) 172 170 173 ! here the drag will depend on ice thickness and type (0.006) 174 fdtcn(ji,jj) = zinda * rau0 * rcp * 0.006 * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) 175 ! also category dependent 176 ! !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead 177 qdtcn(ji,jj) = zinda * fdtcn(ji,jj) * ( 1.0 - at_i(ji,jj) ) * rdt_ice 178 ! 179 ! !-- Lead heat budget, qldif (part 1, next one is in limthd_dh) 180 ! ! caution: exponent betas used as more snow can fallinto leads 181 qldif(ji,jj) = tms(ji,jj) * rdt_ice * ( & 182 & pfrld(ji,jj) * ( qsr(ji,jj) * oatte(ji,jj) & ! solar heat + clem modif 183 & + qns(ji,jj) & ! non solar heat 184 & + fdtcn(ji,jj) & ! turbulent ice-ocean heat 185 & + fsbbq(ji,jj) * ( 1.0 - zinda ) ) & ! residual heat from previous step 186 & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus ) ! latent heat of sprecip melting 171 !-- Energy from the turbulent oceanic heat flux. here the drag will depend on ice thickness and type (0.006) 172 fhtur(ji,jj) = zinda * rau0 * rcp * 0.006 * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 173 ! clem: why not the following? 174 !fhtur(ji,jj) = zinda * rau0 * rcp * 0.006 * SQRT( ust2s(ji,jj) ) * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) 175 176 !-- Energy received in the lead, zqld is defined everywhere (J.m-2) 177 ! It includes turbulent ocean heat flux (only in the leads, the rest is used for bottom melting) 178 zqld = tms(ji,jj) * rdt_ice * & 179 & ( pfrld(ji,jj) * ( qsr(ji,jj) * oatte(ji,jj) & ! solar heat + clem modif 180 & + qns(ji,jj) & ! non solar heat 181 & + fhtur(ji,jj) ) & ! turbulent ice-ocean heat (0 if no ice) 182 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 183 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 184 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 185 186 !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) 187 zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj,1) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 188 189 !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 190 qlead(ji,jj) = MIN( 0._wp , zqld - zqfr ) 191 192 ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 193 IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN 194 fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by a_i since this is (re)multiplied by a_i in limthd_dh.F90 195 qlead(ji,jj) = 0._wp 196 ENDIF 187 197 ! 188 ! Positive heat budget is used for bottom ablation 189 zfntlat = 1.0 - MAX( zzero , SIGN( zone , - qldif(ji,jj) ) ) 190 != 1 if positive heat budget 191 zpareff = 1.0 - zinda * zfntlat 192 != 0 if ice and positive heat budget and 1 if one of those two is false 193 zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / ( rdt_ice * MAX( at_i(ji,jj), epsi10 ) ) 198 IF( qlead(ji,jj) == 0._wp ) zqld = 0._wp ; zqfr = 0._wp 194 199 ! 195 ! Heat budget of the lead, energy transferred from ice to ocean 196 qldif (ji,jj) = zpareff * qldif(ji,jj) 197 qdtcn (ji,jj) = zpareff * qdtcn(ji,jj) 198 ! 199 ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx) 200 qcmif (ji,jj) = rau0 * rcp * fse3t_m(ji,jj,1) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 201 ! 202 ! oceanic heat flux (limthd_dh) 203 fbif (ji,jj) = zinda * ( fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) + fdtcn(ji,jj) ) 204 ! 200 ! ----------------------------------------- 201 ! Net heat flux on top of ice-ocean [W.m-2] 202 ! ----------------------------------------- 203 ! First step here : heat flux at the ocean surface + precip 204 ! Second step below : heat flux at the ice surface (after limthd_dif) 205 hfx_in(ji,jj) = hfx_in(ji,jj) & 206 ! heat flux above the ocean 207 & + pfrld(ji,jj) * ( qns(ji,jj) + qsr(ji,jj) ) & 208 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 209 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 210 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) 211 212 ! ----------------------------------------------------------------------------- 213 ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 214 ! ----------------------------------------------------------------------------- 215 ! First step here : non solar + precip - qlead - qturb 216 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 217 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 218 hfx_out(ji,jj) = hfx_out(ji,jj) & 219 ! Non solar heat flux received by the ocean 220 & + pfrld(ji,jj) * qns(ji,jj) & 221 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 222 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 223 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) & 224 ! heat flux taken from the ocean where there is open water ice formation 225 & - qlead(ji,jj) * r1_rdtice & 226 ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 227 & - at_i(ji,jj) * fhtur(ji,jj) & 228 & - at_i(ji,jj) * fhld(ji,jj) 229 205 230 END DO 206 231 END DO … … 234 259 DO jj = mj0(jjindx), mj1(jjindx) 235 260 jiindex_1d = (jj - 1) * jpi + ji 261 WRITE(numout,*) ' lim_thd : Category no : ', jl 236 262 END DO 237 263 END DO … … 271 297 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) 272 298 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) ) 273 CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 274 #if ! defined key_coupled 275 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 276 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 277 #endif 299 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 300 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 301 IF( .NOT. lk_cpl ) THEN 302 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 303 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 304 ENDIF 278 305 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 279 306 CALL tab_2d_1d( nbpb, t_bo_b (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 280 307 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 281 CALL tab_2d_1d( nbpb, fbif_1d (1:nbpb), fbif , jpi, jpj, npb(1:nbpb) ) 282 CALL tab_2d_1d( nbpb, qldif_1d (1:nbpb), qldif , jpi, jpj, npb(1:nbpb) ) 283 CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice , jpi, jpj, npb(1:nbpb) ) 284 CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw , jpi, jpj, npb(1:nbpb) ) 285 CALL tab_2d_1d( nbpb, dmgwi_1d (1:nbpb), dmgwi , jpi, jpj, npb(1:nbpb) ) 286 CALL tab_2d_1d( nbpb, qlbbq_1d (1:nbpb), zqlbsbq , jpi, jpj, npb(1:nbpb) ) 287 288 CALL tab_2d_1d( nbpb, sfx_thd_1d (1:nbpb), sfx_thd , jpi, jpj, npb(1:nbpb) ) 308 CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) ) 309 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 310 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 311 312 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 313 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 314 315 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 316 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) 317 CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum , jpi, jpj, npb(1:nbpb) ) 318 CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni , jpi, jpj, npb(1:nbpb) ) 319 320 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 321 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) 322 CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum , jpi, jpj, npb(1:nbpb) ) 323 CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni , jpi, jpj, npb(1:nbpb) ) 289 324 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 290 CALL tab_2d_1d( nbpb, fhbri_1d (1:nbpb), fhbri , jpi, jpj, npb(1:nbpb) ) 291 CALL tab_2d_1d( nbpb, fstbif_1d (1:nbpb), fstric , jpi, jpj, npb(1:nbpb) ) 292 CALL tab_2d_1d( nbpb, qfvbq_1d (1:nbpb), qfvbq , jpi, jpj, npb(1:nbpb) ) 293 294 CALL tab_2d_1d( nbpb, iatte_1d (1:nbpb), iatte , jpi, jpj, npb(1:nbpb) ) ! clem modif 295 CALL tab_2d_1d( nbpb, oatte_1d (1:nbpb), oatte , jpi, jpj, npb(1:nbpb) ) ! clem modif 325 326 CALL tab_2d_1d( nbpb, iatte_1d (1:nbpb), iatte , jpi, jpj, npb(1:nbpb) ) 327 CALL tab_2d_1d( nbpb, oatte_1d (1:nbpb), oatte , jpi, jpj, npb(1:nbpb) ) 328 329 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 330 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) 331 CALL tab_2d_1d( nbpb, hfx_tot_1d (1:nbpb), hfx_tot , jpi, jpj, npb(1:nbpb) ) 332 CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw , jpi, jpj, npb(1:nbpb) ) 333 CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub , jpi, jpj, npb(1:nbpb) ) 334 CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) ) 335 CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) ) 336 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 337 296 338 !-------------------------------- 297 339 ! 4.3) Thermodynamic processes 298 340 !-------------------------------- 299 300 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_enmelt( 1, nbpb ) ! computes sea ice energy of melting 301 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_glohec( qt_i_in, qt_s_in, q_i_layer_in, 1, nbpb, jl ) 302 303 ! !---------------------------------! 304 CALL lim_thd_dif( 1, nbpb, jl ) ! Ice/Snow Temperature profile ! 305 ! !---------------------------------! 306 307 CALL lim_thd_enmelt( 1, nbpb ) ! computes sea ice energy of melting compulsory for limthd_dh 308 309 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_glohec ( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl ) 310 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_con_dif( 1 , nbpb , jl ) 311 312 ! !---------------------------------! 313 CALL lim_thd_dh( 1, nbpb, jl ) ! Ice/Snow thickness ! 314 ! !---------------------------------! 315 316 ! !---------------------------------! 317 CALL lim_thd_ent( 1, nbpb, jl ) ! Ice/Snow enthalpy remapping ! 318 ! !---------------------------------! 319 320 ! !---------------------------------! 321 CALL lim_thd_sal( 1, nbpb ) ! Ice salinity computation ! 322 ! !---------------------------------! 341 ! --- diag error on heat diffusion - PART 1 --- ! 342 DO ji = 1, nbpb 343 zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 344 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 345 END DO 346 347 !---------------------------------! 348 ! Ice/Snow Temperature profile ! 349 !---------------------------------! 350 CALL lim_thd_dif( 1, nbpb, jl ) 351 352 ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 353 CALL lim_thd_enmelt( 1, nbpb ) 354 355 DO ji = 1, nbpb 356 ! --- diag error on heat diffusion - PART 2 --- ! 357 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 358 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 359 zhfx_err = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - ftr_ice_1d(ji) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 360 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 361 ! --- correction of qns_ice and surface conduction flux --- ! 362 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err 363 fc_su (ji) = fc_su (ji) - zhfx_err 364 ! --- Heat flux at the ice surface in W.m-2 --- ! 365 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 366 hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 367 368 END DO 369 370 !---------------------------------! 371 ! Ice/Snow thicnkess ! 372 !---------------------------------! 373 ! --- diag error on heat remapping - PART 1 --- ! 374 DO ji = 1, nbpb 375 zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 376 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 377 END DO 378 379 CALL lim_thd_dh( 1, nbpb, jl ) 380 381 ! --- Ice/Snow enthalpy remapping --- ! 382 CALL lim_thd_ent( 1, nbpb, jl ) 383 ! 384 ! --- diag error on heat remapping - PART 2 --- ! 385 DO ji = 1, nbpb 386 zdq(ji) = - ( zq_ini(ji) + dq_i(ji) + dq_s(ji) ) & 387 & + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 388 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 389 hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + zdq(ji) * a_i_b(ji) * r1_rdtice 390 END DO 391 392 !---------------------------------! 393 ! Ice salinity ! 394 !---------------------------------! 395 CALL lim_thd_sal( 1, nbpb ) 323 396 324 397 ! CALL lim_thd_enmelt(1,nbpb) ! computes sea ice energy of melting 325 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_glohec( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl )326 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_con_dh ( 1 , nbpb , jl )327 328 398 !-------------------------------- 329 399 ! 4.4) Move 1D to 2D vectors … … 345 415 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b (1:nbpb,jk), jpi, jpj) 346 416 END DO 347 CALL tab_1d_2d( nbpb, fstric , npb, fstbif_1d (1:nbpb) , jpi, jpj ) 348 CALL tab_1d_2d( nbpb, qldif , npb, qldif_1d (1:nbpb) , jpi, jpj ) 349 CALL tab_1d_2d( nbpb, qfvbq , npb, qfvbq_1d (1:nbpb) , jpi, jpj ) 350 CALL tab_1d_2d( nbpb, rdm_ice , npb, rdm_ice_1d(1:nbpb) , jpi, jpj ) 351 CALL tab_1d_2d( nbpb, rdm_snw , npb, rdm_snw_1d(1:nbpb) , jpi, jpj ) 352 CALL tab_1d_2d( nbpb, dmgwi , npb, dmgwi_1d (1:nbpb) , jpi, jpj ) 353 CALL tab_1d_2d( nbpb, rdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) 354 CALL tab_1d_2d( nbpb, rdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) 355 CALL tab_1d_2d( nbpb, fdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) 356 CALL tab_1d_2d( nbpb, rdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) 357 CALL tab_1d_2d( nbpb, sfx_thd , npb, sfx_thd_1d(1:nbpb) , jpi, jpj ) 417 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 418 419 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 420 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 421 422 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 423 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) 424 CALL tab_1d_2d( nbpb, wfx_sum , npb, wfx_sum_1d(1:nbpb) , jpi, jpj ) 425 CALL tab_1d_2d( nbpb, wfx_sni , npb, wfx_sni_1d(1:nbpb) , jpi, jpj ) 426 427 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 428 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) 429 CALL tab_1d_2d( nbpb, sfx_sum , npb, sfx_sum_1d(1:nbpb) , jpi, jpj ) 430 CALL tab_1d_2d( nbpb, sfx_sni , npb, sfx_sni_1d(1:nbpb) , jpi, jpj ) 358 431 ! 359 432 IF( num_sal == 2 ) THEN 360 433 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 361 CALL tab_1d_2d( nbpb, fhbri , npb, fhbri_1d (1:nbpb) , jpi, jpj )362 434 ENDIF 435 436 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 437 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) 438 CALL tab_1d_2d( nbpb, hfx_tot , npb, hfx_tot_1d(1:nbpb) , jpi, jpj ) 439 CALL tab_1d_2d( nbpb, hfx_snw , npb, hfx_snw_1d(1:nbpb) , jpi, jpj ) 440 CALL tab_1d_2d( nbpb, hfx_sub , npb, hfx_sub_1d(1:nbpb) , jpi, jpj ) 441 CALL tab_1d_2d( nbpb, hfx_err , npb, hfx_err_1d(1:nbpb) , jpi, jpj ) 442 CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj ) 443 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb) , jpi, jpj ) 363 444 ! 364 445 !+++++ temporary stuff for a dummy version 365 CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb) , jpi, jpj ) 366 CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb) , jpi, jpj ) 367 CALL tab_1d_2d( nbpb, fsup2D , npb, fsup (1:nbpb) , jpi, jpj ) 368 CALL tab_1d_2d( nbpb, focea2D , npb, focea (1:nbpb) , jpi, jpj ) 369 CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new (1:nbpb) , jpi, jpj ) 370 CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0 (1:nbpb) , jpi, jpj ) 371 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 446 CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb) , jpi, jpj ) 447 CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb) , jpi, jpj ) 448 CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new (1:nbpb) , jpi, jpj ) 449 CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0 (1:nbpb) , jpi, jpj ) 372 450 !+++++ 451 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 452 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 373 453 ! 374 454 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? … … 384 464 ! 5.1) Ice heat content 385 465 !------------------------ 386 ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 387 zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 466 ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 388 467 DO jl = 1, jpl 389 468 DO jk = 1, nlay_i 390 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef469 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) ) 391 470 END DO 392 471 END DO … … 395 474 ! 5.2) Snow heat content 396 475 !------------------------ 397 ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 398 zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 476 ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 399 477 DO jl = 1, jpl 400 478 DO jk = 1, nlay_s 401 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef479 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) ) 402 480 END DO 403 481 END DO … … 411 489 ! 5.4) Diagnostic thermodynamic growth rates 412 490 !-------------------------------------------- 413 !clem@useless d_v_i_thd(:,:,:) = v_i (:,:,:) - old_v_i(:,:,:) ! ice volumes414 !clem@mv-to-itd dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday415 416 IF( con_i .AND. jiindex_1d > 0 ) fbif(:,:) = fbif(:,:) + zqlbsbq(:,:)417 418 491 IF(ln_ctl) THEN ! Control print 419 492 CALL prt_ctl_info(' ') … … 451 524 !- check conservation (C Rousset) 452 525 IF (ln_limdiahsb) THEN 453 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 454 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 526 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 527 zchk_fw = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 528 zchk_ft = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 455 529 456 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice530 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw 457 531 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 532 zchk_e_i = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 458 533 459 534 zchk_vmin = glob_min(v_i) … … 462 537 463 538 IF(lwp) THEN 464 IF ( ABS( zchk_v_i ) > 1.e- 5 ) WRITE(numout,*) 'violation volume [m3/day] (limthd) = ',(zchk_v_i * rday)539 IF ( ABS( zchk_v_i ) > 1.e-4 ) WRITE(numout,*) 'violation volume [kg/day] (limthd) = ',(zchk_v_i * rday) 465 540 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limthd) = ',(zchk_smv * rday) 541 IF ( ABS( zchk_e_i ) > 1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J] (limthd) = ',(zchk_e_i) 466 542 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limthd) = ',(zchk_vmin * 1.e-3) 467 543 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limthd) = ',zchk_amax … … 472 548 ! ------------------------------- 473 549 ! 474 CALL wrk_dealloc( jpi , jpj, zqlbsbq)475 ! 550 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx, zqfx ) 551 476 552 IF( nn_timing == 1 ) CALL timing_stop('limthd') 477 553 END SUBROUTINE lim_thd 478 554 479 480 SUBROUTINE lim_thd_glohec( eti, ets, etilayer, kideb, kiut, jl ) 481 !!----------------------------------------------------------------------- 482 !! *** ROUTINE lim_thd_glohec *** 483 !! 484 !! ** Purpose : Compute total heat content for each category 485 !! Works with 1d vectors only 486 !!----------------------------------------------------------------------- 487 INTEGER , INTENT(in ) :: kideb, kiut ! bounds for the spatial loop 488 INTEGER , INTENT(in ) :: jl ! category number 489 REAL(wp), INTENT( out), DIMENSION (jpij,jpl ) :: eti, ets ! vertically-summed heat content for ice & snow 490 REAL(wp), INTENT( out), DIMENSION (jpij,jkmax) :: etilayer ! heat content for ice layers 491 !! 492 INTEGER :: ji,jk ! loop indices 493 !!----------------------------------------------------------------------- 494 eti(:,:) = 0._wp 495 ets(:,:) = 0._wp 496 ! 497 DO jk = 1, nlay_i ! total q over all layers, ice [J.m-2] 498 DO ji = kideb, kiut 499 etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 500 eti (ji,jl) = eti(ji,jl) + etilayer(ji,jk) 501 END DO 502 END DO 503 DO ji = kideb, kiut ! total q over all layers, snow [J.m-2] 504 ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / REAL( nlay_s ) 505 END DO 506 ! 507 WRITE(numout,*) ' lim_thd_glohec ' 508 WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) * r1_rdtice 509 WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) * r1_rdtice 510 WRITE(numout,*) ' qt_in : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) * r1_rdtice 511 ! 512 END SUBROUTINE lim_thd_glohec 513 514 515 SUBROUTINE lim_thd_con_dif( kideb, kiut, jl ) 516 !!----------------------------------------------------------------------- 517 !! *** ROUTINE lim_thd_con_dif *** 518 !! 519 !! ** Purpose : Test energy conservation after heat diffusion 520 !!------------------------------------------------------------------- 521 INTEGER , INTENT(in ) :: kideb, kiut ! bounds for the spatial loop 522 INTEGER , INTENT(in ) :: jl ! category number 523 524 INTEGER :: ji, jk ! loop indices 525 INTEGER :: ii, ij 526 INTEGER :: numce ! number of points for which conservation is violated 527 REAL(wp) :: meance ! mean conservation error 528 REAL(wp) :: max_cons_err, max_surf_err 529 !!--------------------------------------------------------------------- 530 531 max_cons_err = 1.0_wp ! maximum tolerated conservation error 532 max_surf_err = 0.001_wp ! maximum tolerated surface error 533 534 !-------------------------- 535 ! Increment of energy 536 !-------------------------- 537 ! global 538 DO ji = kideb, kiut 539 dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 540 END DO 541 ! layer by layer 542 dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) 543 544 !---------------------------------------- 545 ! Atmospheric heat flux, ice heat budget 546 !---------------------------------------- 547 DO ji = kideb, kiut 548 ii = MOD( npb(ji) - 1 , jpi ) + 1 549 ij = ( npb(ji) - 1 ) / jpi + 1 550 fatm (ji,jl) = qnsr_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) 551 sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(ii,ij,jl) 552 END DO 553 554 !-------------------- 555 ! Conservation error 556 !-------------------- 557 DO ji = kideb, kiut 558 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 559 END DO 560 561 numce = 0 562 meance = 0._wp 563 DO ji = kideb, kiut 564 IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 565 numce = numce + 1 566 meance = meance + cons_error(ji,jl) 567 ENDIF 568 END DO 569 IF( numce > 0 ) meance = meance / numce 570 571 WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 572 WRITE(numout,*) ' After lim_thd_dif, category : ', jl 573 WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 574 WRITE(numout,*) ' Number of points where there is a cons err gt than c.e. : ', numce, numit 575 576 !------------------------------------------------------- 577 ! Surface error due to imbalance between Fatm and Fcsu 578 !------------------------------------------------------- 579 numce = 0 580 meance = 0._wp 581 582 DO ji = kideb, kiut 583 surf_error(ji,jl) = ABS ( fatm(ji,jl) - fc_su(ji) ) 584 IF( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) THEN 585 numce = numce + 1 586 meance = meance + surf_error(ji,jl) 587 ENDIF 588 ENDDO 589 IF( numce > 0 ) meance = meance / numce 590 591 WRITE(numout,*) ' Maximum tolerated surface error : ', max_surf_err 592 WRITE(numout,*) ' After lim_thd_dif, category : ', jl 593 WRITE(numout,*) ' Mean surface error on big error points ', meance, numit 594 WRITE(numout,*) ' Number of points where there is a surf err gt than surf_err : ', numce, numit 595 596 WRITE(numout,*) ' fc_su : ', fc_su(jiindex_1d) 597 WRITE(numout,*) ' fatm : ', fatm(jiindex_1d,jl) 598 WRITE(numout,*) ' t_su : ', t_su_b(jiindex_1d) 599 600 !--------------------------------------- 601 ! Write ice state in case of big errors 602 !--------------------------------------- 603 DO ji = kideb, kiut 604 IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. & 605 ( cons_error(ji,jl) .GT. max_cons_err ) ) THEN 606 ii = MOD( npb(ji) - 1, jpi ) + 1 607 ij = ( npb(ji) - 1 ) / jpi + 1 608 ! 609 WRITE(numout,*) ' alerte 1 ' 610 WRITE(numout,*) ' Untolerated conservation / surface error after ' 611 WRITE(numout,*) ' heat diffusion in the ice ' 612 WRITE(numout,*) ' Category : ', jl 613 WRITE(numout,*) ' ii , ij : ', ii, ij 614 WRITE(numout,*) ' lat, lon : ', gphit(ii,ij), glamt(ii,ij) 615 WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 616 WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 617 WRITE(numout,*) ' dq_i : ', - dq_i(ji,jl) * r1_rdtice 618 WRITE(numout,*) ' Fdt : ', sum_fluxq(ji,jl) 619 WRITE(numout,*) 620 ! WRITE(numout,*) ' qt_i_in : ', qt_i_in(ji,jl) 621 ! WRITE(numout,*) ' qt_s_in : ', qt_s_in(ji,jl) 622 ! WRITE(numout,*) ' qt_i_fin : ', qt_i_fin(ji,jl) 623 ! WRITE(numout,*) ' qt_s_fin : ', qt_s_fin(ji,jl) 624 ! WRITE(numout,*) ' qt : ', qt_i_fin(ji,jl) + qt_s_fin(ji,jl) 625 WRITE(numout,*) ' ht_i : ', ht_i_b(ji) 626 WRITE(numout,*) ' ht_s : ', ht_s_b(ji) 627 WRITE(numout,*) ' t_su : ', t_su_b(ji) 628 WRITE(numout,*) ' t_s : ', t_s_b(ji,1) 629 WRITE(numout,*) ' t_i : ', t_i_b(ji,1:nlay_i) 630 WRITE(numout,*) ' t_bo : ', t_bo_b(ji) 631 WRITE(numout,*) ' q_i : ', q_i_b(ji,1:nlay_i) 632 WRITE(numout,*) ' s_i : ', s_i_b(ji,1:nlay_i) 633 WRITE(numout,*) ' tmelts : ', rtt - tmut*s_i_b(ji,1:nlay_i) 634 WRITE(numout,*) 635 WRITE(numout,*) ' Fluxes ' 636 WRITE(numout,*) ' ~~~~~~ ' 637 WRITE(numout,*) ' fatm : ', fatm(ji,jl) 638 WRITE(numout,*) ' fc_su : ', fc_su (ji) 639 WRITE(numout,*) ' fstr_inice : ', qsr_ice_1d(ji)*i0(ji) 640 WRITE(numout,*) ' fc_bo : ', - fc_bo_i (ji) 641 WRITE(numout,*) ' foc : ', fbif_1d(ji) 642 WRITE(numout,*) ' fstroc : ', fstroc (ii,ij,jl) 643 WRITE(numout,*) ' i0 : ', i0(ji) 644 WRITE(numout,*) ' qsr_ice : ', (1.0-i0(ji))*qsr_ice_1d(ji) 645 WRITE(numout,*) ' qns_ice : ', qnsr_ice_1d(ji) 646 WRITE(numout,*) ' Conduction fluxes : ' 647 WRITE(numout,*) ' fc_s : ', fc_s(ji,0:nlay_s) 648 WRITE(numout,*) ' fc_i : ', fc_i(ji,0:nlay_i) 649 WRITE(numout,*) 650 WRITE(numout,*) ' Layer by layer ... ' 651 WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 652 WRITE(numout,*) ' dfc_snow : ', fc_s(ji,1) - fc_s(ji,0) 653 DO jk = 1, nlay_i 654 WRITE(numout,*) ' layer : ', jk 655 WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) * r1_rdtice 656 WRITE(numout,*) ' radab : ', radab(ji,jk) 657 WRITE(numout,*) ' dfc_i : ', fc_i(ji,jk) - fc_i(ji,jk-1) 658 WRITE(numout,*) ' tot f : ', fc_i(ji,jk) - fc_i(ji,jk-1) - radab(ji,jk) 659 END DO 660 661 ENDIF 662 ! 663 END DO 664 ! 665 END SUBROUTINE lim_thd_con_dif 666 667 668 SUBROUTINE lim_thd_con_dh( kideb, kiut, jl ) 669 !!----------------------------------------------------------------------- 670 !! *** ROUTINE lim_thd_con_dh *** 671 !! 672 !! ** Purpose : Test energy conservation after enthalpy redistr. 673 !!----------------------------------------------------------------------- 674 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 675 INTEGER, INTENT(in) :: jl ! category number 676 ! 677 INTEGER :: ji ! loop indices 678 INTEGER :: ii, ij, numce ! local integers 679 REAL(wp) :: meance, max_cons_err !local scalar 680 !!--------------------------------------------------------------------- 681 682 max_cons_err = 1._wp 683 684 !-------------------------- 685 ! Increment of energy 686 !-------------------------- 687 DO ji = kideb, kiut 688 dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) ! global 689 END DO 690 dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) ! layer by layer 691 692 !---------------------------------------- 693 ! Atmospheric heat flux, ice heat budget 694 !---------------------------------------- 695 DO ji = kideb, kiut 696 ii = MOD( npb(ji) - 1 , jpi ) + 1 697 ij = ( npb(ji) - 1 ) / jpi + 1 698 699 fatm (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji) ! total heat flux 700 sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(ii,ij,jl) 701 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 702 END DO 703 704 !-------------------- 705 ! Conservation error 706 !-------------------- 707 DO ji = kideb, kiut 708 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 709 END DO 710 711 numce = 0 712 meance = 0._wp 713 DO ji = kideb, kiut 714 IF( cons_error(ji,jl) .GT. max_cons_err ) THEN 715 numce = numce + 1 716 meance = meance + cons_error(ji,jl) 717 ENDIF 718 ENDDO 719 IF(numce > 0 ) meance = meance / numce 720 721 WRITE(numout,*) ' Error report - Category : ', jl 722 WRITE(numout,*) ' ~~~~~~~~~~~~ ' 723 WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 724 WRITE(numout,*) ' After lim_thd_ent, category : ', jl 725 WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 726 WRITE(numout,*) ' Number of points where there is a cons err gt than 0.1 W/m2 : ', numce, numit 727 728 !--------------------------------------- 729 ! Write ice state in case of big errors 730 !--------------------------------------- 731 DO ji = kideb, kiut 732 IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 733 ii = MOD( npb(ji) - 1, jpi ) + 1 734 ij = ( npb(ji) - 1 ) / jpi + 1 735 ! 736 WRITE(numout,*) ' alerte 1 - category : ', jl 737 WRITE(numout,*) ' Untolerated conservation error after limthd_ent ' 738 WRITE(numout,*) ' ii , ij : ', ii, ij 739 WRITE(numout,*) ' lat, lon : ', gphit(ii,ij), glamt(ii,ij) 740 WRITE(numout,*) ' * ' 741 WRITE(numout,*) ' Ftotal : ', sum_fluxq(ji,jl) 742 WRITE(numout,*) ' dq_t : ', - dq_i(ji,jl) * r1_rdtice 743 WRITE(numout,*) ' dq_i : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) * r1_rdtice 744 WRITE(numout,*) ' dq_s : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 745 WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 746 WRITE(numout,*) ' * ' 747 WRITE(numout,*) ' Fluxes --- : ' 748 WRITE(numout,*) ' fatm : ', fatm(ji,jl) 749 WRITE(numout,*) ' foce : ', fbif_1d(ji) 750 WRITE(numout,*) ' fres : ', ftotal_fin(ji) 751 WRITE(numout,*) ' fhbri : ', fhbricat(ii,ij,jl) 752 WRITE(numout,*) ' * ' 753 WRITE(numout,*) ' Heat contents --- : ' 754 WRITE(numout,*) ' qt_s_in : ', qt_s_in(ji,jl) * r1_rdtice 755 WRITE(numout,*) ' qt_i_in : ', qt_i_in(ji,jl) * r1_rdtice 756 WRITE(numout,*) ' qt_in : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) * r1_rdtice 757 WRITE(numout,*) ' qt_s_fin : ', qt_s_fin(ji,jl) * r1_rdtice 758 WRITE(numout,*) ' qt_i_fin : ', qt_i_fin(ji,jl) * r1_rdtice 759 WRITE(numout,*) ' qt_fin : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) * r1_rdtice 760 WRITE(numout,*) ' * ' 761 WRITE(numout,*) ' Ice variables --- : ' 762 WRITE(numout,*) ' ht_i : ', ht_i_b(ji) 763 WRITE(numout,*) ' ht_s : ', ht_s_b(ji) 764 WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 765 WRITE(numout,*) ' dh_snowice: ', dh_snowice(ji) 766 WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji) 767 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 768 ENDIF 769 ! 770 END DO 771 ! 772 END SUBROUTINE lim_thd_con_dh 773 774 555 775 556 SUBROUTINE lim_thd_enmelt( kideb, kiut ) 776 557 !!----------------------------------------------------------------------- … … 859 640 WRITE(numout,*)' maximal err. on T for heat diffusion computation maxer_i_thd = ', maxer_i_thd 860 641 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice thcon_i_swi = ', thcon_i_swi 642 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 861 643 ENDIF 862 644 ! -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r4332 r4634 6 6 !! History : LIM ! 2003-05 (M. Vancoppenolle) Original code in 1D 7 7 !! ! 2005-06 (M. Vancoppenolle) 3D version 8 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw & rdm_ice8 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw & wfx_ice 9 9 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 10 10 !! 3.5 ! 2012-10 (G. Madec & co) salt flux + bug fixes … … 26 26 USE wrk_nemo ! work arrays 27 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 28 USE cpl_oasis3, ONLY : lk_cpl 29 29 30 IMPLICIT NONE 30 31 PRIVATE … … 34 35 REAL(wp) :: epsi20 = 1.e-20 ! constant values 35 36 REAL(wp) :: epsi10 = 1.e-10 ! 36 REAL(wp) :: epsi13 = 1.e-13 !37 REAL(wp) :: zzero = 0._wp !38 REAL(wp) :: zone = 1._wp !39 37 40 38 !!---------------------------------------------------------------------- … … 74 72 INTEGER :: ji , jk ! dummy loop indices 75 73 INTEGER :: ii, ij ! 2D corresponding indices to ji 76 INTEGER :: isnow ! switch for presence (1) or absence (0) of snow77 INTEGER :: isnowic ! snow ice formation not78 74 INTEGER :: i_ice_switch ! ice thickness above a certain treshold or not 79 75 INTEGER :: iter 80 76 81 REAL(wp) :: zzfmass_i, zihgnew ! local scalar 82 REAL(wp) :: zzfmass_s, zhsnew, ztmelts ! local scalar 83 REAL(wp) :: zhn, zdhcf, zdhbf, zhni, zhnfi, zihg ! 84 REAL(wp) :: zdhnm, zhnnew, zhisn, zihic, zzc ! 77 REAL(wp) :: ztmelts ! local scalar 78 REAL(wp) :: zdh, zfdum ! 85 79 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 86 80 REAL(wp) :: zcoeff ! dummy argument for snowfall partitioning over ice and leads 87 REAL(wp) :: zs m_snowice! snow-ice salinity81 REAL(wp) :: zs_snic ! snow-ice salinity 88 82 REAL(wp) :: zswi1 ! switch for computation of bottom salinity 89 83 REAL(wp) :: zswi12 ! switch for computation of bottom salinity 90 84 REAL(wp) :: zswi2 ! switch for computation of bottom salinity 91 85 REAL(wp) :: zgrr ! bottom growth rate 92 REAL(wp) :: ztform ! bottom formation temperature 93 ! 94 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 86 REAL(wp) :: zt_i_new ! bottom formation temperature 87 88 REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean 89 REAL(wp) :: zEi ! specific enthalpy of sea ice (J/kg) 90 REAL(wp) :: zEw ! specific enthalpy of exchanged water (J/kg) 91 REAL(wp) :: zdE ! specific enthalpy difference (J/kg) 92 REAL(wp) :: zfmdt ! exchange mass flux x time step (J/m2), >0 towards the ocean 93 REAL(wp) :: zsstK ! SST in Kelvin 94 95 95 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 96 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! melting point 97 REAL(wp), POINTER, DIMENSION(:) :: zhsold ! old snow thickness 98 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow 99 REAL(wp), POINTER, DIMENSION(:) :: zqfont_su ! incoming, remaining surface energy 100 REAL(wp), POINTER, DIMENSION(:) :: zqfont_bo ! incoming, bottom energy 101 REAL(wp), POINTER, DIMENSION(:) :: z_f_surf ! surface heat for ablation 102 REAL(wp), POINTER, DIMENSION(:) :: zhgnew ! new ice thickness 103 REAL(wp), POINTER, DIMENSION(:) :: zfmass_i ! 96 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow (J.m-3) 97 REAL(wp), POINTER, DIMENSION(:) :: zq_su ! heat for surface ablation (J.m-2) 98 REAL(wp), POINTER, DIMENSION(:) :: zq_bo ! heat for bottom ablation (J.m-2) 99 REAL(wp), POINTER, DIMENSION(:) :: zq_1cat ! corrected heat in case 1-cat and hmelt>15cm (J.m-2) 100 REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 101 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 102 INTEGER , POINTER, DIMENSION(:) :: icount ! number of layers vanished by melting 104 103 105 104 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt … … 108 107 109 108 REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah 110 111 ! Pathological cases 112 REAL(wp), POINTER, DIMENSION(:) :: zfdt_init ! total incoming heat for ice melt 113 REAL(wp), POINTER, DIMENSION(:) :: zfdt_final ! total remaing heat for ice melt 114 REAL(wp), POINTER, DIMENSION(:) :: zqt_i ! total ice heat content 115 REAL(wp), POINTER, DIMENSION(:) :: zqt_s ! total snow heat content 116 REAL(wp), POINTER, DIMENSION(:) :: zqt_dummy ! dummy heat content 117 118 REAL(wp), POINTER, DIMENSION(:,:) :: zqt_i_lay ! total ice heat content 109 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i ! ice layer thickness 110 111 REAL(wp), POINTER, DIMENSION(:) :: zqh_i ! total ice heat content (J.m-2) 112 REAL(wp), POINTER, DIMENSION(:) :: zqh_s ! total snow heat content (J.m-2) 113 REAL(wp), POINTER, DIMENSION(:) :: zq_s ! total snow enthalpy (J.m-3) 119 114 120 115 ! mass and salt flux (clem) 121 REAL(wp) :: zdvres, zdvsur, zdvbot 122 REAL(wp), POINTER, DIMENSION(:) :: zviold, zvsold ! old ice volume... 116 REAL(wp) :: zdvres, zswitch_sal 123 117 124 118 ! Heat conservation 125 INTEGER :: num_iter_max, numce_dh 126 REAL(wp) :: meance_dh 127 REAL(wp) :: zinda 128 REAL(wp), POINTER, DIMENSION(:) :: zinnermelt 129 REAL(wp), POINTER, DIMENSION(:) :: zfbase, zdq_i 119 INTEGER :: num_iter_max 120 REAL(wp) :: zinda, zindq, zindh 121 REAL(wp), POINTER, DIMENSION(:) :: zintermelt ! debug 122 130 123 !!------------------------------------------------------------------ 131 124 132 CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 133 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 134 CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i ) 135 CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 136 137 CALL wrk_alloc( jpij, zviold, zvsold ) ! clem 125 ! Discriminate between varying salinity (num_sal=2) and prescribed cases (other values) 126 SELECT CASE( num_sal ) ! varying salinity or not 127 CASE( 1, 3, 4 ) ; zswitch_sal = 0 ! prescribed salinity profile 128 CASE( 2 ) ; zswitch_sal = 1 ! varying salinity profile 129 END SELECT 130 131 CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 132 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 133 CALL wrk_alloc( jpij, zintermelt ) 134 CALL wrk_alloc( jpij, jkmax, zdeltah, zh_i ) 135 CALL wrk_alloc( jpij, icount ) 138 136 139 ftotal_fin(:) = 0._wp 140 zfdt_init (:) = 0._wp 141 zfdt_final(:) = 0._wp 142 143 dh_i_surf (:) = 0._wp 144 dh_i_bott (:) = 0._wp 145 dh_snowice(:) = 0._wp 146 147 DO ji = kideb, kiut 148 old_ht_i_b(ji) = ht_i_b(ji) 149 old_ht_s_b(ji) = ht_s_b(ji) 150 zviold(ji) = a_i_b(ji) * ht_i_b(ji) ! clem 151 zvsold(ji) = a_i_b(ji) * ht_s_b(ji) ! clem 152 END DO 137 dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp 138 dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp 139 140 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt (:) = 0._wp 141 zq_1cat(:) = 0._wp ; zq_rema(:) = 0._wp 142 143 zh_s (:) = 0._wp 144 zdh_s_pre(:) = 0._wp 145 zdh_s_mel(:) = 0._wp 146 zdh_s_sub(:) = 0._wp 147 zqh_s (:) = 0._wp 148 zqh_i (:) = 0._wp 149 150 zh_i (:,:) = 0._wp 151 zdeltah (:,:) = 0._wp 152 zintermelt(:) = 0._wp 153 icount (:) = 0 154 155 ! debug 156 dq_i(:) = 0._wp 157 dq_s(:) = 0._wp 158 159 ! initialize layer thicknesses and enthalpies 160 h_i_old (:,0:nlay_i+1) = 0._wp 161 qh_i_old(:,0:nlay_i+1) = 0._wp 162 DO jk = 1, nlay_i 163 DO ji = kideb, kiut 164 h_i_old (ji,jk) = ht_i_b(ji) / REAL( nlay_i ) 165 qh_i_old(ji,jk) = q_i_b(ji,jk) * h_i_old(ji,jk) 166 ENDDO 167 ENDDO 153 168 ! 154 169 !------------------------------------------------------------------------------! 155 ! 1) Calculate available heat for surface a blation!170 ! 1) Calculate available heat for surface and bottom ablation ! 156 171 !------------------------------------------------------------------------------! 157 172 ! 158 173 DO ji = kideb, kiut 159 isnow = INT( 1.0 - MAX( 0.0 , SIGN( 1.0 , - ht_s_b(ji) ) ) ) 160 ztfs (ji) = isnow * rtt + ( 1.0 - isnow ) * rtt 161 z_f_surf (ji) = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 162 z_f_surf (ji) = MAX( zzero , z_f_surf(ji) ) * MAX( zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ) ) 163 zfdt_init(ji) = ( z_f_surf(ji) + MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) ) * rdt_ice 174 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 175 ztmelts = zinda * rtt + ( 1._wp - zinda ) * rtt 176 177 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 178 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 179 180 zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_b(ji) - ztmelts ) ) 181 zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 164 182 END DO ! ji 165 183 166 zqfont_su (:) = 0._wp167 zqfont_bo (:) = 0._wp168 dsm_i_se_1d(:) = 0._wp169 dsm_i_si_1d(:) = 0._wp170 184 ! 171 185 !------------------------------------------------------------------------------! 172 ! 2) Computing layer thicknesses and snow and sea-ice enthalpies. ! 186 ! If snow temperature is above freezing point, then snow melts 187 ! (should not happen but sometimes it does) 173 188 !------------------------------------------------------------------------------! 174 ! 175 DO ji = kideb, kiut ! Layer thickness 176 zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 189 DO ji = kideb, kiut 190 IF( t_s_b(ji,1) > rtt ) THEN !!! Internal melting 191 ! Contribution to heat flux to the ocean [W.m-2], < 0 192 hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_b(ji,1) * ht_s_b(ji) * a_i_b(ji) * r1_rdtice 193 ! Contribution to mass flux 194 wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * ht_s_b(ji) * a_i_b(ji) * r1_rdtice 195 ! updates 196 ht_s_b(ji) = 0._wp 197 q_s_b (ji,1) = 0._wp 198 t_s_b (ji,1) = rtt 199 END IF 200 END DO 201 202 !------------------------------------------------------------! 203 ! 2) Computing layer thicknesses and enthalpies. ! 204 !------------------------------------------------------------! 205 ! 206 DO ji = kideb, kiut 177 207 zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 178 208 END DO 179 209 ! 180 zqt_s(:) = 0._wp ! Total enthalpy of the snow181 210 DO jk = 1, nlay_s 182 211 DO ji = kideb, kiut 183 zq t_s(ji) = zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s)212 zqh_s(ji) = zqh_s(ji) + q_s_b(ji,jk) * zh_s(ji) 184 213 END DO 185 214 END DO 186 215 ! 187 zqt_i(:) = 0._wp ! Total enthalpy of the ice188 216 DO jk = 1, nlay_i 189 217 DO ji = kideb, kiut 190 zzc = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 191 zqt_i(ji) = zqt_i(ji) + zzc 192 zqt_i_lay(ji,jk) = zzc 218 zh_i(ji,jk) = ht_i_b(ji) / REAL( nlay_i ) 219 zqh_i(ji) = zqh_i(ji) + q_i_b(ji,jk) * zh_i(ji,jk) 193 220 END DO 194 221 END DO … … 212 239 ! Martin Vancoppenolle, December 2006 213 240 214 ! Snow fall 215 DO ji = kideb, kiut 216 zcoeff = ( 1.0 - ( 1.0 - at_i_b(ji) )**betas ) / at_i_b(ji) 241 DO ji = kideb, kiut 242 !----------- 243 ! Snow fall 244 !----------- 245 ! thickness change 246 zcoeff = ( 1._wp - ( 1._wp - at_i_b(ji) )**betas ) / at_i_b(ji) 217 247 zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn 218 END DO 219 zdh_s_mel(:) = 0._wp 220 221 ! Melt of fallen snow 222 DO ji = kideb, kiut 223 ! tatm_ice is now in K 224 zqprec (ji) = rhosn * ( cpic * ( rtt - tatm_ice_1d(ji) ) + lfus ) 225 zqfont_su(ji) = z_f_surf(ji) * rdt_ice 226 zdeltah (ji,1) = MIN( 0.e0 , - zqfont_su(ji) / MAX( zqprec(ji) , epsi13 ) ) 227 zqfont_su(ji) = MAX( 0.e0 , - zdh_s_pre(ji) - zdeltah(ji,1) ) * zqprec(ji) 228 zdeltah (ji,1) = MAX( - zdh_s_pre(ji) , zdeltah(ji,1) ) 229 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,1) 230 ! heat conservation 231 qt_s_in(ji,jl) = qt_s_in(ji,jl) + zqprec(ji) * zdh_s_pre(ji) 232 zqt_s (ji) = zqt_s (ji) + zqprec(ji) * zdh_s_pre(ji) 233 zqt_s (ji) = MAX( zqt_s(ji) - zqfont_su(ji) , 0.e0 ) 234 END DO 235 236 237 ! Snow melt due to surface heat imbalance 248 ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 249 zqprec (ji) = rhosn * ( cpic * ( rtt - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus ) 250 IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 251 ! heat flux from snow precip (>0, W.m-2) 252 hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_b(ji) * zqprec(ji) * r1_rdtice 253 ! update thickness 254 ht_s_b (ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_pre(ji) ) 255 256 !--------------------- 257 ! Melt of falling snow 258 !--------------------- 259 ! thickness change 260 zindq = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) ) 261 zdh_s_mel (ji) = - zindq * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 262 zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting 263 ! Heat flux associated with snow melt of falling snow (W.m-2, <0) 264 hfx_snw_1d(ji) = hfx_snw_1d(ji) + zdh_s_mel(ji) * a_i_b(ji) * zqprec(ji) * r1_rdtice 265 ! heat used to melt snow (W.m-2, >0) 266 hfx_tot_1d(ji) = hfx_tot_1d(ji) - zdh_s_mel(ji) * a_i_b(ji) * zqprec(ji) * r1_rdtice 267 ! snow melting only = water into the ocean (then without snow precip) 268 wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * a_i_b(ji) * zdh_s_mel(ji) * r1_rdtice 269 270 ! updates available heat + thickness 271 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) ) 272 ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_mel(ji) ) 273 zh_s (ji) = ht_s_b(ji) / REAL( nlay_s ) 274 275 ! clem debug: variation of enthalpy (J.m-2) 276 dq_s(ji) = dq_s(ji) + ( zdh_s_pre(ji) + zdh_s_mel(ji) ) * zqprec(ji) 277 278 END DO 279 280 ! If heat still available, then melt more snow 281 zdeltah(:,:) = 0._wp ! important 238 282 DO jk = 1, nlay_s 239 283 DO ji = kideb, kiut 240 zdeltah (ji,jk) = - zqfont_su(ji) / q_s_b(ji,jk) 241 zqfont_su(ji) = MAX( 0.0 , - zh_s(ji) - zdeltah(ji,jk) ) * q_s_b(ji,jk) 242 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) 243 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) ! resulting melt of snow 284 ! thickness change 285 zindh = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_b(ji) ) ) 286 zindq = 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_b(ji,jk) + epsi20 ) ) 287 zdeltah (ji,jk) = - zindh * zindq * zq_su(ji) / MAX( q_s_b(ji,jk), epsi20 ) 288 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting 289 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) 290 ! heat flux associated with snow melt(W.m-2, <0) 291 hfx_snw_1d(ji) = hfx_snw_1d(ji) + zdeltah(ji,jk) * a_i_b(ji) * q_s_b(ji,jk) * r1_rdtice 292 ! heat used to melt snow(W.m-2, >0) 293 hfx_tot_1d(ji) = hfx_tot_1d(ji) - zdeltah(ji,jk) * a_i_b(ji) * q_s_b(ji,jk) * r1_rdtice 294 ! snow melting only = water into the ocean (then without snow precip) 295 wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 296 297 ! updates available heat + thickness 298 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_b(ji,jk) ) 299 ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdeltah(ji,jk) ) 300 301 ! clem debug: variation of enthalpy (J.m-2) 302 dq_s(ji) = dq_s(ji) + zdeltah(ji,jk) * q_s_b(ji,jk) 244 303 END DO 245 304 END DO 246 305 247 ! Apply snow melt to snow depth 248 DO ji = kideb, kiut 249 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) 250 ! Old and new snow depths 251 zhsold(ji) = ht_s_b(ji) 252 zhsnew = ht_s_b(ji) + dh_s_tot(ji) 253 ! If snow is still present zhn = 1, else zhn = 0 254 zhn = 1.0 - MAX( zzero , SIGN( zone , - zhsnew ) ) 255 ht_s_b(ji) = MAX( zzero , zhsnew ) 256 ! we recompute dh_s_tot (clem) 257 dh_s_tot (ji) = ht_s_b(ji) - zhsold(ji) 258 ! Volume and mass variations of snow 259 dvsbq_1d (ji) = a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_pre(ji) ) 260 dvsbq_1d (ji) = MIN( zzero, dvsbq_1d(ji) ) 261 !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + rhosn * dvsbq_1d(ji) 306 !---------------------- 307 ! 3.2 Snow sublimation 308 !---------------------- 309 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 310 IF( lk_cpl ) THEN 311 ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 312 zdh_s_sub(:) = 0._wp 313 ELSE 314 ! forced mode: snow thickness change due to sublimation 315 DO ji = kideb, kiut 316 zdh_s_sub(ji) = MAX( - ht_s_b(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 317 ! Heat flux by sublimation [W.m-2], < 0 318 ! sublimate first snow that had fallen, then pre-existing snow 319 zcoeff = ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) * zqprec(ji) + & 320 & ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_b(ji,1) ) & 321 & * a_i_b(ji) * r1_rdtice 322 hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff ! diag only (to close heat budget) 323 ! heat used for sublimation (>0, W.m-2) 324 !!? hfx_tot_1d(ji) = hfx_tot_1d(ji) - zcoeff 325 ! Mass flux by sublimation 326 wfx_sub_1d(ji) = wfx_sub_1d(ji) + rhosn * a_i_b(ji) * zdh_s_sub(ji) * r1_rdtice ! diag only 327 wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * a_i_b(ji) * zdh_s_sub(ji) * r1_rdtice 328 ! new snow thickness 329 ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_sub(ji) ) 330 ! clem debug: variation of enthalpy (J.m-2) 331 dq_s(ji) = dq_s(ji) + zdh_s_sub(ji) * q_s_b(ji,1) 332 END DO 333 ENDIF 334 335 ! --- Update snow diags --- ! 336 DO ji = kideb, kiut 337 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 338 zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 262 339 END DO ! ji 263 340 341 !------------------------------------------- 342 ! 3.3 Update temperature, energy 343 !------------------------------------------- 344 ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 345 zq_s(:) = 0._wp 346 DO jk = 1, nlay_s 347 DO ji = kideb,kiut 348 zindh = MAX( 0._wp , SIGN( 1._wp, - ht_s_b(ji) + epsi20 ) ) 349 q_s_b(ji,jk) = ( 1._wp - zindh ) / MAX( ht_s_b(ji), epsi20 ) * & 350 & ( ( MAX( 0._wp, dh_s_tot(ji) ) ) * zqprec(ji) + & 351 & ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_b(ji) ) * rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) ) 352 zq_s(ji) = zq_s(ji) + q_s_b(ji,jk) 353 END DO 354 END DO 355 264 356 !-------------------------- 265 ! 3. 2Surface ice ablation357 ! 3.4 Surface ice ablation 266 358 !-------------------------- 267 DO ji = kideb, kiut 268 z_f_surf (ji) = zqfont_su(ji) * r1_rdtice ! heat conservation test 269 zdq_i (ji) = 0._wp 270 END DO ! ji 271 359 zdeltah(:,:) = 0._wp ! important 272 360 DO jk = 1, nlay_i 273 361 DO ji = kideb, kiut 274 ! ! melt of layer jk 275 zdeltah (ji,jk) = - zqfont_su(ji) / q_i_b(ji,jk) 276 ! ! recompute heat available 277 zqfont_su(ji ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 278 ! ! melt of layer jk cannot be higher than its thickness 279 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_i(ji) ) 280 ! ! update surface melt 281 dh_i_surf(ji ) = dh_i_surf(ji) + zdeltah(ji,jk) 282 ! ! for energy conservation 283 zdq_i (ji ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 284 ! 285 ! clem 286 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) & 287 & * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic / rdt_ice 362 zEi = - q_i_b(ji,jk) / rhoic ! Specific enthalpy of layer k [J/kg, <0] 363 364 ztmelts = - tmut * s_i_b(ji,jk) + rtt ! Melting point of layer k [K] 365 366 zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of resulting meltwater [J/kg, <0] 367 368 zdE = zEi - zEw ! Specific enthalpy difference < 0 369 370 zfmdt = - zq_su(ji) / zdE ! Mass flux to the ocean [kg/m2, >0] 371 372 zdeltah(ji,jk) = - zfmdt / rhoic ! Melt of layer jk [m, <0] 373 374 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0] 375 376 zq_su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 377 378 dh_i_surf(ji) = dh_i_surf(ji) + zdeltah(ji,jk) ! Cumulate surface melt 379 380 zfmdt = - rhoic * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0] 381 382 zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0] 383 384 ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok) 385 sfx_sum_1d(ji) = sfx_sum_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 386 387 ! Contribution to heat flux [W.m-2], < 0 388 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 389 390 ! Total heat flux used in this process [W.m-2], < 0 391 hfx_tot_1d(ji) = hfx_tot_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice 392 393 ! Contribution to mass flux 394 wfx_sum_1d(ji) = wfx_sum_1d(ji) + rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 395 396 ! record which layers have disappeared (for bottom melting) 397 ! => icount=0 : no layer has vanished 398 ! => icount=5 : 5 layers have vanished 399 zindh = NINT( MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) ) 400 icount(ji) = icount(ji) + zindh 401 zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 402 403 ! clem debug: variation of enthalpy (J.m-2) 404 dq_i(ji) = dq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) 405 406 ! update heat content (J.m-2) and layer thickness 407 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk) 408 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 288 409 END DO 289 410 END DO 290 291 ! !------------------- 292 IF( con_i .AND. jiindex_1d > 0 ) THEN ! Conservation test 293 ! !------------------- 294 numce_dh = 0 295 meance_dh = 0._wp 296 DO ji = kideb, kiut 297 IF ( ( z_f_surf(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN 298 numce_dh = numce_dh + 1 299 meance_dh = meance_dh + z_f_surf(ji) + zdq_i(ji) 300 ENDIF 301 IF( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3 ) THEN! 302 WRITE(numout,*) ' ALERTE heat loss for surface melt ' 303 WRITE(numout,*) ' ii, ij, jl :', ii, ij, jl 304 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 305 WRITE(numout,*) ' z_f_surf : ', z_f_surf(ji) 306 WRITE(numout,*) ' zdq_i : ', zdq_i(ji) 307 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 308 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 309 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 310 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji) 311 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 312 WRITE(numout,*) ' sss_m : ', sss_m(ii,ij) 313 ENDIF 314 END DO 315 ! 316 IF( numce_dh > 0 ) meance_dh = meance_dh / numce_dh 317 WRITE(numout,*) ' Error report - Category : ', jl 318 WRITE(numout,*) ' ~~~~~~~~~~~~ ' 319 WRITE(numout,*) ' Number of points where there is sur. me. error : ', numce_dh 320 WRITE(numout,*) ' Mean basal growth error on error points : ', meance_dh 321 ! 322 ENDIF 323 324 !---------------------- 325 ! 3.3 Snow sublimation 326 !---------------------- 327 328 DO ji = kideb, kiut 329 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 330 #if defined key_coupled 331 zdh_s_sub(ji) = 0._wp ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 332 #else 333 ! ! forced mode: snow thickness change due to sublimation 334 zdh_s_sub(ji) = - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice 335 #endif 336 dh_s_tot (ji) = dh_s_tot(ji) + zdh_s_sub(ji) 337 zdhcf = ht_s_b(ji) + zdh_s_sub(ji) 338 ht_s_b (ji) = MAX( zzero , zdhcf ) 339 ! we recompute dh_s_tot 340 dh_s_tot (ji) = ht_s_b(ji) - zhsold(ji) 341 qt_s_in (ji,jl) = qt_s_in(ji,jl) + zdh_s_sub(ji)*q_s_b(ji,1) 342 END DO 343 344 zqt_dummy(:) = 0.e0 345 DO jk = 1, nlay_s 346 DO ji = kideb,kiut 347 q_s_b (ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 348 zqt_dummy(ji) = zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s ) ! heat conservation 349 END DO 350 END DO 351 352 DO jk = 1, nlay_s 353 DO ji = kideb, kiut 354 ! In case of disparition of the snow, we have to update the snow temperatures 355 zhisn = MAX( zzero , SIGN( zone, - ht_s_b(ji) ) ) 356 t_s_b(ji,jk) = ( 1.0 - zhisn ) * t_s_b(ji,jk) + zhisn * rtt 357 q_s_b(ji,jk) = ( 1.0 - zhisn ) * q_s_b(ji,jk) 358 END DO 411 ! update ice thickness 412 DO ji = kideb, kiut 413 ht_i_b(ji) = MAX( 0._wp , ht_i_b(ji) + dh_i_surf(ji) ) 359 414 END DO 360 415 … … 364 419 !------------------------------------------------------------------------------! 365 420 ! 366 ! Ice basal growth / melt is given by the ratio of heat budget over basal 367 ! ice heat content. Basal heat budget is given by the difference between 368 ! the inner conductive flux (fc_bo_i), from the open water heat flux 369 ! (qlbbqb) and the turbulent ocean flux (fbif). 370 ! fc_bo_i is positive downwards. fbif and qlbbq are positive to the ice 371 372 !----------------------------------------------------- 373 ! 4.1 Basal growth - (a) salinity not varying in time 374 !----------------------------------------------------- 375 IF( num_sal /= 2 ) THEN ! ice salinity constant in time 421 !------------------ 422 ! 4.1 Basal growth 423 !------------------ 424 ! Basal growth is driven by heat imbalance at the ice-ocean interface, 425 ! between the inner conductive flux (fc_bo_i), from the open water heat flux 426 ! (fhldb) and the turbulent ocean flux (fhtur). 427 ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice 428 429 ! If salinity varies in time, an iterative procedure is required, because 430 ! the involved quantities are inter-dependent. 431 ! Basal growth (dh_i_bott) depends upon new ice specific enthalpy (zEi), 432 ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bott) 433 ! -> need for an iterative procedure, which converges quickly 434 435 IF ( num_sal == 2 ) THEN 436 num_iter_max = 5 437 ELSE 438 num_iter_max = 1 439 ENDIF 440 441 !clem debug. Just to be sure that enthalpy at nlay_i+1 is null 442 DO ji = kideb, kiut 443 q_i_b(ji,nlay_i+1) = 0._wp 444 END DO 445 446 ! Iterative procedure 447 DO iter = 1, num_iter_max 376 448 DO ji = kideb, kiut 377 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0._wp ) THEN 378 s_i_new(ji) = sm_i_b(ji) 379 ! Melting point in K 380 ztmelts = - tmut * s_i_new(ji) + rtt 381 ! New ice heat content (Bitz and Lipscomb, 1999) 382 ztform = t_i_b(ji,nlay_i) ! t_bo_b crashes in the 383 ! Baltic 384 q_i_b(ji,nlay_i+1) = rhoic * ( cpic * ( ztmelts - ztform ) & 385 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( ztform - rtt ) ) & 386 & - rcp * ( ztmelts - rtt ) ) 387 ! Basal growth rate = - F*dt / q 388 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 389 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 449 IF( zf_tt(ji) < 0._wp ) THEN 450 451 ! New bottom ice salinity (Cox & Weeks, JGR88 ) 452 !--- zswi1 if dh/dt < 2.0e-8 453 !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 454 !--- zswi2 if dh/dt > 3.6e-7 455 zgrr = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi10 ) ) 456 zswi2 = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) ) 457 zswi12 = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 458 zswi1 = 1. - zswi2 * zswi12 459 zfracs = MIN ( zswi1 * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) ) & 460 & + zswi2 * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) , 0.5 ) 461 462 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 463 464 s_i_new(ji) = zswitch_sal * zfracs * sss_m(ii,ij) & ! New ice salinity 465 + ( 1. - zswitch_sal ) * sm_i_b(ji) 466 ! New ice growth 467 ztmelts = - tmut * s_i_new(ji) + rtt ! New ice melting point (K) 468 469 zt_i_new = zswitch_sal * t_bo_b(ji) + ( 1. - zswitch_sal) * t_i_b(ji, nlay_i) 470 471 zEi = cpic * ( zt_i_new - ztmelts ) & ! Specific enthalpy of forming ice (J/kg, <0) 472 & - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) ) & 473 & + rcp * ( ztmelts-rtt ) 474 475 zEw = rcp * ( t_bo_b(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) 476 477 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 478 479 dh_i_bott(ji) = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) ) 480 481 q_i_b(ji,nlay_i+1) = -zEi * rhoic ! New ice energy of melting (J/m3, >0) 482 483 ENDIF ! fc_bo_i 484 END DO ! ji 485 END DO ! iter 486 487 ! Contribution to Energy and Salt Fluxes 488 DO ji = kideb, kiut 489 IF( zf_tt(ji) < 0._wp ) THEN 490 ! New ice growth 491 492 zfmdt = - rhoic * dh_i_bott(ji) ! Mass flux x time step (kg/m2, < 0) 493 494 ! Contribution to heat flux to the ocean [W.m-2], >0 495 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 496 ! Total heat flux used in this process [W.m-2] 497 hfx_tot_1d(ji) = hfx_tot_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice 498 499 ! Contribution to salt flux () 500 sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_b(ji) * zfmdt * r1_rdtice 501 502 ! Contribution to mass flux 503 wfx_bog_1d(ji) = wfx_bog_1d(ji) + rhoic * a_i_b(ji) * dh_i_bott(ji) * r1_rdtice 504 505 ! clem debug: variation of enthalpy (J.m-2) 506 dq_i(ji) = dq_i(ji) + dh_i_bott(ji) * q_i_b(ji,nlay_i+1) 507 508 ! update heat content (J.m-2) and layer thickness 509 qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_b(ji,nlay_i+1) 510 h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji) 511 ENDIF 512 END DO 513 514 !---------------- 515 ! 4.2 Basal melt 516 !---------------- 517 zdeltah(:,:) = 0._wp ! important 518 DO jk = nlay_i, 1, -1 519 DO ji = kideb, kiut 520 IF( zf_tt(ji) >= 0._wp .AND. jk > icount(ji) ) THEN ! do not calculate where layer has already disappeared from surface melting 521 522 ztmelts = - tmut * s_i_b(ji,jk) + rtt ! Melting point of layer jk (K) 523 524 IF( t_i_b(ji,jk) >= ztmelts ) THEN !!! Internal melting 525 zintermelt(ji) = 1._wp 526 527 zEi = - q_i_b(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0) 528 529 !!zEw = rcp * ( t_i_b(ji,jk) - rtt ) ! Specific enthalpy of meltwater at T = t_i_b (J/kg, <0) 530 531 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 532 ! set up at 0 since no energy is needed to melt water...(it is already melted) 533 534 zdeltah (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 535 ! this should normally not happen, but sometimes, heat diffusion leads to this 536 537 dh_i_bott (ji) = dh_i_bott(ji) + zdeltah(ji,jk) 538 539 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 540 541 ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 542 hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_b(ji) * zEi * r1_rdtice 543 544 ! clem debug: variation of enthalpy (J.m-2) 545 dq_i(ji) = dq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) 546 547 ! update heat content (J.m-2) and layer thickness 548 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk) 549 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 550 551 ELSE !!! Basal melting 552 553 zEi = - q_i_b(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0) 554 555 zEw = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0) 556 557 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 558 559 zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0) 560 561 zdeltah(ji,jk) = - zfmdt / rhoic ! Gross thickness change 562 563 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 564 565 zq_bo(ji) = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 566 567 dh_i_bott(ji) = dh_i_bott(ji) + zdeltah(ji,jk) ! Update basal melt 568 569 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 570 571 zQm = zfmdt * zEw ! Heat exchanged with ocean 572 573 ! Contribution to heat flux to the ocean [W.m-2], <0 574 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 575 576 ! clem debug: variation of enthalpy (J.m-2) 577 dq_i(ji) = dq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) 578 579 ! update heat content (J.m-2) and layer thickness 580 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk) 581 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 582 ENDIF 583 584 ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok) 585 sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 586 587 ! Total heat flux used in this process [W.m-2] 588 hfx_tot_1d(ji) = hfx_tot_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice 589 590 ! Contribution to mass flux 591 wfx_bom_1d(ji) = wfx_bom_1d(ji) + rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 592 593 ENDIF 594 END DO ! ji 595 END DO ! jk 596 597 !------------------------------------------------------------------------------! 598 ! Excessive ablation in a 1-category model 599 ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 600 !------------------------------------------------------------------------------! 601 ! ??? keep ??? 602 ! clem bug: I think this should be included above, so we would not have to 603 ! track heat/salt/mass fluxes backwards 604 IF( jpl == 1 ) THEN 605 DO ji = kideb, kiut 606 IF( zf_tt(ji) >= 0._wp ) THEN 607 zdh = MAX( hmelt , dh_i_bott(ji) ) 608 zdvres = zdh - dh_i_bott(ji) ! >=0 609 dh_i_bott(ji) = zdh 610 611 ! excessive energy is sent to lateral ablation 612 zinda = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_b(ji) - epsi20 ) ) 613 zq_1cat(ji) = zinda * rhoic * lfus * at_i_b(ji) / MAX( 1._wp - at_i_b(ji) , epsi20 ) * zdvres ! J.m-2 >=0 614 615 ! correct salt and mass fluxes 616 sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation 617 wfx_bom_1d(ji) = wfx_bom_1d(ji) + rhoic * a_i_b(ji) * zdvres * r1_rdtice 390 618 ENDIF 391 619 END DO 392 620 ENDIF 393 621 394 !------------------------------------------------- 395 ! 4.1 Basal growth - (b) salinity varying in time 396 !------------------------------------------------- 397 IF( num_sal == 2 ) THEN 398 ! the growth rate (dh_i_bott) is function of the new ice heat content (q_i_b(nlay_i+1)). 399 ! q_i_b depends on the new ice salinity (snewice). 400 ! snewice depends on dh_i_bott ; it converges quickly, so, no problem 401 ! See Vancoppenolle et al., OM08 for more info on this 402 403 ! Initial value (tested 1D, can be anything between 1 and 20) 404 num_iter_max = 4 405 s_i_new(:) = 4.0 406 407 ! Iterative procedure 408 DO iter = 1, num_iter_max 409 DO ji = kideb, kiut 410 IF( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0.e0 ) THEN 411 ii = MOD( npb(ji) - 1, jpi ) + 1 412 ij = ( npb(ji) - 1 ) / jpi + 1 413 ! Melting point in K 414 ztmelts = - tmut * s_i_new(ji) + rtt 415 ! New ice heat content (Bitz and Lipscomb, 1999) 416 q_i_b(ji,nlay_i+1) = rhoic * ( cpic * ( ztmelts - t_bo_b(ji) ) & 417 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) ) & 418 & - rcp * ( ztmelts-rtt ) ) 419 ! Bottom growth rate = - F*dt / q 420 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 421 ! New ice salinity ( Cox and Weeks, JGR, 1988 ) 422 ! zswi2 (1) if dh_i_bott/rdt .GT. 3.6e-7 423 ! zswi12 (1) if dh_i_bott/rdt .LT. 3.6e-7 and .GT. 2.0e-8 424 ! zswi1 (1) if dh_i_bott/rdt .LT. 2.0e-8 425 zgrr = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi13 ) ) 426 zswi2 = MAX( zzero , SIGN( zone , zgrr - 3.6e-7 ) ) 427 zswi12 = MAX( zzero , SIGN( zone , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 428 zswi1 = 1. - zswi2 * zswi12 429 zfracs = zswi1 * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) ) & 430 & + zswi2 * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) 431 zfracs = MIN( 0.5 , zfracs ) 432 s_i_new(ji) = zfracs * sss_m(ii,ij) 433 ENDIF ! fc_bo_i 434 END DO ! ji 435 END DO ! iter 436 437 ! Final values 438 DO ji = kideb, kiut 439 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .LT. 0.0 ) THEN 440 ! New ice salinity must not exceed 20 psu 441 s_i_new(ji) = MIN( s_i_new(ji), s_i_max ) 442 ! Metling point in K 443 ztmelts = - tmut * s_i_new(ji) + rtt 444 ! New ice heat content (Bitz and Lipscomb, 1999) 445 q_i_b(ji,nlay_i+1) = rhoic * ( cpic * ( ztmelts - t_bo_b(ji) ) & 446 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) ) & 447 & - rcp * ( ztmelts - rtt ) ) 448 ! Basal growth rate = - F*dt / q 449 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 450 ! Salinity update 451 ! entrapment during bottom growth 452 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 453 ENDIF ! heat budget 454 END DO 455 ENDIF 456 457 !---------------- 458 ! 4.2 Basal melt 459 !---------------- 460 meance_dh = 0._wp 461 numce_dh = 0 462 zinnermelt(:) = 0._wp 463 464 DO ji = kideb, kiut 465 ! heat convergence at the surface > 0 466 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0._wp ) THEN 467 s_i_new(ji) = s_i_b(ji,nlay_i) 468 zqfont_bo(ji) = rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) 469 zfbase(ji) = zqfont_bo(ji) * r1_rdtice ! heat conservation test 470 zdq_i(ji) = 0._wp 471 dh_i_bott(ji) = 0._wp 472 ENDIF 473 END DO 474 475 DO jk = nlay_i, 1, -1 476 DO ji = kideb, kiut 477 IF( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN 478 ztmelts = - tmut * s_i_b(ji,jk) + rtt 479 IF( t_i_b(ji,jk) >= ztmelts ) THEN !!gm : a comment is needed 480 zdeltah (ji,jk) = - zh_i(ji) 481 dh_i_bott (ji ) = dh_i_bott(ji) + zdeltah(ji,jk) 482 zinnermelt(ji ) = 1._wp 483 ELSE ! normal ablation 484 zdeltah (ji,jk) = - zqfont_bo(ji) / q_i_b(ji,jk) 485 zqfont_bo(ji ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 486 zdeltah (ji,jk) = MAX(zdeltah(ji,jk), - zh_i(ji) ) 487 dh_i_bott(ji ) = dh_i_bott(ji) + zdeltah(ji,jk) 488 zdq_i (ji ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 489 ENDIF 490 ! clem: contribution to salt flux 491 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) & 492 & * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice 493 ENDIF 494 END DO ! ji 495 END DO ! jk 496 497 ! !------------------- 498 IF( con_i .AND. jiindex_1d > 0 ) THEN ! Conservation test 499 ! !------------------- 500 DO ji = kideb, kiut 501 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0.e0 ) THEN 502 IF( ( zfbase(ji) + zdq_i(ji) ) >= 1.e-3 ) THEN 503 numce_dh = numce_dh + 1 504 meance_dh = meance_dh + zfbase(ji) + zdq_i(ji) 505 ENDIF 506 IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3 ) THEN 507 WRITE(numout,*) ' ALERTE heat loss for basal melt : ii, ij, jl :', ii, ij, jl 508 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 509 WRITE(numout,*) ' zfbase : ', zfbase(ji) 510 WRITE(numout,*) ' zdq_i : ', zdq_i(ji) 511 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 512 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 513 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 514 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji) 515 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 516 WRITE(numout,*) ' sss_m : ', sss_m(ii,ij) 517 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 518 WRITE(numout,*) ' innermelt : ', INT( zinnermelt(ji) ) 519 ENDIF 520 ENDIF 521 END DO 522 IF( numce_dh > 0 ) meance_dh = meance_dh / numce_dh 523 WRITE(numout,*) ' Number of points where there is bas. me. error : ', numce_dh 524 WRITE(numout,*) ' Mean basal melt error on error points : ', meance_dh 525 WRITE(numout,*) ' Remaining bottom heat : ', zqfont_bo(jiindex_1d) 526 ! 527 ENDIF 528 529 ! 530 !------------------------------------------------------------------------------! 531 ! 5) Pathological cases ! 532 !------------------------------------------------------------------------------! 533 ! 534 !---------------------------------------------- 535 ! 5.1 Excessive ablation in a 1-category model 536 !---------------------------------------------- 537 538 DO ji = kideb, kiut 539 ! ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 540 IF( jpl == 1 ) THEN ; zdhbf = MAX( hmelt , dh_i_bott(ji) ) 541 ELSE ; zdhbf = dh_i_bott(ji) 542 ENDIF 543 zdvres = zdhbf - dh_i_bott(ji) 544 dh_i_bott(ji) = zdhbf 545 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice 546 ! ! excessive energy is sent to lateral ablation 547 zinda = MAX( 0._wp, SIGN( 1._wp , 1.0 - at_i_b(ji) - epsi10 ) ) 548 fsup(ji) = zinda * rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi10 ) * zdvres * r1_rdtice 549 END DO 550 551 !----------------------------------- 552 ! 5.2 More than available ice melts 553 !----------------------------------- 554 ! then heat applied minus heat content at previous time step should equal heat remaining 555 ! 556 DO ji = kideb, kiut 557 ! Adapt the remaining energy if too much ice melts 558 !-------------------------------------------------- 559 zdvres = MAX( 0._wp, - ht_i_b(ji) - dh_i_surf(ji) - dh_i_bott(ji) ) 560 zdvsur = MIN( 0._wp, dh_i_surf(ji) + zdvres ) - dh_i_surf(ji) ! fill the surface first 561 zdvbot = MAX( 0._wp, zdvres - zdvsur ) ! then the bottom 562 dh_i_surf (ji) = dh_i_surf(ji) + zdvsur ! clem 563 dh_i_bott (ji) = dh_i_bott(ji) + zdvbot ! clem 564 565 ! new ice thickness (clem) 566 zhgnew(ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 567 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice 568 zhgnew(ji) = zihgnew * zhgnew(ji) ! ice thickness is put to 0 569 570 ! !since ice volume is only used for outputs, we keep it global for all categories 571 dvbbq_1d (ji) = a_i_b(ji) * dh_i_bott(ji) 572 573 ! remaining heat 574 zfdt_final(ji) = ( 1.0 - zihgnew ) * ( zqfont_su(ji) + zqfont_bo(ji) ) 575 576 ! If snow remains, energy is used to melt snow 577 zhni = ht_s_b(ji) ! snow depth at previous time step 578 zihg = MAX( zzero , SIGN ( zone , - ht_s_b(ji) ) ) ! =0 if snow 579 580 ! energy of melting of remaining snow 581 zinda = MAX( 0._wp, SIGN( 1._wp , zhni - epsi10 ) ) 582 zqt_s(ji) = ( 1. - zihg ) * zqt_s(ji) / MAX( zhni, epsi10 ) * zinda 583 zdhnm = - ( 1. - zihg ) * ( 1. - zihgnew ) * zfdt_final(ji) / MAX( zqt_s(ji) , epsi13 ) 584 zhnfi = zhni + zdhnm 585 zfdt_final(ji) = MAX( zfdt_final(ji) + zqt_s(ji) * zdhnm , 0.0 ) 586 ht_s_b(ji) = MAX( zzero , zhnfi ) 587 zqt_s(ji) = zqt_s(ji) * ht_s_b(ji) 588 ! we recompute dh_s_tot (clem) 589 dh_s_tot (ji) = ht_s_b(ji) - zhsold(ji) 590 591 ! Mass variations of ice and snow 592 !--------------------------------- 593 ! ! mass variation of the jl category 594 zzfmass_s = - a_i_b(ji) * ( zhni - ht_s_b(ji) ) * rhosn ! snow 595 zzfmass_i = a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic ! ice 596 ! 597 zfmass_i(ji) = zzfmass_i ! ice variation saved to compute salt flux (see below) 598 ! 599 ! ! mass variation cumulated over category 600 !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + zzfmass_s ! snow 601 !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + zzfmass_i ! ice 602 603 ! Remaining heat to the ocean 604 !--------------------------------- 605 focea(ji) = - zfdt_final(ji) * r1_rdtice ! focea is in W.m-2 * dt 606 607 ! residual salt flux (clem) 608 !-------------------------- 609 ! surface 610 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvsur * rhoic * r1_rdtice 611 ! bottom 612 IF ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN ! melting 613 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 614 ELSE ! growth 615 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 616 ENDIF 617 ! 618 ! diagnostic 619 ii = MOD( npb(ji) - 1, jpi ) + 1 620 ij = ( npb(ji) - 1 ) / jpi + 1 621 diag_bot_gr(ii,ij) = diag_bot_gr(ii,ij) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 622 diag_sur_me(ii,ij) = diag_sur_me(ii,ij) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) * r1_rdtice 623 diag_bot_me(ii,ij) = diag_bot_me(ii,ij) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 624 END DO 625 626 ftotal_fin (:) = zfdt_final(:) * r1_rdtice 627 628 !--------------------------- 629 ! heat fluxes 630 !--------------------------- 631 DO ji = kideb, kiut 632 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) ! =1 if ice 633 ! 634 ! Heat flux 635 ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 636 ! excessive total ablation energy (focea) sent to the ocean 637 qfvbq_1d(ji) = qfvbq_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) * rdt_ice 638 639 zihic = 1.0 - MAX( zzero , SIGN( zone , -ht_i_b(ji) ) ) ! equals 0 if ht_i = 0, 1 if ht_i gt 0 640 fscbq_1d(ji) = a_i_b(ji) * fstbif_1d(ji) 641 qldif_1d(ji) = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea (ji) * a_i_b(ji) * rdt_ice & 642 & + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice 643 END DO ! ji 644 645 !------------------------------------------- 646 ! Correct temperature, energy and thickness 647 !------------------------------------------- 648 DO ji = kideb, kiut 649 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) 650 t_su_b(ji) = zihgnew * t_su_b(ji) + ( 1.0 - zihgnew ) * rtt 651 END DO ! ji 652 653 DO jk = 1, nlay_i 654 DO ji = kideb, kiut 655 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) 656 t_i_b(ji,jk) = zihgnew * t_i_b(ji,jk) + ( 1.0 - zihgnew ) * rtt 657 q_i_b(ji,jk) = zihgnew * q_i_b(ji,jk) 658 END DO 659 END DO ! ji 660 661 DO ji = kideb, kiut 662 ht_i_b(ji) = zhgnew(ji) 663 END DO ! ji 622 !------------------------------------------- 623 ! Update temperature, energy 624 !------------------------------------------- 625 DO ji = kideb, kiut 626 ht_i_b(ji) = MAX( 0._wp , ht_i_b(ji) + dh_i_bott(ji) ) 627 END DO 628 629 !------------------------------------------- 630 ! 5. What to do with remaining energy 631 !------------------------------------------- 632 ! If heat still available for melting and snow remains, then melt more snow 633 !------------------------------------------- 634 zdeltah(:,:) = 0._wp ! important 635 DO ji = kideb, kiut 636 zq_rema(ji) = zq_su(ji) + zq_bo(ji) 637 ! zindh = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_b(ji) ) ) ! =1 if snow 638 ! zindq = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) ) 639 ! zdeltah (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 ) 640 ! zdeltah (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_b(ji) ) ) ! bound melting 641 ! zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,1) 642 ! dh_s_tot (ji) = dh_s_tot(ji) + zdeltah(ji,1) 643 ! ht_s_b (ji) = ht_s_b(ji) + zdeltah(ji,1) 644 ! 645 ! zq_rema(ji) = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji) ! update available heat (J.m-2) 646 ! ! Heat flux associated with snow melt 647 ! hfx_snw_1d(ji) = hfx_snw_1d(ji) + zdeltah(ji,1) * a_i_b(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (<0) 648 ! ! heat used to melt snow 649 ! hfx_tot_1d(ji) = hfx_tot_1d(ji) - zdeltah(ji,1) * a_i_b(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0) 650 ! ! Contribution to mass flux 651 ! wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * a_i_b(ji) * zdeltah(ji,1) * r1_rdtice 652 ! ! clem debug: variation of enthalpy (J.m-2) 653 ! dq_s(ji) = dq_s(ji) + zdeltah(ji,1) * q_s_b(ji,1) 654 ! 655 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 656 ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 657 hfx_out(ii,ij) = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_b(ji) ) * r1_rdtice 658 659 IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 660 END DO 661 664 662 ! 665 663 !------------------------------------------------------------------------------| … … 670 668 DO ji = kideb, kiut 671 669 ! 672 dh_snowice(ji) = MAX( zzero , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic ) ) 673 zhgnew(ji) = MAX( zhgnew(ji) , zhgnew(ji) + dh_snowice(ji) ) 674 zhnnew = MIN( ht_s_b(ji) , ht_s_b(ji) - dh_snowice(ji) ) 675 676 ! Changes in ice volume and ice mass. 677 dvnbq_1d (ji) = a_i_b(ji) * ( zhgnew(ji)-ht_i_b(ji) ) 678 dmgwi_1d (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn 679 680 !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic 681 !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + a_i_b(ji) * ( zhnnew - ht_s_b(ji) ) * rhosn 682 683 ! Equivalent salt flux (1) Snow-ice formation component 684 ! ----------------------------------------------------- 685 ii = MOD( npb(ji) - 1, jpi ) + 1 686 ij = ( npb(ji) - 1 ) / jpi + 1 687 688 IF( num_sal == 2 ) THEN ; zsm_snowice = sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic 689 ELSE ; zsm_snowice = sm_i_b(ji) 690 ENDIF 670 dh_snowice(ji) = MAX( 0._wp , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic ) ) 671 672 ht_i_b(ji) = ht_i_b(ji) + dh_snowice(ji) 673 ht_s_b(ji) = ht_s_b(ji) - dh_snowice(ji) 674 675 ! Salinity of snow ice 676 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 677 zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_b(ji) 678 691 679 ! entrapment during snow ice formation 692 ! clem:new salinity difference stored (to be used in limthd_ent.F90)680 ! new salinity difference stored (to be used in limthd_ent.F90) 693 681 IF ( num_sal == 2 ) THEN 694 i_ice_switch = MAX( 0._wp , SIGN( 1._wp , zhgnew(ji) - epsi10 ) )682 i_ice_switch = MAX( 0._wp , SIGN( 1._wp , ht_i_b(ji) - epsi10 ) ) 695 683 ! salinity dif due to snow-ice formation 696 dsm_i_si_1d(ji) = ( zs m_snowice - sm_i_b(ji) ) * dh_snowice(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch684 dsm_i_si_1d(ji) = ( zs_snic - sm_i_b(ji) ) * dh_snowice(ji) / MAX( ht_i_b(ji), epsi10 ) * i_ice_switch 697 685 ! salinity dif due to bottom growth 698 IF ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0._wp ) THEN699 dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_b(ji) ) * dh_i_bott(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch686 IF ( zf_tt(ji) < 0._wp ) THEN 687 dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_b(ji) ) * dh_i_bott(ji) / MAX( ht_i_b(ji), epsi10 ) * i_ice_switch 700 688 ENDIF 701 689 ENDIF 702 690 703 ! Actualize new snow and ice thickness. 704 ht_s_b(ji) = zhnnew 705 ht_i_b(ji) = zhgnew(ji) 706 707 ! Total ablation ! new lines added to debug 691 ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 692 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 693 zfmdt = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp ) ! <0 694 zsstK = sst_m(ii,ij) + rt0 695 zEw = rcp * ( zsstK - rt0 ) 696 zQm = zfmdt * zEw 697 698 ! Contribution to heat flux 699 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 700 701 ! Contribution to salt flux 702 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_b(ji) * zfmdt * r1_rdtice 703 704 ! Contribution to mass flux 705 ! All snow is thrown in the ocean, and seawater is taken to replace the volume 706 wfx_sni_1d(ji) = wfx_sni_1d(ji) + a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 707 wfx_snw_1d(ji) = wfx_snw_1d(ji) - a_i_b(ji) * dh_snowice(ji) * rhosn * r1_rdtice 708 709 ! clem debug: variation of enthalpy (J.m-2) 710 dq_s(ji) = dq_s(ji) - dh_snowice(ji) * q_s_b(ji,1) 711 dq_i(ji) = dq_i(ji) + dh_snowice(ji) * q_s_b(ji,1) + zfmdt * zEw 712 713 ! update heat content (J.m-2) and layer thickness 714 qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_b(ji,1) + zfmdt * zEw 715 h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 716 717 ! Total ablation (to debug) 708 718 IF( ht_i_b(ji) <= 0._wp ) a_i_b(ji) = 0._wp 709 719 710 ! diagnostic ( snow ice growth )711 ii = MOD( npb(ji) - 1, jpi ) + 1712 ij = ( npb(ji) - 1 ) / jpi + 1713 diag_sni_gr(ii,ij) = diag_sni_gr(ii,ij) + dh_snowice(ji)*a_i_b(ji) * r1_rdtice714 !715 ! salt flux716 sfx_thd_1d(ji) = sfx_thd_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice717 !--------------------------------718 ! Update mass fluxes (clem)719 !--------------------------------720 rdm_ice_1d(ji) = rdm_ice_1d(ji) + ( a_i_b(ji) * ht_i_b(ji) - zviold(ji) ) * rhoic721 rdm_snw_1d(ji) = rdm_snw_1d(ji) + ( a_i_b(ji) * ht_s_b(ji) - zvsold(ji) ) * rhosn722 723 720 END DO !ji 724 ! 725 CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 726 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 727 CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 728 CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) 729 ! 730 CALL wrk_dealloc( jpij, zviold, zvsold ) ! clem 721 722 ! 723 !------------------------------------------- 724 ! Update temperature, energy 725 !------------------------------------------- 726 !clem bug: we should take snow into account here 727 DO ji = kideb, kiut 728 zindh = 1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_b(ji) ) ) 729 t_su_b(ji) = zindh * t_su_b(ji) + ( 1.0 - zindh ) * rtt 730 END DO ! ji 731 732 DO jk = 1, nlay_s 733 DO ji = kideb,kiut 734 ! mask enthalpy 735 zinda = MAX( 0._wp , SIGN( 1._wp, - ht_s_b(ji) ) ) 736 q_s_b(ji,jk) = ( 1.0 - zinda ) * q_s_b(ji,jk) 737 ! recalculate t_s_b from q_s_b 738 t_s_b(ji,jk) = rtt + ( 1._wp - zinda ) * ( - q_s_b(ji,jk) / ( rhosn * cpic ) + lfus / cpic ) 739 END DO 740 END DO 741 742 CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 743 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 744 CALL wrk_dealloc( jpij, zintermelt ) 745 CALL wrk_dealloc( jpij, jkmax, zdeltah, zh_i ) 746 CALL wrk_dealloc( jpij, icount ) 747 ! 731 748 ! 732 749 END SUBROUTINE lim_thd_dh -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r4332 r4634 25 25 USE wrk_nemo ! work arrays 26 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 USE cpl_oasis3, ONLY : lk_cpl 27 28 28 29 IMPLICIT NONE … … 111 112 REAL(wp) :: zraext_s = 1.e+8_wp ! extinction coefficient of radiation in the snow 112 113 REAL(wp) :: zkimin = 0.10_wp ! minimum ice thermal conductivity 114 REAL(wp) :: ztsu_err = 1.e-5_wp ! range around which t_su is considered as 0°C 113 115 REAL(wp) :: ztmelt_i ! ice melting temperature 114 116 REAL(wp) :: zerritmax ! current maximal error on temperature … … 145 147 REAL(wp), DIMENSION(kiut,jkmax+2) :: zdiagbis 146 148 REAL(wp), DIMENSION(kiut,jkmax+2,3) :: ztrid ! tridiagonal system terms 149 REAL(wp) :: ztemp ! local scalar 147 150 !!------------------------------------------------------------------ 148 151 ! … … 150 153 ! 1) Initialization ! 151 154 !------------------------------------------------------------------------------! 152 ! 155 ! clem clean: replace just ztfs by rtt 153 156 DO ji = kideb , kiut 154 157 ! is there snow or not 155 158 isnow(ji)= NINT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) ) ) 156 159 ! surface temperature of fusion 157 !!gm ??? ztfs(ji) = rtt !!!????158 160 ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 159 161 ! layer thickness … … 194 196 ! zfsw = (1-i0).qsr_ice is absorbed at the surface 195 197 ! zftrice = io.qsr_ice is below the surface 196 ! f stbif= io.qsr_ice.exp(-k(h_i)) transmitted below the ice198 ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 197 199 198 200 DO ji = kideb , kiut … … 253 255 254 256 DO ji = kideb, kiut ! Radiation transmitted below the ice 255 fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 256 END DO 257 258 ! +++++ 259 ! just to check energy conservation 260 DO ji = kideb, kiut 261 ii = MOD( npb(ji) - 1 , jpi ) + 1 262 ij = ( npb(ji) - 1 ) / jpi + 1 263 fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 264 END DO 265 ! +++++ 266 267 DO layer = 1, nlay_i 268 DO ji = kideb, kiut 269 radab(ji,layer) = zradab_i(ji,layer) 270 END DO 257 !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 258 ftr_ice_1d(ji) = zradtr_i(ji,nlay_i) 271 259 END DO 272 260 … … 279 267 ztsuold (ji) = t_su_b(ji) ! temperature at the beg of iter pr. 280 268 ztsuoldit(ji) = t_su_b(ji) ! temperature at the previous iter 281 t_su_b (ji) = MIN( t_su_b(ji), ztfs(ji)-0.00001 ) ! necessary 269 t_su_b (ji) = MIN( t_su_b(ji), ztfs(ji) - ztsu_err ) ! necessary 270 !!ztsuold (ji) = t_su_b(ji) ! temperature at the beg of iter pr. 271 !!ztsuoldit(ji) = t_su_b(ji) ! temperature at the previous iter 282 272 zerrit (ji) = 1000._wp ! initial value of error 283 273 END DO … … 328 318 DO layer = 1, nlay_i-1 329 319 DO ji = kideb , kiut 330 ztcond_i(ji,layer) = rcdic + 0.090_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) & 331 & / MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt) & 332 & - 0.0055_wp* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt ) 320 ztemp = t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2._wp * rtt 321 ztcond_i(ji,layer) = rcdic + 0.0900_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) & 322 & / MIN( -2.0_wp * epsi10, ztemp ) & 323 & - 0.0055_wp * ztemp 333 324 ztcond_i(ji,layer) = MAX( ztcond_i(ji,layer), zkimin ) 334 325 END DO 335 326 END DO 336 327 DO ji = kideb , kiut 337 ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN(-epsi10,t_bo_b(ji)-rtt) & 338 & - 0.011_wp * ( t_bo_b(ji) - rtt ) 328 ztemp = t_bo_b(ji) - rtt 329 ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN( -epsi10, ztemp ) & 330 & - 0.011_wp * ztemp 339 331 ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin ) 340 332 END DO … … 405 397 406 398 ! update of the non solar flux according to the update in T_su 407 qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * & 408 ( t_su_b(ji) - ztsuoldit(ji) ) 399 qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 409 400 410 401 ! update incoming flux 411 402 zf(ji) = zfsw(ji) & ! net absorbed solar radiation 412 + qns r_ice_1d(ji)! non solar total flux403 + qns_ice_1d(ji) ! non solar total flux 413 404 ! (LWup, LWdw, SH, LH) 414 405 406 ! heat flux used to change surface temperature 407 !hfx_tot_1d(ji) = hfx_tot_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) * a_i_b(ji) 415 408 END DO 416 409 … … 713 706 !-------------------------------------------------------------------------! 714 707 DO ji = kideb, kiut 715 #if ! defined key_coupled716 708 ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux) 717 qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 718 #endif 709 IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 719 710 ! ! surface ice conduction flux 720 711 isnow(ji) = NINT( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) ) ) … … 725 716 END DO 726 717 727 !-------------------------! 728 ! Heat conservation ! 729 !-------------------------! 730 IF( con_i .AND. jiindex_1d > 0 ) THEN 731 DO ji = kideb, kiut 732 ! Upper snow value 733 fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) ) 734 ! Bott. snow value 735 fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) ) 736 END DO 737 DO ji = kideb, kiut ! Upper ice layer 738 fc_i(ji,0) = - REAL( isnow(ji) ) * & ! interface flux if there is snow 739 ( zkappa_i(ji,0) * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 740 - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * & 741 zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 742 END DO 743 DO layer = 1, nlay_i - 1 ! Internal ice layers 744 DO ji = kideb, kiut 745 fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - t_i_b(ji,layer) ) 746 ii = MOD( npb(ji) - 1, jpi ) + 1 747 ij = ( npb(ji) - 1 ) / jpi + 1 748 END DO 749 END DO 750 DO ji = kideb, kiut ! Bottom ice layers 751 fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 752 END DO 753 ENDIF 718 !----------------------------------------- 719 ! Heat flux used to warm/cool ice in W.m-2 720 !----------------------------------------- 721 DO ji = kideb, kiut 722 IF( t_su_b(ji) < rtt ) THEN ! case T_su < 0degC 723 hfx_tot_1d(ji) = hfx_tot_1d(ji) + ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 724 ELSE ! case T_su = 0degC 725 hfx_tot_1d(ji) = hfx_tot_1d(ji) + ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 726 ENDIF 727 END DO 728 754 729 ! 755 730 END SUBROUTINE lim_thd_dif -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r4332 r4634 10 10 !! ! 2006-11 (X. Fettweis) Vectorized 11 11 !! 3.0 ! 2008-03 (M. Vancoppenolle) Energy conservation and clean code 12 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 12 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 13 !! - ! 2014-05 (C. Rousset) complete rewriting 13 14 !!---------------------------------------------------------------------- 14 15 #if defined key_lim3 … … 22 23 USE domain ! 23 24 USE phycst ! physical constants 25 USE sbc_oce ! Surface boundary condition: ocean fields 24 26 USE ice ! LIM variables 25 27 USE par_ice ! LIM parameters … … 36 38 PUBLIC lim_thd_ent ! called by lim_thd 37 39 38 REAL(wp) :: epsi20 = 1.e-20_wp ! constant values 39 REAL(wp) :: epsi10 = 1.e-10_wp ! 40 REAL(wp) :: zzero = 0._wp ! 41 REAL(wp) :: zone = 1._wp ! 40 REAL(wp) :: epsi20 = 1.e-20 ! constant values 41 REAL(wp) :: epsi10 = 1.e-10 ! constant values 42 42 43 43 !!---------------------------------------------------------------------- … … 53 53 !! 54 54 !! ** Purpose : 55 !! This routine computes new vertical grids 56 !! in the ice and in the snow, and consistently redistributes 57 !! temperatures in the snow / ice. 55 !! This routine computes new vertical grids in the ice, 56 !! and consistently redistributes temperatures. 58 57 !! Redistribution is made so as to ensure to energy conservation 59 58 !! … … 61 60 !! ** Method : linear conservative remapping 62 61 !! 63 !! ** Steps : 1) Grid 64 !! 2) Switches 65 !! 3) Snow redistribution 66 !! 4) Ice enthalpy redistribution 67 !! 5) Ice salinity, recover temperature 62 !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses 63 !! 2) linear remapping on the new layers 64 !! 3) Ice salinity update + recover temperature from enthalpies 68 65 !! 69 66 !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 … … 72 69 INTEGER , INTENT(in) :: jl ! Thickness cateogry number 73 70 74 INTEGER :: ji,jk ! dummy loop indices 75 INTEGER :: ii, ij , & ! dummy indices 76 ntop0 , & ! old layer top index 77 nbot1 , & ! new layer bottom index 78 ntop1 , & ! new layer top index 79 limsum , & ! temporary loop index 80 nlayi0,nlays0 , & ! old number of layers 81 maxnbot0 , & ! old layer bottom index 82 layer0, layer1 ! old/new layer indexes 83 84 85 REAL(wp) :: & 86 ztmelts , & ! ice melting point 87 zqsnic , & ! enthalpy of snow ice layer 88 zhsnow , & ! temporary snow thickness variable 89 zswitch , & ! dummy switch argument 90 zfac1 , & ! dummy factor 91 zfac2 , & ! dummy factor 92 ztform , & !: bottom formation temperature 93 zaaa , & !: dummy factor 94 zbbb , & !: dummy factor 95 zccc , & !: dummy factor 96 zdiscrim !: dummy factor 97 98 INTEGER, POINTER, DIMENSION(:) :: snswi ! snow switch 99 INTEGER, POINTER, DIMENSION(:) :: nbot0 ! old layer bottom index 100 INTEGER, POINTER, DIMENSION(:) :: icsuind ! ice surface index 101 INTEGER, POINTER, DIMENSION(:) :: icsuswi ! ice surface switch 102 INTEGER, POINTER, DIMENSION(:) :: icboind ! ice bottom index 103 INTEGER, POINTER, DIMENSION(:) :: icboswi ! ice bottom switch 104 INTEGER, POINTER, DIMENSION(:) :: snicind ! snow ice index 105 INTEGER, POINTER, DIMENSION(:) :: snicswi ! snow ice switch 106 INTEGER, POINTER, DIMENSION(:) :: snind ! snow index 71 INTEGER :: ji,ii,ij ! dummy loop indices 72 INTEGER :: jk0, jk1 ! old/new layer indices 73 REAL(wp) :: ztmelts ! temperature of melting 74 REAL(wp) :: zswitch, zaaa, zbbb, zccc, zdiscrim ! converting enthalpy to temperature 107 75 ! 108 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! thickness of an ice layer 109 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! thickness of a snow layer 110 REAL(wp), POINTER, DIMENSION(:) :: zqsnow ! enthalpy of the snow put in snow ice 111 REAL(wp), POINTER, DIMENSION(:) :: zdeltah ! temporary variable 112 REAL(wp), POINTER, DIMENSION(:) :: zqti_in, zqts_in 113 REAL(wp), POINTER, DIMENSION(:) :: zqti_fin, zqts_fin 114 115 REAL(wp), POINTER, DIMENSION(:,:) :: zm0 ! old layer-system vertical cotes 116 REAL(wp), POINTER, DIMENSION(:,:) :: qm0 ! old layer-system heat content 117 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! new snow system vertical cotes 118 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! new ice system vertical cotes 119 REAL(wp), POINTER, DIMENSION(:,:) :: zthick0 ! old ice thickness 120 REAL(wp), POINTER, DIMENSION(:,:) :: zhl0 ! old and new layer thicknesses 121 REAL(wp), POINTER, DIMENSION(:,:) :: zrl01 122 123 REAL(wp) :: zinda 76 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces 77 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces 124 78 !!------------------------------------------------------------------- 125 79 126 CALL wrk_alloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind ) ! integer 127 CALL wrk_alloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin ) ! real 128 CALL wrk_alloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 129 CALL wrk_alloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 80 CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 81 CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 130 82 131 zthick0(:,:) = 0._wp 132 zm0 (:,:) = 0._wp 133 qm0 (:,:) = 0._wp 134 zrl01 (:,:) = 0._wp 135 zhl0 (:,:) = 0._wp 136 z_i (:,:) = 0._wp 137 z_s (:,:) = 0._wp 138 139 ! 140 !------------------------------------------------------------------------------| 141 ! 1) Grid | 142 !------------------------------------------------------------------------------| 143 nlays0 = nlay_s 144 nlayi0 = nlay_i 145 146 DO ji = kideb, kiut 147 zh_i(ji) = old_ht_i_b(ji) / REAL( nlay_i ) 148 zh_s(ji) = old_ht_s_b(ji) / REAL( nlay_s ) 149 END DO 150 151 ! 152 !------------------------------------------------------------------------------| 153 ! 2) Switches | 154 !------------------------------------------------------------------------------| 155 ! 2.1 snind(ji), snswi(ji) 156 ! snow surface behaviour : computation of snind(ji)-snswi(ji) 157 ! snind(ji) : index which equals 158 ! 0 if snow is accumulating 159 ! 1 if 1st layer is melting 160 ! 2 if 2nd layer is melting ... 161 DO ji = kideb, kiut 162 snind (ji) = 0 163 zdeltah(ji) = 0._wp 164 ENDDO !ji 165 166 DO jk = 1, nlays0 83 !-------------------------------------------------------------------------- 84 ! 1) Cumulative integral of old enthalpy * thicnkess and layers interfaces 85 !-------------------------------------------------------------------------- 86 zqh_cum0(:,0:nlay_i+2) = 0._wp 87 zh_cum0 (:,0:nlay_i+2) = 0._wp 88 DO jk0 = 1, nlay_i+2 167 89 DO ji = kideb, kiut 168 snind(ji) = jk * NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)))) & 169 + snind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji))))) 170 zdeltah(ji)= zdeltah(ji) + zh_s(ji) 171 END DO ! ji 172 END DO ! jk 173 174 ! snswi(ji) : switch which value equals 1 if snow melts 175 ! 0 if not 176 DO ji = kideb, kiut 177 snswi(ji) = MAX(0,NINT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 178 END DO ! ji 179 180 ! 2.2 icsuind(ji), icsuswi(ji) 181 ! ice surface behaviour : computation of icsuind(ji)-icsuswi(ji) 182 ! icsuind(ji) : index which equals 183 ! 0 if nothing happens at the surface 184 ! 1 if first layer is melting 185 ! 2 if 2nd layer is reached by melt ... 186 DO ji = kideb, kiut 187 icsuind(ji) = 0 188 zdeltah(ji) = 0._wp 189 END DO !ji 190 DO jk = 1, nlayi0 191 DO ji = kideb, kiut 192 icsuind(ji) = jk * NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)))) & 193 + icsuind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji))))) 194 zdeltah(ji) = zdeltah(ji) + zh_i(ji) 195 END DO ! ji 196 ENDDO !jk 197 198 ! icsuswi(ji) : switch which equals 199 ! 1 if ice melts at the surface 200 ! 0 if not 201 DO ji = kideb, kiut 202 icsuswi(ji) = MAX(0,NINT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 90 zqh_cum0(ji,jk0) = zqh_cum0(ji,jk0-1) + qh_i_old(ji,jk0-1) 91 zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + h_i_old (ji,jk0-1) 92 ENDDO 203 93 ENDDO 204 94 205 ! 2.3 icboind(ji), icboswi(ji) 206 ! ice bottom behaviour : computation of icboind(ji)-icboswi(ji) 207 ! icboind(ji) : index which equals 208 ! 0 if accretion is on the way 209 ! 1 if last layer has started to melt 210 ! 2 if penultiem layer is melting ... and so on 211 ! N+1 if all layers melt and that snow transforms into ice 212 DO ji = kideb, kiut 213 icboind(ji) = 0 214 zdeltah(ji) = 0._wp 215 END DO 216 DO jk = nlayi0, 1, -1 95 !------------------------------------ 96 ! 2) Interpolation on the new layers 97 !------------------------------------ 98 ! new layers interfaces 99 zh_cum1(:,0:nlay_i) = 0._wp 100 DO jk1 = 1, nlay_i 217 101 DO ji = kideb, kiut 218 icboind(ji) = (nlayi0+1-jk) * NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)))) & 219 & + icboind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji))))) 220 zdeltah(ji) = zdeltah(ji) + zh_i(ji) 221 END DO 222 END DO 223 224 DO ji = kideb, kiut 225 ! case of total ablation with remaining snow 226 IF ( ( ht_i_b(ji) .GT. epsi20 ) .AND. & 227 ( ht_i_b(ji) - dh_snowice(ji) .LT. epsi20 ) ) icboind(ji) = nlay_i + 1 228 END DO 229 230 ! icboswi(ji) : switch which equals 231 ! 1 if ice accretion is on the way 232 ! 0 if ablation is on the way 233 DO ji = kideb, kiut 234 icboswi(ji) = MAX(0,NINT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 235 END DO 236 237 ! 2.4 snicind(ji), snicswi(ji) 238 ! snow ice formation : calcul de snicind(ji)-snicswi(ji) 239 ! snicind(ji) : index which equals 240 ! 0 if no snow-ice forms 241 ! 1 if last layer of snow has started to melt 242 ! 2 if penultiem layer ... 243 DO ji = kideb, kiut 244 snicind(ji) = 0 245 zdeltah(ji) = 0._wp 246 END DO 247 DO jk = nlays0, 1, -1 248 DO ji = kideb, kiut 249 snicind(ji) = (nlays0+1-jk) & 250 * NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)))) + snicind(ji) & 251 * (1 - NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji))))) 252 zdeltah(ji) = zdeltah(ji) + zh_s(ji) 253 END DO 254 END DO 255 256 ! snicswi(ji) : switch which equals 257 ! 1 if snow-ice forms 258 ! 0 if not 259 DO ji = kideb, kiut 260 snicswi(ji) = MAX(0,NINT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 102 zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + ht_i_b(ji) / REAL( nlay_i ) 103 ENDDO 261 104 ENDDO 262 105 263 ! 264 !------------------------------------------------------------------------------| 265 ! 3) Snow redistribution | 266 !------------------------------------------------------------------------------| 267 ! 268 !------------- 269 ! Old profile 270 !------------- 106 zqh_cum1(:,0:nlay_i) = 0._wp 107 ! new cumulative q*h => linear interpolation 108 DO jk0 = 1, nlay_i+1 109 DO jk1 = 1, nlay_i-1 110 DO ji = kideb, kiut 111 IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN 112 zqh_cum1(ji,jk1) = ( zqh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1 ) ) + & 113 & zqh_cum0(ji,jk0 ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) ) & 114 & / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) ) 115 ENDIF 116 ENDDO 117 ENDDO 118 ENDDO 119 ! to ensure that total heat content is strictly conserved, set: 120 zqh_cum1(:,nlay_i) = zqh_cum0(:,nlay_i+2) 271 121 272 ! by 'old', it is meant that layers coming from accretion are included, 273 ! and that interfacial layers which were partly melted are reduced 274 275 ! indexes of the vectors 276 !------------------------ 277 ntop0 = 1 278 maxnbot0 = 0 279 280 DO ji = kideb, kiut 281 nbot0(ji) = nlays0 + 1 - snind(ji) + ( 1 - snicind(ji) ) * snicswi(ji) 282 ! cotes of the top of the layers 283 zm0(ji,0) = 0._wp 284 maxnbot0 = MAX ( maxnbot0 , nbot0(ji) ) 285 END DO 286 IF( lk_mpp ) CALL mpp_max( maxnbot0, kcom=ncomm_ice ) 287 288 DO jk = 1, maxnbot0 122 ! new enthalpies 123 DO jk1 = 1, nlay_i 289 124 DO ji = kideb, kiut 290 !change 291 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 292 limsum = MIN( limsum , nlay_s ) 293 zm0(ji,jk) = dh_s_tot(ji) + zh_s(ji) * REAL( limsum ) 294 END DO 295 END DO 296 297 DO ji = kideb, kiut 298 zm0(ji,nbot0(ji)) = dh_s_tot(ji) - REAL( snicswi(ji) ) * dh_snowice(ji) + zh_s(ji) * REAL( nlays0 ) 299 zm0(ji,1) = dh_s_tot(ji) * REAL( 1 - snswi(ji) ) + REAL( snswi(ji) ) * zm0(ji,1) 300 END DO 301 302 DO jk = ntop0, maxnbot0 303 DO ji = kideb, kiut 304 zthick0(ji,jk) = zm0(ji,jk) - zm0(ji,jk-1) ! layer thickness 305 END DO 306 END DO 307 308 zqts_in(:) = 0._wp 309 310 DO ji = kideb, kiut ! layer heat content 311 qm0 (ji,1) = rhosn * ( cpic * ( rtt - REAL( 1 - snswi(ji) ) * tatm_ice_1d(ji) & 312 & - REAL( snswi(ji) ) * t_s_b (ji,1) ) & 313 & + lfus ) * zthick0(ji,1) 314 zqts_in(ji) = zqts_in(ji) + qm0(ji,1) 315 END DO 316 317 DO jk = 2, maxnbot0 318 DO ji = kideb, kiut 319 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 320 limsum = MIN( limsum , nlay_s ) 321 qm0(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus ) * zthick0(ji,jk) 322 zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, - ht_s_b(ji) ) ) 323 zqts_in(ji) = zqts_in(ji) + REAL( 1 - snswi(ji) ) * qm0(ji,jk) * zswitch 324 END DO ! jk 325 END DO ! ji 326 327 !------------------------------------------------ 328 ! Energy given by the snow in snow-ice formation 329 !------------------------------------------------ 330 ! zqsnow, enthalpy of the flooded snow 331 DO ji = kideb, kiut 332 zqsnow (ji) = rhosn * lfus 333 zdeltah(ji) = 0._wp 334 END DO 335 336 DO jk = nlays0, 1, -1 337 DO ji = kideb, kiut 338 zhsnow = MAX( 0._wp , dh_snowice(ji)-zdeltah(ji) ) 339 zqsnow (ji) = zqsnow (ji) + rhosn*cpic*(rtt-t_s_b(ji,jk)) 340 zdeltah(ji) = zdeltah(ji) + zh_s(ji) 341 END DO 342 END DO 343 344 DO ji = kideb, kiut 345 zqsnow(ji) = zqsnow(ji) * dh_snowice(ji) 346 END DO 347 348 !------------------ 349 ! new snow profile 350 !------------------ 351 352 !-------------- 353 ! Vector index 354 !-------------- 355 ntop1 = 1 356 nbot1 = nlay_s 357 358 !------------------- 359 ! Layer coordinates 360 !------------------- 361 DO ji = kideb, kiut 362 zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 363 z_s(ji,0) = 0._wp 125 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + epsi20 ) ) 126 q_i_b(ji,jk1) = zswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) * REAL( nlay_i ) / MAX( ht_i_b(ji), epsi20 ) 127 ENDDO 364 128 ENDDO 365 129 366 DO jk = 1, nlay_s 367 DO ji = kideb, kiut 368 z_s(ji,jk) = zh_s(ji) * REAL( jk ) 369 END DO 370 END DO 371 372 !----------------- 373 ! Layer thickness 374 !----------------- 375 DO layer0 = ntop0, maxnbot0 376 DO ji = kideb, kiut 377 zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) 378 END DO 379 END DO 380 381 DO layer1 = ntop1, nbot1 382 DO ji = kideb, kiut 383 q_s_b(ji,layer1) = 0._wp 384 END DO 385 END DO 386 387 !---------------- 388 ! Weight factors 389 !---------------- 390 DO layer0 = ntop0, maxnbot0 391 DO layer1 = ntop1, nbot1 392 DO ji = kideb, kiut 393 zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 394 zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1)) & 395 & - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1))) / MAX(zhl0(ji,layer0),epsi10)) 396 q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0) & 397 & * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 398 END DO 399 END DO 400 END DO 401 402 ! Heat conservation 403 zqts_fin(:) = 0._wp 404 DO jk = 1, nlay_s 405 DO ji = kideb, kiut 406 zqts_fin(ji) = zqts_fin(ji) + q_s_b(ji,jk) 407 END DO 408 END DO 409 410 IF ( con_i .AND. jiindex_1d > 0 ) THEN 411 DO ji = kideb, kiut 412 IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice > 1.0e-6 ) THEN 413 ii = MOD( npb(ji) - 1, jpi ) + 1 414 ij = ( npb(ji) - 1 ) / jpi + 1 415 WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice 416 WRITE(numout,*) ' ji, jj : ', ii, ij 417 WRITE(numout,*) ' ht_s_b : ', ht_s_b(ji) 418 WRITE(numout,*) ' zqts_in : ', zqts_in (ji) * r1_rdtice 419 WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) * r1_rdtice 420 WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) 421 WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 422 WRITE(numout,*) ' snswi : ', snswi(ji) 423 ENDIF 424 END DO 425 ENDIF 426 427 !--------------------- 428 ! Recover heat content 429 !--------------------- 430 DO jk = 1, nlay_s 431 DO ji = kideb, kiut 432 zinda = MAX( 0._wp, SIGN( 1._wp , zh_s(ji) - epsi10 ) ) 433 q_s_b(ji,jk) = zinda * q_s_b(ji,jk) / MAX( zh_s(ji) , epsi10 ) 434 END DO !ji 435 END DO !jk 436 437 !--------------------- 438 ! Recover temperature 439 !--------------------- 440 zfac1 = 1. / ( rhosn * cpic ) 441 zfac2 = lfus / cpic 442 DO jk = 1, nlay_s 443 DO ji = kideb, kiut 444 zswitch = MAX ( 0.0 , SIGN ( 1.0, - ht_s_b(ji) ) ) 445 t_s_b(ji,jk) = rtt + ( 1.0 - zswitch ) * ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 446 END DO 447 END DO 448 ! 449 !------------------------------------------------------------------------------| 450 ! 4) Ice redistribution | 451 !------------------------------------------------------------------------------| 452 ! 453 !------------- 454 ! OLD PROFILE 455 !------------- 456 457 !---------------- 458 ! Vector indexes 459 !---------------- 460 ntop0 = 1 461 maxnbot0 = 0 462 463 DO ji = kideb, kiut 464 ! reference number of the bottommost layer 465 nbot0(ji) = MAX( 1 , MIN( nlayi0 + ( 1 - icboind(ji) ) + & 466 & ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) , nlay_i + 2 ) ) 467 ! maximum reference number of the bottommost layer over all domain 468 maxnbot0 = MAX( maxnbot0 , nbot0(ji) ) 469 END DO 470 471 !------------------------- 472 ! Cotes of old ice layers 473 !------------------------- 474 zm0(:,0) = 0._wp 475 476 DO jk = 1, maxnbot0 477 DO ji = kideb, kiut 478 ! jk goes from 1 to nbot0 479 ! the ice layer number goes from 1 to nlay_i 480 ! limsum is the real ice layer number corresponding to present jk 481 limsum = ( (icsuswi(ji)*(icsuind(ji)+jk-1) + & 482 (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji) 483 zm0(ji,jk)= REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) & 484 + REAL(limsum) * zh_i(ji) 485 END DO 486 END DO 487 488 DO ji = kideb, kiut 489 zm0(ji,nbot0(ji)) = REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) + dh_i_bott(ji) & 490 + zh_i(ji) * REAL(nlayi0) 491 zm0(ji,1) = REAL(snicswi(ji))*dh_snowice(ji) + REAL(1-snicswi(ji))*zm0(ji,1) 492 END DO 493 494 !----------------------------- 495 ! Thickness of old ice layers 496 !----------------------------- 497 DO jk = ntop0, maxnbot0 498 DO ji = kideb, kiut 499 zthick0(ji,jk) = zm0(ji,jk) - zm0(ji,jk-1) 500 END DO 501 END DO 502 503 !--------------------------- 504 ! Inner layers heat content 505 !--------------------------- 506 qm0(:,:) = 0.0 507 zqti_in(:) = 0.0 508 509 DO jk = ntop0, maxnbot0 510 DO ji = kideb, kiut 511 limsum = MAX(1,MIN(snicswi(ji)*(jk-1) + icsuswi(ji)*(jk-1+icsuind(ji)) + & 512 (1-icsuswi(ji))*(1-snicswi(ji))*jk,nlay_i)) 513 ztmelts = -tmut * s_i_b(ji,limsum) + rtt 514 qm0(ji,jk) = rhoic * ( cpic * (ztmelts-t_i_b(ji,limsum)) + lfus * ( 1.0-(ztmelts-rtt)/ & 515 MIN((t_i_b(ji,limsum)-rtt),-epsi20) ) - rcp*(ztmelts-rtt) ) & 516 * zthick0(ji,jk) 517 END DO 518 END DO 519 520 !---------------------------- 521 ! Bottom layers heat content 522 !---------------------------- 523 DO ji = kideb, kiut 524 ztmelts = REAL( 1 - icboswi(ji) ) * (-tmut * s_i_b (ji,nlayi0) ) & ! case of melting ice 525 & + REAL( icboswi(ji) ) * (-tmut * s_i_new(ji) ) & ! case of forming ice 526 & + rtt ! in Kelvin 527 528 ! bottom formation temperature 529 ztform = t_i_b(ji,nlay_i) 530 IF( num_sal == 2 ) ztform = t_bo_b(ji) 531 qm0(ji,nbot0(ji)) = REAL( 1 - icboswi(ji) )*qm0(ji,nbot0(ji)) & ! case of melting ice 532 & + REAL( icboswi(ji) ) * rhoic * ( cpic*(ztmelts-ztform) & ! case of forming ice 533 + lfus *( 1.0-(ztmelts-rtt) / MIN ( (ztform-rtt) , - epsi10 ) ) & 534 - rcp*(ztmelts-rtt) ) * zthick0(ji,nbot0(ji) ) 535 END DO 536 537 !----------------------------- 538 ! Snow ice layer heat content 539 !----------------------------- 540 DO ji = kideb, kiut 541 ! energy of the flooding seawater 542 zqsnic = rau0 * rcp * ( rtt - t_bo_b(ji) ) * dh_snowice(ji) * & 543 (rhoic - rhosn) / rhoic * REAL(snicswi(ji)) ! generally positive 544 ! Heat conservation diagnostic 545 qt_i_in(ji,jl) = qt_i_in(ji,jl) + zqsnic 546 547 qldif_1d(ji) = qldif_1d(ji) + zqsnic * a_i_b(ji) 548 549 ! enthalpy of the newly formed snow-ice layer 550 ! = enthalpy of snow + enthalpy of frozen water 551 zqsnic = zqsnow(ji) + zqsnic 552 qm0(ji,1) = REAL(snicswi(ji)) * zqsnic + REAL( 1 - snicswi(ji) ) * qm0(ji,1) 553 554 END DO ! ji 555 556 DO jk = ntop0, maxnbot0 557 DO ji = kideb, kiut 558 ! Heat conservation 559 zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi10) ) & 560 & * MAX( 0.0 , SIGN( 1. , REAL(nbot0(ji) - jk) ) ) 561 END DO 562 END DO 563 564 !------------- 565 ! NEW PROFILE 566 !------------- 567 568 !--------------- 569 ! Vectors index 570 !--------------- 571 ntop1 = 1 572 nbot1 = nlay_i 573 574 !------------------ 575 ! Layers thickness 576 !------------------ 577 DO ji = kideb, kiut 578 zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 579 ENDDO 580 581 !------------- 582 ! Layer cotes 583 !------------- 584 z_i(:,0) = 0._wp 585 DO jk = 1, nlay_i 586 DO ji = kideb, kiut 587 z_i(ji,jk) = zh_i(ji) * jk 588 END DO 589 END DO 590 591 !--thicknesses of the layers 592 DO layer0 = ntop0, maxnbot0 593 DO ji = kideb, kiut 594 zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) ! thicknesses of the layers 595 END DO 596 END DO 597 598 !------------------------ 599 ! Weights for relayering 600 !------------------------ 601 q_i_b(:,:) = 0._wp 602 DO layer0 = ntop0, maxnbot0 603 DO layer1 = ntop1, nbot1 604 DO ji = kideb, kiut 605 zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 606 zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_i(ji,layer1)) & 607 - MAX(zm0(ji,layer0-1), z_i(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10)) 608 q_i_b(ji,layer1) = q_i_b(ji,layer1) & 609 + zrl01(layer1,layer0)*qm0(ji,layer0) & 610 * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi10)) & 611 * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 612 END DO 613 END DO 614 END DO 615 616 !------------------------- 617 ! Heat conservation check 618 !------------------------- 619 zqti_fin(:) = 0._wp 620 DO jk = 1, nlay_i 621 DO ji = kideb, kiut 622 zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) 623 END DO 624 END DO 625 ! 626 IF ( con_i .AND. jiindex_1d > 0 ) THEN 627 DO ji = kideb, kiut 628 IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice > 1.0e-6 ) THEN 629 ii = MOD( npb(ji) - 1, jpi ) + 1 630 ij = ( npb(ji) - 1 ) / jpi + 1 631 WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice 632 WRITE(numout,*) ' ji, jj : ', ii, ij 633 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 634 WRITE(numout,*) ' zqti_in : ', zqti_in (ji) * r1_rdtice 635 WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) * r1_rdtice 636 WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji) 637 WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji) 638 WRITE(numout,*) ' dh_snowice:', dh_snowice(ji) 639 WRITE(numout,*) ' icsuswi : ', icsuswi(ji) 640 WRITE(numout,*) ' icboswi : ', icboswi(ji) 641 WRITE(numout,*) ' snicswi : ', snicswi(ji) 642 ENDIF 643 END DO 644 ENDIF 645 646 !---------------------- 647 ! Recover heat content 648 !---------------------- 649 DO jk = 1, nlay_i 650 DO ji = kideb, kiut 651 zinda = MAX( 0._wp, SIGN( 1._wp , zh_i(ji) - epsi10 ) ) 652 q_i_b(ji,jk) = zinda * q_i_b(ji,jk) / MAX( zh_i(ji) , epsi10 ) 653 END DO !ji 654 END DO !jk 655 656 ! Heat conservation 657 zqti_fin(:) = 0.0 658 DO jk = 1, nlay_i 659 DO ji = kideb, kiut 660 zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) * zh_i(ji) 661 END DO 662 END DO 663 664 ! 665 !------------------------------------------------------------------------------| 666 ! 5) Update salinity and recover temperature | 667 !------------------------------------------------------------------------------| 668 ! 130 !--------------------------------------------------------- 131 ! 3) Update ice salinity and recover ice temperature 132 !--------------------------------------------------------- 669 133 ! Update salinity (basal entrapment, snow ice formation) 670 134 DO ji = kideb, kiut … … 672 136 END DO !ji 673 137 674 ! Recover temperature675 DO jk = 1, nlay_i138 ! Recover ice temperature 139 DO jk1 = 1, nlay_i 676 140 DO ji = kideb, kiut 677 ztmelts = -tmut*s_i_b(ji,jk) + rtt 678 !Conversion q(S,T) -> T (second order equation) 679 zaaa = cpic 680 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 681 zccc = lfus * ( ztmelts - rtt ) 682 zdiscrim = SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 683 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 684 END DO !ji 141 ztmelts = -tmut * s_i_b(ji,jk1) + rtt 142 ! Conversion q(S,T) -> T (second order equation) 143 zaaa = cpic 144 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk1) / rhoic - lfus 145 zccc = lfus * ( ztmelts - rtt ) 146 zdiscrim = SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 147 t_i_b(ji,jk1) = rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 148 149 ! mask temperature 150 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_b(ji) ) ) 151 t_i_b(ji,jk1) = zswitch * t_i_b(ji,jk1) + ( 1._wp - zswitch ) * rtt 152 END DO 153 END DO 685 154 686 END DO !jk687 155 ! 688 CALL wrk_dealloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind ) ! integer 689 CALL wrk_dealloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin ) ! real 690 CALL wrk_dealloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 691 CALL wrk_dealloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 156 CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 157 CALL wrk_dealloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 692 158 ! 693 159 END SUBROUTINE lim_thd_ent -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r4332 r4634 37 37 38 38 REAL(wp) :: epsi10 = 1.e-10_wp ! 39 REAL(wp) :: zzero = 0._wp ! 40 REAL(wp) :: zone = 1._wp ! 39 REAL(wp) :: epsi20 = 1.e-20_wp ! 41 40 42 41 !!---------------------------------------------------------------------- … … 76 75 INTEGER :: layer, nbpac ! local integers 77 76 INTEGER :: ii, ij, iter ! - - 78 REAL(wp) :: ztmelts, zdv, z qold, zfrazb, zweight, zalphai, zindb, zinda, zde ! local scalars77 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zindb, zinda, zde ! local scalars 79 78 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new ! - - 80 79 REAL(wp) :: ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit ! - - 81 80 LOGICAL :: iterate_frazil ! iterate frazil ice collection thickness 82 81 CHARACTER (len = 15) :: fieldid 83 ! 82 83 REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 84 REAL(wp) :: zEi ! sea ice specific enthalpy (J/kg) 85 REAL(wp) :: zEw ! seawater specific enthalpy (J/kg) 86 REAL(wp) :: zfmdt ! mass flux x time step (kg/m2, >0 towards ocean) 87 84 88 INTEGER , POINTER, DIMENSION(:) :: zcatac ! indexes of categories where new ice grows 85 89 REAL(wp), POINTER, DIMENSION(:) :: zswinew ! switch for new ice or not … … 95 99 REAL(wp), POINTER, DIMENSION(:) :: zat_i_ac ! total ice fraction 96 100 REAL(wp), POINTER, DIMENSION(:) :: zat_i_lev ! total ice fraction for level ice only (type 1) 97 REAL(wp), POINTER, DIMENSION(:) :: z dh_frazb ! accretion of frazil ice at the ice bottom101 REAL(wp), POINTER, DIMENSION(:) :: zv_frazb ! accretion of frazil ice at the ice bottom 98 102 REAL(wp), POINTER, DIMENSION(:) :: zvrel_ac ! relative ice / frazil velocity (1D vector) 99 103 100 REAL(wp), POINTER, DIMENSION(:,:) :: zhice_old ! previous ice thickness101 REAL(wp), POINTER, DIMENSION(:,:) :: zdummy ! dummy thickness of new ice102 REAL(wp), POINTER, DIMENSION(:,:) :: zdhicbot ! thickness of new ice which is accreted vertically103 104 REAL(wp), POINTER, DIMENSION(:,:) :: zv_old ! old volume of ice in category jl 104 105 REAL(wp), POINTER, DIMENSION(:,:) :: za_old ! old area of ice in category jl … … 110 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_ac !: 1-D version of e_i 111 112 112 REAL(wp), POINTER, DIMENSION(:) :: zqbgow ! heat budget of the open water (negative)113 REAL(wp), POINTER, DIMENSION(:) :: zdhex ! excessively thick accreted sea ice (hlead-hice)114 115 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqm0 ! old layer-system heat content 116 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zthick0 ! old ice thickness … … 125 123 CALL wrk_alloc( jpij, zcatac ) ! integer 126 124 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 127 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, z dh_frazb, zvrel_ac, zqbgow, zdhex)128 CALL wrk_alloc( jpij,jpl, z hice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac )125 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zv_frazb, zvrel_ac ) 126 CALL wrk_alloc( jpij,jpl, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 129 127 CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac ) 130 128 CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) … … 154 152 DO ji = 1, jpi 155 153 !Energy of melting q(S,T) [J.m-3] 156 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) , epsi10 ) * REAL( nlay_i )157 154 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 158 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 155 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 156 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 159 157 END DO 160 158 END DO … … 196 194 DO ji = 1, jpi 197 195 198 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0) THEN196 IF ( qlead(ji,jj) < 0._wp ) THEN 199 197 !------------- 200 198 ! Wind stress … … 278 276 DO jj = 1, jpj 279 277 DO ji = 1, jpi 280 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) >0._wp ) THEN278 IF ( qlead(ji,jj) < 0._wp ) THEN 281 279 nbpac = nbpac + 1 282 280 npac( nbpac ) = (jj - 1) * jpi + ji … … 290 288 DO ji = mi0(jiindx), mi1(jiindx) 291 289 DO jj = mj0(jjindx), mj1(jjindx) 292 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) >0._wp ) THEN290 IF ( qlead(ji,jj) < 0._wp ) THEN 293 291 jiindex_1d = (jj - 1) * jpi + ji 294 292 ENDIF … … 318 316 END DO ! jl 319 317 320 CALL tab_2d_1d( nbpac, qldif_1d (1:nbpac) , qldif , jpi, jpj, npac(1:nbpac) ) 321 CALL tab_2d_1d( nbpac, qcmif_1d (1:nbpac) , qcmif , jpi, jpj, npac(1:nbpac) ) 318 CALL tab_2d_1d( nbpac, qlead_1d (1:nbpac) , qlead , jpi, jpj, npac(1:nbpac) ) 322 319 CALL tab_2d_1d( nbpac, t_bo_b (1:nbpac) , t_bo , jpi, jpj, npac(1:nbpac) ) 323 CALL tab_2d_1d( nbpac, sfx_thd_1d(1:nbpac) , sfx_thd, jpi, jpj, npac(1:nbpac) ) 324 CALL tab_2d_1d( nbpac, rdm_ice_1d(1:nbpac) , rdm_ice, jpi, jpj, npac(1:nbpac) ) 320 CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac) , sfx_opw, jpi, jpj, npac(1:nbpac) ) 321 CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac) , wfx_opw, jpi, jpj, npac(1:nbpac) ) 322 CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac) , wfx_opw, jpi, jpj, npac(1:nbpac) ) 325 323 CALL tab_2d_1d( nbpac, hicol_b (1:nbpac) , hicol , jpi, jpj, npac(1:nbpac) ) 326 324 CALL tab_2d_1d( nbpac, zvrel_ac (1:nbpac) , zvrel , jpi, jpj, npac(1:nbpac) ) 325 326 CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac) , hfx_thd, jpi, jpj, npac(1:nbpac) ) 327 CALL tab_2d_1d( nbpac, hfx_tot_1d(1:nbpac) , hfx_tot, jpi, jpj, npac(1:nbpac) ) 327 328 328 329 !------------------------------------------------------------------------------! 329 330 ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice 330 331 !------------------------------------------------------------------------------! 332 333 !----------------------------------------- 334 ! Keep old ice areas and volume in memory 335 !----------------------------------------- 336 zv_old(:,:) = zv_i_ac(:,:) 337 za_old(:,:) = za_i_ac(:,:) 331 338 332 339 !---------------------- … … 365 372 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) ) & 366 373 & - rcp * ( ztmelts - rtt ) ) 374 ! MV HC 2014 comment I dont see why this line below is here... ? 375 ! This implies that ze_newice gets to rhoic*Lfus if it was negative, but this should never happen 367 376 ze_newice(ji) = MAX( ze_newice(ji) , 0._wp ) & 368 377 & + MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) ) * rhoic * lfus … … 375 384 END DO ! ji 376 385 377 !--------------------------378 ! Open water energy budget379 !--------------------------380 DO ji = 1, nbpac381 zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji) !<0382 END DO ! ji383 384 386 !------------------- 385 387 ! Volume of new ice 386 388 !------------------- 387 389 DO ji = 1, nbpac 388 zv_newice(ji) = - zqbgow(ji) / ze_newice(ji) 390 391 zEi = - ze_newice(ji) / rhoic ! specific enthalpy of forming ice [J/kg] 392 393 zEw = rcp * ( t_bo_b(ji) - rt0 ) ! specific enthalpy of seawater at t_bo_b [J/kg] 394 ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 395 396 zdE = zEi - zEw ! specific enthalpy difference [J/kg] 397 398 zfmdt = - qlead_1d(ji) / zdE ! Fm.dt [kg/m2] (<0) 399 ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point 400 zv_newice(ji) = - zfmdt / rhoic 401 402 zQm = zfmdt * zEw ! heat to the ocean >0 associated with mass flux 403 404 ! Contribution to heat flux to the ocean [W.m-2], >0 405 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice 406 ! Total heat flux used in this process [W.m-2] 407 hfx_tot_1d(ji) = hfx_tot_1d(ji) - zfmdt * zdE * r1_rdtice 408 ! mass flux 409 wfx_opw_1d(ji) = wfx_opw_1d(ji) + zv_newice(ji) * rhoic * r1_rdtice 410 ! salt flux 411 sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 389 412 390 413 ! A fraction zfrazb of frazil ice is accreted at the ice bottom 391 414 zfrazb = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 392 z dh_frazb(ji)= zfrazb * zv_newice(ji)415 zv_frazb(ji) = zfrazb * zv_newice(ji) 393 416 zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 394 417 END DO … … 402 425 ! 403 426 zde = ze_newice(ji) / unit_fac * area(ii,ij) * zv_newice(ji) 427 !zde = ze_newice(ji) * area(ii,ij) * zv_newice(ji) 404 428 ! 429 ! clem: change that? 405 430 vt_i_init(ii,ij) = vt_i_init(ii,ij) + zv_newice(ji) ! volume 406 431 et_i_init(ii,ij) = et_i_init(ii,ij) + zde ! Energy 407 432 408 433 END DO 409 410 ! keep new ice volume in memory411 CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , jpi, jpj )412 434 413 435 !----------------- … … 415 437 !----------------- 416 438 DO ji = 1, nbpac 417 ii = MOD( npac(ji) - 1 , jpi ) + 1418 ij = ( npac(ji) - 1 ) / jpi + 1419 439 za_newice(ji) = zv_newice(ji) / zh_newice(ji) 420 diag_lat_gr(ii,ij) = diag_lat_gr(ii,ij) + zv_newice(ji) * r1_rdtice ! clem421 440 END DO !ji 422 441 … … 424 443 ! 6) Redistribute new ice area and volume into ice categories ! 425 444 !------------------------------------------------------------------------------! 426 427 !-----------------------------------------428 ! Keep old ice areas and volume in memory429 !-----------------------------------------430 zv_old(:,:) = zv_i_ac(:,:)431 za_old(:,:) = za_i_ac(:,:)432 445 433 446 !------------------------------------------- … … 458 471 za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 459 472 zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) 460 zat_i_ac(ji) = zat_i_ac(ji) + za_i_ac (ji,jl)461 473 zcatac (ji) = jl 462 474 ENDIF 475 zat_i_ac(ji) = zat_i_ac(ji) + za_i_ac (ji,jl) 463 476 END DO 464 477 END DO … … 469 482 DO ji = 1, nbpac 470 483 jl = zcatac(ji) ! categroy in which new ice is put 471 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) + epsi10 ) ) ! zindb=1 if ice =0 otherwise 472 zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb ! old ice thickness 473 zdhex (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) ) ! difference in thickness 474 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) ) ! ice totally new in jl category 484 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) ) ! 0 if old ice 475 485 END DO 476 486 … … 478 488 DO ji = 1, nbpac 479 489 jl = zcatac(ji) 480 zqold = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 481 zalphai = MIN( zhice_old(ji,jl) * REAL( jk ) / REAL( nlay_i ), zh_newice(ji) ) & 482 & - MIN( zhice_old(ji,jl) * REAL( jk - 1 ) / REAL( nlay_i ), zh_newice(ji) ) 483 ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji) & 484 + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl) * zqold * zhice_old(ji,jl) / REAL( nlay_i ) & 485 + za_newice(ji) * ze_newice(ji) * zalphai & 486 + za_newice(ji) * ze_newice(ji) * zdhex(ji) / REAL( nlay_i ) ) / ( ( zv_i_ac(ji,jl) ) / REAL( nlay_i ) ) 490 ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji) & 491 & + ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_ac(ji,jk,jl) * zv_old(ji,jl) ) / zv_i_ac(ji,jl) 487 492 END DO 488 493 END DO … … 491 496 ! Add excessive volume of new ice at the bottom 492 497 !----------------------------------------------- 493 ! If the ice concentration exceeds 1, the remaining volume of new ice494 ! is equally redistributed among all ice categories in which there is495 ! ice496 497 ! Fraction of level ice498 498 jm = 1 499 zat_i_lev(:) = 0._wp 500 501 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 502 DO ji = 1, nbpac 503 zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl) 504 END DO 505 END DO 506 507 IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 508 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 509 DO ji = 1, nbpac 510 zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) ) 511 zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_lev(ji) - epsi10 ) ) ! clem 512 zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zinda * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi10 ) 513 END DO 514 END DO 515 IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 516 517 !--------------------------------- 518 ! Heat content - bottom accretion 519 !--------------------------------- 520 jm = 1 521 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 522 DO ji = 1, nbpac 523 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) + epsi10 ) ) ! zindb=1 if ice =0 otherwise 524 zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 525 zdhicbot (ji,jl) = zdv_res(ji) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb & 526 & + zindb * zdh_frazb(ji) ! frazil ice may coalesce 527 zdummy(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb ! thickness of residual ice 528 END DO 529 END DO 530 531 ! old layers thicknesses and enthalpies 499 500 ! --- Redistributing energy on the new grid (energy is equally distributed in every layer) --- ! 501 ! DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 502 ! DO jk = 1, nlay_i 503 ! DO ji = 1, nbpac 504 ! ze_i_ac(ji,jk,jl) = ( ze_i_ac(ji,jk,jl) * zv_i_ac(ji,jl) + ze_newice(ji) * ( zdv_res(ji) + zv_frazb(ji) ) ) / & 505 ! & ( zv_i_ac(ji,jl) + ( zdv_res(ji) + zv_frazb(ji) ) ) 506 ! END DO 507 ! END DO 508 ! END DO 509 510 ! --- Redistributing energy on the new grid (energy is sent to the bottom) PART 1 --- ! 532 511 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 533 512 DO jk = 1, nlay_i 534 513 DO ji = 1, nbpac 535 zthick0(ji,jk,jl) = z hice_old(ji,jl) / REAL( nlay_i )514 zthick0(ji,jk,jl) = zv_i_ac(ji,jl) / REAL( nlay_i ) 536 515 zqm0 (ji,jk,jl) = ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 537 516 END DO 538 517 END DO 539 518 END DO 540 !!gm ??? why the previous do loop if ocerwriten by the following one ?541 519 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 542 520 DO ji = 1, nbpac 543 zthick0(ji,nlay_i+1,jl) = zdhicbot(ji,jl) 544 zqm0 (ji,nlay_i+1,jl) = ze_newice(ji) * zdhicbot(ji,jl) 521 zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_ac(ji) - epsi10 ) ) 522 zthick0(ji,nlay_i+1,jl) = zinda * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_ac(ji,jl) / MAX( zat_i_ac(ji) , epsi10 ) 523 zqm0 (ji,nlay_i+1,jl) = ze_newice(ji) * zthick0(ji,nlay_i+1,jl) 545 524 END DO ! ji 546 525 END DO ! jl 547 526 548 ! Redistributing energy on the new grid549 527 ze_i_ac(:,:,:) = 0._wp 550 528 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) … … 552 530 DO layer = 1, nlay_i + 1 553 531 DO ji = 1, nbpac 554 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) ) 555 ! Redistributing energy on the new grid 556 zweight = MAX ( MIN( zhice_old(ji,jl) * REAL( layer ), zdummy(ji,jl) * REAL( jk ) ) & 557 & - MAX( zhice_old(ji,jl) * REAL( layer - 1 ) , zdummy(ji,jl) * REAL( jk - 1 ) ) , 0._wp ) & 558 & /( MAX(REAL(nlay_i) * zthick0(ji,layer,jl),epsi10) ) * zindb 559 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl) 560 END DO ! ji 561 END DO ! layer 562 END DO ! jk 563 END DO ! jl 564 532 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zthick0(ji,layer,jl) + epsi10 ) ) 533 zweight = zindb * MAX( 0._wp, & 534 & MIN( zv_i_ac(ji,jl) * REAL( layer ), ( zv_i_ac(ji,jl) + zthick0(ji,nlay_i+1,jl) ) * REAL( jk ) ) & 535 & - MAX( zv_i_ac(ji,jl) * REAL( layer - 1 ), ( zv_i_ac(ji,jl) + zthick0(ji,nlay_i+1,jl) ) * REAL( jk - 1 ) ) ) & 536 & / ( REAL( nlay_i ) * MAX( zthick0(ji,layer,jl), epsi10 ) ) 537 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl) 538 END DO 539 END DO 540 END DO 541 END DO 542 543 ! --- new volumes and layer thickness --- 544 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 545 DO ji = 1, nbpac 546 zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_ac(ji) - epsi10 ) ) 547 zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zinda * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_ac(ji,jl) / MAX( zat_i_ac(ji) , epsi10 ) 548 END DO 549 END DO 550 551 ! --- Redistributing energy on the new grid (energy is sent to the bottom) PART 2 --- ! 565 552 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 566 553 DO jk = 1, nlay_i 567 554 DO ji = 1, nbpac 568 555 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) ) 569 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) & 570 & / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * REAL( nlay_i ) * zindb 556 ze_i_ac(ji,jk,jl) = zindb * ze_i_ac(ji,jk,jl) / MAX( zv_i_ac(ji,jl), epsi10 ) * REAL( nlay_i ) 571 557 END DO 572 558 END DO 573 559 END DO 560 574 561 575 562 !------------ … … 589 576 DO jl = 1, jpl 590 577 DO ji = 1, nbpac 591 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) ) ! 0 if no ice and 1 if yes592 578 zdv = zv_i_ac(ji,jl) - zv_old(ji,jl) 593 zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) * zindb ! clem modif579 zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) 594 580 END DO 595 581 END DO 596 582 !clem ENDIF 597 598 !--------------------------------599 ! Update mass/salt fluxes (clem)600 !--------------------------------601 DO jl = 1, jpl602 DO ji = 1, nbpac603 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) ) ! 0 if no ice and 1 if yes604 zdv = zv_i_ac(ji,jl) - zv_old(ji,jl)605 rdm_ice_1d(ji) = rdm_ice_1d(ji) + zdv * rhoic * zindb606 sfx_thd_1d(ji) = sfx_thd_1d(ji) - zdv * rhoic * zs_newice(ji) * r1_rdtice * zindb607 END DO608 END DO609 583 610 584 !------------------------------------------------------------------------------! … … 615 589 CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 616 590 CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 617 !clem IF ( num_sal == 2 ) & 618 CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 591 CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 619 592 DO jk = 1, nlay_i 620 593 CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 621 594 END DO 622 595 END DO 623 CALL tab_1d_2d( nbpac, sfx_thd, npac(1:nbpac), sfx_thd_1d(1:nbpac), jpi, jpj ) 624 CALL tab_1d_2d( nbpac, rdm_ice, npac(1:nbpac), rdm_ice_1d(1:nbpac), jpi, jpj ) 596 CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj ) 597 CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 598 CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 599 600 CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj ) 601 CALL tab_1d_2d( nbpac, hfx_tot, npac(1:nbpac), hfx_tot_1d(1:nbpac), jpi, jpj ) 625 602 ! 626 603 ENDIF ! nbpac > 0 … … 630 607 !------------------------------------------------------------------------------! 631 608 DO jl = 1, jpl 632 DO jk = 1, nlay_i ! heat content in 10^9 Joules 633 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / REAL( nlay_i ) / unit_fac 609 DO jk = 1, nlay_i 610 DO jj = 1, jpj 611 DO ji = 1, jpi 612 ! heat content in Joules 613 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ) * unit_fac ) 614 !e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ) ) 615 END DO 616 END DO 634 617 END DO 635 618 END DO … … 669 652 CALL wrk_dealloc( jpij, zcatac ) ! integer 670 653 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 671 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, z dh_frazb, zvrel_ac, zqbgow, zdhex)672 CALL wrk_dealloc( jpij,jpl, z hice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac )654 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zv_frazb, zvrel_ac ) 655 CALL wrk_dealloc( jpij,jpl, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 673 656 CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac ) 674 657 CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r4045 r4634 53 53 ! 54 54 INTEGER :: ji, jk ! dummy loop indices 55 REAL(wp) :: zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch,ztmelts ! local scalars55 REAL(wp) :: iflush, igravdr, ztmelts ! local scalars 56 56 REAL(wp) :: zaaa, zbbb, zccc, zdiscrim ! local scalars 57 REAL(wp), POINTER, DIMENSION(:) :: ze_init, zhiold, zsiold58 57 !!--------------------------------------------------------------------- 59 60 CALL wrk_alloc( jpij, ze_init, zhiold, zsiold )61 58 62 59 !------------------------------------------------------------------------------| … … 77 74 IF( num_sal == 2 ) THEN 78 75 79 !---------------------------------80 ! Thickness at previous time step81 !---------------------------------82 DO ji = kideb, kiut83 zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji)84 zsiold(ji) = sm_i_b(ji)85 END DO86 87 !---------------------88 ! Global heat content89 !---------------------90 ze_init(:) = 0._wp91 DO jk = 1, nlay_i92 DO ji = kideb, kiut93 ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / REAL (nlay_i )94 END DO95 END DO96 97 76 DO ji = kideb, kiut 98 77 ! 99 78 ! Switches 100 79 !---------- 101 iflush = MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt ) ) ! =1 if summer 102 igravdr = MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) ) ! =1 if t_su < t_bo 103 iaccrbo = MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) ) ) ! =1 if bottom accretion 104 i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) ) 105 isnowic = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch ! =1 if snow ice formation 80 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_b(ji) - rtt ) ) ! =1 if summer 81 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_b(ji) - t_su_b(ji) ) ) ! =1 if t_su < t_bo 106 82 107 83 !--------------------- 108 84 ! Salinity tendencies 109 85 !--------------------- 110 ! ! drainage by gravity drainage 111 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice 112 ! ! drainage by flushing 113 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 114 86 ! 87 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice ! drainage by gravity 88 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice ! drainage by flushing 89 ! 115 90 !----------------- 116 91 ! Update salinity … … 120 95 sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 121 96 122 ! if no ice, salinity = 0.1123 i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) )124 sm_i_b(ji) = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch )125 126 !----------------------------127 ! Heat flux - brine drainage128 !----------------------------129 fhbri_1d(ji) = 0._wp130 131 97 !---------------------------- 132 98 ! Salt flux - brine drainage 133 99 !---------------------------- 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_rdtice100 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_b(ji) * ht_i_b(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 135 101 136 102 END DO … … 164 130 IF( num_sal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) 165 131 166 !167 CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold )168 132 ! 169 133 END SUBROUTINE lim_thd_sal -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r4332 r4634 37 37 38 38 REAL(wp) :: epsi10 = 1.e-10_wp 39 REAL(wp) :: rzero = 0._wp 40 REAL(wp) :: rone = 1._wp 39 REAL(wp) :: epsi20 = 1.e-20_wp 41 40 42 41 !! * Substitution … … 67 66 INTEGER :: ierr ! error status 68 67 REAL(wp) :: zindb , zindsn , zindic, zindh, zinda ! local scalar 69 REAL(wp) :: zusvosn, zusvoic, zbigval ! - -70 68 REAL(wp) :: zcfl , zusnit ! - - 71 REAL(wp) :: z e , zsal , zage ! - -69 REAL(wp) :: zsal , zage ! - - 72 70 ! 73 71 REAL(wp), POINTER, DIMENSION(:,:) :: zui_u, zvi_v, zsm, zs0at, zs0ow 74 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 75 73 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zs0e 76 REAL(wp) :: zchk_v_i, zchk_smv, zchk_ fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)74 REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b ! Check conservation (C Rousset) 77 75 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset) 78 76 ! mass and salt flux (clem) 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold ! old ice volume... 80 ! correct ice thickness (clem) 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold ! old ice volume... 81 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zaiold, zhimax ! old ice concentration and thickness 82 REAL(wp) :: zdv, zda, zvi, zvs, zsmv 79 REAL(wp), POINTER, DIMENSION(:,:) :: zeiold, zesold ! old enthalpies 80 REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei 83 81 !!--------------------------------------------------------------------- 84 82 IF( nn_timing == 1 ) CALL timing_start('limtrp') 85 83 86 CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow )84 CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 87 85 CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 88 86 CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 89 87 90 CALL wrk_alloc( jpi,jpj,jpl,zviold ) ! clem 91 CALL wrk_alloc( jpi,jpj,jpl,zaiold, zhimax ) ! clem 88 CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold ) ! clem 92 89 93 90 ! ------------------------------- 94 91 !- check conservation (C Rousset) 95 92 IF( ln_limdiahsb ) THEN 96 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) )93 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 97 94 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 98 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 99 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 95 zchk_e_i_b = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 96 zchk_fw_b = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 97 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 98 zchk_ft_b = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 100 99 ENDIF 101 100 !- check conservation (C Rousset) … … 117 116 ! mass and salt flux init (clem) 118 117 zviold(:,:,:) = v_i(:,:,:) 118 zeiold(:,:) = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 119 zesold(:,:) = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 119 120 120 121 !--- Thickness correction init. (clem) ------------------------------- … … 167 168 ! ENDIF 168 169 !!gm end 169 initad = 1 + NINT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) )170 initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 170 171 zusnit = 1.0 / REAL( initad ) 171 172 IF( zcfl > 0.5 .AND. lwp ) & … … 175 176 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! 176 177 DO jk = 1,initad 177 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area178 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 178 179 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 179 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), &180 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:), & 180 181 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 181 182 DO jl = 1, jpl 182 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---183 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 183 184 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 184 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &185 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 185 186 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 186 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---187 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 187 188 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 188 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &189 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 189 190 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 190 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---191 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 191 192 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 192 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &193 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 193 194 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 194 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---195 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 195 196 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 196 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &197 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 197 198 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 198 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---199 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 199 200 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 200 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), &201 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 201 202 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 202 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---203 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 203 204 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 204 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &205 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 205 206 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 206 207 DO layer = 1, nlay_i !--- ice heat contents --- 207 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &208 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 208 209 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 209 210 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 210 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &211 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 211 212 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 212 213 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) … … 216 217 ELSE 217 218 DO jk = 1, initad 218 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area219 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 219 220 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 220 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), &221 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:), & 221 222 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 222 223 DO jl = 1, jpl 223 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---224 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 224 225 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 225 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &226 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 226 227 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 227 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---228 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 228 229 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 229 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &230 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 230 231 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 231 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---232 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 232 233 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 233 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &234 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 234 235 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 235 236 236 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---237 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 237 238 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 238 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &239 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 239 240 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 240 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---241 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 241 242 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 242 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), &243 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 243 244 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 244 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---245 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 245 246 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 246 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &247 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 247 248 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 248 249 DO layer = 1, nlay_i !--- ice heat contents --- 249 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &250 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 250 251 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 251 252 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 252 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &253 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 253 254 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 254 255 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) … … 268 269 zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:) 269 270 zs0a (:,:,jl) = zs0a (:,:,jl) / area(:,:) 270 zs0c0 (:,:,jl) = zs0c0 (:,:,jl) / area(:,:) 271 DO jk = 1, nlay_i 272 zs0e(:,:,jk,jl) = zs0e(:,:,jk,jl) / area(:,:) 273 END DO 271 ! 274 272 END DO 275 273 … … 289 287 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 290 288 DO ji = 1 , fs_jpim1 ! vector opt. 291 pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji ,jj) ) ) ) &292 & * ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj)293 pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji,jj ) ) ) ) &294 & * ( 1._wp - MAX( rzero, SIGN( rone,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj)289 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji ,jj) ) ) ) & 290 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 291 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj ) ) ) ) & 292 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 295 293 END DO 296 294 END DO … … 305 303 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 306 304 DO ji = 1 , fs_jpim1 ! vector opt. 307 pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji ,jj,jl) ) ) ) &308 & * ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)309 pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji,jj ,jl) ) ) ) &310 & * ( 1._wp - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)305 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji ,jj,jl) ) ) ) & 306 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 307 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj ,jl) ) ) ) & 308 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 311 309 END DO 312 310 END DO … … 334 332 DO jj = 1, jpj 335 333 DO ji = 1, jpi 336 zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl) )337 zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl) )338 zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl) )339 zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl) )340 zs0a (ji,jj,jl) = MAX( rzero, zs0a (ji,jj,jl) )341 zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl) )334 zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) ) 335 zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) ) 336 zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) ) 337 zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) ) 338 zs0a (ji,jj,jl) = MAX( 0._wp, zs0a (ji,jj,jl) ) 339 zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) ) 342 340 zs0at (ji,jj) = zs0at(ji,jj) + zs0a(ji,jj,jl) 343 341 END DO … … 346 344 347 345 !--------------------------------------------------------- 348 ! 5.2) Snow thickness, Ice thickness, Ice concentrations346 ! 5.2) Update and mask variables 349 347 !--------------------------------------------------------- 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 zindb = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - epsi10) ) 353 zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 354 ato_i(ji,jj) = zs0ow(ji,jj) 355 END DO 356 END DO 357 358 DO jl = 1, jpl ! Remove very small areas 348 DO jl = 1, jpl 359 349 DO jj = 1, jpj 360 350 DO ji = 1, jpi 361 zvi = zs0ice(ji,jj,jl) 362 zvs = zs0sn(ji,jj,jl) 351 zindb= MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 352 353 zvi = zs0ice(ji,jj,jl) 354 zvs = zs0sn (ji,jj,jl) 355 zes = zs0c0 (ji,jj,jl) 356 zsmv = zs0sm (ji,jj,jl) 363 357 ! 364 zindb = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - epsi10) ) 365 ! 366 v_s(ji,jj,jl) = zindb * zs0sn (ji,jj,jl) 367 v_i(ji,jj,jl) = zindb * zs0ice(ji,jj,jl) 368 ! 369 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 370 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 371 zindb = MAX( zindsn, zindic ) 372 ! 373 zs0a(ji,jj,jl) = zindb * zs0a(ji,jj,jl) !ice concentration 374 a_i (ji,jj,jl) = zs0a(ji,jj,jl) 375 v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 376 v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 377 ! 378 ! Update mass fluxes (clem) 379 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 380 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 358 ! Remove very small areas 359 v_s(ji,jj,jl) = zindb * zs0sn (ji,jj,jl) 360 v_i(ji,jj,jl) = zindb * zs0ice(ji,jj,jl) 361 a_i(ji,jj,jl) = zindb * zs0a (ji,jj,jl) 362 e_s(ji,jj,1,jl) = zindb * zs0c0 (ji,jj,jl) 363 ! Ice salinity and age 364 IF( num_sal == 2 ) THEN 365 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 366 ENDIF 367 oa_i(ji,jj,jl) = MAX( zindb * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl) 368 369 ! Update fluxes 370 wfx_res(ji,jj) = wfx_res(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 371 wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 372 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 373 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 381 374 END DO 382 375 END DO 383 376 END DO 377 378 DO jl = 1, jpl 379 DO jk = 1, nlay_i 380 DO jj = 1, jpj 381 DO ji = 1, jpi 382 zindb = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 383 zei = zs0e(ji,jj,jk,jl) 384 e_i(ji,jj,jk,jl) = zindb * MAX( 0._wp, zs0e(ji,jj,jk,jl) ) 385 ! Update fluxes 386 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 387 END DO !ji 388 END DO ! jj 389 END DO ! jk 390 END DO ! jl 384 391 385 392 !--- Thickness correction in case too high (clem) -------------------------------------------------------- … … 390 397 391 398 IF ( v_i(ji,jj,jl) > 0._wp ) THEN 392 zvi = v_i(ji,jj,jl) 393 zvs = v_s(ji,jj,jl) 394 zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl) 399 zvi = v_i (ji,jj,jl) 400 zvs = v_s (ji,jj,jl) 401 zsmv = smv_i(ji,jj,jl) 402 zes = e_s (ji,jj,1,jl) 403 zei = SUM( e_i(ji,jj,:,jl) ) 404 zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl) 395 405 !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl) 396 406 … … 399 409 & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN 400 410 ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 401 zindh = MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) )402 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi 10 )411 zindh = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 412 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 403 413 ELSE 404 414 ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 405 zindh = MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) )406 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi 10 )415 zindh = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 416 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 407 417 ENDIF 408 418 409 419 ! small correction due to *zindh for a_i 410 v_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) 411 v_s(ji,jj,jl) = zindh * v_s(ji,jj,jl) 420 v_i (ji,jj,jl) = zindh * v_i (ji,jj,jl) 421 v_s (ji,jj,jl) = zindh * v_s (ji,jj,jl) 422 smv_i(ji,jj,jl) = zindh * smv_i(ji,jj,jl) 423 e_s(ji,jj,1,jl) = zindh * e_s(ji,jj,1,jl) 424 e_i(ji,jj,:,jl) = zindh * e_i(ji,jj,:,jl) 412 425 413 426 ! Update mass fluxes 414 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 415 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 427 wfx_res(ji,jj) = wfx_res(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 428 wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 429 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 430 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 431 hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,:,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 416 432 417 433 ENDIF 418 434 419 435 diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 420 421 END DO 422 END DO 423 END DO 424 425 ! --- 436 diag_trp_vs(ji,jj) = diag_trp_vs(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * r1_rdtice 437 438 END DO 439 END DO 440 END DO 441 ! ------------------------------------------------- 442 443 ! --- diags --- 426 444 DO jj = 1, jpj 427 445 DO ji = 1, jpi 428 zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) ! clem@useless??429 END DO430 END DO431 432 !---------------------- 433 ! 5.3) Ice properties434 !----------------------435 436 zbigval = 1.e+13437 446 diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 447 diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 448 END DO 449 END DO 450 451 ! --- agglomerate variables (clem) ----------------- 452 vt_i (:,:) = 0._wp 453 vt_s (:,:) = 0._wp 454 at_i (:,:) = 0._wp 455 ! 438 456 DO jl = 1, jpl 439 457 DO jj = 1, jpj 440 458 DO ji = 1, jpi 441 zsmv = zs0sm(ji,jj,jl) 442 443 ! Switches and dummy variables 444 zusvosn = 1.0/MAX( v_s(ji,jj,jl) , epsi10 ) 445 zusvoic = 1.0/MAX( v_i(ji,jj,jl) , epsi10 ) 446 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 447 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 448 zindb = MAX( zindsn, zindic ) 449 450 ! Ice salinity and age 451 !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 452 IF( num_sal == 2 ) THEN 453 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 454 ENDIF 455 456 zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) ), 0._wp ) * a_i(ji,jj,jl) 457 oa_i (ji,jj,jl) = zindic * zage 458 459 ! Snow heat content 460 ze = MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval ) 461 e_s(ji,jj,1,jl) = zindsn * ze 462 463 ! Update salt fluxes (clem) 464 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 465 END DO !ji 466 END DO !jj 467 END DO ! jl 468 469 DO jl = 1, jpl 470 DO jk = 1, nlay_i 471 DO jj = 1, jpj 472 DO ji = 1, jpi 473 ! Ice heat content 474 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 475 ze = MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval ) 476 e_i(ji,jj,jk,jl) = zindic * ze 477 END DO !ji 478 END DO ! jj 479 END DO ! jk 480 END DO ! jl 481 482 483 ! --- agglomerate variables (clem) ----------------- 484 vt_i (:,:) = 0._wp 485 vt_s (:,:) = 0._wp 486 at_i (:,:) = 0._wp 487 ! 488 DO jl = 1, jpl 459 ! 460 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 461 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 462 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 463 END DO 464 END DO 465 END DO 466 ! ------------------------------------------------- 467 468 ! open water 489 469 DO jj = 1, jpj 490 470 DO ji = 1, jpi 491 ! 492 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 493 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 494 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 495 ! 496 zinda = MAX( rzero , SIGN( rone , at_i(ji,jj) - epsi10 ) ) 497 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda ! ice thickness 498 END DO 499 END DO 500 END DO 501 ! ------------------------------------------------- 502 503 471 ! open water = 1 if at_i=0 472 zindb = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 473 ato_i(ji,jj) = zindb + (1._wp - zindb ) * zs0ow(ji,jj) 474 END DO 475 END DO 504 476 505 477 ENDIF … … 539 511 !- check conservation (C Rousset) 540 512 IF( ln_limdiahsb ) THEN 541 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 542 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 513 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 514 zchk_fw = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 515 zchk_ft = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 543 516 544 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 545 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 517 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw 518 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 519 zchk_e_i = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 546 520 547 521 zchk_vmin = glob_min(v_i) … … 551 525 552 526 IF(lwp) THEN 553 IF ( ABS( zchk_v_i ) > 1.e- 5) THEN554 WRITE(numout,*) 'violation volume [ m3/day] (limtrp) = ',(zchk_v_i * rday)527 IF ( ABS( zchk_v_i ) > 1.e-4 ) THEN 528 WRITE(numout,*) 'violation volume [kg/day] (limtrp) = ',(zchk_v_i * rday) 555 529 WRITE(numout,*) 'u_ice max [m/s] (limtrp) = ',zchk_umax 556 530 WRITE(numout,*) 'number of time steps (limtrp) =',kt 557 531 ENDIF 558 532 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday) 533 IF ( ABS( zchk_e_i ) > 1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J] (limtrp) = ',(zchk_e_i) 559 534 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limtrp) = ',(zchk_vmin * 1.e-3) 560 535 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limtrp) = ',zchk_amin … … 564 539 ! ------------------------------- 565 540 ! 566 CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow )541 CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 567 542 CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 568 543 CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e ) 569 544 570 CALL wrk_dealloc( jpi, jpj,jpl,zaiold, zhimax ) ! clem545 CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax ) ! clem 571 546 ! 572 547 IF( nn_timing == 1 ) CALL timing_stop('limtrp') -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r4332 r4634 32 32 USE par_ice 33 33 USE limitd_th 34 USE limitd_me 34 35 USE limvar 35 36 USE prtctl ! Print control … … 49 50 50 51 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 51 REAL(wp) :: rzero = 0._wp ! - -52 REAL(wp) :: rone = 1._wp ! - -53 52 54 53 !! * Substitutions … … 80 79 INTEGER :: jbnd1, jbnd2 81 80 INTEGER :: i_ice_switch 82 INTEGER :: ind_im, layer ! indices for internal melt83 REAL(wp) :: zweight, zesum, z_da_i, zhimax84 81 REAL(wp) :: zinda, zindb, zindsn, zindic 85 REAL(wp) :: zindg, zh, zdvres, zviold2 86 REAL(wp) :: zbigvalue, zvsold2, z_da_ex 87 REAL(wp) :: z_prescr_hi, zat_i_old, ztmelts, ze_s 88 89 REAL(wp), POINTER, DIMENSION(:) :: zthick0, zqm0 ! thickness of the layers and heat contents for 90 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 82 REAL(wp) :: zh, zdvres, zsal 83 REAL(wp) :: zat_i_old, ztmelts 84 85 REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b ! Check conservation (C Rousset) 91 86 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 92 ! mass and salt flux (clem)93 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume...94 87 !!------------------------------------------------------------------- 95 88 IF( nn_timing == 1 ) CALL timing_start('limupdate1') 96 97 CALL wrk_alloc( jkmax, zthick0, zqm0 )98 99 CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem100 89 101 90 !------------------------------------------------------------------------------ … … 106 95 ! Trend terms 107 96 !----------------- 108 d_u_ice_dyn(:,:) = u_ice(:,:) - old_u_ice(:,:)109 d_v_ice_dyn(:,:) = v_ice(:,:) - old_v_ice(:,:)110 d_a_i_trp (:,:,:) = a_i (:,:,:) - old_a_i (:,:,:)111 d_v_s_trp (:,:,:) = v_s (:,:,:) - old_v_s (:,:,:)112 d_v_i_trp (:,:,:) = v_i (:,:,:) - old_v_i (:,:,:)113 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - old_e_s (:,:,:,:)114 d_e_i_trp (:,:,:,:) = e_i (:,:,:,:) - old_e_i (:,:,:,:)115 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:)116 d_smv_i_trp(:,:,:) = 0._wp117 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:)118 119 ! mass and salt flux init (clem)120 zviold(:,:,:) = v_i(:,:,:)121 zvsold(:,:,:) = v_s(:,:,:)122 zsmvold(:,:,:) = smv_i(:,:,:)123 97 124 98 ! ------------------------------- 125 99 !- check conservation (C Rousset) 126 100 IF (ln_limdiahsb) THEN 127 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) )101 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 128 102 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 129 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 130 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 103 zchk_e_i_b = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 104 zchk_fw_b = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 105 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 106 zchk_ft_b = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 131 107 ENDIF 132 108 !- check conservation (C Rousset) 133 109 ! ------------------------------- 134 110 111 ! zap small values 112 !----------------- 113 CALL lim_itd_me_zapsmall 114 135 115 CALL lim_var_glo2eqv 136 137 !--------------------------------------138 ! 2. Review of all pathological cases139 !--------------------------------------140 141 ! clem: useless now142 !-------------------------------------------143 ! 2.1) Advection of ice in an ice-free cell144 !-------------------------------------------145 ! should be removed since it is treated after dynamics now146 ! zhimax = 5._wp147 ! ! first category148 ! DO jj = 1, jpj149 ! DO ji = 1, jpi150 ! !--- the thickness of such an ice is often out of bounds151 ! !--- thus we recompute a new area while conserving ice volume152 ! zat_i_old = SUM( old_a_i(ji,jj,:) )153 ! zindb = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_trp(ji,jj,1) ) - epsi10 ) )154 ! IF( ( ABS( d_v_i_trp(ji,jj,1) ) / MAX( ABS( d_a_i_trp(ji,jj,1) ), epsi10 ) * zindb .GT. zhimax ) &155 ! & .AND.( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) &156 ! & .AND.( zat_i_old .LT. 1.e-6 ) ) THEN ! new line157 ! ht_i(ji,jj,1) = hi_max(1) * 0.5_wp158 ! a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1)159 ! ENDIF160 ! END DO161 ! END DO162 !163 ! zhimax = 20._wp164 ! ! other categories165 ! DO jl = 2, jpl166 ! jm = ice_types(jl)167 ! DO jj = 1, jpj168 ! DO ji = 1, jpi169 ! zindb = MAX( rzero, SIGN( rone, ABS( d_a_i_trp(ji,jj,jl) ) - epsi10 ) )170 ! ! this correction is very tricky... sometimes, advection gets wrong i don't know why171 ! ! it makes problems when the advected volume and concentration do not seem to be172 ! ! related with each other173 ! ! the new thickness is sometimes very big!174 ! ! and sometimes d_a_i_trp and d_v_i_trp have different sign175 ! ! which of course is plausible176 ! ! but fuck! it fucks everything up :)177 ! IF ( ( ABS( d_v_i_trp(ji,jj,jl) ) / MAX( ABS( d_a_i_trp(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) &178 ! & .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN179 ! ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp180 ! a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl)181 ! ENDIF182 ! END DO ! ji183 ! END DO !jj184 ! END DO !jl185 116 186 117 at_i(:,:) = 0._wp … … 203 134 END DO 204 135 205 zbigvalue = 1.0e+20206 207 DO jl = 1, jpl208 DO jj = 1, jpj 136 !--- 2.13 ice concentration should not exceed amax 137 !----------------------------------------------------- 138 DO jl = 1, jpl 139 DO jj = 1, jpj 209 140 DO ji = 1, jpi 210 211 !switches 212 zindb = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 213 !switch = 1 if a_i > 1e-06 and 0 if not 214 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 215 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 216 ! bug fix 25 avril 2007 217 zindb = zindb*zindic 218 219 !--- 2.3 Correction to ice age 220 !------------------------------ 221 ! IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 222 ! o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 223 ! ENDIF 224 IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 225 oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 141 IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 142 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 143 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 226 144 ENDIF 227 oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 228 229 !--- 2.4 Correction to snow thickness 230 !------------------------------------- 231 ! ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0 232 ! v_s(ji,jj,jl) = MAX( zindb * v_s(ji,jj,jl), 0.0) 233 ! snow thickness cannot be smaller than 1e-6 234 zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 235 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 236 237 !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 238 239 !--- 2.5 Correction to ice thickness 240 !------------------------------------- 241 zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 242 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 243 244 !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 245 !sfx_res(ji,jj) = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 246 247 !--- 2.6 Snow is transformed into ice if the original ice cover disappears 248 !---------------------------------------------------------------------------- 249 zindg = tms(ji,jj) * MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 250 zdvres = zindg * rhosn * v_s(ji,jj,jl) / rau0 251 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 252 253 zdvres = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 254 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 255 256 !--- 2.7 Correction to ice concentrations 257 !-------------------------------------------- 258 ! if greater than 0, ice concentration cannot be smaller than 1e-10 259 a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 260 261 !------------------------- 262 ! 2.8) Snow heat content 263 !------------------------- 264 e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0._wp, e_s(ji,jj,1,jl) ), zbigvalue ) ) 265 266 END DO ! ji 267 END DO ! jj 268 END DO ! jl 269 270 !------------------------ 271 ! 2.9) Ice heat content 272 !------------------------ 273 274 DO jl = 1, jpl 275 DO jk = 1, nlay_i 276 DO jj = 1, jpj 277 DO ji = 1, jpi 278 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 279 e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 280 END DO ! ji 281 END DO ! jj 282 END DO !jk 283 END DO !jl 284 285 at_i(:,:) = 0._wp 145 END DO 146 END DO 147 END DO 148 149 at_i(:,:) = 0.0 286 150 DO jl = 1, jpl 287 151 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 288 152 END DO 289 290 !--- 2.13 ice concentration should not exceed amax 291 ! (it should not be the case) 292 !----------------------------------------------------- 293 DO jj = 1, jpj 294 DO ji = 1, jpi 295 z_da_ex = MAX( at_i(ji,jj) - amax , 0.0 ) 296 zindb = MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) ) 297 DO jl = 1, jpl 298 z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 299 a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 300 ! 301 zinda = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 302 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 303 !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 304 END DO 305 END DO 306 END DO 307 at_i(:,:) = a_i(:,:,1) 308 DO jl = 2, jpl 309 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 310 END DO 311 312 153 154 313 155 ! Final thickness distribution rebinning 314 156 ! -------------------------------------- … … 322 164 323 165 166 ! zap small values 167 !----------------- 168 CALL lim_itd_me_zapsmall 169 324 170 !--------------------- 325 171 ! 2.11) Ice salinity 326 172 !--------------------- 327 ! clem correct bug on smv_i 328 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 329 330 IF ( num_sal == 2 ) THEN ! general case 173 IF ( num_sal == 2 ) THEN 331 174 DO jl = 1, jpl 332 !DO jk = 1, nlay_i333 DO j j = 1, jpj334 DO ji = 1, jpi335 ! salinity stays in bounds336 !clem smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) )337 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )338 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ))339 smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl)340 END DO ! ji341 END DO ! j j342 !END DO !jk175 DO jj = 1, jpj 176 DO ji = 1, jpi 177 zsal = smv_i(ji,jj,jl) 178 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 179 ! salinity stays in bounds 180 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 181 smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 182 ! associated salt flux 183 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 184 END DO ! ji 185 END DO ! jj 343 186 END DO !jl 344 187 ENDIF 345 188 189 ! ------------------- 346 190 at_i(:,:) = a_i(:,:,1) 347 191 DO jl = 2, jpl 348 192 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 349 193 END DO 350 351 352 !--------------------------------353 ! Update mass/salt fluxes (clem)354 !--------------------------------355 DO jl = 1, jpl356 DO jj = 1, jpj357 DO ji = 1, jpi358 diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice359 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic360 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn361 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice362 END DO363 END DO364 END DO365 194 195 196 ! ------------------------------------------------- 197 ! Diagnostics 198 ! ------------------------------------------------- 199 d_u_ice_dyn(:,:) = u_ice(:,:) - old_u_ice(:,:) 200 d_v_ice_dyn(:,:) = v_ice(:,:) - old_v_ice(:,:) 201 d_a_i_trp (:,:,:) = a_i (:,:,:) - old_a_i (:,:,:) 202 d_v_s_trp (:,:,:) = v_s (:,:,:) - old_v_s (:,:,:) 203 d_v_i_trp (:,:,:) = v_i (:,:,:) - old_v_i (:,:,:) 204 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - old_e_s (:,:,:,:) 205 d_e_i_trp (:,:,1:nlay_i,:) = e_i (:,:,1:nlay_i,:) - old_e_i(:,:,1:nlay_i,:) 206 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 207 d_smv_i_trp(:,:,:) = 0._wp 208 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 209 366 210 ! ------------------------------- 367 211 !- check conservation (C Rousset) 368 IF (ln_limdiahsb) THEN369 370 zchk_f s = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b371 zchk_f w = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b212 IF( ln_limdiahsb ) THEN 213 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 214 zchk_fw = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 215 zchk_ft = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 372 216 373 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice217 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw 374 218 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 219 zchk_e_i = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 375 220 376 221 zchk_vmin = glob_min(v_i) 377 222 zchk_amax = glob_max(SUM(a_i,dim=3)) 378 223 zchk_amin = glob_min(a_i) 379 224 380 225 IF(lwp) THEN 381 IF ( ABS( zchk_v_i ) > 1.e- 5 ) WRITE(numout,*) 'violation volume [m3/day] (limupdate1) = ',(zchk_v_i * rday)226 IF ( ABS( zchk_v_i ) > 1.e-4 ) WRITE(numout,*) 'violation volume [kg/day] (limupdate1) = ',(zchk_v_i * rday) 382 227 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate1) = ',(zchk_smv * rday) 228 IF ( ABS( zchk_e_i ) > 1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J] (limupdate1) = ',(zchk_e_i) 383 229 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limupdate1) = ',(zchk_vmin * 1.e-3) 384 230 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limupdate1) = ',zchk_amax 385 231 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limupdate1) = ',zchk_amin 386 232 ENDIF 387 ENDIF233 ENDIF 388 234 !- check conservation (C Rousset) 389 235 ! ------------------------------- … … 446 292 CALL prt_ctl_info(' - Heat / FW fluxes : ') 447 293 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 448 CALL prt_ctl(tab2d_1=fmmec , clinfo1= ' lim_update1 : fmmec : ', tab2d_2=fhmec , clinfo2= ' fhmec : ')449 294 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update1 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 450 CALL prt_ctl(tab2d_1=fhbri , clinfo1= ' lim_update1 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ')451 295 452 296 CALL prt_ctl_info(' ') … … 458 302 ENDIF 459 303 460 461 CALL wrk_dealloc( jkmax, zthick0, zqm0 )462 463 CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem464 465 304 IF( nn_timing == 1 ) CALL timing_stop('limupdate1') 466 305 END SUBROUTINE lim_update1 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r4332 r4634 45 45 PUBLIC lim_update2 ! routine called by ice_step 46 46 47 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 48 REAL(wp) :: rzero = 0._wp ! - - 49 REAL(wp) :: rone = 1._wp ! - - 50 47 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 48 REAL(wp) :: epsi20 = 1.e-20_wp 49 51 50 !! * Substitutions 52 51 # include "vectopt_loop_substitute.h90" … … 77 76 INTEGER :: jbnd1, jbnd2 78 77 INTEGER :: i_ice_switch 79 INTEGER :: ind_im, layer ! indices for internal melt80 REAL(wp) :: z weight, zesum, zhimax, z_da_i81 REAL(wp) :: zinda, zindb, zindsn, zindic 82 REAL(wp) :: z indg, zh, zdvres, zviold283 REAL(wp) :: z bigvalue, zvsold2, z_da_ex84 REAL(wp) :: z _prescr_hi, zat_i_old, ztmelts, ze_s85 86 INTEGER , POINTER, DIMENSION(:,:,:) :: internal_melt87 REAL(wp), POINTER, DIMENSION(:) :: zthick0, zqm0 ! thickness of the layers and heat contents for 88 REAL(wp) :: zchk_v_i, zchk_smv, zchk_ fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)78 REAL(wp) :: zindb, zindsn, zindic 79 REAL(wp) :: zh, zdvres, zsal 80 81 REAL(wp) :: zEs ! specific enthalpy of snow (J/kg) 82 REAL(wp) :: zEi ! specific enthalpy of ice (J/kg) 83 REAL(wp) :: zEw ! specific enthalpy of exchanged water (J/kg) 84 REAL(wp) :: zdE ! specific enthalpy difference (J/kg) 85 REAL(wp) :: zfmdt ! exchange mass flux x time step (J/m2), >0 towards the ocean 86 87 REAL(wp) :: zchk_v_i, zchk_smv, zchk_e_i, zchk_fs, zchk_fw, zchk_ft, zchk_v_i_b, zchk_smv_b, zchk_e_i_b, zchk_fs_b, zchk_fw_b, zchk_ft_b ! Check conservation (C Rousset) 89 88 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 90 ! mass and salt flux (clem)91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume...92 89 !!------------------------------------------------------------------- 93 90 IF( nn_timing == 1 ) CALL timing_start('limupdate2') 94 95 CALL wrk_alloc( jpi,jpj,jpl, internal_melt ) ! integer96 CALL wrk_alloc( jkmax, zthick0, zqm0 )97 98 CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem99 91 100 92 !---------------------------------------------------------------------------------------- 101 93 ! 1. Computation of trend terms 102 94 !---------------------------------------------------------------------------------------- 103 !- Trend terms104 d_a_i_thd(:,:,:) = a_i(:,:,:) - old_a_i(:,:,:)105 d_v_s_thd(:,:,:) = v_s(:,:,:) - old_v_s(:,:,:)106 d_v_i_thd(:,:,:) = v_i(:,:,:) - old_v_i(:,:,:)107 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)108 d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:)109 !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:)110 d_smv_i_thd(:,:,:) = 0._wp111 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:)112 ! diag only (clem)113 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday114 115 ! mass and salt flux init (clem)116 zviold(:,:,:) = v_i(:,:,:)117 zvsold(:,:,:) = v_s(:,:,:)118 zsmvold(:,:,:) = smv_i(:,:,:)119 95 120 96 ! ------------------------------- 121 97 !- check conservation (C Rousset) 122 98 IF (ln_limdiahsb) THEN 123 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) )99 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 124 100 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 125 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 126 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 101 zchk_e_i_b = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 102 zchk_fw_b = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) 103 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 104 zchk_ft_b = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 127 105 ENDIF 128 106 !- check conservation (C Rousset) 129 107 ! ------------------------------- 130 108 109 ! zap small values 110 !----------------- 111 CALL lim_itd_me_zapsmall 112 131 113 CALL lim_var_glo2eqv 132 114 … … 134 116 ! 2. Review of all pathological cases 135 117 !-------------------------------------- 136 137 ! clem: useless now138 !-------------------------------------------139 ! 2.1) Advection of ice in an ice-free cell140 !-------------------------------------------141 ! should be removed since it is treated after dynamics now142 ! zhimax = 5._wp143 ! ! first category144 ! DO jj = 1, jpj145 ! DO ji = 1, jpi146 ! !--- the thickness of such an ice is often out of bounds147 ! !--- thus we recompute a new area while conserving ice volume148 ! zat_i_old = SUM( old_a_i(ji,jj,:) )149 ! zindb = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_thd(ji,jj,1) ) - epsi10 ) )150 ! IF ( ( ABS( d_v_i_thd(ji,jj,1) ) / MAX( ABS( d_a_i_thd(ji,jj,1) ),epsi10 ) * zindb .GT. zhimax ) &151 ! & .AND. ( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) &152 ! & .AND. ( zat_i_old .LT. 1.e-6 ) ) THEN ! new line153 ! ht_i(ji,jj,1) = hi_max(1) * 0.5_wp154 ! a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1)155 ! ENDIF156 ! END DO157 ! END DO158 159 ! zhimax = 20._wp160 ! ! other categories161 ! DO jl = 2, jpl162 ! jm = ice_types(jl)163 ! DO jj = 1, jpj164 ! DO ji = 1, jpi165 ! zindb = MAX( rzero, SIGN( rone, ABS( d_a_i_thd(ji,jj,jl)) - epsi10 ) )166 ! ! this correction is very tricky... sometimes, advection gets wrong i don't know why167 ! ! it makes problems when the advected volume and concentration do not seem to be168 ! ! related with each other169 ! ! the new thickness is sometimes very big!170 ! ! and sometimes d_a_i_trp and d_v_i_trp have different sign171 ! ! which of course is plausible172 ! ! but fuck! it fucks everything up :)173 ! IF ( ( ABS( d_v_i_thd(ji,jj,jl) ) / MAX( ABS( d_a_i_thd(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) &174 ! & .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN175 ! ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp176 ! a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl)177 ! ENDIF178 ! END DO ! ji179 ! END DO !jj180 ! END DO !jl181 182 118 at_i(:,:) = 0._wp 183 119 DO jl = 1, jpl … … 194 130 END DO 195 131 196 !--------------------------------- 197 ! 2.3) Melt of an internal layer 198 !--------------------------------- 199 internal_melt(:,:,:) = 0 200 201 DO jl = 1, jpl 202 DO jk = 1, nlay_i 203 DO jj = 1, jpj 204 DO ji = 1, jpi 205 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 206 IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) & 207 & .AND. ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 208 internal_melt(ji,jj,jl) = 1 209 ENDIF 210 END DO ! ji 211 END DO ! jj 212 END DO !jk 213 END DO !jl 214 215 DO jl = 1, jpl 216 DO jj = 1, jpj 217 DO ji = 1, jpi 218 IF( internal_melt(ji,jj,jl) == 1 ) THEN 219 ! initial ice thickness 220 !----------------------- 221 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 222 223 ! reduce ice thickness 224 !----------------------- 225 ind_im = 0 226 zesum = 0.0 227 DO jk = 1, nlay_i 228 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 229 IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) ind_im = ind_im + 1 230 zesum = zesum + e_i(ji,jj,jk,jl) 231 END DO 232 ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) 233 v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 234 235 !CLEM 236 zdvres = REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) * a_i(ji,jj,jl) 237 !rdm_ice(ji,jj) = rdm_ice(ji,jj) - zdvres * rhoic 238 !sfx_res(ji,jj) = sfx_res(ji,jj) + sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 239 240 ! redistribute heat 241 !----------------------- 242 ! old thicknesses and enthalpies 243 ind_im = 0 244 DO jk = 1, nlay_i 245 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 246 IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND. & 247 ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN 248 ind_im = ind_im + 1 249 zthick0(ind_im) = ht_i(ji,jj,jl) * REAL(ind_im / nlay_i) 250 zqm0 (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 ) 251 ENDIF 252 END DO 253 254 ! Redistributing energy on the new grid 255 IF ( ind_im .GT. 0 ) THEN 256 257 DO jk = 1, nlay_i 258 e_i(ji,jj,jk,jl) = 0.0 259 DO layer = 1, ind_im 260 zweight = MAX ( & 261 MIN( ht_i(ji,jj,jl) * REAL(layer/ind_im) , ht_i(ji,jj,jl) * REAL(jk / nlay_i) ) - & 262 MAX( ht_i(ji,jj,jl) * REAL((layer-1)/ind_im) , ht_i(ji,jj,jl) * REAL((jk-1) / nlay_i) ) , 0.0 ) & 263 / ( ht_i(ji,jj,jl) / REAL(ind_im) ) 264 265 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) + zweight*zqm0(layer) 266 END DO !layer 267 END DO ! jk 268 269 zesum = 0.0 270 DO jk = 1, nlay_i 271 zesum = zesum + e_i(ji,jj,jk,jl) 272 END DO 273 274 ELSE ! ind_im .EQ. 0, total melt 275 e_i(ji,jj,jk,jl) = 0.0 276 ENDIF 277 278 ENDIF ! internal_melt 279 280 END DO ! ji 281 END DO !jj 282 END DO !jl 283 284 internal_melt(:,:,:) = 0 285 286 287 ! Melt of snow 288 !-------------- 289 DO jl = 1, jpl 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 ! snow energy of melting 293 zinda = MAX( 0._wp, SIGN( 1._wp, v_s(ji,jj,jl) - epsi10 ) ) 294 ze_s = zinda * e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) / MAX( v_s(ji,jj,jl), epsi10 ) ! snow energy of melting 295 296 ! If snow energy of melting smaller then Lf 297 ! Then all snow melts and meltwater, heat go to the ocean 298 IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = 1 299 300 END DO 301 END DO 302 END DO 303 304 DO jl = 1, jpl 305 DO jj = 1, jpj 306 DO ji = 1, jpi 307 IF ( internal_melt(ji,jj,jl) == 1 ) THEN 308 zdvres = v_s(ji,jj,jl) 309 ! release heat 310 fheat_res(ji,jj) = fheat_res(ji,jj) + ze_s * zdvres / rdt_ice 311 ! release mass 312 !rdm_snw(ji,jj) = rdm_snw(ji,jj) - zdvres * rhosn 313 ! 314 v_s(ji,jj,jl) = 0.0 315 e_s(ji,jj,1,jl) = 0.0 316 ENDIF 317 END DO 318 END DO 319 END DO 320 321 zbigvalue = 1.0e+20 322 DO jl = 1, jpl 323 DO jj = 1, jpj 324 DO ji = 1, jpi 325 326 !switches 327 zindb = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 328 !switch = 1 if a_i > 1e-06 and 0 if not 329 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 330 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 331 ! bug fix 25 avril 2007 332 zindb = zindb*zindic 333 334 !--- 2.3 Correction to ice age 335 !------------------------------ 336 ! IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 337 ! o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 338 ! ENDIF 339 IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 340 oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 341 ENDIF 342 oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 343 344 !--- 2.4 Correction to snow thickness 345 !------------------------------------- 346 zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 347 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 348 349 !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 350 351 !--- 2.5 Correction to ice thickness 352 !------------------------------------- 353 zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 354 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 355 356 !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 357 !sfx_res(ji,jj) = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 358 359 !--- 2.6 Snow is transformed into ice if the original ice cover disappears 360 !---------------------------------------------------------------------------- 361 zindg = tms(ji,jj) * MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 362 zdvres = zindg * rhosn * v_s(ji,jj,jl) / rau0 363 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 364 365 zdvres = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 366 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 367 368 !--- 2.7 Correction to ice concentrations 369 !-------------------------------------------- 370 a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 371 372 !------------------------- 373 ! 2.8) Snow heat content 374 !------------------------- 375 e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) ) 376 377 END DO ! ji 378 END DO ! jj 379 END DO ! jl 380 381 !------------------------ 382 ! 2.9) Ice heat content 383 !------------------------ 384 385 DO jl = 1, jpl 386 DO jk = 1, nlay_i 387 DO jj = 1, jpj 388 DO ji = 1, jpi 389 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 390 e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 391 END DO ! ji 392 END DO ! jj 393 END DO !jk 394 END DO !jl 395 396 132 133 !clem debug: it is done in limthd_dh now 134 ! ! Melt of snow 135 ! !-------------- 136 ! DO jl = 1, jpl 137 ! DO jj = 1, jpj 138 ! DO ji = 1, jpi 139 ! IF( v_s(ji,jj,jl) >= epsi20 ) THEN 140 ! ! If snow energy of melting smaller then Lf 141 ! ! Then all snow melts and heat go to the ocean 142 ! !IF ( zEs <= lfus ) THEN 143 ! IF( t_s(ji,jj,1,jl) >= rtt ) THEN 144 ! zdvres = - v_s(ji,jj,jl) 145 ! zEs = - e_s(ji,jj,1,jl) * unit_fac / ( area(ji,jj) * MAX( v_s(ji,jj,jl), epsi20 ) ) ! snow energy of melting (J.m-3) 146 ! ! Contribution to heat flux to the ocean [W.m-2], < 0 147 ! hfx_res(ji,jj) = hfx_res(ji,jj) - zEs * zdvres * r1_rdtice 148 ! ! Contribution to mass flux 149 ! wfx_snw(ji,jj) = wfx_snw(ji,jj) + rhosn * zdvres * r1_rdtice 150 ! ! updates 151 ! v_s (ji,jj,jl) = 0._wp 152 ! ht_s(ji,jj,jl) = 0._wp 153 ! e_s (ji,jj,1,jl) = 0._wp 154 ! t_s (ji,jj,1,jl) = rtt 155 ! ENDIF 156 ! ENDIF 157 ! END DO 158 ! END DO 159 ! END DO 160 !clem debug 161 162 !--- 2.12 Constrain the thickness of the smallest category above 10 cm 163 !---------------------------------------------------------------------- 397 164 DO jm = 1, jpm 398 165 DO jj = 1, jpj 399 166 DO ji = 1, jpi 400 167 jl = ice_cat_bounds(jm,1) 401 !--- 2.12 Constrain the thickness of the smallest category above 5 cm 402 !---------------------------------------------------------------------- 403 zindb = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 404 ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi10) 405 zh = MAX( rone , zindb * hiclim / MAX( ht_i(ji,jj,jl) , epsi10 ) ) 406 ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh 407 ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh 408 a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh 409 !CLEM 410 v_i (ji,jj,jl) = a_i(ji,jj,jl) * ht_i(ji,jj,jl) 411 v_s (ji,jj,jl) = a_i(ji,jj,jl) * ht_s(ji,jj,jl) 168 IF( v_i(ji,jj,jl) > 0._wp .AND. ht_i(ji,jj,jl) < hiclim ) THEN 169 zh = hiclim / ht_i(ji,jj,jl) 170 ht_s(ji,jj,jl) = ht_s(ji,jj,jl) * zh 171 ht_i(ji,jj,jl) = ht_i(ji,jj,jl) * zh 172 a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh 173 ENDIF 412 174 END DO !ji 413 175 END DO !jj 414 176 END DO !jm 415 177 178 !--- 2.13 ice concentration should not exceed amax 179 !----------------------------------------------------- 416 180 at_i(:,:) = 0.0 417 181 DO jl = 1, jpl 418 182 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 419 183 END DO 420 421 !--- 2.13 ice concentration should not exceed amax 422 ! (it should not be the case) 423 !----------------------------------------------------- 424 DO jj = 1, jpj 425 DO ji = 1, jpi 426 z_da_ex = MAX( at_i(ji,jj) - amax , 0.0 ) 427 zindb = MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) ) 428 DO jl = 1, jpl 429 z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 430 a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 431 ! 432 zinda = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 433 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 434 !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 184 185 DO jl = 1, jpl 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 189 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 190 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 191 ENDIF 435 192 END DO 436 193 END DO 437 194 END DO 195 438 196 at_i(:,:) = 0.0 439 197 DO jl = 1, jpl … … 451 209 END DO 452 210 211 ! zap small values 212 !----------------- 213 CALL lim_itd_me_zapsmall 214 453 215 !--------------------- 454 216 ! 2.11) Ice salinity 455 217 !--------------------- 456 ! clem correct bug on smv_i 457 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 458 459 IF ( num_sal == 2 ) THEN ! general case 218 IF ( num_sal == 2 ) THEN 460 219 DO jl = 1, jpl 461 !DO jk = 1, nlay_i462 DO j j = 1, jpj463 DO ji = 1, jpi464 ! salinity stays in bounds465 !clem smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) )466 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )467 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ))468 smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl)469 END DO ! ji470 END DO ! j j471 !END DO !jk220 DO jj = 1, jpj 221 DO ji = 1, jpi 222 zsal = smv_i(ji,jj,jl) 223 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 224 ! salinity stays in bounds 225 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 226 smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 227 ! associated salt flux 228 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 229 END DO ! ji 230 END DO ! jj 472 231 END DO !jl 473 232 ENDIF 233 474 234 475 235 ! ------------------- … … 501 261 v_ice(:,:) = v_ice(:,:) * tmv(:,:) 502 262 503 !-------------------------------- 504 ! Update mass/salt fluxes (clem) 505 !-------------------------------- 506 DO jl = 1, jpl 507 DO jj = 1, jpj 508 DO ji = 1, jpi 509 diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice 510 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic 511 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn 512 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice 513 END DO 514 END DO 515 END DO 263 264 ! ------------------------------------------------- 265 ! Diagnostics 266 ! ------------------------------------------------- 267 d_a_i_thd(:,:,:) = a_i(:,:,:) - old_a_i(:,:,:) 268 d_v_s_thd(:,:,:) = v_s(:,:,:) - old_v_s(:,:,:) 269 d_v_i_thd(:,:,:) = v_i(:,:,:) - old_v_i(:,:,:) 270 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:) 271 d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - old_e_i(:,:,1:nlay_i,:) 272 !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 273 d_smv_i_thd(:,:,:) = 0._wp 274 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 275 ! diag only (clem) 276 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 516 277 517 278 ! ------------------------------- 518 279 !- check conservation (C Rousset) 519 IF (ln_limdiahsb) THEN520 521 zchk_f s = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b522 zchk_f w = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b280 IF( ln_limdiahsb ) THEN 281 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 282 zchk_fw = glob_sum( ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fw_b 283 zchk_ft = glob_sum( ( hfx_tot(:,:) - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zchk_ft_b 523 284 524 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:) , dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice285 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b ) * r1_rdtice - zchk_fw 525 286 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 287 zchk_e_i = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zchk_e_i_b * r1_rdtice + zchk_ft 526 288 527 289 zchk_vmin = glob_min(v_i) … … 530 292 531 293 IF(lwp) THEN 532 IF ( ABS( zchk_v_i ) > 1.e- 5 ) WRITE(numout,*) 'violation volume [m3/day] (limupdate2) = ',(zchk_v_i * rday)294 IF ( ABS( zchk_v_i ) > 1.e-4 ) WRITE(numout,*) 'violation volume [kg/day] (limupdate2) = ',(zchk_v_i * rday) 533 295 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate2) = ',(zchk_smv * rday) 296 IF ( ABS( zchk_e_i ) > 1.e-2 ) WRITE(numout,*) 'violation enthalpy [1e9 J] (limupdate2) = ',(zchk_e_i) 534 297 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limupdate2) = ',(zchk_vmin * 1.e-3) 535 298 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limupdate2) = ',zchk_amax 536 299 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limupdate2) = ',zchk_amin 537 300 ENDIF 538 ENDIF301 ENDIF 539 302 !- check conservation (C Rousset) 540 303 ! ------------------------------- … … 596 359 CALL prt_ctl_info(' - Heat / FW fluxes : ') 597 360 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 598 CALL prt_ctl(tab2d_1=fmmec , clinfo1= ' lim_update2 : fmmec : ', tab2d_2=fhmec , clinfo2= ' fhmec : ')599 361 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update2 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 600 CALL prt_ctl(tab2d_1=fhbri , clinfo1= ' lim_update2 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ')601 362 602 363 CALL prt_ctl_info(' ') … … 608 369 ENDIF 609 370 610 CALL wrk_dealloc( jpi,jpj,jpl, internal_melt ) ! integer611 CALL wrk_dealloc( jkmax, zthick0, zqm0 )612 613 CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem614 615 371 IF( nn_timing == 1 ) CALL timing_stop('limupdate2') 616 372 END SUBROUTINE lim_update2 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r4332 r4634 67 67 68 68 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 69 REAL(wp) :: zzero = 0.e0 ! - -70 REAL(wp) :: zone = 1.e0 ! - -71 69 72 70 !!---------------------------------------------------------------------- … … 113 111 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 114 112 ! 115 zinda = MAX( zzero , SIGN( zone, at_i(ji,jj) - epsi10 ) )113 zinda = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 116 114 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda ! ice thickness 117 115 END DO … … 134 132 DO jj = 1, jpj 135 133 DO ji = 1, jpi 136 zinda = MAX( zzero , SIGN( zone, vt_i(ji,jj) - epsi10 ) )137 zindb = MAX( zzero , SIGN( zone, at_i(ji,jj) - epsi10 ) )134 zinda = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 135 zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 138 136 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content 139 137 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda ! ice salinity … … 205 203 DO ji = 1, jpi 206 204 ! ! Energy of melting q(S,T) [J.m-3] 207 zq_i = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)208 205 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) ! zindb = 0 if no ice and 1 if yes 209 zq_i = zq_i * unit_fac * zindb !convert units 206 zq_i = zindb * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp) 207 zq_i = zq_i * unit_fac !convert units 210 208 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt ! Ice layer melt temperature 211 209 ! … … 231 229 DO ji = 1, jpi 232 230 !Energy of melting q(S,T) [J.m-3] 233 zq_s = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)234 231 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) ) ! zindb = 0 if no ice and 1 if yes 235 zq_s = zq_s * unit_fac * zindb ! convert units 232 zq_s = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 233 zq_s = zq_s * unit_fac ! convert units 236 234 ! 237 235 t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) … … 320 318 DO jj = 1, jpj 321 319 DO ji = 1, jpi 322 z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01, ht_i(ji,jj,jl) )320 z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) ) 323 321 END DO 324 322 END DO … … 475 473 ! 476 474 DO ji = kideb, kiut ! Slope of the linear profile zs_zero 477 z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( 0.01, ht_i_b(ji) )475 z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( epsi10 , ht_i_b(ji) ) 478 476 END DO 479 477 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r4332 r4634 9 9 !!---------------------------------------------------------------------- 10 10 !! lim_wri : write of the diagnostics variables in ouput file 11 !! lim_wri_init : initialization and namelist read12 11 !! lim_wri_state : write for initial state or/and abandon 13 12 !!---------------------------------------------------------------------- … … 36 35 PUBLIC lim_wri_state ! called by dia_wri_state 37 36 38 INTEGER, PARAMETER :: jpnoumax = 43 !: maximum number of variable for ice output39 40 INTEGER :: noumef ! number of fields41 INTEGER :: noumefa ! number of additional fields42 INTEGER :: add_diag_swi ! additional diagnostics43 INTEGER :: nz ! dimension for the itd field44 45 REAL(wp) , DIMENSION(jpnoumax) :: cmulti ! multiplicative constant46 REAL(wp) , DIMENSION(jpnoumax) :: cadd ! additive constant47 REAL(wp) , DIMENSION(jpnoumax) :: cmultia ! multiplicative constant48 REAL(wp) , DIMENSION(jpnoumax) :: cadda ! additive constant49 CHARACTER(len = 35), DIMENSION(jpnoumax) :: titn, titna ! title of the field50 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: nam , nama ! name of the field51 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: uni , unia ! unit of the field52 INTEGER , DIMENSION(jpnoumax) :: nc , nca ! switch for saving field ( = 1 ) or not ( = 0 )53 54 37 REAL(wp) :: epsi06 = 1.e-6_wp 55 REAL(wp) :: zzero = 0._wp56 REAL(wp) :: zone = 1._wp57 38 !!---------------------------------------------------------------------- 58 39 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) … … 78 59 INTEGER, INTENT(in) :: kindic ! if kindic < 0 there has been an error somewhere 79 60 ! 80 INTEGER :: ji, jj, jk, jl, jf, ipl ! dummy loop indices 81 INTEGER :: ierr 82 REAL(wp),DIMENSION(1) :: zdept 83 REAL(wp) :: zsto, zjulian, zout, zindh, zinda, zindb, zindc 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcmo, zcmoa 85 REAL(wp), POINTER, DIMENSION(:,: ) :: zfield 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmaskitd, zoi, zei 87 88 CHARACTER(len = 60) :: clhstnam, clop, clhstnama 89 90 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 91 INTEGER , SAVE :: nicea, nhorida, ndimitd 92 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndex51 93 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndexitd 61 INTEGER :: ji, jj, jk, jl ! dummy loop indices 62 REAL(wp) :: zinda, zindb, z1_365 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zoi, zei 64 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, z2da, z2db, zind ! 2D workspace 94 65 !!------------------------------------------------------------------- 95 66 96 67 IF( nn_timing == 1 ) CALL timing_start('limwri') 97 68 98 CALL wrk_alloc( jpi, jpj, zfield ) 99 CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 100 CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 101 102 ipl = jpl 103 104 IF( numit == nstart ) THEN 105 106 ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr ) 107 IF( lk_mpp ) CALL mpp_sum ( ierr ) 108 IF( ierr /= 0 ) THEN 109 CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' ) ; RETURN 110 ENDIF 111 112 CALL lim_wri_init 113 114 IF(lwp) WRITE(numout,*) ' lim_wri, first time step ' 115 IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi 116 117 !-------------------- 118 ! 1) Initialization 119 !-------------------- 120 121 !------------- 122 ! Normal file 123 !------------- 124 niter = ( nit000 - 1 ) / nn_fsbc 125 CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 126 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 127 !clem 128 ! zsto = rdt_ice 129 ! IF( ln_mskland ) THEN ; clop = "ave(only(x))" ! put 1.e+20 on land (very expensive!!) 130 ! ELSE ; clop = "ave(x)" ! no use of the mask value (require less cpu time) 131 ! ENDIF 132 ! zout = nwrite * rdt_ice / nn_fsbc 133 ! zdept(1) = 0. 134 ! 135 ! CALL dia_nam ( clhstnam, nwrite, 'icemod_old' ) 136 ! CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice, & 137 ! & nhorid, nice, domain_id=nidom, snc4chunks=snc4set ) 138 ! CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 139 ! CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 140 ! 141 ! DO jf = 1 , noumef 142 ! IF(lwp) WRITE(numout,*) 'jf', jf 143 ! IF ( nc(jf) == 1 ) THEN 144 ! CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & 145 ! , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 146 ! IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout' 147 ! IF(lwp) WRITE(numout,*) nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout 148 ! ENDIF 149 ! END DO 150 ! 151 ! CALL histend(nice, snc4set) 152 !clem 153 ! 154 !----------------- 155 ! ITD file output 156 !----------------- 157 zsto = rdt_ice 158 clop = "ave(x)" 159 zout = nwrite * rdt_ice / nn_fsbc 160 zdept(1) = 0. 161 162 CALL dia_nam ( clhstnama, nwrite, 'icemoa' ) 163 CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit, & 164 1, jpi, 1, jpj, & ! zoom 165 niter, zjulian, rdt_ice, & ! time 166 nhorida, & ! ? linked with horizontal ... 167 nicea , domain_id=nidom, snc4chunks=snc4set) ! file 168 CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz ) 169 DO jl = 1, jpl 170 zmaskitd(:,:,jl) = tmask(:,:,1) 171 END DO 172 CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 173 CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd ) 174 CALL histdef( nicea, "iice_itd", "Ice area in categories" , "-" , & 175 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 176 CALL histdef( nicea, "iice_hid", "Ice thickness in categories" , "m" , & 177 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 178 CALL histdef( nicea, "iice_hsd", "Snow depth in in categories" , "m" , & 179 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 180 CALL histdef( nicea, "iice_std", "Ice salinity distribution" , "ppt" , & 181 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 182 CALL histdef( nicea, "iice_otd", "Ice age distribution" , "days", & 183 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 184 CALL histdef( nicea, "iice_etd", "Brine volume distr. " , "%" , & 185 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 186 CALL histend(nicea, snc4set) 187 ENDIF 188 189 ! !-----------------------------------------------------------------------! 190 ! !--2. Computation of instantaneous values ! 191 ! !-----------------------------------------------------------------------! 192 193 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 194 !IF( ln_nicep ) THEN 195 ! WRITE(numout,*) 196 ! WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit 197 ! WRITE(numout,*) '~~~~~~~ ' 198 ! WRITE(numout,*) ' kindic = ', kindic 199 !ENDIF 200 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 201 202 !-- calculs des valeurs instantanees 203 zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 204 zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 205 206 ! Ice surface temperature and some fluxes 69 CALL wrk_alloc( jpi, jpj, jpl, zoi, zei ) 70 CALL wrk_alloc( jpi, jpj , z2d, z2da, z2db, zind ) 71 72 !----------------------------- 73 ! Mean category values 74 !----------------------------- 75 76 CALL lim_var_icetm ! mean sea ice temperature 77 78 CALL lim_var_bv ! brine volume 79 80 DO jj = 1, jpj ! presence indicator of ice 81 DO ji = 1, jpi 82 zind(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 83 END DO 84 END DO 85 ! 86 ! 87 CALL iom_put( "iceconc" , at_i ) ! ice concentration 88 ! 89 DO jj = 1, jpj ! mean ice thickness 90 DO ji = 1, jpi 91 z2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj) 92 END DO 93 END DO 94 CALL iom_put( "icethic_cea" , z2d ) ! ice thickness (i.e. icethi(:,:)) 95 CALL iom_put( "icevolu" , vt_i ) ! ice volume = mean ice thickness over the cell 96 DO jj = 1, jpj 97 DO ji = 1, jpi 98 z2d(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj) 99 END DO 100 END DO 101 CALL iom_put( "snowthic_cea" , z2d ) ! snow thickness = mean snow thickness over the cell 102 CALL iom_put( "isst" , sst_m ) ! sea surface temperature 103 CALL iom_put( "isss" , sss_m ) ! sea surface salinity 104 CALL iom_put( "qt_oce" , qns + qsr ) ! total flux at ocean surface 105 ! 106 DO jj = 2 , jpjm1 107 DO ji = 2 , jpim1 108 z2da(ji,jj) = ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 109 z2db(ji,jj) = ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 110 END DO 111 END DO 112 CALL lbc_lnk( z2da, 'T', -1. ) 113 CALL lbc_lnk( z2db, 'T', -1. ) 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 z2d(ji,jj) = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) ) 117 END DO 118 END DO 119 CALL iom_put( "uice_ipa" , z2da ) ! ice velocity u component 120 CALL iom_put( "vice_ipa" , z2db ) ! ice velocity v component 121 CALL iom_put( "icevel" , z2d ) ! ice velocity module 122 !!SF BE CAREFUL : qsr_oce qnd qns_oce are after penetration over ice 123 CALL iom_put( "qsr_oce" , qsr ) ! solar flux at ocean surface 124 CALL iom_put( "qns_oce" , qns ) ! non-solar flux at ocean surface 125 !!SF end be careful 126 CALL iom_put( "utau_ice" , utau_ice ) ! wind stress over ice along i-axis at I-point 127 CALL iom_put( "vtau_ice" , vtau_ice ) ! wind stress over ice along j-axis at I-point 128 !!SF commented because this computation is not ok 129 !SF because qsr is not qsr_ocean but it contains already qsr_ice 130 !SF 131 !SF DO jj = 1 , jpj 132 !SF DO ji = 1 , jpi 133 !SF z2d(ji,jj) = ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj) 134 !SF END DO 135 !SF END DO 136 !SF CALL iom_put( "qsr_io" , z2d ) ! solar flux at ice/ocean surface 137 !SF DO jj = 1 , jpj 138 !SF DO ji = 1 , jpi 139 !SF z2d(ji,jj) = ( 1._wp - at_i(ji,jj) ) * qns(ji,jj) 140 !SF END DO 141 !SF END DO 142 !SF CALL iom_put( "qns_io" , z2d ) ! non-solar flux at ice/ocean surface 143 CALL iom_put( "snowpre" , sprecip ) ! snow precipitation 144 CALL iom_put( "micesalt" , smt_i ) ! mean ice salinity 145 ! 146 z2d(:,:) = 0.e0 207 147 DO jl = 1, jpl 208 148 DO jj = 1, jpj 209 149 DO ji = 1, jpi 210 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 211 zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl) 212 zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl) 213 zcmo(ji,jj,27) = zcmo(ji,jj,27) + zinda*(t_su(ji,jj,jl)-rtt)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 214 zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 150 z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * oa_i(ji,jj,jl) 215 151 END DO 216 152 END DO 217 153 END DO 218 219 ! Mean sea ice temperature 220 CALL lim_var_icetm 221 222 ! Brine volume 223 CALL lim_var_bv 224 225 DO jj = 2 , jpjm1 226 DO ji = 2 , jpim1 227 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 228 zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) ) ) 229 230 zcmo(ji,jj,1) = at_i(ji,jj) 231 zcmo(ji,jj,2) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 232 zcmo(ji,jj,3) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 233 zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * rday ! Bottom thermodynamic ice production 234 zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * rday ! Dynamic ice production (rid/raft) 235 zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * rday ! Lateral thermodynamic ice production 236 zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * rday ! Snow ice production ice production 237 zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda 238 239 zcmo(ji,jj,6) = fbif(ji,jj)*at_i(ji,jj) 240 zcmo(ji,jj,7) = ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 241 zcmo(ji,jj,8) = ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 242 zcmo(ji,jj,9) = sst_m(ji,jj) 243 zcmo(ji,jj,10) = sss_m(ji,jj) 244 245 zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 246 zcmo(ji,jj,12) = qsr(ji,jj) 247 zcmo(ji,jj,13) = qns(ji,jj) 248 zcmo(ji,jj,14) = fhbri(ji,jj) 249 zcmo(ji,jj,15) = utau_ice(ji,jj) 250 zcmo(ji,jj,16) = vtau_ice(ji,jj) 251 zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj) 252 zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj) 253 zcmo(ji,jj,19) = sprecip(ji,jj) 254 zcmo(ji,jj,20) = smt_i(ji,jj) 255 zcmo(ji,jj,25) = et_i(ji,jj) 256 zcmo(ji,jj,26) = et_s(ji,jj) 257 zcmo(ji,jj,28) = sfx_bri(ji,jj) 258 zcmo(ji,jj,29) = sfx_thd(ji,jj) 259 260 zcmo(ji,jj,30) = bv_i(ji,jj) 261 zcmo(ji,jj,31) = hicol(ji,jj) * zindb 262 zcmo(ji,jj,32) = strength(ji,jj) 263 zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 264 zcmo(ji,jj,34) = diag_sur_me(ji,jj) * rday ! Surface melt 265 zcmo(ji,jj,35) = diag_bot_me(ji,jj) * rday ! Bottom melt 266 zcmo(ji,jj,36) = divu_i(ji,jj) 267 zcmo(ji,jj,37) = shear_i(ji,jj) 268 zcmo(ji,jj,38) = diag_res_pr(ji,jj) * rday ! Bottom melt 269 zcmo(ji,jj,39) = vt_i(ji,jj) ! ice volume 270 zcmo(ji,jj,40) = vt_s(ji,jj) ! snow volume 271 272 zcmo(ji,jj,41) = sfx_mec(ji,jj) 273 zcmo(ji,jj,42) = sfx_res(ji,jj) 274 275 zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * rday ! transport of ice volume 276 277 END DO 278 END DO 279 280 ! 281 ! ecriture d'un fichier netcdf 282 ! 283 niter = niter + 1 284 !clem 285 ! DO jf = 1 , noumef 286 ! ! 287 ! zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) 288 ! ! 289 ! IF( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN ; CALL lbc_lnk( zfield, 'T', -1. ) 290 ! ELSE ; CALL lbc_lnk( zfield, 'T', 1. ) 291 ! ENDIF 292 ! ! 293 ! IF( ln_nicep ) THEN 294 ! WRITE(numout,*) 295 ! WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim' 296 ! WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 297 ! ENDIF 298 ! IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 299 ! ! 300 ! END DO 301 ! 302 ! IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 303 ! IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 304 ! CALL histclo( nice ) 305 ! ENDIF 306 !clem 307 ! 308 CALL iom_put ('iceconc', zcmo(:,:,1) ) ! field1: ice concentration 309 CALL iom_put ('icethic_cea', zcmo(:,:,2) ) ! field2: ice thickness (i.e. icethi(:,:)) 310 CALL iom_put ('snowthic_cea', zcmo(:,:,3)) ! field3: snow thickness 311 CALL iom_put ('icebopr', zcmo(:,:,4) ) ! field4: daily bottom thermo ice production 312 CALL iom_put ('icedypr', zcmo(:,:,5) ) ! field5: daily dynamic ice production 313 CALL iom_put ('ioceflxb', zcmo(:,:,6) ) ! field6: Oceanic flux at the ice base 314 CALL iom_put ('uice_ipa', zcmo(:,:,7) ) ! field7: ice velocity u component 315 CALL iom_put ('vice_ipa', zcmo(:,:,8) ) ! field8: ice velocity v component 316 CALL iom_put ('isst', zcmo(:,:,9) ) ! field 9: sea surface temperature 317 CALL iom_put ('isss', zcmo(:,:,10) ) ! field 10: sea surface salinity 318 CALL iom_put ('qt_oce', zcmo(:,:,11) ) ! field 11: total flux at ocean surface 319 CALL iom_put ('qsr_oce', zcmo(:,:,12) ) ! field 12: solar flux at ocean surface 320 CALL iom_put ('qns_oce', zcmo(:,:,13) ) ! field 13: non-solar flux at ocean surface 321 !CALL iom_put ('hfbri', fhbri ) ! field 14: heat flux due to brine release 322 CALL iom_put( 'utau_ice', zcmo(:,:,15) ) ! Wind stress over ice along i-axis at I-point 323 CALL iom_put( 'vtau_ice', zcmo(:,:,16) ) ! Wind stress over ice along j-axis at I-point 324 CALL iom_put ('qsr_io', zcmo(:,:,17) ) ! field 17: solar flux at ice/ocean surface 325 CALL iom_put ('qns_io', zcmo(:,:,18) ) ! field 18: non-solar flux at ice/ocean surface 326 !CALL iom_put ('snowpre', zcmo(:,:,19) * rday ! field 19 :snow precip 327 CALL iom_put ('micesalt', zcmo(:,:,20) ) ! field 20 :mean ice salinity 328 CALL iom_put ('miceage', zcmo(:,:,21) / 365) ! field 21: mean ice age 329 CALL iom_put ('icelapr',zcmo(:,:,22) ) ! field 22: daily lateral thermo ice prod. 330 CALL iom_put ('icesipr',zcmo(:,:,23) ) ! field 23: daily snowice ice prod. 331 CALL iom_put ('micet', zcmo(:,:,24) ) ! field 24: mean ice temperature 332 CALL iom_put ('icehc', zcmo(:,:,25) ) ! field 25: ice total heat content 333 CALL iom_put ('isnowhc', zcmo(:,:,26) ) ! field 26: snow total heat content 334 CALL iom_put ('icest', zcmo(:,:,27) ) ! field 27: ice surface temperature 335 CALL iom_put ('sfxbri', zcmo(:,:,28) * rday ) ! field 28: brine salt flux 336 CALL iom_put ('sfxthd', zcmo(:,:,29) * rday ) ! field 29: equivalent FW salt flux 337 CALL iom_put ('ibrinv', zcmo(:,:,30) *100 ) ! field 30: brine volume 338 CALL iom_put ('icecolf', zcmo(:,:,31) ) ! field 31: frazil ice collection thickness 339 CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 ) ! field 32: ice strength 340 CALL iom_put ('icevel', zcmo(:,:,33) ) ! field 33: ice velocity 341 CALL iom_put ('isume', zcmo(:,:,34) ) ! field 34: surface melt 342 CALL iom_put ('ibome', zcmo(:,:,35) ) ! field 35: bottom melt 343 CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8) ! field 36: divergence 344 CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 ) ! field 37: shear 345 CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate 346 CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume 347 CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume 348 CALL iom_put ('sfxmec', zcmo(:,:,41) * rday ) ! field 41: salt flux from ridging rafting 349 CALL iom_put ('sfxres', zcmo(:,:,42) * rday ) ! field 42: salt flux from limupdate (resultant) 350 CALL iom_put ('icetrp', zcmo(:,:,43) ) ! field 43: ice volume transport 351 352 !----------------------------- 353 ! Thickness distribution file 354 !----------------------------- 355 IF( add_diag_swi == 1 ) THEN 154 z1_365 = 1._wp / 365._wp 155 CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age 156 DO jj = 1, jpj 157 DO ji = 1, jpi 158 z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zind(ji,jj) 159 END DO 160 END DO 161 162 CALL iom_put( "micet" , z2d ) ! mean ice temperature 163 CALL iom_put( "icehc" , et_i ) ! ice total heat content 164 CALL iom_put( "isnowhc" , et_s ) ! snow total heat content 165 ! 166 z2d(:,:) = 0.e0 167 DO jl = 1, jpl 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 ) 171 END DO 172 END DO 173 END DO 174 CALL iom_put( "icest" , z2d ) ! ice surface temperature 175 CALL iom_put( "ibrinv" , bv_i * 100._wp ) ! brine volume 176 DO jj = 1, jpj 177 DO ji = 1, jpi 178 zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) ) 179 z2d(ji,jj) = hicol(ji,jj) * zindb 180 END DO 181 END DO 182 CALL iom_put( "icecolf" , z2d ) ! frazil ice collection thickness 183 CALL iom_put( "icestr" , strength * 0.001 ) ! ice strength 184 CALL iom_put( "idive" , divu_i * 1.0e8 ) ! divergence 185 CALL iom_put( "ishear" , shear_i * 1.0e8 ) ! shear 186 CALL iom_put( "snowvol" , vt_s ) ! snow volume 187 188 CALL iom_put( "icetrp" , diag_trp_vi * rday ) ! ice volume transport 189 CALL iom_put( "snwtrp" , diag_trp_vs * rday ) ! snw volume transport 190 CALL iom_put( "deitrp" , diag_trp_ei ) ! advected ice enthalpy (W/m2) 191 CALL iom_put( "destrp" , diag_trp_es ) ! advected snw enthalpy (W/m2) 192 193 CALL iom_put( "sfxbog" , sfx_bog * rday ) ! salt flux from brines 194 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from brines 195 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from brines 196 CALL iom_put( "sfxsni" , sfx_sni * rday ) ! salt flux from brines 197 CALL iom_put( "sfxopw" , sfx_opw * rday ) ! salt flux from brines 198 CALL iom_put( "sfxdyn" , sfx_dyn * rday ) ! salt flux from ridging rafting 199 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from limupdate (resultant) 200 CALL iom_put( "sfxbri" , sfx_bri * rday ) ! salt flux from brines 201 CALL iom_put( "sfx" , sfx * rday ) ! total salt flux 202 203 CALL iom_put( "vfxres" , wfx_res * rday / rhoic ) ! daily prod./melting due to limupdate 204 CALL iom_put( "vfxopw" , wfx_opw * rday / rhoic ) ! daily lateral thermodynamic ice production 205 CALL iom_put( "vfxsni" , wfx_sni * rday / rhoic ) ! daily snowice ice production 206 CALL iom_put( "vfxbog" , wfx_bog * rday / rhoic ) ! daily bottom thermodynamic ice production 207 CALL iom_put( "vfxdyn" , wfx_dyn * rday / rhoic ) ! daily dynamic ice production (rid/raft) 208 CALL iom_put( "vfxsum" , wfx_sum * rday / rhoic ) ! surface melt 209 CALL iom_put( "vfxbom" , wfx_bom * rday / rhoic ) ! bottom melt 210 CALL iom_put( "vfxice" , wfx_ice * rday / rhoic ) ! total ice growth/melt 211 CALL iom_put( "vfxsnw" , wfx_snw * rday / rhoic ) ! total snw growth/melt 212 CALL iom_put( "vfxsub" , wfx_sub * rday / rhoic ) ! sublimation (snow) 213 214 CALL iom_put ('hfxdhc1', diag_heat_dhc1(:,:) ) ! Heat content variation in snow and ice 215 CALL iom_put ('hfxspr', hfx_spr(:,:) ) ! Heat content of snow precip 216 CALL iom_put ('hfxqsr', qsr(:,:) ) ! solar fluxes used by snw/ice 217 CALL iom_put ('hfxqns', qns(:,:) ) ! non solar fluxes used by snw/ice 218 219 CALL iom_put ('hfxthd', hfx_thd(:,:) ) ! 220 CALL iom_put ('hfxdyn', hfx_dyn(:,:) ) ! 221 CALL iom_put ('hfxres', hfx_res(:,:) ) ! 222 CALL iom_put ('hfxout', hfx_out(:,:) ) ! 223 CALL iom_put ('hfxin' , hfx_in(:,:) ) ! 224 CALL iom_put ('hfxtot', hfx_tot(:,:) ) ! 225 CALL iom_put ('hfxsnw', hfx_snw(:,:) ) ! 226 CALL iom_put ('hfxsub', hfx_sub(:,:) ) ! 227 CALL iom_put ('hfxerr', hfx_err(:,:) ) ! 228 CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) ) ! 229 230 !-------------------------------- 231 ! Output values for each category 232 !-------------------------------- 356 233 357 234 DO jl = 1, jpl … … 367 244 DO jj = 1, jpj 368 245 DO ji = 1, jpi 369 zinda = MAX( zzero , SIGN( zone, a_i(ji,jj,jl) - epsi06 ) )246 zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 370 247 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda 371 248 END DO 372 249 END DO 373 250 END DO 251 252 CALL iom_put( "iceage_cat" , zoi ) ! ice age for categories 374 253 375 254 ! Compute brine volume … … 379 258 DO jj = 1, jpj 380 259 DO ji = 1, jpi 381 zinda = MAX( zzero , SIGN( zone, a_i(ji,jj,jl) - epsi06 ) )260 zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 382 261 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 383 262 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * & … … 392 271 END DO 393 272 394 CALL histwrite( nicea, "iice_itd", niter, a_i , ndimitd , ndexitd ) ! area 395 CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd ) ! thickness 396 CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd ) ! snow depth 397 CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd ) ! salinity 398 CALL histwrite( nicea, "iice_otd", niter, zoi , ndimitd , ndexitd ) ! age 399 CALL histwrite( nicea, "iice_etd", niter, zei , ndimitd , ndexitd ) ! brine volume 273 CALL iom_put( "iceconc_cat" , a_i ) ! area for categories 274 CALL iom_put( "icethic_cat" , ht_i ) ! thickness for categories 275 CALL iom_put( "snowthic_cat" , ht_s ) ! snow depth for categories 276 CALL iom_put( "salinity_cat" , sm_i ) ! salinity for categories 277 CALL iom_put( "brinevol_cat" , zei ) ! brine volume for categories 400 278 401 279 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s … … 403 281 ! not yet implemented 404 282 405 IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 406 IF(lwp) WRITE(numout,*) ' Closing the icemod file ' 407 CALL histclo( nicea ) 408 ENDIF 409 ! 410 ENDIF 411 412 CALL wrk_dealloc( jpi, jpj, zfield ) 413 CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 414 CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 283 CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei ) 284 CALL wrk_dealloc( jpi, jpj , z2d, zind, z2da, z2db ) 415 285 416 286 IF( nn_timing == 1 ) CALL timing_stop('limwri') … … 419 289 #endif 420 290 421 SUBROUTINE lim_wri_init422 !!-------------------------------------------------------------------423 !! *** ROUTINE lim_wri_init ***424 !!425 !! ** Purpose : ???426 !!427 !! ** Method : Read the namicewri namelist and check the parameter428 !! values called at the first timestep (nit000)429 !!430 !! ** input : Namelist namicewri431 !!-------------------------------------------------------------------432 INTEGER :: nf ! ???433 434 TYPE FIELD435 CHARACTER(len = 35) :: ztitle436 CHARACTER(len = 8 ) :: zname437 CHARACTER(len = 8 ) :: zunit438 INTEGER :: znc439 REAL :: zcmulti440 REAL :: zcadd441 END TYPE FIELD442 443 TYPE(FIELD) :: &444 field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &445 field_7 , field_8 , field_9 , field_10, field_11, field_12, &446 field_13, field_14, field_15, field_16, field_17, field_18, &447 field_19, field_20, field_21, field_22, field_23, field_24, &448 field_25, field_26, field_27, field_28, field_29, field_30, &449 field_31, field_32, field_33, field_34, field_35, field_36, &450 field_37, field_38, field_39, field_40, field_41, field_42, field_43451 452 TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield453 !454 NAMELIST/namiceout/ noumef, &455 field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &456 field_7 , field_8 , field_9 , field_10, field_11, field_12, &457 field_13, field_14, field_15, field_16, field_17, field_18, &458 field_19, field_20, field_21, field_22, field_23, field_24, &459 field_25, field_26, field_27, field_28, field_29, field_30, &460 field_31, field_32, field_33, field_34, field_35, field_36, &461 field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi462 !!-------------------------------------------------------------------463 464 REWIND( numnam_ice ) ! Read Namelist namicewri465 READ ( numnam_ice , namiceout )466 467 zfield(1) = field_1468 zfield(2) = field_2469 zfield(3) = field_3470 zfield(4) = field_4471 zfield(5) = field_5472 zfield(6) = field_6473 zfield(7) = field_7474 zfield(8) = field_8475 zfield(9) = field_9476 zfield(10) = field_10477 zfield(11) = field_11478 zfield(12) = field_12479 zfield(13) = field_13480 zfield(14) = field_14481 zfield(15) = field_15482 zfield(16) = field_16483 zfield(17) = field_17484 zfield(18) = field_18485 zfield(19) = field_19486 zfield(20) = field_20487 zfield(21) = field_21488 zfield(22) = field_22489 zfield(23) = field_23490 zfield(24) = field_24491 zfield(25) = field_25492 zfield(26) = field_26493 zfield(27) = field_27494 zfield(28) = field_28495 zfield(29) = field_29496 zfield(30) = field_30497 zfield(31) = field_31498 zfield(32) = field_32499 zfield(33) = field_33500 zfield(34) = field_34501 zfield(35) = field_35502 zfield(36) = field_36503 zfield(37) = field_37504 zfield(38) = field_38505 zfield(39) = field_39506 zfield(40) = field_40507 zfield(41) = field_41508 zfield(42) = field_42509 zfield(43) = field_43510 511 DO nf = 1, noumef512 titn (nf) = zfield(nf)%ztitle513 nam (nf) = zfield(nf)%zname514 uni (nf) = zfield(nf)%zunit515 nc (nf) = zfield(nf)%znc516 cmulti(nf) = zfield(nf)%zcmulti517 cadd (nf) = zfield(nf)%zcadd518 END DO519 520 IF(lwp) THEN ! control print521 WRITE(numout,*)522 WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'523 WRITE(numout,*) '~~~~~~~~~~~~'524 WRITE(numout,*) ' number of fields to be stored noumef = ', noumef525 WRITE(numout,*) ' title name unit Saving (1/0) ', &526 & ' multiplicative constant additive constant '527 DO nf = 1 , noumef528 WRITE(numout,*) ' ', titn(nf), ' ' , nam (nf), ' ' , uni (nf), &529 & ' ' , nc (nf),' ', cmulti(nf), ' ', cadd(nf)530 END DO531 WRITE(numout,*) ' add_diag_swi ', add_diag_swi532 ENDIF533 !534 END SUBROUTINE lim_wri_init535 291 536 292 SUBROUTINE lim_wri_state( kt, kid, kh_i ) … … 549 305 INTEGER, INTENT( in ) :: kid , kh_i 550 306 !!---------------------------------------------------------------------- 551 !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz )307 552 308 553 309 CALL histdef( kid, "iicethic", "Ice thickness" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) … … 572 328 CALL histdef( kid, "iicesume", "Ice surface melt" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 573 329 CALL histdef( kid, "iisfxthd", "Salt flux from thermo" , "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 574 CALL histdef( kid, "iisfx mec", "Salt flux from dynmics" , "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )330 CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics" , "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 575 331 CALL histdef( kid, "iisfxres", "Salt flux from limupdate", "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 576 577 578 !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )579 !CALL histdef( kid, "iice_hid", "Ice thickness by cat" , "m" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )580 !CALL histdef( kid, "iice_hsd", "Snow thickness by cat" , "m" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )581 !CALL histdef( kid, "iice_std", "Ice salinity by cat" , "PSU" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )582 332 583 333 CALL histend( kid, snc4set ) ! end of the file definition … … 597 347 CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 598 348 599 CALL histwrite( kid, "iicebopr", kt, diag_bot_gr, jpi*jpj, (/1/) )600 CALL histwrite( kid, "iicedypr", kt, diag_dyn_gr, jpi*jpj, (/1/) )601 CALL histwrite( kid, "iicelapr", kt, diag_lat_gr, jpi*jpj, (/1/) )602 CALL histwrite( kid, "iicesipr", kt, diag_sni_gr, jpi*jpj, (/1/) )603 CALL histwrite( kid, "iicerepr", kt, diag_res_pr, jpi*jpj, (/1/) )604 CALL histwrite( kid, "iicebome", kt, diag_bot_me, jpi*jpj, (/1/) )605 CALL histwrite( kid, "iicesume", kt, diag_sur_me, jpi*jpj, (/1/) )606 CALL histwrite( kid, "iisfxthd", kt, sfx_thd , jpi*jpj, (/1/) )607 CALL histwrite( kid, "iisfx mec", kt, sfx_mec, jpi*jpj, (/1/) )349 CALL histwrite( kid, "iicebopr", kt, wfx_bog , jpi*jpj, (/1/) ) 350 CALL histwrite( kid, "iicedypr", kt, wfx_dyn , jpi*jpj, (/1/) ) 351 CALL histwrite( kid, "iicelapr", kt, wfx_opw , jpi*jpj, (/1/) ) 352 CALL histwrite( kid, "iicesipr", kt, wfx_sni , jpi*jpj, (/1/) ) 353 CALL histwrite( kid, "iicerepr", kt, wfx_res , jpi*jpj, (/1/) ) 354 CALL histwrite( kid, "iicebome", kt, wfx_bom , jpi*jpj, (/1/) ) 355 CALL histwrite( kid, "iicesume", kt, wfx_sum , jpi*jpj, (/1/) ) 356 !CALL histwrite( kid, "iisfxthd", kt, sfx_thd , jpi*jpj, (/1/) ) 357 CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn , jpi*jpj, (/1/) ) 608 358 CALL histwrite( kid, "iisfxres", kt, sfx_res , jpi*jpj, (/1/) ) 609 359 610 !CALL histwrite( kid, "iice_itd", kt, a_i , jpi*jpj*jpl, (/1/) ) ! area 611 !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/) ) ! thickness 612 !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/) ) ! snow depth 613 !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/) ) ! salinity 360 ! Close the file 361 ! ----------------- 362 CALL histclo( kid ) 614 363 615 364 END SUBROUTINE lim_wri_state -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
r3764 r4634 89 89 DO jj = 2 , jpjm1 90 90 DO ji = 2 , jpim1 ! NO vector opt. 91 zindh = MAX( zzero , SIGN( zone, ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )92 zinda = MAX( zzero , SIGN( zone, ( 1.0 - frld(ji,jj) ) - 0.10 ) )91 zindh = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 92 zinda = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 93 93 zindb = zindh * zinda 94 ztmu = MAX( 0.5 * zone, ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )94 ztmu = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 95 95 zcmo(ji,jj,1) = ht_s (ji,jj,1) 96 96 zcmo(ji,jj,2) = ht_i (ji,jj,1) 97 zcmo(ji,jj,3) = hicifp(ji,jj)97 zcmo(ji,jj,3) = 0. 98 98 zcmo(ji,jj,4) = frld (ji,jj) 99 99 zcmo(ji,jj,5) = sist (ji,jj) 100 zcmo(ji,jj,6) = f bif(ji,jj)100 zcmo(ji,jj,6) = fhtur (ji,jj) 101 101 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 102 102 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & … … 132 132 DO jj = 2 , jpjm1 133 133 DO ji = 2 , jpim1 ! NO vector opt. 134 zindh = MAX( zzero , SIGN( zone, ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )135 zinda = MAX( zzero , SIGN( zone, ( 1.0 - frld(ji,jj) ) - 0.10 ) )134 zindh = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 135 zinda = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 136 136 zindb = zindh * zinda 137 ztmu = MAX( 0.5 * zone, ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )137 ztmu = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 138 138 rcmoy(ji,jj,1) = ht_s (ji,jj,1) 139 139 rcmoy(ji,jj,2) = ht_i (ji,jj,1) 140 rcmoy(ji,jj,3) = hicifp(ji,jj)140 rcmoy(ji,jj,3) = 0. 141 141 rcmoy(ji,jj,4) = frld (ji,jj) 142 142 rcmoy(ji,jj,5) = sist (ji,jj) 143 rcmoy(ji,jj,6) = f bif(ji,jj)143 rcmoy(ji,jj,6) = fhtur (ji,jj) 144 144 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 145 145 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r4045 r4634 49 49 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npac !: correspondance between points (lateral accretion) 50 50 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qldif_1d !: <==> the 2D qldif 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qcmif_1d !: <==> the 2D qcmif 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fstbif_1d !: <==> the 2D fstric 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fltbif_1d !: <==> the 2D ffltbif 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fscbq_1d !: <==> the 2D fscmcbq 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlead_1d !: <==> the 2D qlead 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftr_ice_1d !: <==> the 2D ftr_ice 56 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsr_ice_1d !: <==> the 2D qsr_ice 57 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr1_i0_1d !: <==> the 2D fr1_i0 58 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr2_i0_1d !: <==> the 2D fr2_i0 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qnsr_ice_1d !: <==> the 2D qns_ice 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qfvbq_1d !: <==> the 2D qfvbq 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qns_ice_1d !: <==> the 2D qns_ice 61 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_bo_b !: <==> the 2D t_bo 58 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_tot_1d 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_thd_1d 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_spr_1d 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_snw_1d 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_sub_1d 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_res_1d 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_1d 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_rem_1d 67 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_ice_1d !: <==> the 2D wfx_ice 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_snw_1d !: <==> the 2D wfx_snw 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sub_1d !: <==> the 2D wfx_sub 71 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_bog_1d !: <==> the 2D wfx_ice 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_bom_1d !: <==> the 2D wfx_ice 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sum_1d !: <==> the 2D wfx_ice 75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sni_1d !: <==> the 2D wfx_ice 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_opw_1d !: <==> the 2D wfx_ice 77 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bri_1d !: <==> the 2D sfx_bri 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bog_1d !: 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bom_1d !: 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sum_1d !: 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sni_1d !: 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_opw_1d !: 62 84 63 85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sprecip_1d !: <==> the 2D sprecip 64 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: frld_1d !: <==> the 2D frld 65 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_b !: <==> the 2D frld 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fbif_1d !: <==> the 2D fbif 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm_ice_1d !: <==> the 2D rdm_ice 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm_snw_1d !: <==> the 2D rdm_snw 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlbbq_1d !: <==> the 2D qlbsbq 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dmgwi_1d !: <==> the 2D dmgwi 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvsbq_1d !: <==> the 2D rdvosif 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvbbq_1d !: <==> the 2D rdvobif 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvlbq_1d !: <==> the 2D rdvolif 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvnbq_1d !: <==> the 2D rdvolif 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhtur_1d !: <==> the 2D fhtur 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhld_1d !: <==> the 2D fhld 75 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqns_ice_1d !: <==> the 2D dqns_ice 76 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qla_ice_1d !: <==> the 2D qla_ice … … 78 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tatm_ice_1d !: <==> the 2D tatm_ice 79 94 ! ! to reintegrate longwave flux inside the ice thermodynamics 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fsup !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: focea !: Remaining energy in case of total ablation82 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_i_b !: Ice thickness at the beginnning of the time step [m]84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_s_b !: Snow thickness at the beginning of the time step [m]85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bri_1d !: <==> the 2D sfx_bri86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhbri_1d !: Heat flux due to brine drainage87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_thd_1d !: <==> the 2D sfx_thd88 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_fl_1d !: Ice salinity variations due to flushing 89 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_gd_1d !: Ice salinity variations due to gravity drainage … … 104 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sm_i_b !: Ice bulk salinity [ppt] 105 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_snowice !: Salinity of new snow ice on top of the ice107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: o_i_b !: Ice age [days]108 114 109 115 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: iatte_1d !: clem attenuation coef of the input solar flux (unitless) … … 116 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_s_b !: Snow enthalpy per unit volume 117 123 118 ! Clean the following ... 119 ! These variables are coded for conservation checks 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_i_in !: ice energy summed over categories (initial) 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_i_fin !: ice energy summed over categories (final) 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_s_in, qt_s_fin !: snow energy summed over categories 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dq_i, sum_fluxq !: increment of energy, sum of fluxes 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fatm, foce !: atmospheric, oceanic, heat flux 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cons_error, surf_error !: conservation, surface error 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dq_i !: variation of ice enthalpy (debug) 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dq_s !: variation of snw enthalpy (debug) 126 126 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_layer_in !: goes to trash 128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_layer_fin !: goes to trash 129 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dq_i_layer, radab !: goes to trash 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qh_i_old !: ice heat content (q*h, J.m-2) 128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_i_old !: ice thickness layer (m) 130 129 131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftotal_in !: initial total heat flux132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftotal_fin !: final total heat flux133 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fc_s135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fc_i136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: de_s_lay137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: de_i_lay138 139 130 INTEGER , PUBLIC :: jiindex_1d ! 1D index of debugging point 140 131 … … 151 142 !!---------------------------------------------------------------------! 152 143 INTEGER :: thd_ice_alloc ! return value 153 INTEGER :: ierr( 4)144 INTEGER :: ierr(3) 154 145 !!---------------------------------------------------------------------! 155 146 156 147 ALLOCATE( npb (jpij) , npac (jpij), & 157 148 ! ! 158 & qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d (jpij) , & 159 & fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) , & 160 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) , & 161 & qfvbq_1d (jpij) , t_bo_b (jpij) , iatte_1d (jpij) , & 162 & oatte_1d (jpij) , STAT=ierr(1) ) 149 & qlead_1d (jpij) , ftr_ice_1d (jpij) , & 150 & qsr_ice_1d (jpij) , & 151 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) , & 152 & t_bo_b (jpij) , iatte_1d (jpij) , & 153 & oatte_1d (jpij) , hfx_tot_1d(jpij), hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 154 & hfx_snw_1d(jpij), hfx_sub_1d(jpij), hfx_err_1d(jpij) , hfx_res_1d(jpij) , hfx_err_rem_1d(jpij), STAT=ierr(1) ) 163 155 ! 164 156 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_b (jpij) , & 165 & fbif_1d (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) , & 166 & qlbbq_1d (jpij) , dmgwi_1d (jpij) , dvsbq_1d (jpij) , & 167 & dvbbq_1d (jpij) , dvlbq_1d (jpij) , dvnbq_1d (jpij) , & 157 & fhtur_1d (jpij) , wfx_ice_1d (jpij) , wfx_snw_1d (jpij) , & 158 & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , & 168 159 & dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) , & 169 & tatm_ice_1d(jpij) , fsup (jpij) , focea (jpij) ,&170 & i0 (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,&171 & sfx_bri_1d (jpij) , fhbri_1d (jpij) , sfx_thd_1d (jpij) ,&160 & tatm_ice_1d(jpij) , & 161 & i0 (jpij) , & 162 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , & 172 163 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 173 164 & dsm_i_si_1d(jpij) , hicol_b (jpij) , STAT=ierr(2) ) … … 176 167 & ht_s_b (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 177 168 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) , & 178 & dh_snowice(jpij) , sm_i_b (jpij) , s_i_new (jpij) , & 179 & s_snowice (jpij) , o_i_b (jpij) , & 180 ! ! 181 & t_s_b(jpij,nlay_s), & 182 ! ! 169 & dh_snowice(jpij) , sm_i_b (jpij) , s_i_new (jpij) , & 170 & dq_i (jpij) , dq_s (jpij), t_s_b(jpij,nlay_s), & 183 171 & t_i_b(jpij,jkmax), s_i_b(jpij,jkmax) , & 184 & q_i_b(jpij,jkmax), q_s_b(jpij,jkmax) , STAT=ierr(3)) 172 & q_i_b(jpij,jkmax), q_s_b(jpij,jkmax) , & 173 & qh_i_old(jpij,0:jkmax), h_i_old(jpij,0:jkmax) , STAT=ierr(3)) 185 174 ! 186 ALLOCATE( qt_i_in (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in (jpij,jpl) , &187 & qt_s_fin (jpij,jpl) , dq_i (jpij,jpl) , sum_fluxq (jpij,jpl) , &188 & fatm (jpij,jpl) , foce (jpij,jpl) , cons_error(jpij,jpl) , &189 & surf_error(jpij,jpl) , &190 ! !191 & q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax) , &192 & dq_i_layer (jpij,jkmax) , radab (jpij,jkmax) , &193 ! !194 & ftotal_in(jpij), ftotal_fin(jpij) , &195 ! !196 & fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s) , &197 & fc_i(jpij,0:jkmax) , de_i_lay(jpij,jkmax) , STAT=ierr(4) )198 199 175 thd_ice_alloc = MAXVAL( ierr ) 200 176 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
r3294 r4634 468 468 #else 469 469 DO jh = 1, nb_ana 470 CALL iom_put( TRIM(tname(jh))//'x_v', out_ u(:,:,jh) )471 CALL iom_put( TRIM(tname(jh))//'y_v', out_ u(:,:,nb_ana+jh) )470 CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh) ) 471 CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,nb_ana+jh) ) 472 472 END DO 473 473 #endif -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4045 r4634 12 12 !! ! 1999-02 (E. Guilyardi) name of netCDF files + variables 13 13 !! 8.2 ! 2000-06 (M. Imbard) Original code (diabort.F) 14 !! NEMO 1.0 ! 2002-06 ( A.Bozec, E. Durand) Original code (diainit.F)14 !! NEMO 1.0 ! 2002-06 (RUN025_CTL_DIAGA.Bozec, E. Durand) Original code (diainit.F) 15 15 !! - ! 2002-09 (G. Madec) F90: Free form and module 16 16 !! - ! 2002-12 (G. Madec) merge of diabort and diainit, F90 … … 129 129 REAL(wp) :: zztmp, zztmpx, zztmpy ! 130 130 !! 131 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 131 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 132 REAL(wp), POINTER, DIMENSION(:,:) :: z2ds ! 2D workspace 132 133 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace 133 134 !!---------------------------------------------------------------------- … … 135 136 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 136 137 ! 137 CALL wrk_alloc( jpi , jpj , z2d )138 CALL wrk_alloc( jpi , jpj , z2d , z2ds ) 138 139 CALL wrk_alloc( jpi , jpj, jpk , z3d ) 139 140 ! … … 176 177 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 177 178 179 ! clem: heat and salt content 180 z2d(:,:) = 0._wp 181 z2ds(:,:) = 0._wp 182 DO jk = 1, jpkm1 183 DO jj = 2, jpjm1 184 DO ji = fs_2, fs_jpim1 ! vector opt. 185 z2d(ji,jj) = z2d(ji,jj) + rau0 * rcp * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 186 z2ds(ji,jj) = z2ds(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 187 END DO 188 END DO 189 END DO 190 CALL lbc_lnk( z2d, 'T', 1. ) 191 CALL lbc_lnk( z2ds, 'T', 1. ) 192 CALL iom_put( "heatc", z2d ) ! vertically integrated heat content (J/m2) 193 CALL iom_put( "saltc", z2ds ) ! vertically integrated salt content (PSU*kg/m2) 194 195 178 196 IF( lk_diaar5 ) THEN 179 197 z3d(:,:,jpk) = 0.e0 180 198 DO jk = 1, jpkm1 181 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 199 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 182 200 END DO 183 201 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 202 184 203 zztmp = 0.5 * rcp 185 204 z2d(:,:) = 0.e0 205 z2ds(:,:) = 0.e0 186 206 DO jk = 1, jpkm1 187 207 DO jj = 2, jpjm1 188 208 DO ji = fs_2, fs_jpim1 ! vector opt. 189 209 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 210 z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 190 211 END DO 191 212 END DO 192 213 END DO 193 214 CALL lbc_lnk( z2d, 'U', -1. ) 215 CALL lbc_lnk( z2ds, 'U', -1. ) 194 216 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction 217 CALL iom_put( "u_salttr", z2ds ) ! salt transport in i-direction 218 219 z3d(:,:,jpk) = 0.e0 195 220 DO jk = 1, jpkm1 196 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 221 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 197 222 END DO 198 223 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 224 199 225 z2d(:,:) = 0.e0 226 z2ds(:,:) = 0.e0 200 227 DO jk = 1, jpkm1 201 228 DO jj = 2, jpjm1 202 229 DO ji = fs_2, fs_jpim1 ! vector opt. 203 230 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 231 z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 204 232 END DO 205 233 END DO 206 234 END DO 207 235 CALL lbc_lnk( z2d, 'V', -1. ) 208 CALL iom_put( "v_heattr", z2d ) ! heat transport in i-direction 209 ENDIF 210 ! 211 CALL wrk_dealloc( jpi , jpj , z2d ) 236 CALL lbc_lnk( z2ds, 'V', -1. ) 237 CALL iom_put( "v_heattr", z2d ) ! heat transport in j-direction 238 CALL iom_put( "v_salttr", z2ds ) ! salt transport in j-direction 239 ENDIF 240 ! 241 CALL wrk_dealloc( jpi , jpj , z2d , z2ds ) 212 242 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 213 243 ! -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r3625 r4634 54 54 REAL(wp), PUBLIC :: r1_rau0 !: = 1. / rau0 [m3/kg] 55 55 REAL(wp), PUBLIC :: rauw = 1000._wp !: volumic mass of pure water [m3/kg] 56 REAL(wp), PUBLIC :: rcp = 4.e3_wp !: ocean specific heat [J/ Kelvin]57 REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [ Kelvin/J]56 REAL(wp), PUBLIC :: rcp = 4.e3_wp !: ocean specific heat [J/kg/K] 57 REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [kg.K/J] 58 58 REAL(wp), PUBLIC :: r1_rau0_rcp !: = 1. / ( rau0 * rcp ) 59 59 … … 69 69 #if defined key_lim3 || defined key_cice 70 70 REAL(wp), PUBLIC :: rhoic = 917._wp !: volumic mass of sea ice [kg/m3] 71 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice 72 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow 73 REAL(wp), PUBLIC :: cpic = 2067.0_wp !: specific heat for ice 71 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice [W/m/K] 72 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow [W/m/K] 73 REAL(wp), PUBLIC :: cpic = 2067.0_wp !: specific heat for ice [J/kg/K] 74 74 REAL(wp), PUBLIC :: lsub = 2.834e+6_wp !: pure ice latent heat of sublimation [J/kg] 75 75 REAL(wp), PUBLIC :: lfus = 0.334e+6_wp !: latent heat of fusion of fresh ice [J/kg] 76 REAL(wp), PUBLIC :: tmut = 0.054_wp !: decrease of seawater meltpoint with salinity 76 REAL(wp), PUBLIC :: tmut = 0.054_wp !: decrease of seawater meltpoint with salinity [degC/ppt] 77 77 REAL(wp), PUBLIC :: xlsn !: = lfus*rhosn (volumetric latent heat fusion of snow) [J/m3] 78 78 #else -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r4345 r4634 32 32 USE trc_oce, ONLY : nn_dttrc ! !: frequency of step on passive tracers 33 33 USE icb_oce, ONLY : class_num ! !: iceberg classes 34 USE par_ice 34 35 USE domngb ! ocean space and time domain 35 36 USE phycst ! physical constants … … 131 132 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 132 133 # endif 134 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 133 135 CALL iom_set_axis_attr( "icbcla", class_num ) 134 136 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r3625 r4634 599 599 zdqlw = 4.0 * emic * stefan * ztice3 600 600 zdqsb = zrhovacshi 601 zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) ) 601 602 ! MV 2014 we must cap derivative also 603 IF ( p_qla(ji,jj,jl) .GT. 0.0 ) THEN 604 zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) ) 605 ELSE 606 zdqla = 0.0 607 ENDIF 602 608 ! 603 609 p_dqla(ji,jj,jl) = zdqla ! latent flux sensitivity -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4332 r4634 70 70 REAL(wp), PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation 71 71 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 72 REAL(wp), PARAMETER :: Cice = 1. 4e-3 ! iovi 1.63e-3 ! transfer coefficient over ice72 REAL(wp), PARAMETER :: Cice = 1.63e-3 ! MV Drag, water, and heat transfer coefficient in CORE formulation 73 73 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 74 74 … … 494 494 zcoef_dqsb = rhoa * cpa * Cice 495 495 zcoef_frca = 1.0 - 0.3 496 ! MV 2014 the proper cloud fraction (mean summer months from the CLIO climato, NH+SH) is 0.19 497 zcoef_frca = 1.0 - 0.19 496 498 497 499 !!gm brutal.... … … 579 581 p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 580 582 ! Long Wave (lw) 583 ! MV come back to the original CORE forcing 581 584 ! iovino 582 IF( ff(ji,jj) .GT. 0._wp ) THEN583 z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)584 ELSE585 586 ENDIF585 ! IF( ff(ji,jj) .GT. 0._wp ) THEN 586 ! z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 587 ! ELSE 588 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 589 ! ENDIF 587 590 ! lw sensitivity 588 591 z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 … … 599 602 & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) ) 600 603 ! Latent heat sensitivity for ice (Dqla/Dt) 601 p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 604 ! MV we also have to cap the sensitivity if the flux is zero 605 IF ( p_qla(ji,jj,jl) .GT. 0.0 ) THEN 606 p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 607 ELSE 608 p_dqla(ji,jj,jl) = 0.0 609 ENDIF 610 602 611 ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 603 612 z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r4345 r4634 59 59 USE prtctl ! Print control 60 60 USE lib_fortran ! 61 USE cpl_oasis3, ONLY : lk_cpl 61 62 62 63 #if defined key_bdy … … 133 134 INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE) 134 135 !! 135 INTEGER :: j l! dummy loop index136 INTEGER :: ji, jj, jl, jk ! dummy loop index 136 137 REAL(wp) :: zcoef ! local scalar 137 138 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice_os, zalb_ice_cs ! albedo of the ice under overcast/clear sky 138 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean albedo of ice (for coupled)139 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean albedo of ice 139 140 140 141 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_ice_all ! Mean albedo over all categories … … 146 147 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all ! Mean d(qns)/dT over all categories 147 148 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all ! Mean d(qla)/dT over all categories 149 REAL(wp) :: ztmelts ! clem 2014: for HC diags 150 REAL(wp) :: epsi20 = 1.e-20 ! 148 151 !!---------------------------------------------------------------------- 149 152 … … 152 155 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 153 156 154 CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 155 156 #if defined key_coupled 157 IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_alloc( jpi,jpj,jpl, zalb_ice) 158 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 159 & CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 160 #endif 157 CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 158 159 IF( lk_cpl ) THEN 160 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 161 & CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 162 ENDIF 161 163 162 164 IF( kt == nit000 ) THEN … … 168 170 ! 169 171 IF( ln_nicep ) THEN ! control print at a given point 170 jiindx = 177 ; jjindx = 112172 jiindx = 3 ; jjindx = 49 171 173 IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 172 174 ENDIF … … 176 178 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only ! 177 179 ! !----------------------! 178 ! ! Bulk Formul ea!180 ! ! Bulk Formulae ! 179 181 ! !----------------! 180 182 ! … … 192 194 IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) + zalb_ice_os (:,:,:) ) 193 195 194 #if defined key_coupled 195 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 196 ! 197 ! Compute mean albedo and temperature 198 zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) ) 199 ztem_ice_all (:,:) = fice_ice_ave ( tn_ice (:,:,:) ) 200 ! 196 IF( lk_cpl ) THEN 197 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 198 ! 199 ! Compute mean albedo and temperature 200 zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) ) 201 ztem_ice_all (:,:) = fice_ice_ave ( tn_ice (:,:,:) ) 202 ! 203 ENDIF 201 204 ENDIF 202 #endif203 205 ! Bulk formulea - provides the following fields: 204 206 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] … … 218 220 ! 219 221 CASE( 4 ) ! CORE bulk formulation 220 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice_cs, & 222 ! MV 2014 223 ! We must account for cloud fraction in the computation of the albedo 224 ! The present ref just uses the clear sky value 225 ! The overcast sky value is 0.06 higher, and polar skies are mostly overcast 226 ! CORE has no cloud fraction, hence we must prescribe it 227 ! Mean summer cloud fraction computed from CLIO = 0.81 228 zalb_ice(:,:,:) = 0.19 * zalb_ice_cs(:,:,:) + 0.81 * zalb_ice_os(:,:,:) 229 ! Following line, we replace zalb_ice_cs by simply zalb_ice 230 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , & 221 231 & utau_ice , vtau_ice , qns_ice , qsr_ice , & 222 232 & qla_ice , dqns_ice , dqla_ice , & … … 239 249 240 250 ! Average over all categories 241 #if defined key_coupled 251 IF( lk_cpl ) THEN 242 252 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 243 253 … … 269 279 END IF 270 280 END IF 271 #endif 281 ENDIF 272 282 ! !----------------------! 273 283 ! ! LIM-3 time-stepping ! … … 285 295 old_smv_i(:,:,:) = smv_i(:,:,:) ! salt content 286 296 old_oa_i (:,:,:) = oa_i (:,:,:) ! areal age content 287 !288 old_ u_ice(:,:) = u_ice(:,:)289 old_v_ice(:,:) = v_ice(:,:) 290 ! ! intialisation to zero!!gm is it truly necessary ???297 old_u_ice(:,:) = u_ice(:,:) 298 old_v_ice(:,:) = v_ice(:,:) 299 300 ! trends !!gm is it truly necessary ??? 291 301 d_a_i_thd (:,:,:) = 0._wp ; d_a_i_trp (:,:,:) = 0._wp 292 302 d_v_i_thd (:,:,:) = 0._wp ; d_v_i_trp (:,:,:) = 0._wp … … 296 306 d_smv_i_thd(:,:,:) = 0._wp ; d_smv_i_trp(:,:,:) = 0._wp 297 307 d_oa_i_thd (:,:,:) = 0._wp ; d_oa_i_trp (:,:,:) = 0._wp 298 ! 299 d_u_ice_dyn(:,:) = 0._wp 300 d_v_ice_dyn(:,:) = 0._wp 301 ! 302 sfx (:,:) = 0._wp ; sfx_thd (:,:) = 0._wp 303 sfx_bri(:,:) = 0._wp ; sfx_mec (:,:) = 0._wp ; sfx_res (:,:) = 0._wp 304 fhbri (:,:) = 0._wp ; fheat_mec(:,:) = 0._wp ; fheat_res(:,:) = 0._wp 305 fhmec (:,:) = 0._wp ; 306 fmmec (:,:) = 0._wp 307 fmmflx (:,:) = 0._wp 308 focea2D(:,:) = 0._wp 309 fsup2D (:,:) = 0._wp 310 311 ! used in limthd.F90 312 rdvosif(:,:) = 0._wp ! variation of ice volume at surface 313 rdvobif(:,:) = 0._wp ! variation of ice volume at bottom 314 fdvolif(:,:) = 0._wp ! total variation of ice volume 315 rdvonif(:,:) = 0._wp ! lateral variation of ice volume 316 fstric (:,:) = 0._wp ! part of solar radiation transmitted through the ice 317 ffltbif(:,:) = 0._wp ! linked with fstric 318 qfvbq (:,:) = 0._wp ! linked with fstric 319 rdm_snw(:,:) = 0._wp ! variation of snow mass per unit area 320 rdm_ice(:,:) = 0._wp ! variation of ice mass per unit area 321 hicifp (:,:) = 0._wp ! daily thermodynamic ice production. 322 ! 323 diag_sni_gr(:,:) = 0._wp ; diag_lat_gr(:,:) = 0._wp 324 diag_bot_gr(:,:) = 0._wp ; diag_dyn_gr(:,:) = 0._wp 325 diag_bot_me(:,:) = 0._wp ; diag_sur_me(:,:) = 0._wp 326 diag_res_pr(:,:) = 0._wp ; diag_trp_vi(:,:) = 0._wp 308 d_u_ice_dyn(:,:) = 0._wp ; d_v_ice_dyn(:,:) = 0._wp 309 310 ! salt, heat and mass fluxes 311 sfx (:,:) = 0._wp ; 312 sfx_bri(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp ; sfx_res(:,:) = 0._wp 313 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 314 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 315 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 316 317 hfx_thd(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp ; hfx_snw(:,:) = 0._wp 318 hfx_tot(:,:) = 0._wp ; hfx_spr(:,:) = 0._wp ; hfx_res(:,:) = 0._wp 319 hfx_sub(:,:) = 0._wp ; hfx_err(:,:) = 0._wp ; hfx_in (:,:) = 0._wp ; hfx_out(:,:) = 0._wp 320 hfx_err_rem(:,:) = 0._wp 321 322 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 323 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp 324 wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp 325 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 326 wfx_res(:,:) = 0._wp ; 327 ! 328 fhld (:,:) = 0._wp 329 fmmflx(:,:) = 0._wp 330 ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice 331 332 ! diags 333 diag_trp_vi(:,:) = 0._wp ; diag_trp_vs(:,:) = 0._wp ; diag_trp_ei(:,:) = 0._wp ; diag_trp_es(:,:) = 0._wp ; 334 diag_heat_dhc1(:,:) = 0._wp ; 335 327 336 ! dynamical invariants 328 337 delta_i(:,:) = 0._wp ; divu_i(:,:) = 0._wp ; shear_i(:,:) = 0._wp … … 375 384 zcoef = rdt_ice /rday ! Ice natural aging 376 385 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 377 CALL lim_var_glo2eqv ! this CALL is maybe not necessary (Martin)386 !clem CALL lim_var_glo2eqv ! this CALL is maybe not necessary (Martin) 378 387 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' ) ! control print 379 388 CALL lim_itd_th( kt ) ! Remap ice categories, lateral accretion ! … … 391 400 ! ! Diagnostics and outputs 392 401 IF (ln_limdiaout) CALL lim_diahsb 393 !clem # if ! defined key_iomput 402 394 403 CALL lim_wri( 1 ) ! Ice outputs 395 !clem # endif 404 396 405 IF( kt == nit000 .AND. ln_rstart ) & 397 406 & CALL iom_close( numrir ) ! clem: close input ice restart file … … 413 422 414 423 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 415 ! 416 CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 417 418 #if defined key_coupled 419 IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice) 420 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 421 & CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 422 #endif 424 CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 425 426 IF( lk_cpl ) THEN 427 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 428 & CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 429 ENDIF 423 430 ! 424 431 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') … … 534 541 ! WRITE(numout,*) ' sst : ', sst_m(ji,jj) 535 542 ! WRITE(numout,*) ' sss : ', sss_m(ji,jj) 536 ! WRITE(numout,*) ' s_i_newice : ', s_i_newice(ji,jj,1:jpl)537 543 ! WRITE(numout,*) 538 544 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 591 597 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 592 598 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 593 !WRITE(numout,*) ' qcmif : ', qcmif(ji,jj)594 !WRITE(numout,*) ' qldif : ', qldif(ji,jj)595 !WRITE(numout,*) ' qcmif : ', qcmif(ji,jj) / rdt_ice596 !WRITE(numout,*) ' qldif : ', qldif(ji,jj) / rdt_ice597 !WRITE(numout,*) ' qfvbq : ', qfvbq(ji,jj)598 !WRITE(numout,*) ' qdtcn : ', qdtcn(ji,jj)599 !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice600 !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice601 !WRITE(numout,*) ' fdtcn : ', fdtcn(ji,jj)602 !WRITE(numout,*) ' fhmec : ', fhmec(ji,jj)603 !WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj)604 !WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)605 !WRITE(numout,*) ' fhbri : ', fhbri(ji,jj)606 599 ! 607 600 !CALL lim_prt_state( kt, ji, jj, 2, ' ') … … 790 783 WRITE(numout,*) ' - Heat / FW fluxes ' 791 784 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 792 WRITE(numout,*) ' emp : ', emp (ji,jj) 793 WRITE(numout,*) ' sfx : ', sfx (ji,jj) 794 WRITE(numout,*) ' sfx_thd : ', sfx_thd(ji,jj) 795 WRITE(numout,*) ' sfx_bri : ', sfx_bri (ji,jj) 796 WRITE(numout,*) ' sfx_mec : ', sfx_mec (ji,jj) 797 WRITE(numout,*) ' sfx_res : ', sfx_res(ji,jj) 798 WRITE(numout,*) ' fmmec : ', fmmec (ji,jj) 799 WRITE(numout,*) ' fhmec : ', fhmec (ji,jj) 800 WRITE(numout,*) ' fhbri : ', fhbri (ji,jj) 801 WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj) 785 WRITE(numout,*) ' - Heat fluxes in and out the ice ***' 786 WRITE(numout,*) ' qsr_ini : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( old_a_i(ji,jj,:) * qsr_ice(ji,jj,:) ) 787 WRITE(numout,*) ' qns_ini : ', pfrld(ji,jj) * qns(ji,jj) + SUM( old_a_i(ji,jj,:) * qns_ice(ji,jj,:) ) 788 WRITE(numout,*) 802 789 WRITE(numout,*) 803 790 WRITE(numout,*) ' sst : ', sst_m(ji,jj) … … 829 816 WRITE(numout,*) ' qsr : ', qsr(ji,jj) 830 817 WRITE(numout,*) ' qns : ', qns(ji,jj) 831 WRITE(numout,*) ' fdtcn : ', fdtcn(ji,jj) 832 WRITE(numout,*) ' qcmif : ', qcmif(ji,jj) * r1_rdtice 833 WRITE(numout,*) ' qldif : ', qldif(ji,jj) * r1_rdtice 818 WRITE(numout,*) 819 WRITE(numout,*) ' hfx_mass : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 820 WRITE(numout,*) ' hfx_in : ', hfx_in(ji,jj) 821 WRITE(numout,*) ' hfx_out : ', hfx_out(ji,jj) 822 WRITE(numout,*) ' hfx_tot : ', hfx_tot(ji,jj) 823 WRITE(numout,*) ' dhc : ', diag_heat_dhc1(ji,jj) 824 WRITE(numout,*) 825 WRITE(numout,*) ' hfx_dyn : ', hfx_dyn(ji,jj) 826 WRITE(numout,*) ' hfx_thd : ', hfx_thd(ji,jj) 827 WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj) 828 WRITE(numout,*) ' fhtur : ', fhtur(ji,jj) 829 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_rdtice 834 830 WRITE(numout,*) 835 831 WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 836 832 WRITE(numout,*) ' emp : ', emp (ji,jj) 837 WRITE(numout,*) ' sfx_bri : ', sfx_bri(ji,jj)838 833 WRITE(numout,*) ' sfx : ', sfx (ji,jj) 839 834 WRITE(numout,*) ' sfx_res : ', sfx_res(ji,jj) 840 WRITE(numout,*) ' sfx_mec : ', sfx_mec(ji,jj) 841 WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 842 WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 835 WRITE(numout,*) ' sfx_bri : ', sfx_bri(ji,jj) 836 WRITE(numout,*) ' sfx_dyn : ', sfx_dyn(ji,jj) 843 837 WRITE(numout,*) 844 838 WRITE(numout,*) ' - Momentum fluxes ' 845 839 WRITE(numout,*) ' utau : ', utau(ji,jj) 846 840 WRITE(numout,*) ' vtau : ', vtau(ji,jj) 847 ENDIF 841 ENDIF 848 842 WRITE(numout,*) ' ' 849 843 ! -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r4332 r4634 155 155 nkrnf = 0 156 156 rnf (:,:) = 0.0_wp 157 rnf_b (:,:) = 0.0_wp 157 158 rnfmsk (:,:) = 0.0_wp 158 159 rnfmsk_z(:) = 0.0_wp -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/oce.F90
r4220 r4634 22 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ub , un , ua !: i-horizontal velocity [m/s] 23 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vb , vn , va !: j-horizontal velocity [m/s] 24 ! bg jchanut tschanges 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua_bak , va_bak !: Saved trends for mod. ts [m/s2] 26 ! end jchanut tschanges 24 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wn !: vertical velocity [m/s] 25 28 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rotb , rotn !: relative vorticity [s-1] … … 73 76 ! 74 77 ALLOCATE( ub (jpi,jpj,jpk) , un (jpi,jpj,jpk) , ua(jpi,jpj,jpk) , & 75 & vb (jpi,jpj,jpk) , vn (jpi,jpj,jpk) , va(jpi,jpj,jpk) , & 78 & vb (jpi,jpj,jpk) , vn (jpi,jpj,jpk) , va(jpi,jpj,jpk) , & 79 ! bg jchanut tschanges 80 #if defined key_dynspg_ts 81 ! These temporary arrays are used to save tendencies computed before the time stepping of tracers. 82 ! These could be suppressed if ua and va would not have been used as temporary arrays 83 ! during tracers' update 84 & ua_bak(jpi,jpj,jpk) , va_bak(jpi,jpj,jpk) , & 85 #endif 86 ! end jchanut tschanges 76 87 & wn (jpi,jpj,jpk) , & 77 88 & rotb (jpi,jpj,jpk) , rotn (jpi,jpj,jpk) , & -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r3294 r4634 86 86 !!--------------------------------------------------------------------- 87 87 # include "par_AMM_12km.h90" 88 #elif defined key_spitz_r025 89 !!--------------------------------------------------------------------- 90 !! 'key_spitz_r025' : regional basin : SPITZBERGEN025 91 !!--------------------------------------------------------------------- 92 # include "par_SPITZ_R025.h90" 93 #elif defined key_spitz_r005 94 !!--------------------------------------------------------------------- 95 !! 'key_spitz_r005' : regional basin : SPITZBERGEN005 96 !!--------------------------------------------------------------------- 97 # include "par_SPITZ_R005.h90" 98 #elif defined key_spitz_r001 99 !!--------------------------------------------------------------------- 100 !! 'key_spitz_r005' : regional basin : SPITZBERGEN002 101 !!--------------------------------------------------------------------- 102 # include "par_SPITZ_R001.h90" 88 103 #else 89 104 !!--------------------------------------------------------------------- -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/step.F90
r4345 r4634 109 109 ! 110 110 ! VERTICAL PHYSICS 111 ! bg jchanut tschanges 112 ! One need bottom friction parameter in ssh_wzv routine with time splitting. 113 ! The idea could be to move the call below before ssh_wzv. However, "now" scale factors 114 ! at U-V points (which are set thanks to sshu_n, sshv_n) are actually available in sshwzv. 115 ! These are needed for log bottom friction... 116 #if ! defined key_dynspg_ts 111 117 CALL zdf_bfr( kstp ) ! bottom friction 118 #endif 119 ! end jchanut tschanges 112 120 113 121 ! ! Vertical eddy viscosity and diffusivity coefficients … … 207 215 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 208 216 209 ELSE ! centered hpg (eos then time stepping) 217 ELSE 218 ! centered hpg (eos then time stepping) 219 ! bg jchanut tschanges 220 #if ! defined key_dynspg_ts 221 ! eos already called 210 222 CALL eos ( tsn, rhd, rhop ) ! now in situ density for hpg computation 211 223 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv, & ! zps: now hor. derivative 212 224 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 225 #endif 226 ! end jchanut tschanges 213 227 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 214 228 CALL tra_nxt( kstp ) ! tracer fields at next time step … … 218 232 ! Dynamics (tsa used as workspace) 219 233 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 234 ! bg jchanut tschanges 235 #if defined key_dynspg_ts 236 ! revert to previously computed tendencies: 237 ! (not using ua, va as temporary arrays during tracers' update could avoid that) 238 ua(:,:,:) = ua_bak(:,:,:) 239 va(:,:,:) = va_bak(:,:,:) 240 CALL dyn_bfr( kstp ) ! bottom friction 241 CALL dyn_zdf( kstp ) ! vertical diffusion 242 #else 243 ! end jchanut tschanges 220 244 ua(:,:,:) = 0.e0 ! set dynamics trends to zero 221 245 va(:,:,:) = 0.e0 … … 237 261 CALL dyn_zdf( kstp ) ! vertical diffusion 238 262 CALL dyn_spg( kstp, indic ) ! surface pressure gradient 263 ! bg jchanut tschanges 264 #endif 265 ! end jchanut tschanges 239 266 CALL dyn_nxt( kstp ) ! lateral velocity at next time step 240 267 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r3770 r4634 271 271 ! 272 272 ! Level of light extinction 273 !cr pjl = jpkm1 274 !cr DO jk = jpkm1, 1, -1 275 !cr zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) ) 276 !cr IF( zem >= zhext ) pjl = jk ! last T-level reached by Qsr 277 !cr END DO 273 278 pjl = jpkm1 274 279 DO jk = jpkm1, 1, -1 275 zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) ) 276 IF( zem >= zhext ) pjl = jk ! last T-level reached by Qsr 280 IF(SUM(tmask(:,:,jk)) > 0 ) THEN 281 zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) ) 282 IF( zem >= zhext ) pjl = jk ! last T-level reached by Qsr 283 ELSE 284 pjl = jk ! or regional sea-bed depth 285 ENDIF 277 286 END DO 278 287 !
Note: See TracChangeset
for help on using the changeset viewer.