- Timestamp:
- 2016-11-22T18:43:11+01:00 (8 years ago)
- Location:
- branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM
- Files:
-
- 5 added
- 3 deleted
- 55 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
r5517 r7309 61 61 <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 62 62 <field field_ref="empmr" name="wfo" /> 63 <field field_ref="emp_oce" name="emp_oce" long_name="Evap minus Precip over ocean" /> 64 <field field_ref="emp_ice" name="emp_ice" long_name="Evap minus Precip over ice" /> 63 65 <field field_ref="qsr_oce" name="qsr_oce" /> 64 66 <field field_ref="qns_oce" name="qns_oce" /> -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice_cfg
r4690 r7309 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! NEMO/LIM-2 : Ice configuration namelist. Overwrites SHARED/namelist_ice_lim2_ref 2 !! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 3 !! 1 - Generic parameters (namicerun) 4 !! 2 - Diagnostics (namicediag) 5 !! 3 - Ice initialization (namiceini) 6 !! 4 - Ice discretization (namiceitd) 7 !! 5 - Ice dynamics and transport (namicedyn) 8 !! 6 - Ice diffusion (namicehdf) 9 !! 7 - Ice thermodynamics (namicethd) 10 !! 8 - Ice salinity (namicesal) 11 !! 9 - Ice mechanical redistribution (namiceitdme) 3 12 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 4 5 !----------------------------------------------------------------------- 6 &namicerun ! Share parameters for dynamics/advection/thermo 7 !----------------------------------------------------------------------- 13 !------------------------------------------------------------------------------ 14 &namicerun ! Generic parameters 15 !------------------------------------------------------------------------------ 8 16 / 9 !----------------------------------------------------------------------- 10 &namice ini ! ice initialisation11 !----------------------------------------------------------------------- 17 !------------------------------------------------------------------------------ 18 &namicediag ! Diagnostics 19 !------------------------------------------------------------------------------ 12 20 / 13 !----------------------------------------------------------------------- 14 &namice dyn ! ice dynamic15 !----------------------------------------------------------------------- 21 !------------------------------------------------------------------------------ 22 &namiceini ! Ice initialization 23 !------------------------------------------------------------------------------ 16 24 / 17 !----------------------------------------------------------------------- 18 &namice thd ! ice thermodynamic19 !----------------------------------------------------------------------- 25 !------------------------------------------------------------------------------ 26 &namiceitd ! Ice discretization 27 !------------------------------------------------------------------------------ 20 28 / 21 !----------------------------------------------------------------------- 22 &namice sal ! ice salinity23 !----------------------------------------------------------------------- 29 !------------------------------------------------------------------------------ 30 &namicedyn ! Ice dynamics and transport 31 !------------------------------------------------------------------------------ 24 32 / 25 !----------------------------------------------------------------------- 26 &namice itdme ! parameters for mechanical redistribution of ice27 !----------------------------------------------------------------------- 33 !------------------------------------------------------------------------------ 34 &namicehdf ! Ice horizontal diffusion 35 !------------------------------------------------------------------------------ 28 36 / 29 !----------------------------------------------------------------------- 30 &namice dia ! ice diagnostics31 !----------------------------------------------------------------------- 37 !------------------------------------------------------------------------------ 38 &namicethd ! Ice thermodynamics 39 !------------------------------------------------------------------------------ 32 40 / 41 !------------------------------------------------------------------------------ 42 &namicesal ! Ice salinity 43 !------------------------------------------------------------------------------ 44 / 45 !------------------------------------------------------------------------------ 46 &namiceitdme ! Ice mechanical redistribution (ridging and rafting) 47 !------------------------------------------------------------------------------ 48 / -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/CONFIG/SHARED/field_def.xml
r6472 r7309 239 239 <field id="hflx_rain_cea" long_name="heat flux due to rainfall" standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water" unit="W/m2" /> 240 240 <field id="hflx_evap_cea" long_name="heat flux due to evaporation" standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water" unit="W/m2" /> 241 <field id="hflx_snow_cea" long_name="heat flux due to snow falling over ice-free ocean" standard_name="heat_flux_into_sea_water_due_to_snow_thermodynamics" unit="W/m2" /> 241 <field id="hflx_snow_cea" long_name="heat flux due to snow falling" standard_name="heat_flux_onto_ocean_and_ice_due_to_snow_thermodynamics" unit="W/m2" /> 242 <field id="hflx_snow_ai_cea" long_name="heat flux due to snow falling over ice" standard_name="heat_flux_onto_ice_due_to_snow_thermodynamics" unit="W/m2" /> 243 <field id="hflx_snow_ao_cea" long_name="heat flux due to snow falling over ice-free ocean" standard_name="heat_flux_onto_sea_water_due_to_snow_thermodynamics" unit="W/m2" /> 242 244 <field id="hflx_ice_cea" long_name="heat flux due to ice thermodynamics" standard_name="heat_flux_into_sea_water_due_to_sea_ice_thermodynamics" unit="W/m2" /> 243 245 <field id="hflx_rnf_cea" long_name="heat flux due to runoffs" standard_name="temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water" unit="W/m2" /> … … 317 319 <field id="icevolu" long_name="ice volume" unit="m" /> 318 320 <field id="snowvol" long_name="snow volume" unit="m" /> 321 <field id="tau_icebfr" long_name="ice friction on ocean bottom for landfast ice" unit="N/m2" /> 319 322 320 323 <field id="icetrp" long_name="ice volume transport" unit="m/day" /> … … 330 333 <field id="sfxbom" long_name="salt flux from bot melt" unit="1e-3*kg/m2/day" /> 331 334 <field id="sfxsum" long_name="salt flux from surf melt" unit="1e-3*kg/m2/day" /> 335 <field id="sfxlam" long_name="salt flux from lateral melt" unit="1e-3*kg/m2/day" /> 332 336 <field id="sfxsni" long_name="salt flux from snow-ice formation" unit="1e-3*kg/m2/day" /> 333 337 <field id="sfxopw" long_name="salt flux from open water ice formation" unit="1e-3*kg/m2/day" /> … … 340 344 <field id="vfxsni" long_name="daily snowice ice prod." unit="m/day" /> 341 345 <field id="vfxsum" long_name="surface melt" unit="m/day" /> 346 <field id="vfxlam" long_name="lateral melt" unit="m/day" /> 342 347 <field id="vfxbom" long_name="bottom melt" unit="m/day" /> 343 348 <field id="vfxres" long_name="daily resultant ice prod./melting from limupdate" unit="m/day" /> … … 345 350 <field id="vfxsnw" long_name="snw melt/growth" unit="m/day" /> 346 351 <field id="vfxsub" long_name="snw sublimation" unit="m/day" /> 352 <field id="vfxsub_err" long_name="excess of snw sublimation sent to ocean" unit="m/day" /> 347 353 <field id="vfxspr" long_name="snw precipitation on ice" unit="m/day" /> 348 <field id="vfxthin" long_name="daily thermo ice prod. for thin ice( <20cm) + open water"unit="m/day" />354 <field id="vfxthin" long_name="daily thermo ice prod. for thin ice(20cm) + open water" unit="m/day" /> 349 355 350 356 <field id="afxtot" long_name="area tendency (total)" unit="day-1" /> … … 521 527 522 528 <!-- available with ln_diahsb --> 523 <field id="bgtemper" long_name="drift in global mean temperature wrt timestep 1" standard_name="change_over_time_in_sea_water_potential_temperature" unit="degC" />529 <field id="bgtemper" long_name="drift in global mean temperature wrt timestep 1" standard_name="change_over_time_in_sea_water_potential_temperature" unit="degC" /> 524 530 <field id="bgsaline" long_name="drift in global mean salinity wrt timestep 1" standard_name="change_over_time_in_sea_water_practical_salinity" unit="1e-3" /> 525 <field id="bgheatco" long_name="drift in global mean heat content wrt timestep 1" unit="10^9J" /> 526 <field id="bgsaltco" long_name="drift in global mean salt content wrt timestep 1" unit="1e-3*m3" /> 531 <field id="bgheatco" long_name="drift in global mean heat content wrt timestep 1" unit="1.e20J" /> 532 <field id="bgheatfx" long_name="drift in global mean heat flux wrt timestep 1" unit="W/m2" /> 533 <field id="bgsaltco" long_name="drift in global mean salt content wrt timestep 1" unit="1e-3*km3" /> 527 534 <field id="bgvolssh" long_name="drift in global mean ssh volume wrt timestep 1" unit="km3" /> 528 535 <field id="bgvole3t" long_name="drift in global mean volume variation (e3t) wrt timestep 1" unit="km3" /> 529 <field id="bgvoltot" long_name="drift in global mean volume wrt timestep 1" unit="km3" /> 530 <!-- NOTE: No matching iom_put call --> 531 <field id="bgsshtot" long_name="drift in global mean ssh wrt timestep 1" standard_name="global_average_sea_level_change" unit="m" /> 532 <field id="bgfrcvol" long_name="drift in global mean volume from forcing wrt timestep 1" unit="km3" /> 533 <field id="bgfrctem" long_name="drift in global mean heat content from forcing wrt timestep 1" unit="10^9J" /> 534 <field id="bgfrcsal" long_name="drift in global mean salt content from forcing wrt timestep 1" unit="1e-3*km3" /> 535 <field id="bgmistem" long_name="global mean temperature error due to free surface" unit="degC" /> 536 <field id="bgmissal" long_name="global mean salinity error due to free surface" unit="1e-3" /> 537 </field_group> 536 <field id="bgfrcvol" long_name="global mean volume from forcing" unit="km3" /> 537 <field id="bgfrctem" long_name="global mean heat content from forcing" unit="1.e20J" /> 538 <field id="bgfrchfx" long_name="global mean heat flux from forcing" unit="W/m2" /> 539 <field id="bgfrcsal" long_name="global mean salt content from forcing" unit="1e-3*km3" /> 540 <field id="bgmistem" long_name="global mean temperature error due to free surface (no vvl)" unit="degC" /> 541 <field id="bgmissal" long_name="global mean salinity error due to free surface (no vvl)" unit="1e-3" /> 542 </field_group> 538 543 539 544 <!-- LIM3 scalar variables --> … … 541 546 <field_group id="SBC_scalar" domain_ref="1point" > 542 547 <!-- available with ln_limdiaout --> 543 <field id="ibgvoltot" long_name="global mean ice volume" unit="km3" /> 544 <field id="sbgvoltot" long_name="global mean snow volume" unit="km3" /> 545 <field id="ibgarea" long_name="global mean ice area" unit="km2" /> 546 <field id="ibgsaline" long_name="global mean ice salinity" unit="1e-3" /> 547 <field id="ibgtemper" long_name="global mean ice temperature" unit="degC" /> 548 <field id="ibgheatco" long_name="global mean ice heat content" unit="10^20J" /> 549 <field id="sbgheatco" long_name="global mean snow heat content" unit="10^20J" /> 550 <field id="ibgsaltco" long_name="global mean ice salt content" unit="1e-3*km3" /> 551 552 <field id="ibgvfx" long_name="global mean volume flux (emp)" unit="m/day" /> 553 <field id="ibgvfxbog" long_name="global mean volume flux (bottom growth)" unit="m/day" /> 554 <field id="ibgvfxopw" long_name="global mean volume flux (open water growth)" unit="m/day" /> 555 <field id="ibgvfxsni" long_name="global mean volume flux (snow-ice growth)" unit="m/day" /> 556 <field id="ibgvfxdyn" long_name="global mean volume flux (dynamic growth)" unit="m/day" /> 557 <field id="ibgvfxbom" long_name="global mean volume flux (bottom melt)" unit="m/day" /> 558 <field id="ibgvfxsum" long_name="global mean volume flux (surface melt)" unit="m/day" /> 559 <field id="ibgvfxres" long_name="global mean volume flux (resultant)" unit="m/day" /> 560 <field id="ibgvfxspr" long_name="global mean volume flux (snow precip)" unit="m/day" /> 561 <field id="ibgvfxsnw" long_name="global mean volume flux (snow melt)" unit="m/day" /> 562 <field id="ibgvfxsub" long_name="global mean volume flux (snow sublimation)" unit="m/day" /> 563 564 <field id="ibgsfx" long_name="global mean salt flux (total)" unit="1e-3*m/day" /> 565 <field id="ibgsfxbri" long_name="global mean salt flux (brines)" unit="1e-3*m/day" /> 566 <field id="ibgsfxdyn" long_name="global mean salt flux (dynamic)" unit="1e-3*m/day" /> 567 <field id="ibgsfxres" long_name="global mean salt flux (resultant)" unit="1e-3*m/day" /> 568 <field id="ibgsfxbog" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 569 <field id="ibgsfxopw" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 570 <field id="ibgsfxsni" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 571 <field id="ibgsfxbom" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 572 <field id="ibgsfxsum" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 573 <field id="ibgsfxsub" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 574 575 <field id="ibghfxdhc" long_name="Heat content variation in snow and ice" unit="W" /> 576 <field id="ibghfxspr" long_name="Heat content of snow precip" unit="W" /> 577 578 <field id="ibghfxthd" long_name="heat fluxes from ice-ocean exchange during thermo" unit="W" /> 579 <field id="ibghfxsum" long_name="heat fluxes causing surface ice melt" unit="W" /> 580 <field id="ibghfxbom" long_name="heat fluxes causing bottom ice melt" unit="W" /> 581 <field id="ibghfxbog" long_name="heat fluxes causing bottom ice growth" unit="W" /> 582 <field id="ibghfxdif" long_name="heat fluxes causing ice temperature change" unit="W" /> 583 <field id="ibghfxopw" long_name="heat fluxes causing open water ice formation" unit="W" /> 584 <field id="ibghfxdyn" long_name="heat fluxes from ice-ocean exchange during dynamic" unit="W" /> 585 <field id="ibghfxres" long_name="heat fluxes from ice-ocean exchange during resultant" unit="W" /> 586 <field id="ibghfxsub" long_name="heat fluxes from sublimation" unit="W" /> 587 <field id="ibghfxsnw" long_name="heat fluxes from snow-ocean exchange" unit="W" /> 588 <field id="ibghfxout" long_name="non solar heat fluxes received by the ocean" unit="W" /> 589 <field id="ibghfxin" long_name="total heat fluxes at the ice surface" unit="W" /> 590 591 <field id="ibgfrcvol" long_name="global mean forcing volume (emp)" unit="km3" /> 592 <field id="ibgfrcsfx" long_name="global mean forcing salt (sfx)" unit="1e-3*km3" /> 593 <field id="ibgvolgrm" long_name="global mean ice growth+melt volume" unit="km3" /> 548 <field id="ibgfrcvoltop" long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)" unit="km3" /> 549 <field id="ibgfrcvolbot" long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3" /> 550 <field id="ibgfrctemtop" long_name="global mean heat on top of ice/snw/ocean-atm " unit="1e20J" /> 551 <field id="ibgfrctembot" long_name="global mean heat below ice (on top of ocean) " unit="1e20J" /> 552 <field id="ibgfrcsal" long_name="global mean ice/snow forcing (salt equivalent ocean volume)" unit="pss*km3" /> 553 <field id="ibgfrchfxtop" long_name="global mean heat flux on top of ice/snw/ocean-atm " unit="W/m2" /> 554 <field id="ibgfrchfxbot" long_name="global mean heat flux below ice (on top of ocean) " unit="W/m2" /> 555 556 <field id="ibgvolume" long_name="drift in ice/snow volume (equivalent ocean volume)" unit="km3" /> 557 <field id="ibgsaltco" long_name="drift in ice salt content (equivalent ocean volume)" unit="pss*km3" /> 558 <field id="ibgheatco" long_name="drift in ice/snow heat content" unit="1e20J" /> 559 <field id="ibgheatfx" long_name="drift in ice/snow heat flux" unit="W/m2" /> 560 561 <field id="ibgvol_tot" long_name="global mean ice volume" unit="km3" /> 562 <field id="sbgvol_tot" long_name="global mean snow volume" unit="km3" /> 563 <field id="ibgarea_tot" long_name="global mean ice area" unit="km2" /> 564 <field id="ibgsalt_tot" long_name="global mean ice salt content" unit="1e-3*km3" /> 565 <field id="ibgheat_tot" long_name="global mean ice heat content" unit="1e20J" /> 566 <field id="sbgheat_tot" long_name="global mean snow heat content" unit="1e20J" /> 594 567 </field_group> 595 568 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
r6416 r7309 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! LIM3 namelist 2 !! LIM3 namelist: 3 3 !! 1 - Generic parameters (namicerun) 4 !! 2 - Ice initialization (namiceini) 5 !! 3 - Ice discretization (namiceitd) 6 !! 4 - Ice dynamics and transport (namicedyn) 7 !! 5 - Ice thermodynamics (namicethd) 8 !! 6 - Ice salinity (namicesal) 9 !! 7 - Ice mechanical redistribution (namiceitdme) 10 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 4 !! 2 - Diagnostics (namicediag) 5 !! 3 - Ice initialization (namiceini) 6 !! 4 - Ice discretization (namiceitd) 7 !! 5 - Ice dynamics and transport (namicedyn) 8 !! 6 - Ice diffusion (namicehdf) 9 !! 7 - Ice thermodynamics (namicethd) 10 !! 8 - Ice salinity (namicesal) 11 !! 9 - Ice mechanical redistribution (namiceitdme) 12 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 11 13 ! 12 14 !------------------------------------------------------------------------------ 13 15 &namicerun ! Generic parameters 14 16 !------------------------------------------------------------------------------ 15 jpl = 5 ! number of ice categories 16 nlay_i = 2 ! number of ice layers 17 nlay_s = 1 ! number of snow layers (only 1 is working) 18 cn_icerst_in = "restart_ice" ! suffix of ice restart name (input) 19 cn_icerst_indir = "." ! directory from which to read input ice restarts 20 cn_icerst_out = "restart_ice" ! suffix of ice restart name (output) 21 cn_icerst_outdir = "." ! directory in which to write output ice restarts 22 ln_limdyn = .true. ! ice dynamics (T) or thermodynamics only (F) 23 rn_amax_n = 0.999 ! maximum tolerated ice concentration NH 24 rn_amax_s = 0.999 ! maximum tolerated ice concentration SH 25 ln_limdiahsb = .false. ! check the heat and salt budgets (T) or not (F) 26 ln_limdiaout = .true. ! output the heat and salt budgets (T) or not (F) 27 ln_icectl = .false. ! ice points output for debug (T or F) 28 iiceprt = 10 ! i-index for debug 29 jiceprt = 10 ! j-index for debug 17 jpl = 5 ! number of ice categories 18 nlay_i = 2 ! number of ice layers 19 nlay_s = 1 ! number of snow layers (only 1 is working) 20 rn_amax_n = 0.997 ! maximum tolerated ice concentration NH 21 rn_amax_s = 0.997 ! maximum tolerated ice concentration SH 22 cn_icerst_in = "restart_ice" ! suffix of ice restart name (input) 23 cn_icerst_out = "restart_ice" ! suffix of ice restart name (output) 24 cn_icerst_indir = "." ! directory to read input ice restarts 25 cn_icerst_outdir = "." ! directory to write output ice restarts 26 ln_limthd = .true. ! ice thermo (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 27 ln_limdyn = .true. ! ice dynamics (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 28 nn_limdyn = 2 ! (ln_limdyn=T) switch for ice dynamics 29 ! 2: total 30 ! 1: advection only (no diffusion, no ridging/rafting) 31 ! 0: advection only (as 1 but with prescribed velocity, bypass rheology) 32 rn_uice = 0.00001 ! (nn_limdyn=0) ice u-velocity 33 rn_vice = -0.00001 ! (nn_limdyn=0) ice v-velocity 34 / 35 !------------------------------------------------------------------------------ 36 &namicediag ! Diagnostics 37 !------------------------------------------------------------------------------ 38 ln_limdiachk = .false. ! check online the heat, mass & salt budgets (T) or not (F) 39 ln_limdiahsb = .false. ! output the heat, mass & salt budgets (T) or not (F) 40 ln_limctl = .false. ! ice points output for debug (T or F) 41 iiceprt = 10 ! i-index for debug 42 jiceprt = 10 ! j-index for debug 30 43 / 31 44 !------------------------------------------------------------------------------ 32 45 &namiceini ! Ice initialization 33 46 !------------------------------------------------------------------------------ 34 ln_iceini = .true. ! activate ice initialization (T) or not (F) 35 rn_thres_sst = 2.0 ! maximum water temperature with initial ice (degC) 36 rn_hts_ini_n = 0.3 ! initial real snow thickness (m), North 37 rn_hts_ini_s = 0.3 ! " " South 38 rn_hti_ini_n = 3.0 ! initial real ice thickness (m), North 39 rn_hti_ini_s = 1.0 ! " " South 40 rn_ati_ini_n = 0.9 ! initial ice concentration (-), North 41 rn_ati_ini_s = 0.9 ! " " South 42 rn_smi_ini_n = 6.3 ! initial ice salinity (g/kg), North 43 rn_smi_ini_s = 6.3 ! " " South 44 rn_tmi_ini_n = 270. ! initial ice/snw temperature (K), North 45 rn_tmi_ini_s = 270. ! " " South 47 ! -- limistate -- ! 48 ln_limini = .true. ! activate ice initialization (T) or not (F) 49 ln_limini_file = .false. ! netcdf file provided for initialization (T) or not (F) 50 rn_thres_sst = 2.0 ! maximum water temperature with initial ice (degC) 51 rn_hts_ini_n = 0.3 ! initial real snow thickness (m), North 52 rn_hts_ini_s = 0.3 ! " " South 53 rn_hti_ini_n = 3.0 ! initial real ice thickness (m), North 54 rn_hti_ini_s = 1.0 ! " " South 55 rn_ati_ini_n = 0.9 ! initial ice concentration (-), North 56 rn_ati_ini_s = 0.9 ! " " South 57 rn_smi_ini_n = 6.3 ! initial ice salinity (g/kg), North 58 rn_smi_ini_s = 6.3 ! " " South 59 rn_tmi_ini_n = 270. ! initial ice/snw temperature (K), North 60 rn_tmi_ini_s = 270. ! " " South 46 61 / 47 62 !------------------------------------------------------------------------------ … … 56 71 &namicedyn ! Ice dynamics and transport 57 72 !------------------------------------------------------------------------------ 58 nn_icestr = 0 ! ice strength parameteriztaion 59 ! 0: Hibler_79 P = pstar*<h>*exp(-c_rhg*A) 60 ! 1: Rothrock_75 P = Cf*coeff*integral(wr.h^2) 61 ln_icestr_bvf = .false. ! ice strength function brine volume (T) or not (F) 62 rn_pe_rdg = 17.0 ! ridging work divided by pot. energy change in ridging, if nn_icestr = 1 63 rn_pstar = 2.0e+04 ! ice strength thickness parameter (N/m2), nn_icestr = 0 64 rn_crhg = 20.0 ! ice strength conc. parameter (-), nn_icestr = 0 65 rn_cio = 5.0e-03 ! ice-ocean drag coefficient (-) 66 rn_creepl = 1.0e-12 ! creep limit (s-1) 67 rn_ecc = 2.0 ! eccentricity of the elliptical yield curve 68 nn_nevp = 120 ! number of EVP subcycles 69 rn_relast = 0.333 ! ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 70 ! advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 71 nn_ahi0 = 2 ! horizontal diffusivity computation 72 ! 0: use rn_ahi0_ref 73 ! 1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length ) 74 ! 2: use rn_ahi0_ref x grid cell length / ( 2deg mean grid cell length ) 75 rn_ahi0_ref = 350.0 ! horizontal sea ice diffusivity (m2/s) 76 ! if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution 73 ! -- limtrp & limadv -- ! 74 nn_limadv = 0 ! choose the advection scheme (-1=Prather ; 0=Ultimate-Macho) 75 nn_limadv_ord = 5 ! choose the order of the advection scheme (if nn_limadv=0) 76 ! -- limitd_me -- ! 77 nn_icestr = 0 ! ice strength parameteriztaion 78 ! 0: Hibler_79 P = pstar*<h>*exp(-c_rhg*A) 79 ! 1: Rothrock_75 P = Cf*coeff*integral(wr.h^2) 80 rn_pe_rdg = 17.0 ! (nn_icestr=1) ridging work divided by pot. energy change in ridging 81 rn_pstar = 2.0e+04 ! (nn_icestr=0) ice strength thickness parameter (N/m2) 82 rn_crhg = 20.0 ! (nn_icestr=0) ice strength conc. parameter (-) 83 ln_icestr_bvf = .false. ! ice strength function brine volume (T) or not (F) 84 ! 85 ! -- limdyn & limrhg -- ! 86 rn_cio = 5.0e-03 ! ice-ocean drag coefficient (-) 87 rn_creepl = 1.0e-12 ! creep limit (s-1) 88 rn_ecc = 2.0 ! eccentricity of the elliptical yield curve 89 nn_nevp = 120 ! number of EVP subcycles 90 rn_relast = 0.333 ! ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 91 ! advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 92 ln_landfast = .false. ! landfast ice parameterization (T or F) 93 rn_gamma = 0.15 ! (ln_landfast=T) fraction of ocean depth that ice must reach to initiate landfast 94 ! recommended range: [0.1 ; 0.25] 95 rn_icebfr = 10. ! (ln_landfast=T) maximum bottom stress per unit area of contact (N/m2) 96 ! a very large value ensures ice velocity=0 even with a small contact area 97 ! recommended range: ?? (should be greater than atm-ice stress => >0.1 N/m2) 98 rn_lfrelax = 1.e-5 ! (ln_landfast=T) relaxation time scale to reach static friction (s-1) 77 99 / 78 100 !------------------------------------------------------------------------------ 79 101 &namicehdf ! Ice horizontal diffusion 80 102 !------------------------------------------------------------------------------ 81 nn_convfrq = 5 ! convergence check frequency of the Crant-Nicholson scheme (perf. optimization) 103 ! -- limhdf -- ! 104 nn_ahi0 = -1 ! horizontal diffusivity computation 105 ! -1: no diffusion (bypass limhdf) 106 ! 0: use rn_ahi0_ref 107 ! 1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length ) 108 ! 2: use rn_ahi0_ref x grid cell length / ( 2deg mean grid cell length ) 109 rn_ahi0_ref = 350.0 ! horizontal sea ice diffusivity (m2/s) 110 ! if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution 82 111 / 83 112 !------------------------------------------------------------------------------ 84 113 &namicethd ! Ice thermodynamics 85 114 !------------------------------------------------------------------------------ 86 rn_hnewice = 0.1 ! thickness for new ice formation in open water (m) 87 ln_frazil = .false. ! use frazil ice collection thickness as a function of wind (T) or not (F) 88 rn_maxfrazb = 1.0 ! maximum fraction of frazil ice collecting at the ice base 89 rn_vfrazb = 0.417 ! thresold drift speed for frazil ice collecting at the ice bottom (m/s) 90 rn_Cfrazb = 5.0 ! squeezing coefficient for frazil ice collecting at the ice bottom 91 rn_himin = 0.10 ! minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice 92 rn_betas = 0.66 ! exponent in lead-ice repratition of snow precipitation 93 ! betas = 1 -> equipartition, betas < 1 -> more on leads 94 rn_kappa_i = 1.0 ! radiation attenuation coefficient in sea ice (m-1) 95 nn_conv_dif = 50 ! maximal number of iterations for heat diffusion computation 96 rn_terr_dif = 0.0001 ! maximum temperature after heat diffusion (degC) 97 nn_ice_thcon= 1 ! sea ice thermal conductivity 98 ! 0: k = k0 + beta.S/T (Untersteiner, 1964) 99 ! 1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007) 100 nn_monocat = 0 ! virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0) 101 ! 2: simple piling instead of ridging --- temporary option 102 ! 3: activate G(he) only --- temporary option 103 ! 4: activate lateral melting only --- temporary option 104 ln_it_qnsice = .true. ! iterate the surface non-solar flux with surface temperature (T) or not (F) 115 ! -- limthd_dif -- ! 116 rn_kappa_i = 1.0 ! radiation attenuation coefficient in sea ice (m-1) 117 nn_conv_dif = 50 ! maximal number of iterations for heat diffusion computation 118 rn_terr_dif = 1.0e-04 ! maximum temperature after heat diffusion (degC) 119 nn_ice_thcon = 1 ! sea ice thermal conductivity 120 ! 0: k = k0 + beta.S/T (Untersteiner, 1964) 121 ! 1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007) 122 ln_it_qnsice = .true. ! iterate the surface non-solar flux with surface temperature (T) or not (F) 123 nn_monocat = 0 ! virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0) 124 ! 2: simple piling instead of ridging --- temporary option 125 ! 3: activate G(he) only --- temporary option 126 ! 4: activate extra lateral melting only --- temporary option 127 ! -- limthd_dh -- ! 128 ln_limdH = .true. ! activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 129 rn_betas = 0.66 ! exponent in lead-ice repratition of snow precipitation 130 ! betas = 1 -> equipartition, betas < 1 -> more on leads 131 ! -- limthd_da -- ! 132 ln_limdA = .true. ! activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 133 rn_beta = 1.0 ! (ln_latmelt=T) coef. beta for lateral melting param. Recommended range=[0.8-1.2] 134 ! => decrease = more melt and melt peaks toward higher concentration (A~0.5 for beta=1 ; A~0.8 for beta=0.2) 135 ! 0.3 = best fit for western Fram Strait and Antarctica 136 ! 1.4 = best fit for eastern Fram Strait 137 rn_dmin = 8. ! (ln_latmelt=T) minimum floe diameter for lateral melting param. Recommended range=[6-10] 138 ! => 6 vs 8m = +40% melting at the peak (A~0.5) 139 ! 10 vs 8m = -20% melting 140 ! -- limthd_lac -- ! 141 ln_limdO = .true. ! activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 142 rn_hnewice = 0.1 ! thickness for new ice formation in open water (m) 143 ln_frazil = .false. ! Frazil ice parameterization (ice collection as a function of wind) 144 rn_maxfrazb = 1.0 ! (ln_frazil=T) maximum fraction of frazil ice collecting at the ice base 145 rn_vfrazb = 0.417 ! (ln_frazil=T) thresold drift speed for frazil ice collecting at the ice bottom (m/s) 146 rn_Cfrazb = 5.0 ! (ln_frazil=T) squeezing coefficient for frazil ice collecting at the ice bottom 147 ! -- limitd_th -- ! 148 rn_himin = 0.1 ! minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice 105 149 / 106 150 !------------------------------------------------------------------------------ 107 151 &namicesal ! Ice salinity 108 152 !------------------------------------------------------------------------------ 109 nn_icesal = 2 ! ice salinity option 110 ! 1: constant ice salinity (S=rn_icesal) 111 ! 2: varying salinity parameterization S(z,t) 112 ! 3: prescribed salinity profile S(z), Schwarzacher, 1959 113 rn_icesal = 4. ! ice salinity (g/kg, nn_icesal = 1 only) 114 rn_sal_gd = 5. ! restoring ice salinity, gravity drainage (g/kg) 115 rn_time_gd = 1.73e+6 ! restoring time scale, gravity drainage (s) 116 rn_sal_fl = 2. ! restoring ice salinity, flushing (g/kg) 117 rn_time_fl = 8.64e+5 ! restoring time scale, flushing (s) 118 rn_simax = 20. ! maximum tolerated ice salinity (g/kg) 119 rn_simin = 0.1 ! minimum tolerated ice salinity (g/kg) 153 ! -- limthd_sal -- ! 154 ln_limdS = .true. ! activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 155 nn_icesal = 2 ! ice salinity option 156 ! 1: constant ice salinity (S=rn_icesal) 157 ! 2: varying salinity parameterization S(z,t) 158 ! 3: prescribed salinity profile S(z), Schwarzacher, 1959 159 rn_icesal = 4. ! (nn_icesal=1) ice salinity (g/kg) 160 rn_sal_gd = 5. ! restoring ice salinity, gravity drainage (g/kg) 161 rn_time_gd = 1.73e+6 ! restoring time scale, gravity drainage (s) 162 rn_sal_fl = 2. ! restoring ice salinity, flushing (g/kg) 163 rn_time_fl = 8.64e+5 ! restoring time scale, flushing (s) 164 rn_simax = 20. ! maximum tolerated ice salinity (g/kg) 165 rn_simin = 0.1 ! minimum tolerated ice salinity (g/kg) 120 166 / 121 167 !------------------------------------------------------------------------------ 122 168 &namiceitdme ! Ice mechanical redistribution (ridging and rafting) 123 169 !------------------------------------------------------------------------------ 124 rn_Cs = 0.5 ! fraction of shearing energy contributing to ridging 125 rn_fsnowrdg = 0.5 ! snow volume fraction that survives in ridging 126 rn_fsnowrft = 0.5 ! snow volume fraction that survives in rafting 127 nn_partfun = 1 ! type of ridging participation function 128 ! 0: linear (Thorndike et al, 1975) 129 ! 1: exponential (Lipscomb, 2007 130 rn_gstar = 0.15 ! fractional area of thin ice being ridged (nn_partfun = 0) 131 rn_astar = 0.05 ! exponential measure of ridging ice fraction (nn_partfun = 1) 132 rn_hstar = 100.0 ! determines the maximum thickness of ridged ice (m) (Hibler, 1980) 133 ln_rafting = .true. ! rafting activated (T) or not (F) 134 rn_hraft = 0.75 ! threshold thickness for rafting (m) 135 rn_craft = 5.0 ! squeezing coefficient used in the rafting function 136 rn_por_rdg = 0.3 ! porosity of newly ridged ice (Lepparanta et al., 1995) 170 ! -- limitd_me -- ! 171 rn_cs = 0.5 ! fraction of shearing energy contributing to ridging 172 nn_partfun = 1 ! type of ridging participation function 173 ! 0: linear (Thorndike et al, 1975) 174 ! 1: exponential (Lipscomb, 2007) 175 rn_gstar = 0.15 ! (nn_partfun = 0) fractional area of thin ice being ridged 176 rn_astar = 0.05 ! (nn_partfun = 1) exponential measure of ridging ice fraction 177 ln_ridging = .true. ! ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 178 rn_hstar = 100.0 ! (ln_ridging = T) determines the maximum thickness of ridged ice (m) (Hibler, 1980) 179 rn_por_rdg = 0.3 ! (ln_ridging = T) porosity of newly ridged ice (Lepparanta et al., 1995) 180 rn_fsnowrdg = 0.5 ! (ln_ridging = T) snow volume fraction that survives in ridging 181 ln_rafting = .true. ! rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 182 rn_hraft = 0.75 ! (ln_rafting = T) threshold thickness for rafting (m) 183 rn_craft = 5.0 ! (ln_rafting = T) squeezing coefficient used in the rafting function 184 rn_fsnowrft = 0.5 ! (ln_rafting = T) snow volume fraction that survives in rafting 137 185 / -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/CONFIG/SHARED/namelist_ref
r6497 r7309 11 11 !! 6 - Tracer (nameos, namtra_adv, namtra_ldf, namtra_ldfeiv, namtra_dmp) 12 12 !! 7 - dynamics (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) 13 !! 8 - Verical physics (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx )13 !! 8 - Verical physics (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx, namzdf_tmx_new) 14 14 !! 9 - diagnostics (namnc4, namtrd, namspr, namflo, namhsb, namsto) 15 15 !! 10 - miscellaneous (nammpp, namctl) … … 295 295 &namsbc_ana ! analytical surface boundary condition 296 296 !----------------------------------------------------------------------- 297 ! --- oce variables --- ! 297 298 nn_tau000 = 0 ! gently increase the stress over the first ntau_rst time-steps 298 299 rn_utau0 = 0.5 ! uniform value for the i-stress … … 301 302 rn_qsr0 = 0.e0 ! uniform value for the solar radiation 302 303 rn_emp0 = 0.e0 ! uniform value for the freswater budget (E-P) 304 ! --- ice variables --- ! 305 rn_iutau0 = 0.e0 ! uniform value for the i-stress over ice 306 rn_ivtau0 = 0.e0 ! uniform value for the j-stress over ice 307 rn_iqns0 = 0.e0 ! uniform value for the total heat flux over ice 308 rn_iqsr0 = 0.e0 ! uniform value for the solar radiation over ice 309 rn_sprec0 = 0.e0 ! uniform value for snow precip 310 rn_ievap0 = 0.e0 ! uniform value for sublimation 303 311 / 304 312 !----------------------------------------------------------------------- … … 353 361 rn_vfac = 0. ! multiplicative factor for ocean/ice velocity 354 362 ! in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 363 ln_Cd_L12 = .false. ! Modify the drag ice-atm and oce-atm depending on ice concentration 364 ! This parameterization is from Lupkes et al. (JGR 2012) 355 365 / 356 366 !----------------------------------------------------------------------- … … 401 411 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 402 412 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 413 l_sasread = .TRUE. ! Read fields in a file if .TRUE. , or initialize to 0. in sbcssm.F90 if .FALSE. 403 414 sn_usp = 'sas_grid_U', 120 , 'vozocrtx', .true. , .true. , 'yearly' , '' , '' , '' 404 415 sn_vsp = 'sas_grid_V', 120 , 'vomecrty', .true. , .true. , 'yearly' , '' , '' , '' -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
r6140 r7309 83 83 CALL ice_run_2 ! read in namelist some run parameters 84 84 ! 85 rdt_ice = nn_fsbc * rdt 85 rdt_ice = nn_fsbc * rdt ! sea-ice time step 86 86 numit = nit000 - 1 87 87 ! -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
r3625 r7309 80 80 njeqm1 = njeq - 1 81 81 82 fcor(:,:) = 2. * omega * SIN( gphi t(:,:) * rad ) ! coriolis factor at T-point82 fcor(:,:) = 2. * omega * SIN( gphif(:,:) * rad ) ! coriolis factor at T-point 83 83 84 84 !i DO jj = 1, jpj -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r6490 r7309 146 146 !! smt_i | - | Mean sea ice salinity | ppt | 147 147 !! tm_i | - | Mean sea ice temperature | K | 148 !! ot_i ! - ! Sea ice areal age content | day |149 148 !! et_i ! - ! Total ice enthalpy | J/m2 | 150 149 !! et_s ! - ! Total snow enthalpy | J/m2 | 151 !! bv_i ! - ! Mean relative brine volume| ??? |150 !! bv_i ! - ! relative brine volume | ??? | 152 151 !!===================================================================== 153 152 … … 157 156 !! * Share Module variables 158 157 !!-------------------------------------------------------------------------- 158 ! !!** ice-generic parameters namelist (namicerun) ** 159 INTEGER , PUBLIC :: jpl !: number of ice categories 160 INTEGER , PUBLIC :: nlay_i !: number of ice layers 161 INTEGER , PUBLIC :: nlay_s !: number of snow layers 162 REAL(wp) , PUBLIC :: rn_amax_n !: maximum ice concentration Northern hemisphere 163 REAL(wp) , PUBLIC :: rn_amax_s !: maximum ice concentration Southern hemisphere 164 CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input) 165 CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output) 166 CHARACTER(len=256), PUBLIC :: cn_icerst_indir !: ice restart input directory 167 CHARACTER(len=256), PUBLIC :: cn_icerst_outdir!: ice restart output directory 168 LOGICAL , PUBLIC :: ln_limthd !: flag for ice thermo (T) or not (F) 169 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F) 170 INTEGER , PUBLIC :: nn_limdyn !: flag for ice dynamics 171 REAL(wp) , PUBLIC :: rn_uice !: prescribed u-vel (case nn_limdyn=0) 172 REAL(wp) , PUBLIC :: rn_vice !: prescribed v-vel (case nn_limdyn=0) 173 174 ! !!** ice-diagnostics namelist (namicediag) ** 175 LOGICAL , PUBLIC :: ln_limdiachk !: flag for ice diag (T) or not (F) 176 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 177 LOGICAL , PUBLIC :: ln_limctl !: flag for sea-ice points output (T) or not (F) 178 INTEGER , PUBLIC :: iiceprt !: debug i-point 179 INTEGER , PUBLIC :: jiceprt !: debug j-point 180 181 ! !!** ice-init namelist (namiceini) ** 182 ! -- limistate -- ! 183 LOGICAL , PUBLIC :: ln_limini ! initialization or not 184 LOGICAL , PUBLIC :: ln_limini_file ! Ice initialization state from 2D netcdf file 185 REAL(wp), PUBLIC :: rn_thres_sst ! threshold water temperature for initial sea ice 186 REAL(wp), PUBLIC :: rn_hts_ini_n ! initial snow thickness in the north 187 REAL(wp), PUBLIC :: rn_hts_ini_s ! initial snow thickness in the south 188 REAL(wp), PUBLIC :: rn_hti_ini_n ! initial ice thickness in the north 189 REAL(wp), PUBLIC :: rn_hti_ini_s ! initial ice thickness in the south 190 REAL(wp), PUBLIC :: rn_ati_ini_n ! initial leads area in the north 191 REAL(wp), PUBLIC :: rn_ati_ini_s ! initial leads area in the south 192 REAL(wp), PUBLIC :: rn_smi_ini_n ! initial salinity 193 REAL(wp), PUBLIC :: rn_smi_ini_s ! initial salinity 194 REAL(wp), PUBLIC :: rn_tmi_ini_n ! initial temperature 195 REAL(wp), PUBLIC :: rn_tmi_ini_s ! initial temperature 196 197 ! !!** ice-thickness distribution namelist (namiceitd) ** 198 INTEGER , PUBLIC :: nn_catbnd !: categories distribution following: tanh function (1), or h^(-alpha) function (2) 199 REAL(wp), PUBLIC :: rn_himean !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only) 200 201 ! !!** ice-dynamics namelist (namicedyn) ** 202 ! -- limtrp & limadv -- ! 203 INTEGER , PUBLIC :: nn_limadv !: choose the advection scheme (-1=Prather ; 0=Ultimate-Macho) 204 INTEGER , PUBLIC :: nn_limadv_ord !: choose the order of the advection scheme (if Ultimate-Macho) 205 ! -- limitd_me -- ! 206 INTEGER , PUBLIC :: nn_icestr !: ice strength parameterization (0=Hibler79 1=Rothrock75) 207 REAL(wp), PUBLIC :: rn_pe_rdg !: ridging work divided by pot. energy change in ridging, nn_icestr = 1 208 REAL(wp), PUBLIC :: rn_pstar !: determines ice strength, Hibler JPO79 209 REAL(wp), PUBLIC :: rn_crhg !: determines changes in ice strength 210 LOGICAL , PUBLIC :: ln_icestr_bvf !: use brine volume to diminish ice strength 211 ! -- limdyn & limrhg -- ! 212 REAL(wp), PUBLIC :: rn_cio !: drag coefficient for oceanic stress 213 REAL(wp), PUBLIC :: rn_creepl !: creep limit : has to be under 1.0e-9 214 REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve 215 INTEGER , PUBLIC :: nn_nevp !: number of iterations for subcycling 216 REAL(wp), PUBLIC :: rn_relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 217 LOGICAL , PUBLIC :: ln_landfast !: landfast ice parameterization (T or F) 218 REAL(wp), PUBLIC :: rn_gamma !: fraction of ocean depth that ice must reach to initiate landfast ice 219 REAL(wp), PUBLIC :: rn_icebfr !: maximum bottom stress per unit area of contact (landfast ice) 220 REAL(wp), PUBLIC :: rn_lfrelax !: relaxation time scale (s-1) to reach static friction (landfast ice) 221 222 ! !!** ice-diffusion namelist (namicehdf) ** 223 INTEGER , PUBLIC :: nn_ahi0 !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 224 REAL(wp), PUBLIC :: rn_ahi0_ref !: sea-ice hor. eddy diffusivity coeff. (m2/s) 225 226 ! !!** ice-thermodynamics namelist (namicethd) ** 227 ! -- limthd_dif -- ! 228 REAL(wp), PUBLIC :: rn_kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 229 REAL(wp), PUBLIC :: nn_conv_dif !: maximal number of iterations for heat diffusion 230 REAL(wp), PUBLIC :: rn_terr_dif !: maximal tolerated error (C) for heat diffusion 231 INTEGER , PUBLIC :: nn_ice_thcon !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 232 LOGICAL , PUBLIC :: ln_it_qnsice !: iterate surface flux with changing surface temperature or not (F) 233 INTEGER , PUBLIC :: nn_monocat !: virtual ITD mono-category parameterizations (1) or not (0) 234 ! -- limthd_dh -- ! 235 LOGICAL , PUBLIC :: ln_limdH !: activate ice thickness change from growing/melting (T) or not (F) 236 REAL(wp), PUBLIC :: rn_betas !: coef. for partitioning of snowfall between leads and sea ice 237 ! -- limthd_da -- ! 238 LOGICAL , PUBLIC :: ln_limdA !: activate lateral melting param. (T) or not (F) 239 REAL(wp), PUBLIC :: rn_beta !: coef. beta for lateral melting param. 240 REAL(wp), PUBLIC :: rn_dmin !: minimum floe diameter for lateral melting param. 241 ! -- limthd_lac -- ! 242 LOGICAL , PUBLIC :: ln_limdO !: activate ice growth in open-water (T) or not (F) 243 REAL(wp), PUBLIC :: rn_hnewice !: thickness for new ice formation (m) 244 LOGICAL , PUBLIC :: ln_frazil !: use of frazil ice collection as function of wind (T) or not (F) 245 REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 246 REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice 247 REAL(wp), PUBLIC :: rn_Cfrazb !: squeezing coefficient for collection of bottom frazil ice 248 ! -- limitd_th -- ! 249 REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness 250 251 ! !!** ice-salinity namelist (namicesal) ** 252 LOGICAL , PUBLIC :: ln_limdS !: activate gravity drainage and flushing (T) or not (F) 253 INTEGER , PUBLIC :: nn_icesal !: salinity configuration used in the model 254 ! ! 1 - constant salinity in both space and time 255 ! ! 2 - prognostic salinity (s(z,t)) 256 ! ! 3 - salinity profile, constant in time 257 REAL(wp), PUBLIC :: rn_icesal !: bulk salinity (ppt) in case of constant salinity 258 REAL(wp), PUBLIC :: rn_sal_gd !: restoring salinity for gravity drainage [PSU] 259 REAL(wp), PUBLIC :: rn_time_gd !: restoring time constant for gravity drainage (= 20 days) [s] 260 REAL(wp), PUBLIC :: rn_sal_fl !: restoring salinity for flushing [PSU] 261 REAL(wp), PUBLIC :: rn_time_fl !: restoring time constant for gravity drainage (= 10 days) [s] 262 REAL(wp), PUBLIC :: rn_simax !: maximum ice salinity [PSU] 263 REAL(wp), PUBLIC :: rn_simin !: minimum ice salinity [PSU] 264 265 ! !!** ice-mechanical redistribution namelist (namiceitdme) 266 REAL(wp), PUBLIC :: rn_cs !: fraction of shearing energy contributing to ridging 267 INTEGER , PUBLIC :: nn_partfun !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 268 REAL(wp), PUBLIC :: rn_gstar !: fractional area of young ice contributing to ridging 269 REAL(wp), PUBLIC :: rn_astar !: equivalent of G* for an exponential participation function 270 LOGICAL , PUBLIC :: ln_ridging !: ridging of ice or not 271 REAL(wp), PUBLIC :: rn_hstar !: thickness that determines the maximal thickness of ridged ice 272 REAL(wp), PUBLIC :: rn_por_rdg !: initial porosity of ridges (0.3 regular value) 273 REAL(wp), PUBLIC :: rn_fsnowrdg !: fractional snow loss to the ocean during ridging 274 LOGICAL , PUBLIC :: ln_rafting !: rafting of ice or not 275 REAL(wp), PUBLIC :: rn_hraft !: threshold thickness (m) for rafting / ridging 276 REAL(wp), PUBLIC :: rn_craft !: coefficient for smoothness of the hyperbolic tangent in rafting 277 REAL(wp), PUBLIC :: rn_fsnowrft !: fractional snow loss to the ocean during ridging 278 279 ! !!** some other parameters 159 280 INTEGER , PUBLIC :: nstart !: iteration number of the begining of the run 160 281 INTEGER , PUBLIC :: nlast !: iteration number of the end of the run … … 163 284 REAL(wp), PUBLIC :: rdt_ice !: ice time step 164 285 REAL(wp), PUBLIC :: r1_rdtice !: = 1. / rdt_ice 165 166 ! !!** ice-thickness distribution namelist (namiceitd) **167 INTEGER , PUBLIC :: nn_catbnd !: categories distribution following: tanh function (1), or h^(-alpha) function (2)168 REAL(wp), PUBLIC :: rn_himean !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only)169 170 ! !!** ice-dynamics namelist (namicedyn) **171 LOGICAL , PUBLIC :: ln_icestr_bvf !: use brine volume to diminish ice strength172 INTEGER , PUBLIC :: nn_icestr !: ice strength parameterization (0=Hibler79 1=Rothrock75)173 INTEGER , PUBLIC :: nn_nevp !: number of iterations for subcycling174 INTEGER , PUBLIC :: nn_ahi0 !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation)175 REAL(wp), PUBLIC :: rn_pe_rdg !: ridging work divided by pot. energy change in ridging, nn_icestr = 1176 REAL(wp), PUBLIC :: rn_cio !: drag coefficient for oceanic stress177 REAL(wp), PUBLIC :: rn_pstar !: determines ice strength (N/M), Hibler JPO79178 REAL(wp), PUBLIC :: rn_crhg !: determines changes in ice strength179 REAL(wp), PUBLIC :: rn_creepl !: creep limit : has to be under 1.0e-9180 REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve181 REAL(wp), PUBLIC :: rn_ahi0_ref !: sea-ice hor. eddy diffusivity coeff. (m2/s)182 REAL(wp), PUBLIC :: rn_relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)183 184 ! !!** ice-salinity namelist (namicesal) **185 REAL(wp), PUBLIC :: rn_simax !: maximum ice salinity [PSU]186 REAL(wp), PUBLIC :: rn_simin !: minimum ice salinity [PSU]187 REAL(wp), PUBLIC :: rn_sal_gd !: restoring salinity for gravity drainage [PSU]188 REAL(wp), PUBLIC :: rn_sal_fl !: restoring salinity for flushing [PSU]189 REAL(wp), PUBLIC :: rn_time_gd !: restoring time constant for gravity drainage (= 20 days) [s]190 REAL(wp), PUBLIC :: rn_time_fl !: restoring time constant for gravity drainage (= 10 days) [s]191 REAL(wp), PUBLIC :: rn_icesal !: bulk salinity (ppt) in case of constant salinity192 193 ! !!** ice-salinity namelist (namicesal) **194 INTEGER , PUBLIC :: nn_icesal !: salinity configuration used in the model195 ! ! 1 - constant salinity in both space and time196 ! ! 2 - prognostic salinity (s(z,t))197 ! ! 3 - salinity profile, constant in time198 INTEGER , PUBLIC :: nn_ice_thcon !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)199 INTEGER , PUBLIC :: nn_monocat !: virtual ITD mono-category parameterizations (1) or not (0)200 LOGICAL , PUBLIC :: ln_it_qnsice !: iterate surface flux with changing surface temperature or not (F)201 202 ! !!** ice-mechanical redistribution namelist (namiceitdme)203 REAL(wp), PUBLIC :: rn_cs !: fraction of shearing energy contributing to ridging204 REAL(wp), PUBLIC :: rn_fsnowrdg !: fractional snow loss to the ocean during ridging205 REAL(wp), PUBLIC :: rn_fsnowrft !: fractional snow loss to the ocean during ridging206 REAL(wp), PUBLIC :: rn_gstar !: fractional area of young ice contributing to ridging207 REAL(wp), PUBLIC :: rn_astar !: equivalent of G* for an exponential participation function208 REAL(wp), PUBLIC :: rn_hstar !: thickness that determines the maximal thickness of ridged ice209 REAL(wp), PUBLIC :: rn_hraft !: threshold thickness (m) for rafting / ridging210 REAL(wp), PUBLIC :: rn_craft !: coefficient for smoothness of the hyperbolic tangent in rafting211 REAL(wp), PUBLIC :: rn_por_rdg !: initial porosity of ridges (0.3 regular value)212 REAL(wp), PUBLIC :: rn_betas !: coef. for partitioning of snowfall between leads and sea ice213 REAL(wp), PUBLIC :: rn_kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]214 REAL(wp), PUBLIC :: nn_conv_dif !: maximal number of iterations for heat diffusion215 REAL(wp), PUBLIC :: rn_terr_dif !: maximal tolerated error (C) for heat diffusion216 217 ! !!** ice-mechanical redistribution namelist (namiceitdme)218 LOGICAL , PUBLIC :: ln_rafting !: rafting of ice or not219 INTEGER , PUBLIC :: nn_partfun !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)220 221 REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( rn_ecc * rn_ecc )222 REAL(wp), PUBLIC :: rhoco !: = rau0 * cio223 286 REAL(wp), PUBLIC :: r1_nlay_i !: 1 / nlay_i 224 287 REAL(wp), PUBLIC :: r1_nlay_s !: 1 / nlay_s 225 ! 226 ! !!** switch for presence of ice or not 227 REAL(wp), PUBLIC :: rswitch 228 ! 229 ! !!** define some parameters 288 REAL(wp), PUBLIC :: rswitch !: switch for the presence of ice (1) or not (0) 230 289 REAL(wp), PUBLIC, PARAMETER :: epsi06 = 1.e-06_wp !: small number 231 290 REAL(wp), PUBLIC, PARAMETER :: epsi10 = 1.e-10_wp !: small number 232 291 REAL(wp), PUBLIC, PARAMETER :: epsi20 = 1.e-20_wp !: small number 233 292 234 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce, v_oce !: surface ocean velocity used in ice dynamics235 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s]236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ust2s, hicol !: friction velocity, ice collection thickness accreted in leads237 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strp1, strp2 !: strength at previous time steps238 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strength 293 ! !!** define arrays 294 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce, v_oce !: surface ocean velocity used in ice dynamics 295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 296 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicol !: ice collection thickness accreted in leads 297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strength !: ice strength 239 298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: stress1_i, stress2_i, stress12_i !: 1st, 2nd & diagonal stress tensor element 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: delta_i 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: divu_i 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i 299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: delta_i !: ice rheology elta factor (Flato & Hibler 95) [s-1] 300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: divu_i !: Divergence of the velocity field [s-1] 301 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i !: Shear of the velocity field [s-1] 243 302 ! 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sist !: Average Sea-Ice Surface Temperature [Kelvin]245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icethi !: total ice thickness (for all categories) (diag only)246 303 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 247 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frld !: Leads fraction = 1 - ice fraction … … 252 309 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 253 310 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange [kg.m-2.s-1] 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice [kg.m-2.s-1] 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: snow/ice sublimation [kg.m-2.s-1] 257 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: ice-ocean mass exchange [kg.m-2.s-1] 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: snow ice growth component of wfx_ice [kg.m-2.s-1] 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: lateral ice growth component of wfx_ice [kg.m-2.s-1] 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: bottom ice growth component of wfx_ice [kg.m-2.s-1] 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: bottom melt component of wfx_ice [kg.m-2.s-1] 264 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: surface melt component of wfx_ice [kg.m-2.s-1] 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg.m-2.s-1] 311 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange [kg.m-2.s-1] 312 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice [kg.m-2.s-1] 313 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: snow/ice sublimation [kg.m-2.s-1] 314 315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: ice-ocean mass exchange [kg.m-2.s-1] 316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: snow ice growth component of wfx_ice [kg.m-2.s-1] 317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: lateral ice growth component of wfx_ice [kg.m-2.s-1] 318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: bottom ice growth component of wfx_ice [kg.m-2.s-1] 319 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 320 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: bottom melt component of wfx_ice [kg.m-2.s-1] 321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: surface melt component of wfx_ice [kg.m-2.s-1] 322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_lam !: lateral melt component of wfx_ice [kg.m-2.s-1] 323 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg.m-2.s-1] 266 324 267 325 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_tot !: ice concentration tendency (total) [s-1] … … 271 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s] 272 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice growth/melt [PSU/m2/s] 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_lam !: salt flux due to ice growth/melt [PSU/m2/s] 273 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice growth/melt [PSU/m2/s] 274 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to ice growth/melt [PSU/m2/s] … … 302 361 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness [W.m-2] 303 362 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ,:) :: ftr_ice !: transmitted solar radiation under ice305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pahu3D , pahv3D306 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: rn_amax_2d !: maximum ice concentration 2d array363 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_amax_2d !: maximum ice concentration 2d array 364 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 365 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pahu3D, pahv3D !: ice hor. eddy diffusivity coef. at U- and V-points 307 366 308 367 !!-------------------------------------------------------------------------- … … 310 369 !!-------------------------------------------------------------------------- 311 370 !! Variables defined for each ice category 312 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i !: Ice thickness (m)313 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration)314 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m)315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area(m)316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_s !: Snow thickness (m)317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K)318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sm_i !: Sea-Ice Bulk salinity (ppt)319 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: smv_i !: Sea-Ice Bulk salinity times volume per area (ppt.m)320 ! ! this is an extensive variable that has to be transported321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (days)322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o v_i !: Sea-Ice Age times volume per area (days.m)323 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (days)371 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i !: Ice thickness (m) 372 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration) 373 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m) 374 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area(m) 375 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_s !: Snow thickness (m) 376 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K) 377 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sm_i !: Sea-Ice Bulk salinity (ppt) 378 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: smv_i !: Sea-Ice Bulk salinity times volume per area (ppt.m) 379 ! ! this is an extensive variable that has to be transported 380 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (days) 381 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (days) 382 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bv_i !: brine volume 324 383 325 384 !! Variables summed over all categories, or associated to all the ice in a single grid cell 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tio_u, tio_v !: components of the ice-ocean stress (N/m2) 328 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ot_i !: mean age over all categories 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories 334 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bv_i !: brine volume averaged over all categories 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smt_i !: mean sea ice salinity averaged over all categories [PSU] 336 337 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 338 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow ... 385 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 387 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 388 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area 389 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content 390 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories 391 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bvm_i !: brine volume averaged over all categories 392 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smt_i !: mean sea ice salinity averaged over all categories [PSU] 393 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories 394 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htm_i !: mean ice thickness over all categories 395 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htm_s !: mean snow thickness over all categories 396 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: om_i !: mean ice age over all categories 397 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_icebfr !: ice friction with bathy (landfast param activated) 398 399 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 400 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow ... 339 401 340 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i 341 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i 342 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: s_i 402 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] 403 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice thermal contents [J/m2] 404 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: s_i !: ice salinities [PSU] 343 405 344 406 !!-------------------------------------------------------------------------- … … 362 424 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures 363 425 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity 426 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i_b !: ice concentration (total) 364 427 365 428 !!-------------------------------------------------------------------------- … … 368 431 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space 369 432 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories 370 371 !!--------------------------------------------------------------------------372 !! * Ice Run373 !!--------------------------------------------------------------------------374 ! !!: ** Namelist namicerun read in sbc_lim_init **375 INTEGER , PUBLIC :: jpl !: number of ice categories376 INTEGER , PUBLIC :: nlay_i !: number of ice layers377 INTEGER , PUBLIC :: nlay_s !: number of snow layers378 CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input)379 CHARACTER(len=256), PUBLIC :: cn_icerst_indir !: ice restart input directory380 CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output)381 CHARACTER(len=256), PUBLIC :: cn_icerst_outdir!: ice restart output directory382 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F)383 LOGICAL , PUBLIC :: ln_icectl !: flag for sea-ice points output (T) or not (F)384 REAL(wp) , PUBLIC :: rn_amax_n !: maximum ice concentration Northern hemisphere385 REAL(wp) , PUBLIC :: rn_amax_s !: maximum ice concentration Southern hemisphere386 INTEGER , PUBLIC :: iiceprt !: debug i-point387 INTEGER , PUBLIC :: jiceprt !: debug j-point388 433 ! 389 434 !!-------------------------------------------------------------------------- 390 435 !! * Ice diagnostics 391 436 !!-------------------------------------------------------------------------- 392 ! Increment of global variables393 437 ! thd refers to changes induced by thermodynamics 394 438 ! trp '' '' '' advection (transport of ice) 395 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 396 LOGICAL , PUBLIC :: ln_limdiaout !: flag for ice diag (T) or not (F) 439 ! 397 440 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume 398 441 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume … … 419 462 INTEGER :: ice_alloc 420 463 ! 421 INTEGER :: ierr(1 7), ii464 INTEGER :: ierr(15), ii 422 465 !!----------------------------------------------------------------- 423 466 … … 427 470 ! stay within Fortran's max-line length limit. 428 471 ii = 1 429 ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 430 & ahiu (jpi,jpj) , ahiv (jpi,jpj) , & 431 & ust2s (jpi,jpj) , hicol (jpi,jpj) , & 432 & strp1 (jpi,jpj) , strp2 (jpi,jpj) , strength (jpi,jpj) , & 433 & stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) , & 434 & delta_i (jpi,jpj) , divu_i (jpi,jpj) , shear_i (jpi,jpj) , STAT=ierr(ii) ) 435 436 ii = ii + 1 437 ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , & 438 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 439 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , & 472 ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 473 & ahiu (jpi,jpj) , ahiv (jpi,jpj) , hicol (jpi,jpj) , & 474 & strength(jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) , & 475 & delta_i (jpi,jpj) , divu_i (jpi,jpj) , shear_i (jpi,jpj) , STAT=ierr(ii) ) 476 477 ii = ii + 1 478 ALLOCATE( t_bo (jpi,jpj) , frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 479 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , wfx_lam(jpi,jpj) , & 440 480 & wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 441 481 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 442 & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , & 443 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), pahu3D(jpi,jpj,jpl+1), pahv3D(jpi,jpj,jpl+1), & 444 & rn_amax_2d (jpi,jpj) , qlead (jpi,jpj) , & 445 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj), & 446 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 482 & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , rn_amax_2d(jpi,jpj), & 483 & fhtur (jpi,jpj) , qlead (jpi,jpj) , & 484 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) , & 485 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 447 486 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , & 448 & hfx_ err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) ,&449 & hfx_ in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,&450 & hfx_ sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,&451 & hfx_ thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj), STAT=ierr(ii) )487 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld (jpi,jpj) , & 488 & hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , & 489 & hfx_opw(jpi,jpj) , hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) , & 490 & hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) , STAT=ierr(ii) ) 452 491 453 492 ! * Ice global state variables 454 493 ii = ii + 1 455 ALLOCATE( ht_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , & 456 & v_s (jpi,jpj,jpl) , ht_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , & 457 & sm_i (jpi,jpj,jpl) , smv_i(jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , & 458 & ov_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl) , STAT=ierr(ii) ) 459 ii = ii + 1 460 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , tio_u(jpi,jpj) , tio_v(jpi,jpj) , & 494 ALLOCATE( ftr_ice(jpi,jpj,jpl) , pahu3D(jpi,jpj,jpl+1) , pahv3D(jpi,jpj,jpl+1) , & 495 & ht_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , & 496 & v_s (jpi,jpj,jpl) , ht_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , & 497 & sm_i (jpi,jpj,jpl) , smv_i (jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , & 498 & oa_i (jpi,jpj,jpl) , bv_i (jpi,jpj,jpl) , STAT=ierr(ii) ) 499 ii = ii + 1 500 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , & 461 501 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) , & 462 & et_i (jpi,jpj) , et_s (jpi,jpj) , ot_i (jpi,jpj) , tm_i (jpi,jpj) , & 463 & bv_i (jpi,jpj) , smt_i(jpi,jpj) , STAT=ierr(ii) ) 502 & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) , & 503 & smt_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) , & 504 & om_i (jpi,jpj) , tau_icebfr(jpi,jpj) , STAT=ierr(ii) ) 464 505 ii = ii + 1 465 506 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) … … 488 529 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 489 530 & a_i_b (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , & 490 & oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) ) 531 & oa_i_b (jpi,jpj,jpl) , STAT=ierr(ii) ) 532 ii = ii + 1 533 ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , at_i_b(jpi,jpj) , STAT=ierr(ii) ) 491 534 492 535 ! * Ice thickness distribution variables … … 496 539 ! * Ice diagnostics 497 540 ii = ii + 1 498 ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj), &499 & diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj), diag_heat (jpi,jpj), &500 & diag_smvi (jpi,jpj) , diag_vice (jpi,jpj), diag_vsnw (jpi,jpj), STAT=ierr(ii) )541 ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj), & 542 & diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj) , diag_heat (jpi,jpj), & 543 & diag_smvi (jpi,jpj) , diag_vice (jpi,jpj) , diag_vsnw (jpi,jpj), STAT=ierr(ii) ) 501 544 502 545 ice_alloc = MAXVAL( ierr(:) ) 503 IF( ice_alloc /= 0 ) CALL ctl_warn('ice_alloc _2: failed to allocate arrays.')546 IF( ice_alloc /= 0 ) CALL ctl_warn('ice_alloc: failed to allocate arrays.') 504 547 ! 505 548 END FUNCTION ice_alloc … … 513 556 !!====================================================================== 514 557 END MODULE ice 515 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r6416 r7309 18 18 USE phycst ! physical constants 19 19 USE ice ! LIM-3 variables 20 USE dom_ice ! LIM-3 domain21 20 USE dom_oce ! ocean domain 22 21 USE in_out_manager ! I/O manager … … 165 164 !! + test if ice concentration and volume are > 0 166 165 !! 167 !! ** Method : This is an online diagnostics which can be activated with ln_limdia hsb=true166 !! ** Method : This is an online diagnostics which can be activated with ln_limdiachk=true 168 167 !! It prints in ocean.output if there is a violation of conservation at each time-step 169 168 !! The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to … … 185 184 ! salt flux 186 185 zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 187 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) 186 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:) & 188 187 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 189 188 190 189 ! water flux 191 zfw_b = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + &192 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) 190 zfw_b = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 191 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:) & 193 192 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 194 193 … … 210 209 ! salt flux 211 210 zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 212 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) 211 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:) & 213 212 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 214 213 215 214 ! water flux 216 zfw = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + &217 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) &215 zfw = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 216 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:) & 218 217 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 219 218 … … 260 259 & cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 261 260 WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 261 IF ( zamax > 1._wp ) WRITE(numout,*) 'violation a_i>1 (',cd_routine,') = ',zamax 262 262 ENDIF 263 263 IF ( zamin < -epsi10 ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin … … 274 274 !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step 275 275 !! 276 !! ** Method : This is an online diagnostics which can be activated with ln_limdia hsb=true276 !! ** Method : This is an online diagnostics which can be activated with ln_limdiachk=true 277 277 !! It prints in ocean.output if there is a violation of conservation at each time-step 278 278 !! The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to … … 288 288 #if ! defined key_bdy 289 289 ! heat flux 290 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - SUM( qevap_ice * a_i_b, dim=3 ) ) & 291 & * e1e2t * tmask(:,:,1) * zconv ) 290 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es & 291 ! & - SUM( qevap_ice * a_i_b, dim=3 ) & !!clem: I think this line must be commented (but need check) 292 & ) * e1e2t * tmask(:,:,1) * zconv ) 292 293 ! salt flux 293 294 zsfx = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
r5836 r7309 5 5 !!====================================================================== 6 6 !! History : 3.5 ! 2015-01 (M. Vancoppenolle) Original code 7 !! 3.7 ! 2016-10 (C. Rousset) Add routine lim_prt3D 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim3 … … 12 13 !! lim_ctl : control prints in case of crash 13 14 !! lim_prt : ice control print at a given grid point 15 !! lim_prt3D : control prints of ice arrays 14 16 !!---------------------------------------------------------------------- 15 17 USE oce ! ocean dynamics and tracers … … 17 19 USE ice ! LIM-3: ice variables 18 20 USE thd_ice ! LIM-3: thermodynamical variables 19 USE dom_ice ! LIM-3: ice domain20 21 USE sbc_oce ! Surface boundary condition: ocean fields 21 22 USE sbc_ice ! Surface boundary condition: ice fields … … 35 36 PUBLIC lim_ctl 36 37 PUBLIC lim_prt 38 PUBLIC lim_prt3D 37 39 38 40 !! * Substitutions … … 445 447 END SUBROUTINE lim_prt 446 448 449 SUBROUTINE lim_prt3D( cd_routine ) 450 !!--------------------------------------------------------------------------------------------------------- 451 !! *** ROUTINE lim_prt3D *** 452 !! 453 !! ** Purpose : CTL prints of ice arrays in case ln_ctl is activated 454 !! 455 !!--------------------------------------------------------------------------------------------------------- 456 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 457 INTEGER :: jk, jl ! dummy loop indices 458 459 CALL prt_ctl_info(' ========== ') 460 CALL prt_ctl_info( cd_routine ) 461 CALL prt_ctl_info(' ========== ') 462 CALL prt_ctl_info(' - Cell values : ') 463 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 464 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' cell area :') 465 CALL prt_ctl(tab2d_1=at_i , clinfo1=' at_i :') 466 CALL prt_ctl(tab2d_1=ato_i , clinfo1=' ato_i :') 467 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' vt_i :') 468 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' vt_s :') 469 CALL prt_ctl(tab2d_1=divu_i , clinfo1=' divu_i :') 470 CALL prt_ctl(tab2d_1=delta_i , clinfo1=' delta_i :') 471 CALL prt_ctl(tab2d_1=stress1_i , clinfo1=' stress1_i :') 472 CALL prt_ctl(tab2d_1=stress2_i , clinfo1=' stress2_i :') 473 CALL prt_ctl(tab2d_1=stress12_i , clinfo1=' stress12_i :') 474 CALL prt_ctl(tab2d_1=strength , clinfo1=' strength :') 475 CALL prt_ctl(tab2d_1=delta_i , clinfo1=' delta_i :') 476 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 477 478 DO jl = 1, jpl 479 CALL prt_ctl_info(' ') 480 CALL prt_ctl_info(' - Category : ', ivar1=jl) 481 CALL prt_ctl_info(' ~~~~~~~~~~') 482 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' ht_i : ') 483 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' ht_s : ') 484 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' t_su : ') 485 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' t_snow : ') 486 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' sm_i : ') 487 CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' o_i : ') 488 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' a_i : ') 489 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' v_i : ') 490 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' v_s : ') 491 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' e_i1 : ') 492 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' e_snow : ') 493 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' smv_i : ') 494 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' oa_i : ') 495 496 DO jk = 1, nlay_i 497 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 498 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i : ') 499 END DO 500 END DO 501 502 CALL prt_ctl_info(' ') 503 CALL prt_ctl_info(' - Heat / FW fluxes : ') 504 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 505 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 506 CALL prt_ctl(tab2d_1=qsr , clinfo1= ' qsr : ', tab2d_2=qns , clinfo2= ' qns : ') 507 CALL prt_ctl(tab2d_1=emp , clinfo1= ' emp : ', tab2d_2=sfx , clinfo2= ' sfx : ') 508 509 CALL prt_ctl_info(' ') 510 CALL prt_ctl_info(' - Stresses : ') 511 CALL prt_ctl_info(' ~~~~~~~~~~ ') 512 CALL prt_ctl(tab2d_1=utau , clinfo1= ' utau : ', tab2d_2=vtau , clinfo2= ' vtau : ') 513 CALL prt_ctl(tab2d_1=utau_ice , clinfo1= ' utau_ice : ', tab2d_2=vtau_ice , clinfo2= ' vtau_ice : ') 514 CALL prt_ctl(tab2d_1=u_oce , clinfo1= ' u_oce : ', tab2d_2=v_oce , clinfo2= ' v_oce : ') 515 516 END SUBROUTINE lim_prt3D 517 447 518 #else 448 519 !!-------------------------------------------------------------------------- … … 454 525 SUBROUTINE lim_prt ! Empty routine 455 526 END SUBROUTINE lim_prt 527 SUBROUTINE lim_prt3D ! Empty routine 528 END SUBROUTINE lim_prt3D 456 529 #endif 457 530 !!====================================================================== -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r6418 r7309 14 14 !!---------------------------------------------------------------------- 15 15 USE ice ! LIM-3: sea-ice variable 16 USE dom_ice ! LIM-3: sea-ice domain17 16 USE dom_oce ! ocean domain 18 17 USE sbc_oce ! surface boundary condition: ocean fields … … 31 30 32 31 PUBLIC lim_diahsb ! routine called by ice_step.F90 33 34 real(wp) :: frc_sal, frc_vol ! global forcing trends 35 real(wp) :: bg_grme ! global ice growth+melt trends 36 32 PUBLIC lim_diahsb_init ! routine called in sbcice_lim.F90 33 34 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 35 REAL(wp) :: frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot ! global forcing trends 36 37 37 !! * Substitutions 38 38 # include "vectopt_loop_substitute.h90" … … 46 46 CONTAINS 47 47 48 SUBROUTINE lim_diahsb 48 SUBROUTINE lim_diahsb( kt ) 49 49 !!--------------------------------------------------------------------------- 50 50 !! *** ROUTINE lim_diahsb *** … … 53 53 !! 54 54 !!--------------------------------------------------------------------------- 55 INTEGER, INTENT(in) :: kt ! number of iteration 55 56 !! 56 real(wp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 57 real(wp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, & 58 & zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn, zbg_sfx_sub 59 real(wp) :: zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 60 real(wp) :: zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub 61 real(wp) :: zbg_hfx_dhc, zbg_hfx_spr 62 real(wp) :: zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in 63 real(wp) :: zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 64 real(wp) :: z_frc_vol, z_frc_sal, z_bg_grme 65 real(wp) :: z1_area ! - - 66 REAL(wp) :: ztmp 57 real(wp) :: zbg_ivol, zbg_svol, zbg_area, zbg_isal, zbg_item ,zbg_stem 58 REAL(wp) :: z_frc_voltop, z_frc_volbot, z_frc_sal, z_frc_temtop, z_frc_tembot 59 REAL(wp) :: zdiff_vol, zdiff_sal, zdiff_tem 67 60 !!--------------------------------------------------------------------------- 68 61 IF( nn_timing == 1 ) CALL timing_start('lim_diahsb') 69 62 70 IF( numit == nstart ) CALL lim_diahsb_init 71 72 ! 1/area 73 z1_area = 1._wp / MAX( glob_sum( e1e2t(:,:) * tmask(:,:,1) ), epsi06 ) 74 75 rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e1e2t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 76 ! ----------------------- ! 77 ! 1 - Content variations ! 78 ! ----------------------- ! 79 zbg_ivo = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume ice 80 zbg_svo = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume snow 81 zbg_are = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! area 82 zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) ) ! mean salt content 83 zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! mean temp content 84 85 !zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 86 !zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 87 88 ! Volume 89 ztmp = rswitch * z1_area * r1_rau0 * rday 90 zbg_vfx = ztmp * glob_sum( emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 91 zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 92 zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 93 zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 94 zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 95 zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 96 zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 97 zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 98 zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 99 zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 100 zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 101 102 ! Salt 103 zbg_sfx = ztmp * glob_sum( sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 104 zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 105 zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 106 zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 107 108 zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 109 zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 110 zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 111 zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 112 zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 113 zbg_sfx_sub = ztmp * glob_sum( sfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 114 115 ! Heat budget 116 zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * 1.e-20 ) ! ice heat content [1.e20 J] 117 zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 118 zbg_hfx_dhc = glob_sum( diag_heat(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 119 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 120 121 zbg_hfx_thd = glob_sum( hfx_thd(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 122 zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 123 zbg_hfx_res = glob_sum( hfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 124 zbg_hfx_sub = glob_sum( hfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 125 zbg_hfx_snw = glob_sum( hfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 126 zbg_hfx_sum = glob_sum( hfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 127 zbg_hfx_bom = glob_sum( hfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 128 zbg_hfx_bog = glob_sum( hfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 129 zbg_hfx_dif = glob_sum( hfx_dif(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 130 zbg_hfx_opw = glob_sum( hfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 131 zbg_hfx_out = glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 132 zbg_hfx_in = glob_sum( hfx_in(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 133 134 ! --------------------------------------------- ! 135 ! 2 - Trends due to forcing and ice growth/melt ! 136 ! --------------------------------------------- ! 137 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 138 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! salt fluxes 139 z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 140 & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 141 & wfx_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 142 ! 143 frc_vol = frc_vol + z_frc_vol * rdt_ice 144 frc_sal = frc_sal + z_frc_sal * rdt_ice 145 bg_grme = bg_grme + z_bg_grme * rdt_ice 63 ! ----------------------- ! 64 ! 1 - Contents ! 65 ! ----------------------- ! 66 zbg_ivol = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! ice volume (km3) 67 zbg_svol = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! snow volume (km3) 68 zbg_area = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-6 ) ! area (km2) 69 zbg_isal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! salt content (pss*km3) 70 zbg_item = glob_sum( et_i * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat content (1.e20 J) 71 zbg_stem = glob_sum( et_s * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat content (1.e20 J) 146 72 147 ! difference 148 !frc_vol = zbg_ivo - frc_vol 149 !frc_sal = zbg_sal - frc_sal 150 151 ! ----------------------- ! 152 ! 3 - Diagnostics writing ! 153 ! ----------------------- ! 154 rswitch = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 155 ! 156 IF( iom_use('ibgvoltot') ) & 157 CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9 ) ! ice volume (km3 equivalent liquid) 158 IF( iom_use('sbgvoltot') ) & 159 CALL iom_put( 'sbgvoltot' , zbg_svo * rhosn * r1_rau0 * 1.e-9 ) ! snw volume (km3 equivalent liquid) 160 IF( iom_use('ibgarea') ) & 161 CALL iom_put( 'ibgarea' , zbg_are * 1.e-6 ) ! ice area (km2) 162 IF( iom_use('ibgsaline') ) & 163 CALL iom_put( 'ibgsaline' , rswitch * zbg_sal / MAX( zbg_ivo, epsi06 ) ) ! ice saline (psu) 164 IF( iom_use('ibgtemper') ) & 165 CALL iom_put( 'ibgtemper' , rswitch * zbg_tem / MAX( zbg_ivo, epsi06 ) ) ! ice temper (C) 166 CALL iom_put( 'ibgheatco' , zbg_ihc ) ! ice heat content (1.e20 J) 167 CALL iom_put( 'sbgheatco' , zbg_shc ) ! snw heat content (1.e20 J) 168 IF( iom_use('ibgsaltco') ) & 169 CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9 ) ! ice salt content (psu*km3 equivalent liquid) 170 171 CALL iom_put( 'ibgvfx' , zbg_vfx ) ! volume flux emp (m/day liquid) 172 CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog ) ! volume flux bottom growth -(m/day equivalent liquid) 173 CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw ) ! volume flux open water growth - 174 CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni ) ! volume flux snow ice growth - 175 CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn ) ! volume flux dynamic growth - 176 CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom ) ! volume flux bottom melt - 177 CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum ) ! volume flux surface melt - 178 CALL iom_put( 'ibgvfxres' , zbg_vfx_res ) ! volume flux resultant - 179 CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr ) ! volume flux from snow precip - 180 CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw ) ! volume flux from snow melt - 181 CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub ) ! volume flux from sublimation - 182 183 CALL iom_put( 'ibgsfx' , zbg_sfx ) ! salt flux -(psu*m/day equivalent liquid) 184 CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri ) ! salt flux brines - 185 CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn ) ! salt flux dynamic - 186 CALL iom_put( 'ibgsfxres' , zbg_sfx_res ) ! salt flux result - 187 CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog ) ! salt flux bottom growth 188 CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw ) ! salt flux open water growth - 189 CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni ) ! salt flux snow ice growth - 190 CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom ) ! salt flux bottom melt - 191 CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum ) ! salt flux surface melt - 192 CALL iom_put( 'ibgsfxsub' , zbg_sfx_sub ) ! salt flux sublimation - 193 194 CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc ) ! Heat content variation in snow and ice [W] 195 CALL iom_put( 'ibghfxspr' , zbg_hfx_spr ) ! Heat content of snow precip [W] 196 197 CALL iom_put( 'ibghfxres' , zbg_hfx_res ) ! 198 CALL iom_put( 'ibghfxsub' , zbg_hfx_sub ) ! 199 CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn ) ! 200 CALL iom_put( 'ibghfxthd' , zbg_hfx_thd ) ! 201 CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw ) ! 202 CALL iom_put( 'ibghfxsum' , zbg_hfx_sum ) ! 203 CALL iom_put( 'ibghfxbom' , zbg_hfx_bom ) ! 204 CALL iom_put( 'ibghfxbog' , zbg_hfx_bog ) ! 205 CALL iom_put( 'ibghfxdif' , zbg_hfx_dif ) ! 206 CALL iom_put( 'ibghfxopw' , zbg_hfx_opw ) ! 207 CALL iom_put( 'ibghfxout' , zbg_hfx_out ) ! 208 CALL iom_put( 'ibghfxin' , zbg_hfx_in ) ! 209 210 CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9 ) ! vol - forcing (km3 equivalent liquid) 211 CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9 ) ! sal - forcing (psu*km3 equivalent liquid) 212 IF( iom_use('ibgvolgrm') ) & 213 CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 214 73 ! ---------------------------! 74 ! 2 - Trends due to forcing ! 75 ! ---------------------------! 76 z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! freshwater flux ice/snow-ocean 77 z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! freshwater flux ice/snow-atm 78 z_frc_sal = r1_rau0 * glob_sum( - sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! salt fluxes ice/snow-ocean 79 z_frc_tembot = glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat on top of ocean (and below ice) 80 z_frc_temtop = glob_sum( hfx_in (:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat on top of ice-coean 81 ! 82 frc_voltop = frc_voltop + z_frc_voltop * rdt_ice ! km3 83 frc_volbot = frc_volbot + z_frc_volbot * rdt_ice ! km3 84 frc_sal = frc_sal + z_frc_sal * rdt_ice ! km3*pss 85 frc_temtop = frc_temtop + z_frc_temtop * rdt_ice ! 1.e20 J 86 frc_tembot = frc_tembot + z_frc_tembot * rdt_ice ! 1.e20 J 87 88 ! ----------------------- ! 89 ! 3 - Content variations ! 90 ! ----------------------- ! 91 zdiff_vol = r1_rau0 * glob_sum( ( rhoic * vt_i(:,:) + rhosn * vt_s(:,:) - vol_loc_ini(:,:) & ! freshwater trend (km3) 92 & ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) 93 zdiff_sal = r1_rau0 * glob_sum( ( rhoic * SUM( smv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) & ! salt content trend (km3*pss) 94 & ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) 95 zdiff_tem = glob_sum( ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) & ! heat content trend (1.e20 J) 96 ! & + SUM( qevap_ice * a_i_b, dim=3 ) & !! clem: I think this line should be commented (but needs a check) 97 & ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) 98 99 ! ----------------------- ! 100 ! 4 - Drifts ! 101 ! ----------------------- ! 102 zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 103 zdiff_sal = zdiff_sal - frc_sal 104 zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 105 106 ! ----------------------- ! 107 ! 5 - Diagnostics writing ! 108 ! ----------------------- ! 109 ! 110 IF( iom_use('ibgvolume') ) CALL iom_put( 'ibgvolume' , zdiff_vol ) ! ice/snow volume drift (km3 equivalent ocean water) 111 IF( iom_use('ibgsaltco') ) CALL iom_put( 'ibgsaltco' , zdiff_sal ) ! ice salt content drift (psu*km3 equivalent ocean water) 112 IF( iom_use('ibgheatco') ) CALL iom_put( 'ibgheatco' , zdiff_tem ) ! ice/snow heat content drift (1.e20 J) 113 IF( iom_use('ibgheatfx') ) CALL iom_put( 'ibgheatfx' , zdiff_tem / & ! ice/snow heat flux drift (W/m2) 114 & glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 115 116 IF( iom_use('ibgfrcvoltop') ) CALL iom_put( 'ibgfrcvoltop' , frc_voltop ) ! vol forcing ice/snw-atm (km3 equivalent ocean water) 117 IF( iom_use('ibgfrcvolbot') ) CALL iom_put( 'ibgfrcvolbot' , frc_volbot ) ! vol forcing ice/snw-ocean (km3 equivalent ocean water) 118 IF( iom_use('ibgfrcsal') ) CALL iom_put( 'ibgfrcsal' , frc_sal ) ! sal - forcing (psu*km3 equivalent ocean water) 119 IF( iom_use('ibgfrctemtop') ) CALL iom_put( 'ibgfrctemtop' , frc_temtop ) ! heat on top of ice/snw/ocean (1.e20 J) 120 IF( iom_use('ibgfrctembot') ) CALL iom_put( 'ibgfrctembot' , frc_tembot ) ! heat on top of ocean(below ice) (1.e20 J) 121 IF( iom_use('ibgfrchfxtop') ) CALL iom_put( 'ibgfrchfxtop' , frc_temtop / & ! heat on top of ice/snw/ocean (W/m2) 122 & glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 123 IF( iom_use('ibgfrchfxbot') ) CALL iom_put( 'ibgfrchfxbot' , frc_tembot / & ! heat on top of ocean(below ice) (W/m2) 124 & glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 125 126 IF( iom_use('ibgvol_tot' ) ) CALL iom_put( 'ibgvol_tot' , zbg_ivol ) ! ice volume (km3) 127 IF( iom_use('sbgvol_tot' ) ) CALL iom_put( 'sbgvol_tot' , zbg_svol ) ! snow volume (km3) 128 IF( iom_use('ibgarea_tot') ) CALL iom_put( 'ibgarea_tot' , zbg_area ) ! ice area (km2) 129 IF( iom_use('ibgsalt_tot') ) CALL iom_put( 'ibgsalt_tot' , zbg_isal ) ! ice salinity content (pss*km3) 130 IF( iom_use('ibgheat_tot') ) CALL iom_put( 'ibgheat_tot' , zbg_item ) ! ice heat content (1.e20 J) 131 IF( iom_use('sbgheat_tot') ) CALL iom_put( 'sbgheat_tot' , zbg_stem ) ! snow heat content (1.e20 J) 215 132 ! 216 133 IF( lrst_ice ) CALL lim_diahsb_rst( numit, 'WRITE' ) 217 134 ! 218 135 IF( nn_timing == 1 ) CALL timing_stop('lim_diahsb') 219 !136 ! 220 137 END SUBROUTINE lim_diahsb 221 138 … … 233 150 !! - Compute coefficients for conversion 234 151 !!--------------------------------------------------------------------------- 235 INTEGER :: jk ! dummy loop indice236 152 INTEGER :: ierror ! local integer 237 153 !! … … 247 163 WRITE(numout,*) '~~~~~~~~~~~~' 248 164 ENDIF 249 ! 165 ! 166 ALLOCATE( vol_loc_ini(jpi,jpj), sal_loc_ini(jpi,jpj), tem_loc_ini(jpi,jpj), STAT=ierror ) 167 IF( ierror > 0 ) THEN 168 CALL ctl_stop( 'lim_diahsb: unable to allocate vol_loc_ini' ) 169 RETURN 170 ENDIF 171 250 172 CALL lim_diahsb_rst( nstart, 'READ' ) !* read or initialize all required files 251 173 ! … … 263 185 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 264 186 ! 265 INTEGER :: id1, id2, id3 ! local integers266 187 !!---------------------------------------------------------------------- 267 188 ! 268 189 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 269 190 IF( ln_rstart ) THEN !* Read the restart file 270 !id1 = iom_varid( numrir, 'frc_vol' , ldstop = .TRUE. )271 191 ! 272 192 IF(lwp) WRITE(numout,*) '~~~~~~~' 273 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp 274 IF(lwp) WRITE(numout,*) '~~~~~~~' 275 CALL iom_get( numrir, 'frc_vol', frc_vol ) 276 CALL iom_get( numrir, 'frc_sal', frc_sal ) 277 CALL iom_get( numrir, 'bg_grme', bg_grme ) 193 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst read at it= ', kt,' date= ', ndastp 194 IF(lwp) WRITE(numout,*) '~~~~~~~' 195 CALL iom_get( numrir, 'frc_voltop' , frc_voltop ) 196 CALL iom_get( numrir, 'frc_volbot' , frc_volbot ) 197 CALL iom_get( numrir, 'frc_temtop' , frc_temtop ) 198 CALL iom_get( numrir, 'frc_tembot' , frc_tembot ) 199 CALL iom_get( numrir, 'frc_sal' , frc_sal ) 200 CALL iom_get( numrir, jpdom_autoglo, 'vol_loc_ini', vol_loc_ini ) 201 CALL iom_get( numrir, jpdom_autoglo, 'tem_loc_ini', tem_loc_ini ) 202 CALL iom_get( numrir, jpdom_autoglo, 'sal_loc_ini', sal_loc_ini ) 278 203 ELSE 279 204 IF(lwp) WRITE(numout,*) '~~~~~~~' 280 205 IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' 281 206 IF(lwp) WRITE(numout,*) '~~~~~~~' 282 frc_vol = 0._wp 283 frc_sal = 0._wp 284 bg_grme = 0._wp 207 ! set trends to 0 208 frc_voltop = 0._wp 209 frc_volbot = 0._wp 210 frc_temtop = 0._wp 211 frc_tembot = 0._wp 212 frc_sal = 0._wp 213 ! record initial ice volume, salt and temp 214 vol_loc_ini(:,:) = rhoic * vt_i(:,:) + rhosn * vt_s(:,:) ! ice/snow volume (kg/m2) 215 tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:) ! ice/snow heat content (J) 216 sal_loc_ini(:,:) = rhoic * SUM( smv_i(:,:,:), dim=3 ) ! ice salt content (pss*kg/m2) 217 285 218 ENDIF 286 219 … … 288 221 ! ! ------------------- 289 222 IF(lwp) WRITE(numout,*) '~~~~~~~' 290 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp223 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst write at it= ', kt,' date= ', ndastp 291 224 IF(lwp) WRITE(numout,*) '~~~~~~~' 292 CALL iom_rstput( kt, nitrst, numriw, 'frc_vol' , frc_vol ) 293 CALL iom_rstput( kt, nitrst, numriw, 'frc_sal' , frc_sal ) 294 CALL iom_rstput( kt, nitrst, numriw, 'bg_grme' , bg_grme ) 225 CALL iom_rstput( kt, nitrst, numriw, 'frc_voltop' , frc_voltop ) 226 CALL iom_rstput( kt, nitrst, numriw, 'frc_volbot' , frc_volbot ) 227 CALL iom_rstput( kt, nitrst, numriw, 'frc_temtop' , frc_temtop ) 228 CALL iom_rstput( kt, nitrst, numriw, 'frc_tembot' , frc_tembot ) 229 CALL iom_rstput( kt, nitrst, numriw, 'frc_sal' , frc_sal ) 230 CALL iom_rstput( kt, nitrst, numriw, 'vol_loc_ini', vol_loc_ini ) 231 CALL iom_rstput( kt, nitrst, numriw, 'tem_loc_ini', tem_loc_ini ) 232 CALL iom_rstput( kt, nitrst, numriw, 'sal_loc_ini', sal_loc_ini ) 295 233 ! 296 234 ENDIF -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r5836 r7309 17 17 USE phycst ! physical constants 18 18 USE dom_oce ! ocean space and time domain 19 USE sbc_oce ! Surface boundary condition: ocean fields20 19 USE sbc_ice ! Surface boundary condition: ice fields 21 20 USE ice ! LIM-3 variables 22 USE dom_ice ! LIM-3 domain23 21 USE limrhg ! LIM-3 rheology 24 22 USE lbclnk ! lateral boundary conditions - MPP exchanges … … 26 24 USE wrk_nemo ! work arrays 27 25 USE in_out_manager ! I/O manager 28 USE prtctl ! Print control29 26 USE lib_fortran ! glob_sum 30 USE timing ! Timing 31 USE limcons ! conservation tests 27 USE timing ! Timing 28 USE limcons ! conservation tests 29 USE limctl ! control prints 32 30 USE limvar 33 31 … … 35 33 PRIVATE 36 34 37 PUBLIC lim_dyn ! routine called by ice_step 35 PUBLIC lim_dyn ! routine called by sbcice_lim.F90 36 PUBLIC lim_dyn_init ! routine called by sbcice_lim.F90 38 37 39 38 !! * Substitutions … … 50 49 !! *** ROUTINE lim_dyn *** 51 50 !! 52 !! ** Purpose : compute ice velocity and ocean-ice stress51 !! ** Purpose : compute ice velocity 53 52 !! 54 53 !! ** Method : … … 56 55 !! ** Action : - Initialisation 57 56 !! - Call of the dynamic routine for each hemisphere 58 !! - computation of the stress at the ocean surface59 !! - treatment of the case if no ice dynamic60 57 !!------------------------------------------------------------------------------------ 61 58 INTEGER, INTENT(in) :: kt ! number of iteration 62 59 !! 63 INTEGER :: ji, jj, jl, ja ! dummy loop indices 64 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 65 REAL(wp) :: zcoef ! local scalar 66 REAL(wp), POINTER, DIMENSION(:) :: zswitch ! i-averaged indicator of sea-ice 67 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 68 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io ! ice-ocean velocity 69 ! 60 INTEGER :: jl, jk ! dummy loop indices 70 61 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 71 62 !!--------------------------------------------------------------------- … … 73 64 IF( nn_timing == 1 ) CALL timing_start('limdyn') 74 65 75 CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 76 CALL wrk_alloc( jpj, zswitch, zmsk ) 77 78 CALL lim_var_agg(1) ! aggregate ice categories 79 80 IF( kt == nit000 ) CALL lim_dyn_init ! Initialization (first time-step only) 81 82 IF( ln_limdyn ) THEN 83 ! 84 ! conservation test 85 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 86 87 u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 88 v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 89 90 ! Rheology (ice dynamics) 91 ! ======== 92 93 ! Define the j-limits where ice rheology is computed 94 ! --------------------------------------------------- 95 96 IF( lk_mpp .OR. lk_mpp_rep ) THEN ! mpp: compute over the whole domain 97 i_j1 = 1 98 i_jpj = jpj 99 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 100 CALL lim_rhg( i_j1, i_jpj ) 101 ELSE ! optimization of the computational area 102 ! 103 DO jj = 1, jpj 104 zswitch(jj) = SUM( 1.0 - at_i(:,jj) ) ! = REAL(jpj) if ocean everywhere on a j-line 105 zmsk (jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line 106 END DO 107 108 IF( l_jeq ) THEN ! local domain include both hemisphere 109 ! ! Rheology is computed in each hemisphere 110 ! ! only over the ice cover latitude strip 111 ! Northern hemisphere 112 i_j1 = njeq 113 i_jpj = jpj 114 DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 115 i_j1 = i_j1 + 1 116 END DO 117 i_j1 = MAX( 1, i_j1-2 ) 118 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : NH i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 119 CALL lim_rhg( i_j1, i_jpj ) 120 ! 121 ! Southern hemisphere 122 i_j1 = 1 123 i_jpj = njeq 124 DO WHILE ( i_jpj >= 1 .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 125 i_jpj = i_jpj - 1 126 END DO 127 i_jpj = MIN( jpj, i_jpj+1 ) 128 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : SH i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 129 ! 130 CALL lim_rhg( i_j1, i_jpj ) 131 ! 132 ELSE ! local domain extends over one hemisphere only 133 ! ! Rheology is computed only over the ice cover 134 ! ! latitude strip 135 i_j1 = 1 136 DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 137 i_j1 = i_j1 + 1 138 END DO 139 i_j1 = MAX( 1, i_j1-2 ) 140 141 i_jpj = jpj 142 DO WHILE ( i_jpj >= 1 .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 143 i_jpj = i_jpj - 1 144 END DO 145 i_jpj = MIN( jpj, i_jpj+1) 146 ! 147 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : one hemisphere: i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 148 ! 149 CALL lim_rhg( i_j1, i_jpj ) 150 ! 151 ENDIF 152 ! 153 ENDIF 154 155 ! computation of friction velocity 156 ! -------------------------------- 157 ! ice-ocean velocity at U & V-points (u_ice v_ice at U- & V-points ; ssu_m, ssv_m at U- & V-points) 158 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 159 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 160 ! frictional velocity at T-point 161 zcoef = 0.5_wp * rn_cio 162 DO jj = 2, jpjm1 163 DO ji = fs_2, fs_jpim1 ! vector opt. 164 ust2s(ji,jj) = zcoef * ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 165 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tmask(ji,jj,1) 166 END DO 167 END DO 168 ! 169 ! conservation test 170 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 171 ! 172 ELSE ! no ice dynamics : transmit directly the atmospheric stress to the ocean 173 ! 174 zcoef = SQRT( 0.5_wp ) * r1_rau0 175 DO jj = 2, jpjm1 176 DO ji = fs_2, fs_jpim1 ! vector opt. 177 ust2s(ji,jj) = zcoef * SQRT( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 178 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tmask(ji,jj,1) 179 END DO 180 END DO 181 ! 182 ENDIF 183 CALL lbc_lnk( ust2s, 'T', 1. ) ! T-point 184 185 IF(ln_ctl) THEN ! Control print 186 CALL prt_ctl_info(' ') 187 CALL prt_ctl_info(' - Cell values : ') 188 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 189 CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn : ust2s :') 190 CALL prt_ctl(tab2d_1=divu_i , clinfo1=' lim_dyn : divu_i :') 191 CALL prt_ctl(tab2d_1=delta_i , clinfo1=' lim_dyn : delta_i :') 192 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_dyn : strength :') 193 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_dyn : cell area :') 194 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_dyn : at_i :') 195 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_dyn : vt_i :') 196 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_dyn : vt_s :') 197 CALL prt_ctl(tab2d_1=stress1_i , clinfo1=' lim_dyn : stress1_i :') 198 CALL prt_ctl(tab2d_1=stress2_i , clinfo1=' lim_dyn : stress2_i :') 199 CALL prt_ctl(tab2d_1=stress12_i, clinfo1=' lim_dyn : stress12_i:') 66 CALL lim_var_agg(1) ! aggregate ice categories 67 ! 68 ! conservation test 69 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 70 71 ! ice velocities before rheology 72 u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 73 v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 74 75 ! Landfast ice parameterization: define max bottom friction 76 tau_icebfr(:,:) = 0._wp 77 IF( ln_landfast ) THEN 200 78 DO jl = 1, jpl 201 CALL prt_ctl_info(' ') 202 CALL prt_ctl_info(' - Category : ', ivar1=jl) 203 CALL prt_ctl_info(' ~~~~~~~~~~') 204 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_dyn : a_i : ') 205 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_dyn : ht_i : ') 206 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_dyn : ht_s : ') 207 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_dyn : v_i : ') 208 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_dyn : v_s : ') 209 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_dyn : e_s : ') 210 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_dyn : t_su : ') 211 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_dyn : t_snow : ') 212 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_dyn : sm_i : ') 213 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_dyn : smv_i : ') 214 DO ja = 1, nlay_i 215 CALL prt_ctl_info(' ') 216 CALL prt_ctl_info(' - Layer : ', ivar1=ja) 217 CALL prt_ctl_info(' ~~~~~~~') 218 CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_dyn : t_i : ') 219 CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_dyn : e_i : ') 220 END DO 79 WHERE( ht_i(:,:,jl) > ht(:,:) * rn_gamma ) tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 221 80 END DO 222 81 ENDIF 82 83 ! Rheology (ice dynamics) 84 ! ======== 85 CALL lim_rhg 223 86 ! 224 CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 225 CALL wrk_dealloc( jpj, zswitch, zmsk ) 87 ! conservation test 88 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 89 90 ! Control prints 91 IF( ln_ctl ) CALL lim_prt3D( 'limdyn' ) 226 92 ! 227 93 IF( nn_timing == 1 ) CALL timing_stop('limdyn') … … 243 109 !!------------------------------------------------------------------- 244 110 INTEGER :: ios ! Local integer output status for namelist read 245 NAMELIST/namicedyn/ nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio, rn_creepl, rn_ecc, & 246 & nn_nevp, rn_relast, nn_ahi0, rn_ahi0_ref 247 INTEGER :: ji, jj 248 REAL(wp) :: za00, zd_max 111 NAMELIST/namicedyn/ nn_limadv, nn_limadv_ord, & 112 & nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio, rn_creepl, rn_ecc, & 113 & nn_nevp, rn_relast, ln_landfast, rn_gamma, rn_icebfr, rn_lfrelax 249 114 !!------------------------------------------------------------------- 250 115 … … 262 127 WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics ' 263 128 WRITE(numout,*) '~~~~~~~~~~~~' 264 WRITE(numout,*)' ice strength parameterization (0=Hibler 1=Rothrock) nn_icestr = ', nn_icestr 265 WRITE(numout,*)' Including brine volume in ice strength comp. ln_icestr_bvf = ', ln_icestr_bvf 266 WRITE(numout,*)' Ratio of ridging work to PotEner change in ridging rn_pe_rdg = ', rn_pe_rdg 267 WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio 268 WRITE(numout,*) ' first bulk-rheology parameter rn_pstar = ', rn_pstar 269 WRITE(numout,*) ' second bulk-rhelogy parameter rn_crhg = ', rn_crhg 270 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl 271 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc 272 WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp 273 WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast 274 WRITE(numout,*) ' horizontal diffusivity calculation nn_ahi0 = ', nn_ahi0 275 WRITE(numout,*) ' horizontal diffusivity coeff. (orca2 grid) rn_ahi0_ref = ', rn_ahi0_ref 129 ! limtrp 130 WRITE(numout,*)' choose the advection scheme (-1=Prather, 0=Ulimate-Macho) nn_limadv = ', nn_limadv 131 WRITE(numout,*)' choose the order of the scheme (if ultimate) nn_limadv_ord = ', nn_limadv_ord 132 ! limrhg 133 WRITE(numout,*)' ice strength parameterization (0=Hibler 1=Rothrock) nn_icestr = ', nn_icestr 134 WRITE(numout,*)' Including brine volume in ice strength comp. ln_icestr_bvf = ', ln_icestr_bvf 135 WRITE(numout,*)' Ratio of ridging work to PotEner change in ridging rn_pe_rdg = ', rn_pe_rdg 136 WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio 137 WRITE(numout,*) ' first bulk-rheology parameter rn_pstar = ', rn_pstar 138 WRITE(numout,*) ' second bulk-rhelogy parameter rn_crhg = ', rn_crhg 139 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl 140 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc 141 WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp 142 WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast 143 WRITE(numout,*) ' Landfast: param (T or F) ln_landfast = ', ln_landfast 144 WRITE(numout,*) ' Landfast: fraction of ocean depth that ice must reach rn_gamma = ', rn_gamma 145 WRITE(numout,*) ' Landfast: maximum bottom stress per unit area of contact rn_icebfr = ', rn_icebfr 146 WRITE(numout,*) ' Landfast: relax time scale (s-1) to reach static friction rn_lfrelax = ', rn_lfrelax 276 147 ENDIF 277 148 ! 278 usecc2 = 1._wp / ( rn_ecc * rn_ecc )279 rhoco = rau0 * rn_cio280 !281 ! Diffusion coefficients282 SELECT CASE( nn_ahi0 )283 284 CASE( 0 )285 ahiu(:,:) = rn_ahi0_ref286 ahiv(:,:) = rn_ahi0_ref287 288 IF(lwp) WRITE(numout,*) ''289 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim constant = rn_ahi0_ref'290 291 CASE( 1 )292 293 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )294 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain295 296 ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60° latitude in orca2297 ! (60° = min latitude for ice cover)298 ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp299 300 IF(lwp) WRITE(numout,*) ''301 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')'302 IF(lwp) WRITE(numout,*) ' value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp303 304 CASE( 2 )305 306 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )307 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain308 309 za00 = rn_ahi0_ref * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60° latitude in orca2310 ! (60° = min latitude for ice cover)311 DO jj = 1, jpj312 DO ji = 1, jpi313 ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1)314 ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1)315 END DO316 END DO317 !318 IF(lwp) WRITE(numout,*) ''319 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to e1'320 IF(lwp) WRITE(numout,*) ' maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max321 322 END SELECT323 324 149 END SUBROUTINE lim_dyn_init 325 150 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r6490 r7309 7 7 !! - ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 8 !! 1.0 ! 2002-08 (C. Ethe) F90, free form 9 !! 3. 0! 2015-08 (O. Tintó and M. Castrillo) added lim_hdf (multiple)9 !! 3.6 ! 2015-08 (O. Tintó and M. Castrillo) added lim_hdf (multiple) 10 10 !!---------------------------------------------------------------------- 11 11 #if defined key_lim3 … … 28 28 PRIVATE 29 29 30 PUBLIC lim_hdf ! called by lim_trp30 PUBLIC lim_hdf ! called by lim_trp 31 31 PUBLIC lim_hdf_init ! called by sbc_lim_init 32 32 33 33 LOGICAL :: linit = .TRUE. ! initialization flag (set to flase after the 1st call) 34 INTEGER :: nn_convfrq !: convergence check frequency of the Crant-Nicholson scheme35 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: efact ! metric coefficient 36 35 … … 44 43 CONTAINS 45 44 46 SUBROUTINE lim_hdf( ptab , ihdf_vars , jpl , nlay_i)45 SUBROUTINE lim_hdf( ptab, ihdf_vars ) 47 46 !!------------------------------------------------------------------- 48 47 !! *** ROUTINE lim_hdf *** … … 55 54 !! ** Action : update ptab with the diffusive contribution 56 55 !!------------------------------------------------------------------- 57 INTEGER :: jpl, nlay_i, isize, ihdf_vars 58 REAL(wp), DIMENSION(:,:,:), INTENT( inout ),TARGET :: ptab ! Field on which the diffusion is applied 59 ! 60 INTEGER :: ji, jj, jk, jl , jm ! dummy loop indices 61 INTEGER :: iter, ierr ! local integers 62 REAL(wp) :: zrlxint ! local scalars 63 REAL(wp), POINTER , DIMENSION ( : ) :: zconv ! local scalars 64 REAL(wp), POINTER , DIMENSION(:,:,:) :: zrlx,zdiv0, ztab0 65 REAL(wp), POINTER , DIMENSION(:,:) :: zflu, zflv, zdiv 66 CHARACTER(lc) :: charout ! local character 67 REAL(wp), PARAMETER :: zrelax = 0.5_wp ! relaxation constant for iterative procedure 68 REAL(wp), PARAMETER :: zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 69 INTEGER , PARAMETER :: its = 100 ! Maximum number of iteration 56 INTEGER, INTENT( in ) :: ihdf_vars ! number of fields to diffuse 57 REAL(wp), DIMENSION(:,:,:), INTENT( inout ), TARGET :: ptab ! Field on which the diffusion is applied 58 ! 59 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 60 INTEGER :: iter, ierr, isize ! local integers 61 REAL(wp) :: zrlxint 62 CHARACTER(lc) :: charout ! local character 63 REAL(wp), PARAMETER :: zrelax = 0.5_wp ! relaxation constant for iterative procedure 64 REAL(wp), PARAMETER :: zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 65 INTEGER , PARAMETER :: num_iter_max = 100 ! Maximum number of iteration 66 INTEGER , PARAMETER :: num_convfrq = 5 ! convergence check frequency of the Crant-Nicholson scheme (perf. optimization) 67 REAL(wp), POINTER, DIMENSION(:) :: zconv 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrlx, zdiv0, ztab0 69 REAL(wp), POINTER, DIMENSION(:,:) :: zflu, zflv, zdiv 70 70 !!------------------------------------------------------------------- 71 71 TYPE(arrayptr) , ALLOCATABLE, DIMENSION(:) :: pt2d_array, zrlx_array 72 CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) :: type_array ! define the nature of ptab array grid-points 73 ! ! = T , U , V , F , W and I points 74 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: psgn_array ! =-1 the sign change across the north fold boundary 75 76 !!--------------------------------------------------------------------- 77 72 CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) :: type_array ! define the nature of ptab array grid-points 73 ! ! = T , U , V , F , W and I points 74 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: psgn_array ! =-1 the sign change across the north fold boundary 75 !!------------------------------------------------------------------- 76 78 77 ! !== Initialisation ==! 79 78 ! +1 open water diffusion 80 isize = jpl *(ihdf_vars+nlay_i)+179 isize = jpl * ( ihdf_vars + nlay_i ) + 1 81 80 ALLOCATE( zconv (isize) ) 82 81 ALLOCATE( pt2d_array(isize) , zrlx_array(isize) ) 83 82 ALLOCATE( type_array(isize) ) 84 83 ALLOCATE( psgn_array(isize) ) 84 85 CALL wrk_alloc( jpi,jpj, zflu, zflv, zdiv ) 86 CALL wrk_alloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 ) 85 87 86 CALL wrk_alloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 87 CALL wrk_alloc( jpi, jpj, zflu, zflv, zdiv ) 88 89 DO jk= 1 , isize 90 pt2d_array(jk)%pt2d=>ptab(:,:,jk) 91 zrlx_array(jk)%pt2d=>zrlx(:,:,jk) 92 type_array(jk)='T' 93 psgn_array(jk)=1. 88 DO jk= 1, isize 89 pt2d_array(jk)%pt2d => ptab(:,:,jk) 90 zrlx_array(jk)%pt2d => zrlx(:,:,jk) 91 type_array(jk) = 'T' 92 psgn_array(jk) = 1. 94 93 END DO 95 94 … … 99 98 IF( lk_mpp ) CALL mpp_sum( ierr ) 100 99 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' ) 101 DO jj = 2, jpjm1 100 DO jj = 2, jpjm1 102 101 DO ji = fs_2 , fs_jpim1 ! vector opt. 103 102 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj) … … 106 105 linit = .FALSE. 107 106 ENDIF 108 ! ! Time integration parameters 109 ! 110 zflu (jpi,: ) = 0._wp 111 zflv (jpi,: ) = 0._wp 112 107 ! 108 ! Arrays initialization 109 zflu(jpi,:) = 0._wp 110 zflv(jpi,:) = 0._wp 113 111 DO jk=1 , isize 114 ztab0(:, : , jk ) = ptab(:,:,jk) ! Arrays initialization112 ztab0(:, : , jk ) = ptab(:,:,jk) 115 113 zdiv0(:, 1 , jk ) = 0._wp 116 114 zdiv0(:,jpj, jk ) = 0._wp … … 119 117 END DO 120 118 121 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==! 122 iter = 0 123 ! 124 DO WHILE( MAXVAL(zconv(:)) > ( 2._wp * 1.e-04 ) .AND. iter <= its ) ! Sub-time step loop 119 ! !== horizontal diffusion using a Crant-Nicholson scheme ==! 120 zconv(:) = 1._wp 121 iter = 0 122 ! 123 DO WHILE( MAXVAL( zconv(:) ) > ( 2._wp * 1.e-04 ) .AND. iter <= num_iter_max ) ! Sub-time step loop 125 124 ! 126 125 iter = iter + 1 ! incrementation of the sub-time step number 127 126 ! 128 127 DO jk = 1 , isize 129 jl = ( jk-1) /( ihdf_vars+nlay_i)+1130 IF ( zconv(jk) > ( 2._wp * 1.e-04 )) THEN128 jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1 129 IF ( zconv(jk) > ( 2._wp * 1.e-04 ) ) THEN 131 130 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 132 131 DO ji = 1 , fs_jpim1 ! vector opt. … … 159 158 CALL lbc_lnk_multi( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 160 159 ! 161 IF ( MOD( iter-1 , nn_convfrq ) == 0 ) THEN !Convergence test every nn_convfrq iterations (perf. optimization ) 162 DO jk=1,isize 160 161 IF ( MOD( iter-1 , num_convfrq ) == 0 ) THEN ! Convergence test every num_convfrq iterations (perf. optimization ) 162 DO jk = 1, isize 163 163 zconv(jk) = 0._wp ! convergence test 164 164 DO jj = 2, jpjm1 … … 175 175 END DO 176 176 ! 177 END DO ! end of sub-time step loop 178 179 ! ----------------------- 180 !!! final step (clem) !!! 177 END DO ! end of sub-time step loop 178 179 ! --- final step --- ! 181 180 DO jk = 1, isize 182 jl = ( jk-1) /( ihdf_vars+nlay_i)+1181 jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1 183 182 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 184 183 DO ji = 1 , fs_jpim1 ! vector opt. … … 198 197 CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 199 198 200 !!! final step (clem) !!! 201 ! ----------------------- 202 199 ! 203 200 IF(ln_ctl) THEN 204 201 DO jk = 1 , isize … … 209 206 ENDIF 210 207 ! 211 CALL wrk_dealloc( jpi, jpj, isize, zrlx, zdiv0, ztab0)212 CALL wrk_dealloc( jpi, jpj, zflu, zflv, zdiv)213 208 CALL wrk_dealloc( jpi,jpj, zflu, zflv, zdiv ) 209 CALL wrk_dealloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 ) 210 ! 214 211 DEALLOCATE( zconv ) 215 212 DEALLOCATE( pt2d_array , zrlx_array ) … … 219 216 END SUBROUTINE lim_hdf 220 217 221 222 218 223 219 SUBROUTINE lim_hdf_init … … 232 228 !!------------------------------------------------------------------- 233 229 INTEGER :: ios ! Local integer output status for namelist read 234 NAMELIST/namicehdf/ nn_convfrq 235 !!------------------------------------------------------------------- 236 ! 237 IF(lwp) THEN 238 WRITE(numout,*) 239 WRITE(numout,*) 'lim_hdf : Ice horizontal diffusion' 240 WRITE(numout,*) '~~~~~~~' 241 ENDIF 230 NAMELIST/namicehdf/ nn_ahi0, rn_ahi0_ref 231 INTEGER :: ji, jj 232 REAL(wp) :: za00, zd_max 233 !!------------------------------------------------------------------- 242 234 ! 243 235 REWIND( numnam_ice_ref ) ! Namelist namicehdf in reference namelist : Ice horizontal diffusion … … 252 244 IF(lwp) THEN ! control print 253 245 WRITE(numout,*) 254 WRITE(numout,*)' Namelist of ice parameters for ice horizontal diffusion computation ' 255 WRITE(numout,*)' convergence check frequency of the Crant-Nicholson scheme nn_convfrq = ', nn_convfrq 246 WRITE(numout,*) 'lim_hdf_init : Ice horizontal diffusion' 247 WRITE(numout,*) '~~~~~~~~~~~' 248 WRITE(numout,*) ' horizontal diffusivity calculation nn_ahi0 = ', nn_ahi0 249 WRITE(numout,*) ' horizontal diffusivity coeff. (orca2 grid) rn_ahi0_ref = ', rn_ahi0_ref 256 250 ENDIF 251 ! 252 ! Diffusion coefficients 253 SELECT CASE( nn_ahi0 ) 254 255 CASE( 0 ) 256 ahiu(:,:) = rn_ahi0_ref 257 ahiv(:,:) = rn_ahi0_ref 258 259 IF(lwp) WRITE(numout,*) '' 260 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim constant = rn_ahi0_ref' 261 262 CASE( 1 ) 263 264 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 265 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain 266 267 ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 268 ! (60deg = min latitude for ice cover) 269 ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 270 271 IF(lwp) WRITE(numout,*) '' 272 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')' 273 IF(lwp) WRITE(numout,*) ' value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp 274 275 CASE( 2 ) 276 277 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 278 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain 279 280 za00 = rn_ahi0_ref * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 281 ! (60deg = min latitude for ice cover) 282 DO jj = 1, jpj 283 DO ji = 1, jpi 284 ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 285 ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 286 END DO 287 END DO 288 ! 289 IF(lwp) WRITE(numout,*) '' 290 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to e1' 291 IF(lwp) WRITE(numout,*) ' maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 292 293 END SELECT 257 294 ! 258 295 END SUBROUTINE lim_hdf_init … … 265 302 !!====================================================================== 266 303 END MODULE limhdf 267 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r6695 r7309 23 23 USE ice ! sea-ice variables 24 24 USE par_oce ! ocean parameters 25 USE dom_ice ! sea-ice domain26 25 USE limvar ! lim_var_salprof 27 26 USE in_out_manager ! I/O manager … … 37 36 PUBLIC lim_istate ! routine called by lim_init.F90 38 37 39 ! !!** init namelist (namiceini) **40 REAL(wp) :: rn_thres_sst ! threshold water temperature for initial sea ice41 REAL(wp) :: rn_hts_ini_n ! initial snow thickness in the north42 REAL(wp) :: rn_hts_ini_s ! initial snow thickness in the south43 REAL(wp) :: rn_hti_ini_n ! initial ice thickness in the north44 REAL(wp) :: rn_hti_ini_s ! initial ice thickness in the south45 REAL(wp) :: rn_ati_ini_n ! initial leads area in the north46 REAL(wp) :: rn_ati_ini_s ! initial leads area in the south47 REAL(wp) :: rn_smi_ini_n ! initial salinity48 REAL(wp) :: rn_smi_ini_s ! initial salinity49 REAL(wp) :: rn_tmi_ini_n ! initial temperature50 REAL(wp) :: rn_tmi_ini_s ! initial temperature51 52 38 INTEGER , PARAMETER :: jpfldi = 6 ! maximum number of files to read 53 39 INTEGER , PARAMETER :: jp_hti = 1 ! index of ice thickness (m) at T-point … … 57 43 INTEGER , PARAMETER :: jp_tmi = 5 ! index of ice temp at T-point 58 44 INTEGER , PARAMETER :: jp_smi = 6 ! index of ice sali at T-point 59 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 60 61 LOGICAL :: ln_iceini ! initialization or not 62 LOGICAL :: ln_iceini_file ! Ice initialization state from 2D netcdf file 45 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 63 46 !!---------------------------------------------------------------------- 64 47 !! LIM 3.0, UCL-LOCEAN-IPSL (2008) … … 101 84 REAL(wp) :: ztmelts, zdh 102 85 INTEGER :: i_hemis, i_fill, jl0 103 REAL(wp) :: z test_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv86 REAL(wp) :: zarg, zV, zconv, zdv 104 87 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 105 88 REAL(wp), POINTER, DIMENSION(:,:) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 106 89 REAL(wp), POINTER, DIMENSION(:,:) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini, zv_i_ini !data by cattegories to fill 108 !-------------------------------------------------------------------- 109 110 CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini, za_i_ini, zv_i_ini ) 90 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini !data by cattegories to fill 91 INTEGER , POINTER, DIMENSION(:) :: itest 92 !-------------------------------------------------------------------- 93 94 CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini, za_i_ini ) 111 95 CALL wrk_alloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 112 96 CALL wrk_alloc( jpi, jpj, zswitch ) 97 Call wrk_alloc( 4, itest ) 113 98 114 99 IF(lwp) WRITE(numout,*) … … 119 104 ! 1) Read namelist 120 105 !-------------------------------------------------------------------- 121 122 CALL lim_istate_init ! reading the initials parameters of the ice 123 124 ! surface temperature 125 DO jl = 1, jpl ! loop over categories 106 CALL lim_istate_init 107 108 ! init surface temperature 109 DO jl = 1, jpl 126 110 t_su (:,:,jl) = rt0 * tmask(:,:,1) 127 111 tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 128 112 END DO 129 113 130 ! basal temperature (considered at freezing point)114 ! init basal temperature (considered at freezing point) 131 115 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 132 116 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 133 117 134 118 135 IF( ln_iceini ) THEN 136 137 !-------------------------------------------------------------------- 138 ! 2) Basal temperature, ice mask and hemispheric index 139 !-------------------------------------------------------------------- 140 141 DO jj = 1, jpj ! ice if sst <= t-freez + ttest 142 DO ji = 1, jpi 143 IF( ( sst_m(ji,jj) - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 144 zswitch(ji,jj) = 0._wp * tmask(ji,jj,1) ! no ice 145 ELSE 146 zswitch(ji,jj) = 1._wp * tmask(ji,jj,1) ! ice 147 ENDIF 148 END DO 149 END DO 150 151 !-------------------------------------------------------------------- 152 ! 3) Initialization of sea ice state variables 153 !-------------------------------------------------------------------- 154 IF( ln_iceini_file )THEN 119 !-------------------------------------------------------------------- 120 ! 2) Initialization of sea ice state variables 121 !-------------------------------------------------------------------- 122 IF( ln_limini ) THEN 123 124 IF( ln_limini_file )THEN 155 125 156 126 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) … … 161 131 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 162 132 163 ELSE ! ln_iceini_file = F 133 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 134 ELSEWHERE ; zswitch(:,:) = 0._wp 135 END WHERE 136 137 ELSE ! ln_limini_file = F 138 139 !-------------------------------------------------------------------- 140 ! 3) Basal temperature, ice mask 141 !-------------------------------------------------------------------- 142 ! no ice if sst <= t-freez + ttest 143 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 144 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 145 END WHERE 164 146 165 147 !----------------------------- … … 169 151 DO jj = 1, jpj 170 152 DO ji = 1, jpi 171 IF( f cor(ji,jj) >= 0._wp ) THEN172 zht_i_ini(ji,jj) = rn_hti_ini_n 173 zht_s_ini(ji,jj) = rn_hts_ini_n 174 zat_i_ini(ji,jj) = rn_ati_ini_n 175 zts_u_ini(ji,jj) = rn_tmi_ini_n 176 zsm_i_ini(ji,jj) = rn_smi_ini_n 177 ztm_i_ini(ji,jj) = rn_tmi_ini_n 153 IF( ff(ji,jj) >= 0._wp ) THEN 154 zht_i_ini(ji,jj) = rn_hti_ini_n * zswitch(ji,jj) 155 zht_s_ini(ji,jj) = rn_hts_ini_n * zswitch(ji,jj) 156 zat_i_ini(ji,jj) = rn_ati_ini_n * zswitch(ji,jj) 157 zts_u_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 158 zsm_i_ini(ji,jj) = rn_smi_ini_n * zswitch(ji,jj) 159 ztm_i_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 178 160 ELSE 179 zht_i_ini(ji,jj) = rn_hti_ini_s 180 zht_s_ini(ji,jj) = rn_hts_ini_s 181 zat_i_ini(ji,jj) = rn_ati_ini_s 182 zts_u_ini(ji,jj) = rn_tmi_ini_s 183 zsm_i_ini(ji,jj) = rn_smi_ini_s 184 ztm_i_ini(ji,jj) = rn_tmi_ini_s 161 zht_i_ini(ji,jj) = rn_hti_ini_s * zswitch(ji,jj) 162 zht_s_ini(ji,jj) = rn_hts_ini_s * zswitch(ji,jj) 163 zat_i_ini(ji,jj) = rn_ati_ini_s * zswitch(ji,jj) 164 zts_u_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 165 zsm_i_ini(ji,jj) = rn_smi_ini_s * zswitch(ji,jj) 166 ztm_i_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 185 167 ENDIF 186 168 END DO 187 169 END DO 188 170 189 ENDIF ! ln_ iceini_file190 171 ENDIF ! ln_limini_file 172 191 173 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) ! ice volume 192 193 174 !--------------------------------------------------------------------- 194 175 ! 3.2) Distribute ice concentration and thickness into the categories … … 199 180 zh_i_ini(:,:,:) = 0._wp 200 181 za_i_ini(:,:,:) = 0._wp 201 zv_i_ini(:,:,:) = 0._wp202 182 203 183 DO jj = 1, jpj … … 206 186 IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 207 187 208 ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0 209 ! ztests = 0 210 211 DO i_fill = jpl, 1, -1 212 213 ! IF( ztests .NE. 4 ) THEN 214 IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN 215 !---------------------------- 216 ! fill the i_fill categories 217 !---------------------------- 218 ! *** 1 category to fill 219 IF ( i_fill .EQ. 1 ) THEN 220 zh_i_ini(ji,jj, 1) = zht_i_ini(ji,jj) 221 za_i_ini(ji,jj, 1) = zat_i_ini(ji,jj) 222 zh_i_ini(ji,jj,2:jpl) = 0._wp 223 za_i_ini(ji,jj,2:jpl) = 0._wp 224 ELSE 225 226 ! *** >1 categores to fill 227 !--- Ice thicknesses in the i_fill - 1 first categories 228 DO jl = 1, i_fill - 1 229 zh_i_ini(ji,jj,jl) = hi_mean(jl) 230 END DO 188 !--- jl0: most likely index where cc will be maximum 189 jl0 = jpl 190 DO jl = 1, jpl 191 IF ( ( zht_i_ini(ji,jj) > hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 192 jl0 = jl 193 CYCLE 194 ENDIF 195 END DO 196 197 ! initialisation of tests 198 itest(:) = 0 199 200 i_fill = jpl + 1 !==================================== 201 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 202 ! iteration !==================================== 203 i_fill = i_fill - 1 204 205 ! initialisation of ice variables for each try 206 zh_i_ini(ji,jj,:) = 0._wp 207 za_i_ini(ji,jj,:) = 0._wp 208 itest(:) = 0 209 210 ! *** case very thin ice: fill only category 1 211 IF ( i_fill == 1 ) THEN 212 zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj) 213 za_i_ini(ji,jj,1) = zat_i_ini(ji,jj) 214 215 ! *** case ice is thicker: fill categories >1 216 ELSE 217 218 ! Fill ice thicknesses in the (i_fill-1) cat by hmean 219 DO jl = 1, i_fill-1 220 zh_i_ini(ji,jj,jl) = hi_mean(jl) 221 END DO 231 222 232 !--- jl0: most likely index where cc will be maximum 233 DO jl = 1, jpl 234 IF ( ( zht_i_ini(ji,jj) > hi_max(jl-1) ) .AND. & 235 & ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 236 jl0 = jl 237 ENDIF 238 END DO 239 jl0 = MIN(jl0, i_fill) 240 241 !--- Concentrations 242 za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 243 DO jl = 1, i_fill - 1 244 IF( jl .NE. jl0 )THEN 245 zsigma = 0.5 * zht_i_ini(ji,jj) 246 zarg = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / zsigma 247 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 248 ENDIF 249 END DO 250 251 zA = 0. ! sum of the areas in the jpl categories 252 DO jl = 1, i_fill - 1 253 zA = zA + za_i_ini(ji,jj,jl) 254 END DO 255 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - zA ! ice conc in the last category 256 IF ( i_fill .LT. jpl ) za_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 257 258 !--- Ice thickness in the last category 259 zV = 0. ! sum of the volumes of the N-1 categories 260 DO jl = 1, i_fill - 1 261 zV = zV + za_i_ini(ji,jj,jl)*zh_i_ini(ji,jj,jl) 262 END DO 263 zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / za_i_ini(ji,jj,i_fill) 264 IF ( i_fill .LT. jpl ) zh_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 265 266 !--- volumes 267 zv_i_ini(ji,jj,:) = za_i_ini(ji,jj,:) * zh_i_ini(ji,jj,:) 268 IF ( i_fill .LT. jpl ) zv_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 269 270 ENDIF ! i_fill 271 272 !--------------------- 273 ! Compatibility tests 274 !--------------------- 275 ! Test 1: area conservation 276 zA_cons = SUM(za_i_ini(ji,jj,:)) ; zconv = ABS(zat_i_ini(ji,jj) - zA_cons ) 277 IF ( zconv .LT. 1.0e-6 ) THEN 278 ztest_1 = 1 279 ELSE 280 ztest_1 = 0 281 ENDIF 282 283 ! Test 2: volume conservation 284 zV_cons = SUM(zv_i_ini(ji,jj,:)) 285 zconv = ABS(zvt_i_ini(ji,jj) - zV_cons) 286 287 IF( zconv .LT. 1.0e-6 ) THEN 288 ztest_2 = 1 289 ELSE 290 ztest_2 = 0 291 ENDIF 292 293 ! Test 3: thickness of the last category is in-bounds ? 294 IF ( zh_i_ini(ji,jj,i_fill) > hi_max(i_fill-1) ) THEN 295 ztest_3 = 1 296 ELSE 297 ztest_3 = 0 298 ENDIF 299 300 ! Test 4: positivity of ice concentrations 301 ztest_4 = 1 302 DO jl = 1, jpl 303 IF ( za_i_ini(ji,jj,jl) .LT. 0._wp ) THEN 304 ztest_4 = 0 223 !--- Concentrations 224 za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 225 DO jl = 1, i_fill - 1 226 IF( jl /= jl0 )THEN 227 zarg = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) ) 228 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 305 229 ENDIF 306 230 END DO 307 308 ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4 309 310 ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 311 312 END DO ! i_fill 313 314 IF(lwp) THEN 315 WRITE(numout,*) ' ztests : ', ztests 316 IF( ztests .NE. 4 )THEN 317 WRITE(numout,*) 318 WRITE(numout,*) ' !!!! ALERT !!! ' 319 WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 320 WRITE(numout,*) 321 WRITE(numout,*) ' *** ztests is not equal to 4 ' 322 WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 323 WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 324 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 325 ENDIF ! ztests .NE. 4 231 232 ! Concentration in the last (i_fill) category 233 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) ) 234 235 ! Ice thickness in the last (i_fill) category 236 zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) ) 237 zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 238 239 ! clem: correction if concentration of upper cat is greater than lower cat 240 ! (it should be a gaussian around jl0 but sometimes it is not) 241 IF ( jl0 /= jpl ) THEN 242 DO jl = jpl, jl0+1, -1 243 IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN 244 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl) 245 zh_i_ini(ji,jj,jl ) = 0._wp 246 za_i_ini(ji,jj,jl ) = 0._wp 247 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1) & 248 & + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 ) 249 END IF 250 ENDDO 251 ENDIF 252 253 ENDIF ! case ice is thick or thin 254 255 !--------------------- 256 ! Compatibility tests 257 !--------------------- 258 ! Test 1: area conservation 259 zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) ) 260 IF ( zconv < epsi06 ) itest(1) = 1 261 262 ! Test 2: volume conservation 263 zconv = ABS( zat_i_ini(ji,jj) * zht_i_ini(ji,jj) & 264 & - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) ) 265 IF ( zconv < epsi06 ) itest(2) = 1 266 267 ! Test 3: thickness of the last category is in-bounds ? 268 IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 269 270 ! Test 4: positivity of ice concentrations 271 itest(4) = 1 272 DO jl = 1, i_fill 273 IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0 274 END DO 275 ! !============================ 276 END DO ! end iteration on categories 277 ! !============================ 278 279 IF( lwp .AND. SUM(itest) /= 4 ) THEN 280 WRITE(numout,*) 281 WRITE(numout,*) ' !!!! ALERT itest is not equal to 4 !!! ' 282 WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 283 WRITE(numout,*) 284 WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:) 285 WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 286 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 326 287 ENDIF 327 328 ENDIF ! zat_i_ini(ji,jj) > 0._wp .AND. zh m_i_ini(ji,jj) > 0._wp329 330 ENDDO 331 ENDDO 288 289 ENDIF ! zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp 290 291 ENDDO 292 ENDDO 332 293 333 294 !--------------------------------------------------------------------- … … 373 334 smv_i = sm_i * v_i 374 335 ENDIF 375 336 376 337 ! Snow temperature and heat content 377 338 DO jk = 1, nlay_s … … 413 374 tn_ice (:,:,:) = t_su (:,:,:) 414 375 415 ELSE ! if ln_ iceini=false376 ELSE ! if ln_limini=false 416 377 a_i (:,:,:) = 0._wp 417 378 v_i (:,:,:) = 0._wp … … 436 397 END DO 437 398 438 ENDIF ! ln_ iceini399 ENDIF ! ln_limini 439 400 440 401 at_i (:,:) = 0.0_wp … … 486 447 sxyage (:,:,:) = 0._wp 487 448 488 489 CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini, za_i_ini, zv_i_ini ) 449 !!!clem 450 !! ! Output the initial state and forcings 451 !! CALL dia_wri_state( 'output.init', nit000 ) 452 !!! 453 454 CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini, za_i_ini ) 490 455 CALL wrk_dealloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 491 456 CALL wrk_dealloc( jpi, jpj, zswitch ) 457 Call wrk_dealloc( 4, itest ) 492 458 493 459 END SUBROUTINE lim_istate … … 518 484 TYPE(FLD_N), DIMENSION(jpfldi) :: slf_i ! array of namelist informations on the fields to read 519 485 ! 520 NAMELIST/namiceini/ ln_ iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, &486 NAMELIST/namiceini/ ln_limini, ln_limini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, & 521 487 & rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, & 522 488 & rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s, & … … 544 510 WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 545 511 WRITE(numout,*) '~~~~~~~~~~~~~~~' 546 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_ iceini = ', ln_iceini547 WRITE(numout,*) ' ice initialization from a netcdf file ln_ iceini_file = ', ln_iceini_file512 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_limini = ', ln_limini 513 WRITE(numout,*) ' ice initialization from a netcdf file ln_limini_file = ', ln_limini_file 548 514 WRITE(numout,*) ' threshold water temp. for initial sea-ice rn_thres_sst = ', rn_thres_sst 549 515 WRITE(numout,*) ' initial snow thickness in the north rn_hts_ini_n = ', rn_hts_ini_n … … 559 525 ENDIF 560 526 561 IF( ln_ iceini_file ) THEN ! Ice initialization using input file527 IF( ln_limini_file ) THEN ! Ice initialization using input file 562 528 ! 563 529 ! set si structure -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r6470 r7309 18 18 USE thd_ice ! LIM thermodynamics 19 19 USE ice ! LIM variables 20 USE dom_ice ! LIM domain21 20 USE limvar ! LIM 22 21 USE lbclnk ! lateral boundary condition - MPP exchanges 23 22 USE lib_mpp ! MPP library 24 23 USE wrk_nemo ! work arrays 25 USE prtctl ! Print control26 24 27 25 USE in_out_manager ! I/O manager 28 26 USE iom ! I/O manager 29 27 USE lib_fortran ! glob_sum 30 USE limdiahsb31 28 USE timing ! Timing 32 29 USE limcons ! conservation tests 30 USE limctl ! control prints 33 31 34 32 IMPLICIT NONE … … 70 68 !! *** ROUTINE lim_itd_me_alloc *** 71 69 !!---------------------------------------------------------------------! 72 ALLOCATE( &70 ALLOCATE( & 73 71 !* Variables shared among ridging subroutines 74 & asum (jpi,jpj) , athorn(jpi,jpj,0:jpl) , & 75 & aksum(jpi,jpj) , & 76 & hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl) , aridge(jpi,jpj,jpl) , & 77 & hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc ) 72 & asum (jpi,jpj) , athorn(jpi,jpj,0:jpl) , aksum (jpi,jpj) , & 73 & hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl) , aridge(jpi,jpj,jpl) , & 74 & hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc ) 78 75 ! 79 76 IF( lim_itd_me_alloc /= 0 ) CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' ) … … 127 124 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross ) 128 125 129 IF(ln_ctl) THEN130 CALL prt_ctl(tab2d_1=ato_i , clinfo1=' lim_itd_me: ato_i : ', tab2d_2=at_i , clinfo2=' at_i : ')131 CALL prt_ctl(tab2d_1=divu_i, clinfo1=' lim_itd_me: divu_i : ', tab2d_2=delta_i, clinfo2=' delta_i : ')132 ENDIF133 134 IF( ln_limdyn ) THEN ! Start ridging and rafting !135 136 126 ! conservation test 137 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)127 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 138 128 139 129 !-----------------------------------------------------------------------------! … … 211 201 DO ji = 1, jpi 212 202 za = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice 213 IF ( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN! would lead to negative ato_i214 zfac = - ato_i(ji,jj) / za203 IF ( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN ! would lead to negative ato_i 204 zfac = - ato_i(ji,jj) / za 215 205 opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice 216 206 ELSEIF( za > 0._wp .AND. za > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN ! would lead to ato_i > asum 217 zfac = ( asum(ji,jj) - ato_i(ji,jj) ) / za207 zfac = ( asum(ji,jj) - ato_i(ji,jj) ) / za 218 208 opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice 219 209 ENDIF … … 259 249 closing_net(ji,jj) = 0._wp 260 250 opning (ji,jj) = 0._wp 251 ato_i (ji,jj) = MAX( 0._wp, 1._wp - SUM( a_i(ji,jj,:) ) ) 261 252 ELSE 262 253 iterate_ridging = 1 … … 292 283 ! control prints 293 284 !-----------------------------------------------------------------------------! 294 IF(ln_ctl) THEN295 CALL lim_var_glo2eqv296 297 CALL prt_ctl_info(' ')298 CALL prt_ctl_info(' - Cell values : ')299 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')300 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_itd_me : cell area :')301 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me : at_i :')302 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me : vt_i :')303 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_me : vt_s :')304 DO jl = 1, jpl305 CALL prt_ctl_info(' ')306 CALL prt_ctl_info(' - Category : ', ivar1=jl)307 CALL prt_ctl_info(' ~~~~~~~~~~')308 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_me : a_i : ')309 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_me : ht_i : ')310 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_me : ht_s : ')311 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_me : v_i : ')312 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_me : v_s : ')313 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_me : e_s : ')314 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_me : t_su : ')315 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_me : t_snow : ')316 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_me : sm_i : ')317 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_me : smv_i : ')318 DO jk = 1, nlay_i319 CALL prt_ctl_info(' ')320 CALL prt_ctl_info(' - Layer : ', ivar1=jk)321 CALL prt_ctl_info(' ~~~~~~~')322 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_me : t_i : ')323 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_me : e_i : ')324 END DO325 END DO326 ENDIF327 328 285 ! conservation test 329 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 330 331 ENDIF ! ln_limdyn=.true. 332 ! 286 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 287 288 ! control prints 289 IF( ln_ctl ) CALL lim_prt3D( 'limitd_me' ) 290 333 291 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 334 292 ! … … 368 326 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 369 327 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 370 328 END DO 371 329 END DO 372 330 END DO … … 438 396 ENDIF 439 397 440 IF( ln_rafting ) THEN ! Ridging and rafting ice participation functions 398 ! --- Ridging and rafting participation concentrations --- ! 399 IF( ln_rafting .AND. ln_ridging ) THEN 441 400 ! 442 401 DO jl = 1, jpl … … 445 404 zdummy = TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) 446 405 aridge(ji,jj,jl) = ( 1._wp + zdummy ) * 0.5_wp * athorn(ji,jj,jl) 447 araft (ji,jj,jl) = ( 1._wp - zdummy ) * 0.5_wp * athorn(ji,jj,jl)406 araft (ji,jj,jl) = athorn(ji,jj,jl) - aridge(ji,jj,jl) 448 407 END DO 449 408 END DO 450 409 END DO 451 452 ELSE 410 ! 411 ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN 453 412 ! 454 413 DO jl = 1, jpl 455 414 aridge(:,:,jl) = athorn(:,:,jl) 415 END DO 416 ! 417 ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN 418 ! 419 DO jl = 1, jpl 420 araft(:,:,jl) = athorn(:,:,jl) 456 421 END DO 457 422 ! … … 657 622 & - sm_i(ji,jj,jl1) * vsw(ij) * rhoic * r1_rdtice ! and get sm_i from the ocean 658 623 ENDIF 659 624 660 625 !------------------------------------------ 661 626 ! 3.7 Put the snow somewhere in the ocean … … 795 760 INTEGER :: numts_rm ! number of time steps for the P smoothing 796 761 REAL(wp) :: zp, z1_3 ! local scalars 797 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 762 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 763 REAL(wp), POINTER, DIMENSION(:,:) :: zstrp1, zstrp2 ! strength at previous time steps 798 764 !!---------------------------------------------------------------------- 799 765 800 CALL wrk_alloc( jpi, jpj, zworka)766 CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 801 767 802 768 !------------------------------------------------------------------------------! … … 844 810 END DO 845 811 846 strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) 812 strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) * tmask(:,:,1) 847 813 ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 848 814 ksmooth = 1 849 815 850 851 852 816 !------------------------------------------------------------------------------! 817 ! 4) Hibler (1979)' method 818 !------------------------------------------------------------------------------! 853 819 ELSE ! kstrngth ne 1: Hibler (1979) form 854 820 ! 855 strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) ) ) 821 strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) ) ) * tmask(:,:,1) 856 822 ! 857 823 ksmooth = 1 … … 866 832 DO jj = 1, jpj 867 833 DO ji = 1, jpi 868 strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv _i(ji,jj),0.0)))834 strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bvm_i(ji,jj),0.0))) 869 835 END DO 870 836 END DO … … 880 846 IF ( ksmooth == 1 ) THEN 881 847 882 CALL lbc_lnk( strength, 'T', 1. )883 884 848 DO jj = 2, jpjm1 885 849 DO ji = 2, jpim1 886 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN850 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN 887 851 zworka(ji,jj) = ( 4.0 * strength(ji,jj) & 888 852 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) & … … 907 871 ! Temporal smoothing 908 872 !-------------------- 909 IF ( numit == nit000 + nn_fsbc - 1 ) THEN910 strp1(:,:) = 0.0911 strp2(:,:) = 0.0912 ENDIF913 914 873 IF ( ksmooth == 2 ) THEN 915 874 916 CALL lbc_lnk( strength, 'T', 1. ) 917 918 DO jj = 1, jpj - 1 919 DO ji = 1, jpi - 1 920 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 875 IF ( numit == nit000 + nn_fsbc - 1 ) THEN 876 zstrp1(:,:) = 0._wp 877 zstrp2(:,:) = 0._wp 878 ENDIF 879 880 DO jj = 2, jpjm1 881 DO ji = 2, jpim1 882 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN 921 883 numts_rm = 1 ! number of time steps for the running mean 922 IF ( strp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1923 IF ( strp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1924 zp = ( strength(ji,jj) + strp1(ji,jj) +strp2(ji,jj) ) / numts_rm925 strp2(ji,jj) =strp1(ji,jj)926 strp1(ji,jj) = strength(ji,jj)884 IF ( zstrp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 885 IF ( zstrp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 886 zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / numts_rm 887 zstrp2(ji,jj) = zstrp1(ji,jj) 888 zstrp1(ji,jj) = strength(ji,jj) 927 889 strength(ji,jj) = zp 928 929 890 ENDIF 930 891 END DO 931 892 END DO 932 893 894 CALL lbc_lnk( strength, 'T', 1. ) ! Boundary conditions 895 933 896 ENDIF ! ksmooth 934 897 935 CALL lbc_lnk( strength, 'T', 1. ) ! Boundary conditions 936 937 CALL wrk_dealloc( jpi, jpj, zworka ) 898 CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 938 899 ! 939 900 END SUBROUTINE lim_itd_me_icestrength … … 953 914 !!------------------------------------------------------------------- 954 915 INTEGER :: ios ! Local integer output status for namelist read 955 NAMELIST/namiceitdme/ rn_cs, rn_fsnowrdg, rn_fsnowrft, & 956 & rn_gstar, rn_astar, rn_hstar, ln_rafting, rn_hraft, rn_craft, rn_por_rdg, & 957 & nn_partfun 916 NAMELIST/namiceitdme/ rn_cs, nn_partfun, rn_gstar, rn_astar, & 917 & ln_ridging, rn_hstar, rn_por_rdg, rn_fsnowrdg, ln_rafting, rn_hraft, rn_craft, rn_fsnowrft 958 918 !!------------------------------------------------------------------- 959 919 ! … … 969 929 IF (lwp) THEN ! control print 970 930 WRITE(numout,*) 971 WRITE(numout,*)' 972 WRITE(numout,*)' 931 WRITE(numout,*)'lim_itd_me_init : ice parameters for mechanical ice redistribution ' 932 WRITE(numout,*)'~~~~~~~~~~~~~~~' 973 933 WRITE(numout,*)' Fraction of shear energy contributing to ridging rn_cs = ', rn_cs 974 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrdg = ', rn_fsnowrdg 975 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft 934 WRITE(numout,*)' Switch for part. function (0) linear (1) exponential nn_partfun = ', nn_partfun 976 935 WRITE(numout,*)' Fraction of total ice coverage contributing to ridging rn_gstar = ', rn_gstar 977 936 WRITE(numout,*)' Equivalent to G* for an exponential part function rn_astar = ', rn_astar 937 WRITE(numout,*)' Ridging of ice sheets or not ln_ridging = ', ln_ridging 978 938 WRITE(numout,*)' Quantity playing a role in max ridged ice thickness rn_hstar = ', rn_hstar 939 WRITE(numout,*)' Initial porosity of ridges rn_por_rdg = ', rn_por_rdg 940 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrdg = ', rn_fsnowrdg 979 941 WRITE(numout,*)' Rafting of ice sheets or not ln_rafting = ', ln_rafting 980 942 WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) rn_hraft = ', rn_hraft 981 943 WRITE(numout,*)' Rafting hyperbolic tangent coefficient rn_craft = ', rn_craft 982 WRITE(numout,*)' Initial porosity of ridges rn_por_rdg = ', rn_por_rdg 983 WRITE(numout,*)' Switch for part. function (0) linear (1) exponential nn_partfun = ', nn_partfun 944 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft 984 945 ENDIF 985 946 ! -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r5407 r7309 18 18 !! lim_itd_shiftice : 19 19 !!---------------------------------------------------------------------- 20 USE dom_ice ! LIM-3 domain21 20 USE par_oce ! ocean parameters 22 21 USE dom_oce ! ocean domain -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r6416 r7309 9 9 !! 3.3 ! 2009-05 (G.Garric) addition of the lim2_evp cas 10 10 !! 3.4 ! 2011-01 (A. Porter) dynamical allocation 11 !! 3.5 ! 2012-08 (R. Benshila) AGRIF 11 !! 3.5 ! 2012-08 (R. Benshila) AGRIF 12 !! 3.6 ! 2016-06 (C. Rousset) Rewriting + landfast ice + possibility to use mEVP (Bouillon 2013) 12 13 !!---------------------------------------------------------------------- 13 #if defined key_lim3 || ( defined key_lim2 && ! defined key_lim2_vp )14 #if defined key_lim3 14 15 !!---------------------------------------------------------------------- 15 !! 'key_lim3' OR LIM-3 sea-ice model 16 !! 'key_lim2' AND NOT 'key_lim2_vp' EVP LIM-2 sea-ice model 16 !! 'key_lim3' LIM-3 sea-ice model 17 17 !!---------------------------------------------------------------------- 18 18 !! lim_rhg : computes ice velocities … … 24 24 USE sbc_oce ! Surface boundary condition: ocean fields 25 25 USE sbc_ice ! Surface boundary condition: ice fields 26 #if defined key_lim3 27 USE ice ! LIM-3: ice variables 28 USE dom_ice ! LIM-3: ice domain 29 USE limitd_me ! LIM-3: 30 #else 31 USE ice_2 ! LIM-2: ice variables 32 USE dom_ice_2 ! LIM-2: ice domain 33 #endif 26 USE ice ! ice variables 27 USE limitd_me ! ice strength 34 28 USE lbclnk ! Lateral Boundary Condition / MPP link 35 29 USE lib_mpp ! MPP library … … 38 32 USE prtctl ! Print control 39 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 40 #if defined key_agrif && defined key_lim241 USE agrif_lim 2_interp34 #if defined key_agrif 35 USE agrif_lim3_interp 42 36 #endif 43 37 #if defined key_bdy … … 48 42 PRIVATE 49 43 50 PUBLIC lim_rhg ! routine called by lim_dyn (or lim_dyn_2)44 PUBLIC lim_rhg ! routine called by lim_dyn 51 45 52 46 !! * Substitutions … … 59 53 CONTAINS 60 54 61 SUBROUTINE lim_rhg ( k_j1, k_jpj )55 SUBROUTINE lim_rhg 62 56 !!------------------------------------------------------------------- 63 57 !! *** SUBROUTINE lim_rhg *** … … 106 100 !! e.g. in the Canadian Archipelago 107 101 !! 102 !! ** Notes : There is the possibility to use mEVP from Bouillon 2013 103 !! (by uncommenting some lines in part 3 and changing alpha and beta parameters) 104 !! but this solution appears very unstable (see Kimmritz et al 2016) 105 !! 108 106 !! References : Hunke and Dukowicz, JPO97 109 107 !! Bouillon et al., Ocean Modelling 2009 108 !! Bouillon et al., Ocean Modelling 2013 110 109 !!------------------------------------------------------------------- 111 INTEGER, INTENT(in) :: k_j1 ! southern j-index for ice computation 112 INTEGER, INTENT(in) :: k_jpj ! northern j-index for ice computation 113 !! 114 INTEGER :: ji, jj ! dummy loop indices 115 INTEGER :: jter ! local integers 110 INTEGER :: ji, jj ! dummy loop indices 111 INTEGER :: jter ! local integers 116 112 CHARACTER (len=50) :: charout 117 REAL(wp) :: zt11, zt12, zt21, zt22, ztagnx, ztagny, delta ! 118 REAL(wp) :: za, zstms ! local scalars 119 REAL(wp) :: zc1, zc2, zc3 ! ice mass 120 121 REAL(wp) :: dtevp , z1_dtevp ! time step for subcycling 122 REAL(wp) :: dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity 123 REAL(wp) :: z0, zr, zcca, zccb ! temporary scalars 124 REAL(wp) :: zu_ice2, zv_ice1 ! 125 REAL(wp) :: zddc, zdtc ! delta on corners and on centre 126 REAL(wp) :: zdst ! shear at the center of the grid point 127 REAL(wp) :: zdsshx, zdsshy ! term for the gradient of ocean surface 128 REAL(wp) :: sigma1, sigma2 ! internal ice stress 129 130 REAL(wp) :: zresm ! Maximal error on ice velocity 131 REAL(wp) :: zintb, zintn ! dummy argument 132 133 REAL(wp), POINTER, DIMENSION(:,:) :: zpresh ! temporary array for ice strength 134 REAL(wp), POINTER, DIMENSION(:,:) :: zpreshc ! Ice strength on grid cell corners (zpreshc) 135 REAL(wp), POINTER, DIMENSION(:,:) :: zfrld1, zfrld2 ! lead fraction on U/V points 136 REAL(wp), POINTER, DIMENSION(:,:) :: zmass1, zmass2 ! ice/snow mass on U/V points 137 REAL(wp), POINTER, DIMENSION(:,:) :: zcorl1, zcorl2 ! coriolis parameter on U/V points 138 REAL(wp), POINTER, DIMENSION(:,:) :: za1ct , za2ct ! temporary arrays 139 REAL(wp), POINTER, DIMENSION(:,:) :: v_oce1 ! ocean u/v component on U points 140 REAL(wp), POINTER, DIMENSION(:,:) :: u_oce2 ! ocean u/v component on V points 141 REAL(wp), POINTER, DIMENSION(:,:) :: u_ice2, v_ice1 ! ice u/v component on V/U point 142 REAL(wp), POINTER, DIMENSION(:,:) :: zf1 , zf2 ! arrays for internal stresses 143 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! mask ocean grid points 113 114 REAL(wp) :: zrhoco ! rau0 * rn_cio 115 REAL(wp) :: zdtevp, z1_dtevp ! time step for subcycling 116 REAL(wp) :: ecc2, z1_ecc2 ! square of yield ellipse eccenticity 117 REAL(wp) :: zbeta, zalph1, z1_alph1, zalph2, z1_alph2 ! alpha and beta from Bouillon 2009 and 2013 118 REAL(wp) :: zm1, zm2, zm3, zmassU, zmassV ! ice/snow mass 119 REAL(wp) :: zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars 120 REAL(wp) :: zTauO, zTauB, zTauE, zCor, zvel ! temporary scalars 121 122 REAL(wp) :: zsig1, zsig2 ! internal ice stress 123 REAL(wp) :: zresm ! Maximal error on ice velocity 124 REAL(wp) :: zintb, zintn ! dummy argument 144 125 145 REAL(wp), POINTER, DIMENSION(:,:) :: zdt ! tension at centre of grid cells 146 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! Shear on northeast corner of grid cells 147 REAL(wp), POINTER, DIMENSION(:,:) :: zs1 , zs2 ! Diagonal stress tensor components zs1 and zs2 148 REAL(wp), POINTER, DIMENSION(:,:) :: zs12 ! Non-diagonal stress tensor component zs12 149 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! Local error on velocity 150 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope: 151 ! ocean surface (ssh_m) if ice is not embedded 152 ! ice top surface if ice is embedded 153 154 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 155 REAL(wp), PARAMETER :: zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity 126 REAL(wp), POINTER, DIMENSION(:,:) :: z1_e1t0, z1_e2t0 ! scale factors 127 REAL(wp), POINTER, DIMENSION(:,:) :: zp_delt ! P/delta at T points 128 ! 129 REAL(wp), POINTER, DIMENSION(:,:) :: zaU , zaV ! ice fraction on U/V points 130 REAL(wp), POINTER, DIMENSION(:,:) :: zmU_t, zmV_t ! ice/snow mass/dt on U/V points 131 REAL(wp), POINTER, DIMENSION(:,:) :: zmf ! coriolis parameter at T points 132 REAL(wp), POINTER, DIMENSION(:,:) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points 133 REAL(wp), POINTER, DIMENSION(:,:) :: zspgU , zspgV ! surface pressure gradient at U/V points 134 REAL(wp), POINTER, DIMENSION(:,:) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points 135 REAL(wp), POINTER, DIMENSION(:,:) :: zfU , zfV ! internal stresses 136 137 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! shear 138 REAL(wp), POINTER, DIMENSION(:,:) :: zs1, zs2, zs12 ! stress tensor components 139 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! check convergence 140 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope: 141 ! ocean surface (ssh_m) if ice is not embedded 142 ! ice top surface if ice is embedded 143 REAL(wp), POINTER, DIMENSION(:,:) :: zswitchU, zswitchV ! dummy arrays 144 REAL(wp), POINTER, DIMENSION(:,:) :: zmaskU, zmaskV ! mask for ice presence 145 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask, zwf ! mask at F points for the ice 146 147 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 148 REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity equals ocean velocity 149 REAL(wp), PARAMETER :: zshlat = 2._wp ! boundary condition for sea-ice velocity (2=no slip ; 0=free slip) 156 150 !!------------------------------------------------------------------- 157 151 158 CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 159 CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 160 CALL wrk_alloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 161 CALL wrk_alloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice ) 162 163 #if defined key_lim2 && ! defined key_lim2_vp 164 # if defined key_agrif 165 USE ice_2, vt_s => hsnm 166 USE ice_2, vt_i => hicm 167 # else 168 vt_s => hsnm 169 vt_i => hicm 170 # endif 171 at_i(:,:) = 1. - frld(:,:) 172 #endif 173 #if defined key_agrif && defined key_lim2 174 CALL agrif_rhg_lim2_load ! First interpolation of coarse values 152 CALL wrk_alloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt ) 153 CALL wrk_alloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia ) 154 CALL wrk_alloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV ) 155 CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 156 CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 157 158 #if defined key_agrif 159 CALL agrif_interp_lim3( 'U', 0, nn_nevp ) ! First interpolation of coarse values 160 CALL agrif_interp_lim3( 'V', 0, nn_nevp ) 175 161 #endif 176 162 ! 177 163 !------------------------------------------------------------------------------! 178 ! 1) Ice strength (zpresh) ! 179 !------------------------------------------------------------------------------! 164 ! 0) mask at F points for the ice 165 !------------------------------------------------------------------------------! 166 ! ocean/land mask 167 DO jj = 1, jpjm1 168 DO ji = 1, jpim1 ! NO vector opt. 169 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 170 END DO 171 END DO 172 CALL lbc_lnk( zfmask, 'F', 1._wp ) 173 174 ! Lateral boundary conditions on velocity (modify zfmask) 175 zwf(:,:) = zfmask(:,:) 176 DO jj = 2, jpjm1 177 DO ji = fs_2, fs_jpim1 ! vector opt. 178 IF( zfmask(ji,jj) == 0._wp ) THEN 179 zfmask(ji,jj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) ) 180 ENDIF 181 END DO 182 END DO 183 DO jj = 2, jpjm1 184 IF( zfmask(1,jj) == 0._wp ) THEN 185 zfmask(1 ,jj) = zshlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 186 ENDIF 187 IF( zfmask(jpi,jj) == 0._wp ) THEN 188 zfmask(jpi,jj) = zshlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 189 ENDIF 190 END DO 191 DO ji = 2, jpim1 192 IF( zfmask(ji,1) == 0._wp ) THEN 193 zfmask(ji,1 ) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 194 ENDIF 195 IF( zfmask(ji,jpj) == 0._wp ) THEN 196 zfmask(ji,jpj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 197 ENDIF 198 END DO 199 CALL lbc_lnk( zfmask, 'F', 1._wp ) 200 201 !------------------------------------------------------------------------------! 202 ! 1) define some variables and initialize arrays 203 !------------------------------------------------------------------------------! 204 zrhoco = rau0 * rn_cio 205 206 ! ecc2: square of yield ellipse eccenticrity 207 ecc2 = rn_ecc * rn_ecc 208 z1_ecc2 = 1._wp / ecc2 209 210 ! Time step for subcycling 211 zdtevp = rdt_ice / REAL( nn_nevp ) 212 z1_dtevp = 1._wp / zdtevp 213 214 ! alpha parameters (Bouillon 2009) 215 zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp 216 zalph2 = zalph1 * z1_ecc2 217 218 ! alpha and beta parameters (Bouillon 2013) 219 !!zalph1 = 40. 220 !!zalph2 = 40. 221 !!zbeta = 3000. 222 !!zbeta = REAL( nn_nevp ) ! close to classical EVP of Hunke (2001) 223 224 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 225 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 226 227 ! Initialise stress tensor 228 zs1 (:,:) = stress1_i (:,:) 229 zs2 (:,:) = stress2_i (:,:) 230 zs12(:,:) = stress12_i(:,:) 231 232 ! Ice strength 233 CALL lim_itd_me_icestrength( nn_icestr ) 234 235 ! scale factors 236 DO jj = 2, jpjm1 237 DO ji = fs_2, fs_jpim1 238 z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj ) + e1t(ji,jj ) ) 239 z1_e2t0(ji,jj) = 1._wp / ( e2t(ji ,jj+1) + e2t(ji,jj ) ) 240 END DO 241 END DO 242 180 243 ! 181 ! Put every vector to 0182 delta_i(:,:) = 0._wp ;183 zpresh (:,:) = 0._wp ;184 zpreshc(:,:) = 0._wp185 u_ice2 (:,:) = 0._wp ; v_ice1(:,:) = 0._wp186 divu_i (:,:) = 0._wp ; zdt (:,:) = 0._wp ; zds(:,:) = 0._wp187 shear_i(:,:) = 0._wp188 189 #if defined key_lim3190 CALL lim_itd_me_icestrength( nn_icestr ) ! LIM-3: Ice strength on T-points191 #endif192 193 DO jj = k_j1 , k_jpj ! Ice mass and temp variables194 DO ji = 1 , jpi195 #if defined key_lim3196 zpresh(ji,jj) = tmask(ji,jj,1) * strength(ji,jj)197 #endif198 #if defined key_lim2199 zpresh(ji,jj) = tmask(ji,jj,1) * pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )200 #endif201 ! zmask = 1 where there is ice or on land202 zmask(ji,jj) = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1)203 END DO204 END DO205 206 ! Ice strength on grid cell corners (zpreshc)207 ! needed for calculation of shear stress208 DO jj = k_j1+1, k_jpj-1209 DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1)210 zstms = tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) + &211 & tmask(ji+1,jj,1) * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1) * wght(ji+1,jj+1,1,1)212 zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) + &213 & zpresh(ji+1,jj) * wght(ji+1,jj+1,2,1) + zpresh(ji,jj) * wght(ji+1,jj+1,1,1) &214 & ) / MAX( zstms, zepsi )215 END DO216 END DO217 CALL lbc_lnk( zpreshc(:,:), 'F', 1. )218 !219 244 !------------------------------------------------------------------------------! 220 245 ! 2) Wind / ocean stress, mass terms, coriolis terms 221 246 !------------------------------------------------------------------------------! 222 !223 ! Wind stress, coriolis and mass terms on the sides of the squares224 ! zfrld1: lead fraction on U-points225 ! zfrld2: lead fraction on V-points226 ! zmass1: ice/snow mass on U-points227 ! zmass2: ice/snow mass on V-points228 ! zcorl1: Coriolis parameter on U-points229 ! zcorl2: Coriolis parameter on V-points230 ! (ztagnx,ztagny): wind stress on U/V points231 ! v_oce1: ocean v component on u points232 ! u_oce2: ocean u component on v points233 247 234 248 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==! … … 242 256 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 243 257 ! 244 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:)) * r1_rau0258 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 245 259 ! 246 260 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! … … 248 262 ENDIF 249 263 250 DO jj = k_j1+1, k_jpj-1264 DO jj = 2, jpjm1 251 265 DO ji = fs_2, fs_jpim1 252 266 253 zc1 = tmask(ji ,jj ,1) * ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) ) 254 zc2 = tmask(ji+1,jj ,1) * ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) ) 255 zc3 = tmask(ji ,jj+1,1) * ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) ) 256 257 zt11 = tmask(ji ,jj,1) * e1t(ji ,jj) 258 zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj) 259 zt21 = tmask(ji,jj ,1) * e2t(ji,jj ) 260 zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1) 261 262 ! Leads area. 263 zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi ) 264 zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi ) 265 266 ! Mass, coriolis coeff. and currents 267 zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi ) 268 zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi ) 269 zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) ) & 270 & / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi ) 271 zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) ) & 272 & / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi ) 273 ! 274 ! Ocean has no slip boundary condition 275 v_oce1(ji,jj) = 0.5 * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji,jj) & 276 & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 277 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 278 279 u_oce2(ji,jj) = 0.5 * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj) & 280 & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 281 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 282 283 ! Wind stress at U,V-point 284 ztagnx = ( 1. - zfrld1(ji,jj) ) * utau_ice(ji,jj) 285 ztagny = ( 1. - zfrld2(ji,jj) ) * vtau_ice(ji,jj) 286 287 ! Computation of the velocity field taking into account the ice internal interaction. 288 ! Terms that are independent of the velocity field. 289 290 ! SB On utilise maintenant le gradient de la pente de l'ocean 291 ! include it later 292 293 zdsshx = ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 294 zdsshy = ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 295 296 za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx 297 za2ct(ji,jj) = ztagny - zmass2(ji,jj) * grav * zdsshy 267 ! ice fraction at U-V points 268 zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 269 zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 270 271 ! Ice/snow mass at U-V points 272 zm1 = ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) ) 273 zm2 = ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) ) 274 zm3 = ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) ) 275 zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 276 zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 277 278 ! Ocean currents at U-V points 279 v_oceU(ji,jj) = 0.5_wp * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji+1,jj) & 280 & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 281 282 u_oceV(ji,jj) = 0.5_wp * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj+1) & 283 & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 284 285 ! Coriolis at T points (m*f) 286 zmf(ji,jj) = zm1 * ff_t(ji,jj) 287 288 ! m/dt 289 zmU_t(ji,jj) = zmassU * z1_dtevp 290 zmV_t(ji,jj) = zmassV * z1_dtevp 291 292 ! Drag ice-atm. 293 zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 294 zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 295 296 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 297 zspgU(ji,jj) = - zmassU * grav * ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 298 zspgV(ji,jj) = - zmassV * grav * ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 299 300 ! masks 301 zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice 302 zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice 303 304 ! switches 305 zswitchU(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassU - zmmin ) ) ! 0 if ice mass < zmmin 306 zswitchV(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassV - zmmin ) ) ! 0 if ice mass < zmmin 298 307 299 308 END DO 300 309 END DO 301 310 CALL lbc_lnk( zmf, 'T', 1. ) 302 311 ! 303 312 !------------------------------------------------------------------------------! … … 305 314 !------------------------------------------------------------------------------! 306 315 ! 307 ! Time step for subcycling308 dtevp = rdt_ice / nn_nevp309 #if defined key_lim3310 dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice )311 #else312 dtotel = dtevp / ( 2._wp * telast )313 #endif314 z1_dtotel = 1._wp / ( 1._wp + dtotel )315 z1_dtevp = 1._wp / dtevp316 !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter)317 ecc2 = rn_ecc * rn_ecc318 ecci = 1. / ecc2319 320 !-Initialise stress tensor321 zs1 (:,:) = stress1_i (:,:)322 zs2 (:,:) = stress2_i (:,:)323 zs12(:,:) = stress12_i(:,:)324 325 316 ! !----------------------! 326 317 DO jter = 1 , nn_nevp ! loop over jter ! 327 318 ! !----------------------! 328 DO jj = k_j1, k_jpj-1 329 zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 330 zv_ice(:,jj) = v_ice(:,jj) 331 END DO 332 333 DO jj = k_j1+1, k_jpj-1 334 DO ji = fs_2, fs_jpim1 !RB bug no vect opt due to zmask 335 336 ! 337 !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002) 338 !- divu_i(:,:), zdt(:,:): divergence and tension at centre of grid cells 339 !- zds(:,:): shear on northeast corner of grid cells 340 ! 341 !- IMPORTANT REMINDER: Dear Gurvan, note that, the way these terms are coded, 342 ! there are many repeated calculations. 343 ! Speed could be improved by regrouping terms. For 344 ! the moment, however, the stress is on clarity of coding to avoid 345 ! bugs (Martin, for Miguel). 346 ! 347 !- ALSO: arrays zdt, zds and delta could 348 ! be removed in the future to minimise memory demand. 349 ! 350 !- MORE NOTES: Note that we are calculating deformation rates and stresses on the corners of 351 ! grid cells, exactly as in the B grid case. For simplicity, the indexation on 352 ! the corners is the same as in the B grid. 353 ! 354 ! 355 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 356 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 357 & ) * r1_e1e2t(ji,jj) 358 359 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 360 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 361 & ) * r1_e1e2t(ji,jj) 362 363 ! 319 IF(ln_ctl) THEN ! Convergence test 320 DO jj = 1, jpjm1 321 zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 322 zv_ice(:,jj) = v_ice(:,jj) 323 END DO 324 ENDIF 325 326 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 327 DO jj = 1, jpjm1 ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 328 DO ji = 1, jpim1 329 330 ! shear at F points 364 331 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 365 332 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 366 & ) * r1_e1e2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) ) & 367 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 368 369 370 v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) & 371 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) & 372 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 373 374 u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 375 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) & 376 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 377 END DO 378 END DO 379 380 CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. ) ! lateral boundary cond. 381 382 DO jj = k_j1+1, k_jpj-1 383 DO ji = fs_2, fs_jpim1 384 385 !- Calculate Delta at centre of grid cells 386 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 387 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) & 388 & ) * r1_e1e2t(ji,jj) 389 390 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) 391 delta_i(ji,jj) = delta + rn_creepl 392 393 !- Calculate Delta on corners 394 zddc = ( ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 395 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 396 & ) * r1_e1e2f(ji,jj) 397 398 zdtc = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 399 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 400 & ) * r1_e1e2f(ji,jj) 401 402 zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl 403 404 !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide). 405 zs1(ji,jj) = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj) * zpresh(ji,jj) & 406 & ) * z1_dtotel 407 zs2(ji,jj) = ( zs2 (ji,jj) + dtotel * ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) & 408 & ) * z1_dtotel 409 !-Calculate stress tensor component zs12 at corners 410 zs12(ji,jj) = ( zs12(ji,jj) + dtotel * ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) & 411 & ) * z1_dtotel 412 413 END DO 414 END DO 415 416 CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 333 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 334 335 END DO 336 END DO 337 CALL lbc_lnk( zds, 'F', 1. ) 338 339 DO jj = 2, jpjm1 340 DO ji = 2, jpim1 ! no vector loop 341 342 ! shear**2 at T points (doc eq. A16) 343 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 344 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 345 & ) * 0.25_wp * r1_e1e2t(ji,jj) 346 347 ! divergence at T points 348 zdiv = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 349 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 350 & ) * r1_e1e2t(ji,jj) 351 zdiv2 = zdiv * zdiv 352 353 ! tension at T points 354 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 355 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 356 & ) * r1_e1e2t(ji,jj) 357 zdt2 = zdt * zdt 358 359 ! delta at T points 360 zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 361 362 ! P/delta at T points 363 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 364 365 ! stress at T points 366 zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv - zdelta ) ) * z1_alph1 367 zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 ) ) * z1_alph2 368 369 END DO 370 END DO 371 CALL lbc_lnk( zp_delt, 'T', 1. ) 372 373 DO jj = 1, jpjm1 374 DO ji = 1, jpim1 375 376 ! P/delta at F points 377 zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 378 379 ! stress at F points 380 zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 ) * 0.5_wp ) * z1_alph2 381 382 END DO 383 END DO 384 CALL lbc_lnk_multi( zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 417 385 418 ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 419 DO jj = k_j1+1, k_jpj-1 420 DO ji = fs_2, fs_jpim1 421 !- contribution of zs1, zs2 and zs12 to zf1 422 zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 423 & + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj) & 424 & + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) & 425 & ) * r1_e1e2u(ji,jj) 426 ! contribution of zs1, zs2 and zs12 to zf2 427 zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 428 & - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj) & 429 & + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj) & 430 & ) * r1_e1e2v(ji,jj) 386 387 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 388 DO jj = 2, jpjm1 389 DO ji = fs_2, fs_jpim1 390 391 ! U points 392 zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 393 & + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj) & 394 & ) * r1_e2u(ji,jj) & 395 & + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) & 396 & ) * 2._wp * r1_e1u(ji,jj) & 397 & ) * r1_e1e2u(ji,jj) 398 399 ! V points 400 zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 401 & - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj) & 402 & ) * r1_e1v(ji,jj) & 403 & + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) & 404 & ) * 2._wp * r1_e2v(ji,jj) & 405 & ) * r1_e1e2v(ji,jj) 406 407 ! u_ice at V point 408 u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 409 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 410 411 ! v_ice at U point 412 v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) & 413 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 414 431 415 END DO 432 416 END DO 433 417 ! 434 ! Computation of ice velocity 435 ! 436 ! Both the Coriolis term and the ice-ocean drag are solved semi-implicitly. 437 ! 438 IF (MOD(jter,2).eq.0) THEN 439 440 DO jj = k_j1+1, k_jpj-1 418 ! --- Computation of ice velocity --- ! 419 ! Bouillon et al. 2013 (eq 47-48) => unstable unless alpha, beta are chosen wisely and large nn_nevp 420 ! Bouillon et al. 2009 (eq 34-35) => stable 421 IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations 422 423 DO jj = 2, jpjm1 441 424 DO ji = fs_2, fs_jpim1 442 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 443 z0 = zmass1(ji,jj) * z1_dtevp 444 445 ! SB modif because ocean has no slip boundary condition 446 zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji ,jj) & 447 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 448 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 449 za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + & 450 & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 451 zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 452 zcca = z0 + za 453 zccb = zcorl1(ji,jj) 454 u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 425 426 ! tau_io/(v_oce - v_ice) 427 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 428 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 429 430 ! tau_bottom/v_ice 431 zvel = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) ) 432 zTauB = - tau_icebfr(ji,jj) / zvel 433 434 ! Coriolis at V-points (energy conserving formulation) 435 zCor = - 0.25_wp * r1_e2v(ji,jj) * & 436 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 437 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 438 439 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 440 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 441 442 ! landfast switch => 0 = static friction ; 1 = sliding friction 443 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 444 445 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 446 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 447 & + zTauE + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 448 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 449 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 450 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 451 & ) * zmaskV(ji,jj) 452 ! Bouillon 2013 453 !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) ) & 454 !! & + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj) & 455 !! & ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj) 456 455 457 END DO 456 458 END DO 457 458 CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 459 #if defined key_agrif && defined key_lim2 460 CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 459 CALL lbc_lnk( v_ice, 'V', -1. ) 460 461 #if defined key_agrif 462 !! CALL agrif_interp_lim3( 'V', jter, nn_nevp ) 463 CALL agrif_interp_lim3( 'V' ) 461 464 #endif 462 465 #if defined key_bdy 463 CALL bdy_ice_lim_dyn( 'U' )466 CALL bdy_ice_lim_dyn( 'V' ) 464 467 #endif 465 468 466 DO jj = k_j1+1, k_jpj-1469 DO jj = 2, jpjm1 467 470 DO ji = fs_2, fs_jpim1 468 469 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 470 z0 = zmass2(ji,jj) * z1_dtevp 471 ! SB modif because ocean has no slip boundary condition 472 zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) & 473 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 474 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 475 za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + & 476 & ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) ) 477 zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 478 zcca = z0 + za 479 zccb = zcorl2(ji,jj) 480 v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 471 472 ! tau_io/(u_oce - u_ice) 473 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 474 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 475 476 ! tau_bottom/u_ice 477 zvel = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) ) 478 zTauB = - tau_icebfr(ji,jj) / zvel 479 480 ! Coriolis at U-points (energy conserving formulation) 481 zCor = 0.25_wp * r1_e1u(ji,jj) * & 482 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 483 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 484 485 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 486 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 487 488 ! landfast switch => 0 = static friction ; 1 = sliding friction 489 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 490 491 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 492 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 493 & + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 494 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 495 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 496 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 497 & ) * zmaskU(ji,jj) 498 ! Bouillon 2013 499 !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) ) & 500 !! & + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj) & 501 !! & ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj) 481 502 END DO 482 503 END DO 483 484 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 485 #if defined key_agrif && defined key_lim2 486 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 504 CALL lbc_lnk( u_ice, 'U', -1. ) 505 506 #if defined key_agrif 507 !! CALL agrif_interp_lim3( 'U', jter, nn_nevp ) 508 CALL agrif_interp_lim3( 'U' ) 487 509 #endif 488 510 #if defined key_bdy 489 CALL bdy_ice_lim_dyn( 'V' )511 CALL bdy_ice_lim_dyn( 'U' ) 490 512 #endif 491 513 492 ELSE 493 DO jj = k_j1+1, k_jpj-1 514 ELSE ! odd iterations 515 516 DO jj = 2, jpjm1 494 517 DO ji = fs_2, fs_jpim1 495 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 496 z0 = zmass2(ji,jj) * z1_dtevp 497 ! SB modif because ocean has no slip boundary condition 498 zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) & 499 & +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 500 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 501 502 za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + & 503 & ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) ) 504 zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 505 zcca = z0 + za 506 zccb = zcorl2(ji,jj) 507 v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 518 519 ! tau_io/(u_oce - u_ice) 520 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 521 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 522 523 ! tau_bottom/u_ice 524 zvel = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) ) 525 zTauB = - tau_icebfr(ji,jj) / zvel 526 527 ! Coriolis at U-points (energy conserving formulation) 528 zCor = 0.25_wp * r1_e1u(ji,jj) * & 529 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 530 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 531 532 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 533 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 534 535 ! landfast switch => 0 = static friction ; 1 = sliding friction 536 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 537 538 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 539 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 540 & + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 541 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 542 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 543 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 544 & ) * zmaskU(ji,jj) 545 ! Bouillon 2013 546 !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) ) & 547 !! & + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj) & 548 !! & ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj) 508 549 END DO 509 550 END DO 510 511 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 512 #if defined key_agrif && defined key_lim2 513 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 551 CALL lbc_lnk( u_ice, 'U', -1. ) 552 553 #if defined key_agrif 554 !! CALL agrif_interp_lim3( 'U', jter, nn_nevp ) 555 CALL agrif_interp_lim3( 'U' ) 514 556 #endif 515 557 #if defined key_bdy 516 CALL bdy_ice_lim_dyn( 'V' )558 CALL bdy_ice_lim_dyn( 'U' ) 517 559 #endif 518 560 519 DO jj = k_j1+1, k_jpj-1561 DO jj = 2, jpjm1 520 562 DO ji = fs_2, fs_jpim1 521 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 522 z0 = zmass1(ji,jj) * z1_dtevp 523 zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji,jj) & 524 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 525 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 526 527 za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + & 528 & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 529 zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 530 zcca = z0 + za 531 zccb = zcorl1(ji,jj) 532 u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 563 564 ! tau_io/(v_oce - v_ice) 565 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 566 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 567 568 ! tau_bottom/v_ice 569 zvel = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) ) 570 ztauB = - tau_icebfr(ji,jj) / zvel 571 572 ! Coriolis at V-points (energy conserving formulation) 573 zCor = - 0.25_wp * r1_e2v(ji,jj) * & 574 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 575 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 576 577 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 578 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 579 580 ! landfast switch => 0 = static friction (tau_icebfr > zTauE); 1 = sliding friction 581 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 582 583 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 584 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 585 & + zTauE + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 586 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 587 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 588 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 589 & ) * zmaskV(ji,jj) 590 ! Bouillon 2013 591 !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) ) & 592 !! & + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj) & 593 !! & ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj) 533 594 END DO 534 595 END DO 535 536 CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 537 #if defined key_agrif && defined key_lim2 538 CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 596 CALL lbc_lnk( v_ice, 'V', -1. ) 597 598 #if defined key_agrif 599 !! CALL agrif_interp_lim3( 'V', jter, nn_nevp ) 600 CALL agrif_interp_lim3( 'V' ) 539 601 #endif 540 602 #if defined key_bdy 541 CALL bdy_ice_lim_dyn( 'U' )603 CALL bdy_ice_lim_dyn( 'V' ) 542 604 #endif 543 605 544 606 ENDIF 545 607 546 IF(ln_ctl) THEN 547 !--- Convergence test. 548 DO jj = k_j1+1 , k_jpj-1 608 IF(ln_ctl) THEN ! Convergence test 609 DO jj = 2 , jpjm1 549 610 zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 550 611 END DO 551 zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) )612 zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 552 613 IF( lk_mpp ) CALL mpp_max( zresm ) ! max over the global domain 553 614 ENDIF 554 615 ! 555 616 ! ! ==================== ! 556 617 END DO ! end loop over jter ! … … 558 619 ! 559 620 !------------------------------------------------------------------------------! 560 ! 4) Prevent ice velocities when the ice is thin 561 !------------------------------------------------------------------------------! 562 ! If the ice volume is below zvmin then ice velocity should equal the 563 ! ocean velocity. This prevents high velocity when ice is thin 564 DO jj = k_j1+1, k_jpj-1 565 DO ji = fs_2, fs_jpim1 566 IF ( vt_i(ji,jj) <= zvmin ) THEN 567 u_ice(ji,jj) = u_oce(ji,jj) 568 v_ice(ji,jj) = v_oce(ji,jj) 569 ENDIF 621 ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 622 !------------------------------------------------------------------------------! 623 DO jj = 1, jpjm1 624 DO ji = 1, jpim1 625 626 ! shear at F points 627 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 628 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 629 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 630 631 END DO 632 END DO 633 CALL lbc_lnk( zds, 'F', 1. ) 634 635 DO jj = 2, jpjm1 636 DO ji = 2, jpim1 ! no vector loop 637 638 ! tension**2 at T points 639 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 640 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 641 & ) * r1_e1e2t(ji,jj) 642 zdt2 = zdt * zdt 643 644 ! shear**2 at T points (doc eq. A16) 645 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 646 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 647 & ) * 0.25_wp * r1_e1e2t(ji,jj) 648 649 ! shear at T points 650 shear_i(ji,jj) = SQRT( zdt2 + zds2 ) 651 652 ! divergence at T points 653 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 654 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 655 & ) * r1_e1e2t(ji,jj) 656 657 ! delta at T points 658 zdelta = SQRT( divu_i(ji,jj) * divu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) 659 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 660 delta_i(ji,jj) = zdelta + rn_creepl * rswitch 661 570 662 END DO 571 663 END DO 572 573 CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. ) 574 575 #if defined key_agrif && defined key_lim2 576 CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' ) 577 CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' ) 578 #endif 579 #if defined key_bdy 580 CALL bdy_ice_lim_dyn( 'U' ) 581 CALL bdy_ice_lim_dyn( 'V' ) 582 #endif 583 584 DO jj = k_j1+1, k_jpj-1 585 DO ji = fs_2, fs_jpim1 586 IF ( vt_i(ji,jj) <= zvmin ) THEN 587 v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji, jj-1) ) * e1t(ji+1,jj) & 588 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) & 589 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 590 591 u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 592 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) & 593 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 594 ENDIF 595 END DO 596 END DO 597 598 CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. ) 599 600 ! Recompute delta, shear and div, inputs for mechanical redistribution 601 DO jj = k_j1+1, k_jpj-1 602 DO ji = fs_2, jpim1 !RB bug no vect opt due to zmask 603 !- divu_i(:,:), zdt(:,:): divergence and tension at centre 604 !- zds(:,:): shear on northeast corner of grid cells 605 IF ( vt_i(ji,jj) <= zvmin ) THEN 606 607 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj ) * u_ice(ji-1,jj ) & 608 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji ,jj-1) * v_ice(ji ,jj-1) & 609 & ) * r1_e1e2t(ji,jj) 610 611 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 612 & -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 613 & ) * r1_e1e2t(ji,jj) 614 ! 615 ! SB modif because ocean has no slip boundary condition 616 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 617 & +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 618 & ) * r1_e1e2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) ) & 619 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 620 621 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 622 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) ) * r1_e1e2t(ji,jj) 623 624 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) 625 delta_i(ji,jj) = delta + rn_creepl 626 627 ENDIF 628 END DO 629 END DO 630 ! 631 !------------------------------------------------------------------------------! 632 ! 5) Store stress tensor and its invariants 633 !------------------------------------------------------------------------------! 634 ! * Invariants of the stress tensor are required for limitd_me 635 ! (accelerates convergence and improves stability) 636 DO jj = k_j1+1, k_jpj-1 637 DO ji = fs_2, fs_jpim1 638 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj ) * v_ice1(ji-1,jj) & 639 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1e2t(ji,jj) 640 shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 641 END DO 642 END DO 643 644 ! Lateral boundary condition 645 CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1., shear_i(:,:), 'T', 1. ) 646 647 ! * Store the stress tensor for the next time step 664 CALL lbc_lnk_multi( shear_i, 'T', 1., divu_i, 'T', 1., delta_i, 'T', 1. ) 665 666 ! --- Store the stress tensor for the next time step --- ! 648 667 stress1_i (:,:) = zs1 (:,:) 649 668 stress2_i (:,:) = zs2 (:,:) 650 669 stress12_i(:,:) = zs12(:,:) 651 652 670 ! 653 !------------------------------------------------------------------------------! 654 ! 6) Control prints of residual and charge ellipse 671 672 !------------------------------------------------------------------------------! 673 ! 5) Control prints of residual and charge ellipse 655 674 !------------------------------------------------------------------------------! 656 675 ! … … 672 691 WRITE(charout,FMT="('lim_rhg :', I4, I6, I1, I1, A10)") 1000, numit, 0, 0, ' ch. ell. ' 673 692 CALL prt_ctl_info(charout) 674 DO jj = k_j1+1, k_jpj-1693 DO jj = 2, jpjm1 675 694 DO ji = 2, jpim1 676 IF ( zpresh(ji,jj) > 1.0) THEN677 sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )678 sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )695 IF (strength(ji,jj) > 1.0) THEN 696 zsig1 = ( zs1(ji,jj) + SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) ) 697 zsig2 = ( zs1(ji,jj) - SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) ) 679 698 WRITE(charout,FMT="('lim_rhg :', I4, I4, D23.16, D23.16, D23.16, D23.16, A10)") 680 699 CALL prt_ctl_info(charout) … … 686 705 ENDIF 687 706 ENDIF 688 ! 689 CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 690 CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 691 CALL wrk_dealloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 692 CALL wrk_dealloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice ) 707 ! 708 709 CALL wrk_dealloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt ) 710 CALL wrk_dealloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia ) 711 CALL wrk_dealloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV ) 712 CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 713 CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 693 714 694 715 END SUBROUTINE lim_rhg … … 699 720 !!---------------------------------------------------------------------- 700 721 CONTAINS 701 SUBROUTINE lim_rhg ( k1 , k2 )! Dummy routine702 WRITE(*,*) 'lim_rhg: You should not have seen this print! error?' , k1, k2722 SUBROUTINE lim_rhg ! Dummy routine 723 WRITE(*,*) 'lim_rhg: You should not have seen this print! error?' 703 724 END SUBROUTINE lim_rhg 704 725 #endif -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r6140 r7309 53 53 INTEGER, INTENT(in) :: kt ! number of iteration 54 54 ! 55 CHARACTER( LEN=20) :: clkt ! ocean time-step define as a character56 CHARACTER( LEN=50) :: clname ! ice output restart file name55 CHARACTER(len=20) :: clkt ! ocean time-step define as a character 56 CHARACTER(len=50) :: clname ! ice output restart file name 57 57 CHARACTER(len=256) :: clpath ! full path to ice output restart file 58 58 !!---------------------------------------------------------------------- … … 91 91 ENDIF 92 92 ! 93 IF( ln_ icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' ) ! control print93 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' ) ! control print 94 94 END SUBROUTINE lim_rst_opn 95 95 … … 105 105 INTEGER :: ji, jj, jk ,jl ! dummy loop indices 106 106 INTEGER :: iter 107 CHARACTER(len= 15) :: znam108 CHARACTER(len= 1) :: zchar, zchar1107 CHARACTER(len=25) :: znam 108 CHARACTER(len=2) :: zchar, zchar1 109 109 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 110 110 !!---------------------------------------------------------------------- … … 128 128 ! Prognostic variables 129 129 DO jl = 1, jpl 130 WRITE(zchar,'(I 1)') jl130 WRITE(zchar,'(I2.2)') jl 131 131 znam = 'v_i'//'_htc'//zchar 132 132 z2d(:,:) = v_i(:,:,jl) … … 150 150 151 151 DO jl = 1, jpl 152 WRITE(zchar,'(I 1)') jl152 WRITE(zchar,'(I2.2)') jl 153 153 znam = 'tempt_sl1'//'_htc'//zchar 154 154 z2d(:,:) = e_s(:,:,1,jl) … … 157 157 158 158 DO jl = 1, jpl 159 WRITE(zchar,'(I 1)') jl159 WRITE(zchar,'(I2.2)') jl 160 160 DO jk = 1, nlay_i 161 WRITE(zchar1,'(I 1)') jk161 WRITE(zchar1,'(I2.2)') jk 162 162 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 163 163 z2d(:,:) = e_i(:,:,jk,jl) … … 174 174 CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) 175 175 176 DO jl = 1, jpl 177 WRITE(zchar,'(I1)') jl 178 znam = 'sxice'//'_htc'//zchar 179 z2d(:,:) = sxice(:,:,jl) 180 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 181 znam = 'syice'//'_htc'//zchar 182 z2d(:,:) = syice(:,:,jl) 183 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 184 znam = 'sxxice'//'_htc'//zchar 185 z2d(:,:) = sxxice(:,:,jl) 186 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 187 znam = 'syyice'//'_htc'//zchar 188 z2d(:,:) = syyice(:,:,jl) 189 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 190 znam = 'sxyice'//'_htc'//zchar 191 z2d(:,:) = sxyice(:,:,jl) 192 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 193 znam = 'sxsn'//'_htc'//zchar 194 z2d(:,:) = sxsn(:,:,jl) 195 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 196 znam = 'sysn'//'_htc'//zchar 197 z2d(:,:) = sysn(:,:,jl) 198 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 199 znam = 'sxxsn'//'_htc'//zchar 200 z2d(:,:) = sxxsn(:,:,jl) 201 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 202 znam = 'syysn'//'_htc'//zchar 203 z2d(:,:) = syysn(:,:,jl) 204 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 205 znam = 'sxysn'//'_htc'//zchar 206 z2d(:,:) = sxysn(:,:,jl) 207 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 208 znam = 'sxa'//'_htc'//zchar 209 z2d(:,:) = sxa(:,:,jl) 210 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 211 znam = 'sya'//'_htc'//zchar 212 z2d(:,:) = sya(:,:,jl) 213 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 214 znam = 'sxxa'//'_htc'//zchar 215 z2d(:,:) = sxxa(:,:,jl) 216 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 217 znam = 'syya'//'_htc'//zchar 218 z2d(:,:) = syya(:,:,jl) 219 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 220 znam = 'sxya'//'_htc'//zchar 221 z2d(:,:) = sxya(:,:,jl) 222 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 223 znam = 'sxc0'//'_htc'//zchar 224 z2d(:,:) = sxc0(:,:,jl) 225 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 226 znam = 'syc0'//'_htc'//zchar 227 z2d(:,:) = syc0(:,:,jl) 228 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 229 znam = 'sxxc0'//'_htc'//zchar 230 z2d(:,:) = sxxc0(:,:,jl) 231 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 232 znam = 'syyc0'//'_htc'//zchar 233 z2d(:,:) = syyc0(:,:,jl) 234 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 235 znam = 'sxyc0'//'_htc'//zchar 236 z2d(:,:) = sxyc0(:,:,jl) 237 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 238 znam = 'sxsal'//'_htc'//zchar 239 z2d(:,:) = sxsal(:,:,jl) 240 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 241 znam = 'sysal'//'_htc'//zchar 242 z2d(:,:) = sysal(:,:,jl) 243 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 244 znam = 'sxxsal'//'_htc'//zchar 245 z2d(:,:) = sxxsal(:,:,jl) 246 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 247 znam = 'syysal'//'_htc'//zchar 248 z2d(:,:) = syysal(:,:,jl) 249 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 250 znam = 'sxysal'//'_htc'//zchar 251 z2d(:,:) = sxysal(:,:,jl) 252 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 253 znam = 'sxage'//'_htc'//zchar 254 z2d(:,:) = sxage(:,:,jl) 255 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 256 znam = 'syage'//'_htc'//zchar 257 z2d(:,:) = syage(:,:,jl) 258 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 259 znam = 'sxxage'//'_htc'//zchar 260 z2d(:,:) = sxxage(:,:,jl) 261 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 262 znam = 'syyage'//'_htc'//zchar 263 z2d(:,:) = syyage(:,:,jl) 264 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 265 znam = 'sxyage'//'_htc'//zchar 266 z2d(:,:) = sxyage(:,:,jl) 267 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 268 END DO 269 270 CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' , sxopw ) 271 CALL iom_rstput( iter, nitrst, numriw, 'syopw ' , syopw ) 272 CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' , sxxopw ) 273 CALL iom_rstput( iter, nitrst, numriw, 'syyopw' , syyopw ) 274 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' , sxyopw ) 275 276 DO jl = 1, jpl 277 WRITE(zchar,'(I1)') jl 278 DO jk = 1, nlay_i 279 WRITE(zchar1,'(I1)') jk 280 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 281 z2d(:,:) = sxe(:,:,jk,jl) 282 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 283 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 284 z2d(:,:) = sye(:,:,jk,jl) 285 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 286 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 287 z2d(:,:) = sxxe(:,:,jk,jl) 288 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 289 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 290 z2d(:,:) = syye(:,:,jk,jl) 291 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 292 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 293 z2d(:,:) = sxye(:,:,jk,jl) 294 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 295 END DO 296 END DO 297 176 ! In case Prather scheme is used for advection, write second order moments 177 ! ------------------------------------------------------------------------ 178 IF( nn_limadv == -1 ) THEN 179 180 DO jl = 1, jpl 181 WRITE(zchar,'(I2.2)') jl 182 znam = 'sxice'//'_htc'//zchar 183 z2d(:,:) = sxice(:,:,jl) 184 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 185 znam = 'syice'//'_htc'//zchar 186 z2d(:,:) = syice(:,:,jl) 187 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 188 znam = 'sxxice'//'_htc'//zchar 189 z2d(:,:) = sxxice(:,:,jl) 190 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 191 znam = 'syyice'//'_htc'//zchar 192 z2d(:,:) = syyice(:,:,jl) 193 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 194 znam = 'sxyice'//'_htc'//zchar 195 z2d(:,:) = sxyice(:,:,jl) 196 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 197 znam = 'sxsn'//'_htc'//zchar 198 z2d(:,:) = sxsn(:,:,jl) 199 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 200 znam = 'sysn'//'_htc'//zchar 201 z2d(:,:) = sysn(:,:,jl) 202 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 203 znam = 'sxxsn'//'_htc'//zchar 204 z2d(:,:) = sxxsn(:,:,jl) 205 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 206 znam = 'syysn'//'_htc'//zchar 207 z2d(:,:) = syysn(:,:,jl) 208 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 209 znam = 'sxysn'//'_htc'//zchar 210 z2d(:,:) = sxysn(:,:,jl) 211 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 212 znam = 'sxa'//'_htc'//zchar 213 z2d(:,:) = sxa(:,:,jl) 214 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 215 znam = 'sya'//'_htc'//zchar 216 z2d(:,:) = sya(:,:,jl) 217 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 218 znam = 'sxxa'//'_htc'//zchar 219 z2d(:,:) = sxxa(:,:,jl) 220 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 221 znam = 'syya'//'_htc'//zchar 222 z2d(:,:) = syya(:,:,jl) 223 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 224 znam = 'sxya'//'_htc'//zchar 225 z2d(:,:) = sxya(:,:,jl) 226 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 227 znam = 'sxc0'//'_htc'//zchar 228 z2d(:,:) = sxc0(:,:,jl) 229 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 230 znam = 'syc0'//'_htc'//zchar 231 z2d(:,:) = syc0(:,:,jl) 232 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 233 znam = 'sxxc0'//'_htc'//zchar 234 z2d(:,:) = sxxc0(:,:,jl) 235 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 236 znam = 'syyc0'//'_htc'//zchar 237 z2d(:,:) = syyc0(:,:,jl) 238 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 239 znam = 'sxyc0'//'_htc'//zchar 240 z2d(:,:) = sxyc0(:,:,jl) 241 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 242 znam = 'sxsal'//'_htc'//zchar 243 z2d(:,:) = sxsal(:,:,jl) 244 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 245 znam = 'sysal'//'_htc'//zchar 246 z2d(:,:) = sysal(:,:,jl) 247 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 248 znam = 'sxxsal'//'_htc'//zchar 249 z2d(:,:) = sxxsal(:,:,jl) 250 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 251 znam = 'syysal'//'_htc'//zchar 252 z2d(:,:) = syysal(:,:,jl) 253 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 254 znam = 'sxysal'//'_htc'//zchar 255 z2d(:,:) = sxysal(:,:,jl) 256 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 257 znam = 'sxage'//'_htc'//zchar 258 z2d(:,:) = sxage(:,:,jl) 259 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 260 znam = 'syage'//'_htc'//zchar 261 z2d(:,:) = syage(:,:,jl) 262 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 263 znam = 'sxxage'//'_htc'//zchar 264 z2d(:,:) = sxxage(:,:,jl) 265 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 266 znam = 'syyage'//'_htc'//zchar 267 z2d(:,:) = syyage(:,:,jl) 268 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 269 znam = 'sxyage'//'_htc'//zchar 270 z2d(:,:) = sxyage(:,:,jl) 271 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 272 END DO 273 274 CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' , sxopw ) 275 CALL iom_rstput( iter, nitrst, numriw, 'syopw ' , syopw ) 276 CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' , sxxopw ) 277 CALL iom_rstput( iter, nitrst, numriw, 'syyopw' , syyopw ) 278 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' , sxyopw ) 279 280 DO jl = 1, jpl 281 WRITE(zchar,'(I2.2)') jl 282 DO jk = 1, nlay_i 283 WRITE(zchar1,'(I2.2)') jk 284 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 285 z2d(:,:) = sxe(:,:,jk,jl) 286 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 287 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 288 z2d(:,:) = sye(:,:,jk,jl) 289 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 290 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 291 z2d(:,:) = sxxe(:,:,jk,jl) 292 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 293 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 294 z2d(:,:) = syye(:,:,jk,jl) 295 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 296 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 297 z2d(:,:) = sxye(:,:,jk,jl) 298 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 299 END DO 300 END DO 301 302 ENDIF 303 304 ! close restart file 305 ! ------------------ 298 306 IF( iter == nitrst ) THEN 299 CALL iom_close( numriw ) ! close the restart file307 CALL iom_close( numriw ) 300 308 lrst_ice = .FALSE. 301 309 ENDIF … … 315 323 REAL(wp) :: zfice, ziter 316 324 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 317 CHARACTER(len= 15) :: znam318 CHARACTER(len= 1) :: zchar, zchar1325 CHARACTER(len=25) :: znam 326 CHARACTER(len=2) :: zchar, zchar1 319 327 INTEGER :: jlibalt = jprstlib 320 328 LOGICAL :: llok … … 347 355 & ' control of time parameter nrstdt' ) 348 356 357 ! Prognostic variables 349 358 DO jl = 1, jpl 350 WRITE(zchar,'(I 1)') jl359 WRITE(zchar,'(I2.2)') jl 351 360 znam = 'v_i'//'_htc'//zchar 352 361 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) … … 370 379 371 380 DO jl = 1, jpl 372 WRITE(zchar,'(I 1)') jl381 WRITE(zchar,'(I2.2)') jl 373 382 znam = 'tempt_sl1'//'_htc'//zchar 374 383 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) … … 377 386 378 387 DO jl = 1, jpl 379 WRITE(zchar,'(I 1)') jl388 WRITE(zchar,'(I2.2)') jl 380 389 DO jk = 1, nlay_i 381 WRITE(zchar1,'(I 1)') jk390 WRITE(zchar1,'(I2.2)') jk 382 391 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 383 392 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) … … 394 403 CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) 395 404 396 DO jl = 1, jpl 397 WRITE(zchar,'(I1)') jl 398 znam = 'sxice'//'_htc'//zchar 399 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 400 sxice(:,:,jl) = z2d(:,:) 401 znam = 'syice'//'_htc'//zchar 402 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 403 syice(:,:,jl) = z2d(:,:) 404 znam = 'sxxice'//'_htc'//zchar 405 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 406 sxxice(:,:,jl) = z2d(:,:) 407 znam = 'syyice'//'_htc'//zchar 408 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 409 syyice(:,:,jl) = z2d(:,:) 410 znam = 'sxyice'//'_htc'//zchar 411 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 412 sxyice(:,:,jl) = z2d(:,:) 413 znam = 'sxsn'//'_htc'//zchar 414 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 415 sxsn(:,:,jl) = z2d(:,:) 416 znam = 'sysn'//'_htc'//zchar 417 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 418 sysn(:,:,jl) = z2d(:,:) 419 znam = 'sxxsn'//'_htc'//zchar 420 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 421 sxxsn(:,:,jl) = z2d(:,:) 422 znam = 'syysn'//'_htc'//zchar 423 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 424 syysn(:,:,jl) = z2d(:,:) 425 znam = 'sxysn'//'_htc'//zchar 426 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 427 sxysn(:,:,jl) = z2d(:,:) 428 znam = 'sxa'//'_htc'//zchar 429 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 430 sxa(:,:,jl) = z2d(:,:) 431 znam = 'sya'//'_htc'//zchar 432 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 433 sya(:,:,jl) = z2d(:,:) 434 znam = 'sxxa'//'_htc'//zchar 435 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 436 sxxa(:,:,jl) = z2d(:,:) 437 znam = 'syya'//'_htc'//zchar 438 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 439 syya(:,:,jl) = z2d(:,:) 440 znam = 'sxya'//'_htc'//zchar 441 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 442 sxya(:,:,jl) = z2d(:,:) 443 znam = 'sxc0'//'_htc'//zchar 444 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 445 sxc0(:,:,jl) = z2d(:,:) 446 znam = 'syc0'//'_htc'//zchar 447 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 448 syc0(:,:,jl) = z2d(:,:) 449 znam = 'sxxc0'//'_htc'//zchar 450 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 451 sxxc0(:,:,jl) = z2d(:,:) 452 znam = 'syyc0'//'_htc'//zchar 453 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 454 syyc0(:,:,jl) = z2d(:,:) 455 znam = 'sxyc0'//'_htc'//zchar 456 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 457 sxyc0(:,:,jl) = z2d(:,:) 458 znam = 'sxsal'//'_htc'//zchar 459 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 460 sxsal(:,:,jl) = z2d(:,:) 461 znam = 'sysal'//'_htc'//zchar 462 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 463 sysal(:,:,jl) = z2d(:,:) 464 znam = 'sxxsal'//'_htc'//zchar 465 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 466 sxxsal(:,:,jl) = z2d(:,:) 467 znam = 'syysal'//'_htc'//zchar 468 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 469 syysal(:,:,jl) = z2d(:,:) 470 znam = 'sxysal'//'_htc'//zchar 471 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 472 sxysal(:,:,jl) = z2d(:,:) 473 znam = 'sxage'//'_htc'//zchar 474 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 475 sxage(:,:,jl) = z2d(:,:) 476 znam = 'syage'//'_htc'//zchar 477 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 478 syage(:,:,jl) = z2d(:,:) 479 znam = 'sxxage'//'_htc'//zchar 480 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 481 sxxage(:,:,jl) = z2d(:,:) 482 znam = 'syyage'//'_htc'//zchar 483 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 484 syyage(:,:,jl) = z2d(:,:) 485 znam = 'sxyage'//'_htc'//zchar 486 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 487 sxyage(:,:,jl)= z2d(:,:) 488 END DO 489 490 CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' , sxopw ) 491 CALL iom_get( numrir, jpdom_autoglo, 'syopw ' , syopw ) 492 CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' , sxxopw ) 493 CALL iom_get( numrir, jpdom_autoglo, 'syyopw' , syyopw ) 494 CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' , sxyopw ) 495 496 DO jl = 1, jpl 497 WRITE(zchar,'(I1)') jl 498 DO jk = 1, nlay_i 499 WRITE(zchar1,'(I1)') jk 500 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 501 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 502 sxe(:,:,jk,jl) = z2d(:,:) 503 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 504 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 505 sye(:,:,jk,jl) = z2d(:,:) 506 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 507 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 508 sxxe(:,:,jk,jl) = z2d(:,:) 509 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 510 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 511 syye(:,:,jk,jl) = z2d(:,:) 512 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 513 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 514 sxye(:,:,jk,jl) = z2d(:,:) 515 END DO 516 END DO 517 ! 405 ! In case Prather scheme is used for advection, read second order moments 406 ! ------------------------------------------------------------------------ 407 IF( nn_limadv == -1 ) THEN 408 409 DO jl = 1, jpl 410 WRITE(zchar,'(I2.2)') jl 411 znam = 'sxice'//'_htc'//zchar 412 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 413 sxice(:,:,jl) = z2d(:,:) 414 znam = 'syice'//'_htc'//zchar 415 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 416 syice(:,:,jl) = z2d(:,:) 417 znam = 'sxxice'//'_htc'//zchar 418 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 419 sxxice(:,:,jl) = z2d(:,:) 420 znam = 'syyice'//'_htc'//zchar 421 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 422 syyice(:,:,jl) = z2d(:,:) 423 znam = 'sxyice'//'_htc'//zchar 424 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 425 sxyice(:,:,jl) = z2d(:,:) 426 znam = 'sxsn'//'_htc'//zchar 427 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 428 sxsn(:,:,jl) = z2d(:,:) 429 znam = 'sysn'//'_htc'//zchar 430 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 431 sysn(:,:,jl) = z2d(:,:) 432 znam = 'sxxsn'//'_htc'//zchar 433 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 434 sxxsn(:,:,jl) = z2d(:,:) 435 znam = 'syysn'//'_htc'//zchar 436 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 437 syysn(:,:,jl) = z2d(:,:) 438 znam = 'sxysn'//'_htc'//zchar 439 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 440 sxysn(:,:,jl) = z2d(:,:) 441 znam = 'sxa'//'_htc'//zchar 442 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 443 sxa(:,:,jl) = z2d(:,:) 444 znam = 'sya'//'_htc'//zchar 445 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 446 sya(:,:,jl) = z2d(:,:) 447 znam = 'sxxa'//'_htc'//zchar 448 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 449 sxxa(:,:,jl) = z2d(:,:) 450 znam = 'syya'//'_htc'//zchar 451 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 452 syya(:,:,jl) = z2d(:,:) 453 znam = 'sxya'//'_htc'//zchar 454 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 455 sxya(:,:,jl) = z2d(:,:) 456 znam = 'sxc0'//'_htc'//zchar 457 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 458 sxc0(:,:,jl) = z2d(:,:) 459 znam = 'syc0'//'_htc'//zchar 460 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 461 syc0(:,:,jl) = z2d(:,:) 462 znam = 'sxxc0'//'_htc'//zchar 463 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 464 sxxc0(:,:,jl) = z2d(:,:) 465 znam = 'syyc0'//'_htc'//zchar 466 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 467 syyc0(:,:,jl) = z2d(:,:) 468 znam = 'sxyc0'//'_htc'//zchar 469 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 470 sxyc0(:,:,jl) = z2d(:,:) 471 znam = 'sxsal'//'_htc'//zchar 472 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 473 sxsal(:,:,jl) = z2d(:,:) 474 znam = 'sysal'//'_htc'//zchar 475 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 476 sysal(:,:,jl) = z2d(:,:) 477 znam = 'sxxsal'//'_htc'//zchar 478 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 479 sxxsal(:,:,jl) = z2d(:,:) 480 znam = 'syysal'//'_htc'//zchar 481 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 482 syysal(:,:,jl) = z2d(:,:) 483 znam = 'sxysal'//'_htc'//zchar 484 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 485 sxysal(:,:,jl) = z2d(:,:) 486 znam = 'sxage'//'_htc'//zchar 487 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 488 sxage(:,:,jl) = z2d(:,:) 489 znam = 'syage'//'_htc'//zchar 490 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 491 syage(:,:,jl) = z2d(:,:) 492 znam = 'sxxage'//'_htc'//zchar 493 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 494 sxxage(:,:,jl) = z2d(:,:) 495 znam = 'syyage'//'_htc'//zchar 496 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 497 syyage(:,:,jl) = z2d(:,:) 498 znam = 'sxyage'//'_htc'//zchar 499 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 500 sxyage(:,:,jl)= z2d(:,:) 501 END DO 502 503 CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' , sxopw ) 504 CALL iom_get( numrir, jpdom_autoglo, 'syopw ' , syopw ) 505 CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' , sxxopw ) 506 CALL iom_get( numrir, jpdom_autoglo, 'syyopw' , syyopw ) 507 CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' , sxyopw ) 508 509 DO jl = 1, jpl 510 WRITE(zchar,'(I2.2)') jl 511 DO jk = 1, nlay_i 512 WRITE(zchar1,'(I2.2)') jk 513 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 514 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 515 sxe(:,:,jk,jl) = z2d(:,:) 516 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 517 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 518 sye(:,:,jk,jl) = z2d(:,:) 519 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 520 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 521 sxxe(:,:,jk,jl) = z2d(:,:) 522 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 523 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 524 syye(:,:,jk,jl) = z2d(:,:) 525 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 526 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 527 sxye(:,:,jk,jl) = z2d(:,:) 528 END DO 529 END DO 530 ! 531 END IF 532 518 533 ! clem: I do not understand why the following IF is needed 519 534 ! I suspect something inconsistent in the main code with option nn_icesal=1 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r6416 r7309 42 42 USE lib_mpp ! MPP library 43 43 USE wrk_nemo ! work arrays 44 USE prtctl ! Print control45 44 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 46 45 … … 48 47 PRIVATE 49 48 50 PUBLIC lim_sbc_init ! called by sbc ice_lim49 PUBLIC lim_sbc_init ! called by sbc_lim_init 51 50 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 52 51 PUBLIC lim_sbc_tau ! called by sbc_ice_lim … … 94 93 !! - fr_i : ice fraction 95 94 !! - tn_ice : sea-ice surface temperature 96 !! - alb_ice : sea-ice albedo ( only useful incoupled mode)95 !! - alb_ice : sea-ice albedo (recomputed only for coupled mode) 97 96 !! 98 97 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 109 108 REAL(wp), POINTER, DIMENSION(:,:) :: zalb ! 2D workspace 110 109 !!--------------------------------------------------------------------- 111 ! 112 ! make calls for heat fluxes before it is modified 113 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 114 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 115 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 116 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 117 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 118 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 119 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 120 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 121 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 122 IF( iom_use('qemp_oce') ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 123 IF( iom_use('qemp_ice') ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 124 IF( iom_use('emp_oce' ) ) CALL iom_put( "emp_oce" , emp_oce(:,:) ) ! emp over ocean (taking into account the snow blown away from the ice) 125 IF( iom_use('emp_ice' ) ) CALL iom_put( "emp_ice" , emp_ice(:,:) ) ! emp over ice (taking into account the snow blown away from the ice) 126 110 111 ! --- case we bypass ice thermodynamics --- ! 112 IF( .NOT. ln_limthd ) THEN ! we suppose ice is impermeable => ocean is isolated from atmosphere 113 hfx_in (:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 114 hfx_out (:,:) = pfrld(:,:) * qns_oce(:,:) + qemp_oce(:,:) 115 ftr_ice (:,:,:) = 0._wp 116 emp_ice (:,:) = 0._wp 117 qemp_ice (:,:) = 0._wp 118 qevap_ice(:,:,:) = 0._wp 119 ENDIF 120 127 121 ! albedo output 128 122 CALL wrk_alloc( jpi,jpj, zalb ) 129 123 130 124 zalb(:,:) = 0._wp 131 WHERE ( SUM( a_i_b, dim=3 )<= epsi06 ) ; zalb(:,:) = 0.066_wp132 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 )125 WHERE ( at_i_b <= epsi06 ) ; zalb(:,:) = 0.066_wp 126 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 133 127 END WHERE 134 128 IF( iom_use('alb_ice' ) ) CALL iom_put( "alb_ice" , zalb(:,:) ) ! ice albedo output 135 129 136 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ))130 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b ) 137 131 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! ice albedo output 138 132 … … 180 174 ! mass flux from ice/ocean 181 175 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 182 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 176 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 183 177 184 178 ! mass flux at the ocean/ice interface 185 179 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) ) ! F/M mass flux save at least for biogeochemical model 186 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 180 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 187 181 END DO 188 182 END DO … … 192 186 !------------------------------------------! 193 187 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 194 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 188 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 195 189 196 190 !-------------------------------------------------------------! … … 221 215 222 216 ! conservation test 223 IF( ln_limdia hsb )CALL lim_cons_final( 'limsbc' )217 IF( ln_limdiachk ) CALL lim_cons_final( 'limsbc' ) 224 218 225 219 ! control prints 226 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 227 ! 228 IF(ln_ctl) THEN 229 CALL prt_ctl( tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ' ) 230 CALL prt_ctl( tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=sfx , clinfo2=' sfx : ' ) 231 CALL prt_ctl( tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ' ) 232 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 233 ENDIF 234 ! 220 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 221 IF( ln_ctl ) CALL lim_prt3D( 'limsbc' ) 222 235 223 END SUBROUTINE lim_sbc_flx 236 224 … … 266 254 INTEGER :: ji, jj ! dummy loop indices 267 255 REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar 268 REAL(wp) :: zat_v, zvtau_ice, zv_t 256 REAL(wp) :: zat_v, zvtau_ice, zv_t, zrhoco ! - - 269 257 !!--------------------------------------------------------------------- 258 zrhoco = rau0 * rn_cio 270 259 ! 271 260 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) … … 278 267 zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t ) 279 268 ! ! update the ocean stress modulus 280 taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * rhoco * zmodt281 tmod_io(ji,jj) = rhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point269 taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 270 tmod_io(ji,jj) = zrhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point 282 271 END DO 283 272 END DO 284 CALL lbc_lnk ( taum, 'T', 1. ) ; CALL lbc_lnk(tmod_io, 'T', 1. )273 CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 285 274 ! 286 275 utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step … … 303 292 END DO 304 293 END DO 305 CALL lbc_lnk( utau, 'U', -1. ) ; CALL lbc_lnk( vtau, 'V', -1. ) ! lateral boundary condition 306 ! 307 IF(ln_ctl) CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau : ', mask1=umask, & 308 & tab2d_2=vtau, clinfo2=' vtau : ' , mask2=vmask ) 294 CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. ) ! lateral boundary condition 295 ! 309 296 ! 310 297 END SUBROUTINE lim_sbc_tau … … 355 342 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 356 343 357 !!gm I really don't like this st aff here... Find a way to put that elsewhere or differently344 !!gm I really don't like this stuff here... Find a way to put that elsewhere or differently 358 345 !!gm 359 346 IF( .NOT.ln_linssh ) THEN -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r6416 r7309 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE ice ! LIM:sea-ice variables24 USE ice ! sea-ice variables 25 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 26 USE sbc_ice ! Surface boundary condition: ice fields 27 USE dom_ice ! LIM: sea-ice domain28 USE thd_ice ! LIM: thermodynamic sea-ice variables29 USE limthd_d if ! LIM: thermodynamics, vertical diffusion30 USE limthd_d h ! LIM: thermodynamics, ice and snow thickness variation31 USE limthd_sal ! LIM: thermodynamics,ice salinity32 USE limthd_ent ! LIM: thermodynamics,ice enthalpy redistribution33 USE limthd_lac ! LIM:lateral accretion34 USE limitd_th ! LIM:remapping thickness distribution35 USE limtab ! LIM:1D <==> 2D transformation36 USE limvar ! LIM: sea-ice variables37 USE limcons ! LIM:conservation tests38 USE limctl ! LIM:control print27 USE thd_ice ! thermodynamic sea-ice variables 28 USE limthd_dif ! vertical diffusion 29 USE limthd_dh ! ice-snow growth and melt 30 USE limthd_da ! lateral melting 31 USE limthd_sal ! ice salinity 32 USE limthd_ent ! ice enthalpy redistribution 33 USE limthd_lac ! lateral accretion 34 USE limitd_th ! remapping thickness distribution 35 USE limtab ! 1D <==> 2D transformation 36 USE limvar ! 37 USE limcons ! conservation tests 38 USE limctl ! control print 39 39 ! 40 40 USE in_out_manager ! I/O manager 41 USE prtctl ! Print control42 41 USE lbclnk ! lateral boundary condition - MPP links 43 42 USE lib_mpp ! MPP library … … 88 87 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 89 88 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 89 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io, zfric ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 90 ! 90 91 !!------------------------------------------------------------------- 91 92 92 93 IF( nn_timing == 1 ) CALL timing_start('limthd') 93 94 95 CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric ) 96 97 IF( kt == nit000 .AND. lwp ) THEN 98 WRITE(numout,*)'' 99 WRITE(numout,*)' lim_thd ' 100 WRITE(numout,*)' ~~~~~~~~' 101 ENDIF 102 94 103 ! conservation test 95 IF( ln_limdia hsb ) CALL lim_cons_hsm( 0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)104 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 96 105 97 106 CALL lim_var_glo2eqv 98 !------------------------------------------------------------------------! 99 ! 1) Initialization of some variables ! 100 !------------------------------------------------------------------------! 107 108 !---------------------------------------------! 109 ! computation of friction velocity at T points 110 !---------------------------------------------! 111 IF( ln_limdyn ) THEN 112 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 113 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 114 DO jj = 2, jpjm1 115 DO ji = fs_2, fs_jpim1 116 zfric(ji,jj) = rn_cio * ( 0.5_wp * & 117 & ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 118 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 119 END DO 120 END DO 121 ELSE ! if no ice dynamics => transmit directly the atmospheric stress to the ocean 122 DO jj = 2, jpjm1 123 DO ji = fs_2, fs_jpim1 124 zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp * & 125 & ( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 126 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 127 END DO 128 END DO 129 ENDIF 130 CALL lbc_lnk( zfric, 'T', 1. ) 131 ! 132 !----------------------------------! 133 ! Initialization and units change 134 !----------------------------------! 101 135 ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice 102 136 103 !--------------------104 ! 1.2) Heat content105 !--------------------106 137 ! Change the units of heat content; from J/m2 to J/m3 107 138 DO jl = 1, jpl … … 109 140 DO jj = 1, jpj 110 141 DO ji = 1, jpi 111 !0 if no ice and 1 if yes112 142 rswitch = MAX( 0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 ) ) 113 143 !Energy of melting q(S,T) [J.m-3] … … 119 149 DO jj = 1, jpj 120 150 DO ji = 1, jpi 121 !0 if no ice and 1 if yes122 151 rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) ) 123 152 !Energy of melting q(S,T) [J.m-3] … … 128 157 END DO 129 158 130 ! 2) Partial computation of forcing for the thermodynamic sea ice model. ! 131 !-----------------------------------------------------------------------------! 159 !--------------------------------------------------------------------! 160 ! Partial computation of forcing for the thermodynamic sea ice model 161 !--------------------------------------------------------------------! 132 162 DO jj = 1, jpj 133 163 DO ji = 1, jpi … … 148 178 149 179 ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 150 zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )180 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 151 181 fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 152 182 fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) … … 166 196 ENDIF 167 197 ! 168 ! ----------------------------------------- 169 ! Net heat flux on top of ice-ocean [W.m-2] 170 ! ----------------------------------------- 198 ! Net heat flux on top of the ice-ocean [W.m-2] 199 ! --------------------------------------------- 171 200 hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 172 173 ! ----------------------------------------------------------------------------- 174 ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 175 ! ----------------------------------------------------------------------------- 176 ! First step here : non solar + precip - qlead - qturb 177 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 178 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 201 END DO 202 END DO 203 204 ! In case we bypass open-water ice formation 205 IF( .NOT. ln_limdO ) qlead(:,:) = 0._wp 206 ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 207 IF( .NOT. ln_limdH ) hfx_in(:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 208 IF( .NOT. ln_limdH ) fhtur (:,:) = 0._wp ; fhld (:,:) = 0._wp 209 210 ! --------------------------------------------------------------------- 211 ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 212 ! --------------------------------------------------------------------- 213 ! First step here : non solar + precip - qlead - qturb 214 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 215 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 216 DO jj = 1, jpj 217 DO ji = 1, jpi 179 218 hfx_out(ji,jj) = pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) & ! Non solar heat flux received by the ocean 180 219 & - qlead(ji,jj) * r1_rdtice & ! heat flux taken from the ocean where there is open water ice formation … … 186 225 187 226 !------------------------------------------------------------------------------! 188 ! 3) Select icy points and fulfill arrays for the vectorial grid.227 ! Thermodynamic computation (only on grid points covered by ice) 189 228 !------------------------------------------------------------------------------! 190 229 191 230 DO jl = 1, jpl !loop over ice categories 192 231 193 IF( kt == nit000 .AND. lwp ) THEN 194 WRITE(numout,*) ' lim_thd : transfer to 1D vectors. Category no : ', jl 195 WRITE(numout,*) ' ~~~~~~~~' 196 ENDIF 197 232 ! select ice covered grid points 198 233 nbpb = 0 199 234 DO jj = 1, jpj … … 208 243 ! debug point to follow 209 244 jiindex_1d = 0 210 IF( ln_ icectl ) THEN245 IF( ln_limctl ) THEN 211 246 DO ji = mi0(iiceprt), mi1(iiceprt) 212 247 DO jj = mj0(jiceprt), mj1(jiceprt) … … 217 252 ENDIF 218 253 219 !------------------------------------------------------------------------------! 220 ! 4) Thermodynamic computation 221 !------------------------------------------------------------------------------! 222 223 IF( lk_mpp ) CALL mpp_ini_ice( nbpb , numout ) 254 IF( lk_mpp ) CALL mpp_ini_ice( nbpb , numout ) 224 255 225 256 IF( nbpb > 0 ) THEN ! If there is no ice, do nothing. 226 ! 227 CALL lim_thd_1d2d( nbpb, jl, 1 ) ! --- Move to 1D arrays ---! 228 ! 229 CALL lim_thd_dif ( 1, nbpb ) ! --- Ice/Snow Temperature profile --- ! 230 ! 231 CALL lim_thd_dh ( 1, nbpb ) ! --- Ice/Snow thickness ---! 232 ! 233 CALL lim_thd_ent ( 1, nbpb, q_i_1d(1:nbpb,:) ) ! --- Ice enthalpy remapping --- ! 234 ! 235 CALL lim_thd_sal ( 1, nbpb ) ! --- Ice salinity --- ! 236 ! 237 CALL lim_thd_temp( 1, nbpb ) ! --- temperature update --- ! 238 ! 239 ! ! --- lateral melting if monocat --- ! 240 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 241 CALL lim_thd_lam( 1, nbpb ) 257 ! 258 s_i_new (:) = 0._wp ; dh_s_tot (:) = 0._wp ! --- some init --- ! 259 dh_i_surf (:) = 0._wp ; dh_i_bott(:) = 0._wp 260 dh_snowice(:) = 0._wp ; dh_i_sub (:) = 0._wp 261 262 CALL lim_thd_1d2d( nbpb, jl, 1 ) ! --- Move to 1D arrays --- ! 263 ! 264 IF( ln_limdH ) CALL lim_thd_dif( 1, nbpb ) ! --- Ice/Snow Temperature profile --- ! 265 ! 266 IF( ln_limdH ) CALL lim_thd_dh( 1, nbpb ) ! --- Ice/Snow thickness --- ! 267 ! 268 IF( ln_limdH ) CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) ) ! --- Ice enthalpy remapping --- ! 269 ! 270 CALL lim_thd_sal( 1, nbpb ) ! --- Ice salinity --- ! 271 ! 272 CALL lim_thd_temp( 1, nbpb ) ! --- temperature update --- ! 273 ! 274 IF( ln_limdH ) THEN 275 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 276 CALL lim_thd_lam( 1, nbpb ) ! --- extra lateral melting if monocat --- ! 277 END IF 242 278 END IF 243 279 ! 244 CALL lim_thd_1d2d( nbpb, jl, 2 ) ! --- Move to 2D arrays ---245 ! 246 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice )!RB necessary ??280 CALL lim_thd_1d2d( nbpb, jl, 2 ) ! --- Move to 2D arrays --- ! 281 ! 282 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 247 283 ENDIF 248 284 ! 249 285 END DO !jl 250 286 251 !------------------------------------------------------------------------------! 252 ! 5) Global variables, diagnostics 253 !------------------------------------------------------------------------------! 254 255 !------------------------ 256 ! Ice heat content 257 !------------------------ 287 IF( ln_limdA) CALL lim_thd_da ! --- lateral melting --- ! 288 258 289 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 259 290 DO jl = 1, jpl … … 261 292 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 262 293 END DO 263 END DO264 265 !------------------------266 ! Snow heat content267 !------------------------268 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)269 DO jl = 1, jpl270 294 DO jk = 1, nlay_s 271 295 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s … … 273 297 END DO 274 298 275 !----------------------------------276 299 ! Change thickness to volume 277 !----------------------------------278 300 v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:) 279 301 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:) … … 292 314 CALL lim_var_zapsmall 293 315 294 !-------------------------------------------- 295 ! Diagnostic thermodynamic growth rates 296 !-------------------------------------------- 297 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' ) ! control print 298 299 IF(ln_ctl) THEN ! Control print 300 CALL prt_ctl_info(' ') 301 CALL prt_ctl_info(' - Cell values : ') 302 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 303 CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_thd : cell area :') 304 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd : at_i :') 305 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd : vt_i :') 306 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_thd : vt_s :') 307 DO jl = 1, jpl 308 CALL prt_ctl_info(' ') 309 CALL prt_ctl_info(' - Category : ', ivar1=jl) 310 CALL prt_ctl_info(' ~~~~~~~~~~') 311 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_thd : a_i : ') 312 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_thd : ht_i : ') 313 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_thd : ht_s : ') 314 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_thd : v_i : ') 315 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_thd : v_s : ') 316 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_thd : e_s : ') 317 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_thd : t_su : ') 318 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_thd : t_snow : ') 319 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_thd : sm_i : ') 320 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_thd : smv_i : ') 321 DO jk = 1, nlay_i 322 CALL prt_ctl_info(' ') 323 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 324 CALL prt_ctl_info(' ~~~~~~~') 325 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_thd : t_i : ') 326 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_thd : e_i : ') 327 END DO 328 END DO 329 ENDIF 330 ! 331 ! 332 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 333 334 !------------------------------------------------------------------------------| 335 ! 6) Transport of ice between thickness categories. | 336 !------------------------------------------------------------------------------| 316 ! control checks 317 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' ) ! control print 318 ! 319 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 320 321 !------------------------------------------------! 322 ! Transport ice between thickness categories 323 !------------------------------------------------! 337 324 ! Given thermodynamic growth rates, transport ice between thickness categories. 338 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)325 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 339 326 340 327 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 341 328 342 IF( ln_limdia hsb) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)343 344 !------------------------------------------------ ------------------------------|345 ! 7) Add frazil ice growing in leads.346 !------------------------------------------------ ------------------------------|347 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)348 349 CALL lim_thd_lac329 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 330 331 !------------------------------------------------! 332 ! Add frazil ice growing in leads 333 !------------------------------------------------! 334 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 335 336 IF( ln_limdO ) CALL lim_thd_lac 350 337 351 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 338 ! conservation test 339 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 352 340 353 341 ! Control print 354 IF(ln_ctl) THEN 355 CALL lim_var_glo2eqv 356 357 CALL prt_ctl_info(' ') 358 CALL prt_ctl_info(' - Cell values : ') 359 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 360 CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_th : cell area :') 361 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th : at_i :') 362 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th : vt_i :') 363 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th : vt_s :') 364 DO jl = 1, jpl 365 CALL prt_ctl_info(' ') 366 CALL prt_ctl_info(' - Category : ', ivar1=jl) 367 CALL prt_ctl_info(' ~~~~~~~~~~') 368 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_th : a_i : ') 369 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_th : ht_i : ') 370 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_th : ht_s : ') 371 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_th : v_i : ') 372 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_th : v_s : ') 373 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_th : e_s : ') 374 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_th : t_su : ') 375 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_th : t_snow : ') 376 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ') 377 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ') 378 DO jk = 1, nlay_i 379 CALL prt_ctl_info(' ') 380 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 381 CALL prt_ctl_info(' ~~~~~~~') 382 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ') 383 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ') 384 END DO 385 END DO 386 ENDIF 387 ! 388 IF( nn_timing == 1 ) CALL timing_stop('limthd') 389 ! 342 IF( ln_ctl ) CALL lim_prt3D( 'limthd' ) 343 ! 344 CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric ) 345 ! 346 IF( nn_timing == 1 ) CALL timing_stop('limthd') 347 390 348 END SUBROUTINE lim_thd 391 349 … … 449 407 zda_mel = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 450 408 a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel ) 451 409 ! adjust thickness 452 410 ht_i_1d(ji) = zvi / a_i_1d(ji) 453 411 ht_s_1d(ji) = zvs / a_i_1d(ji) … … 613 571 !!------------------------------------------------------------------- 614 572 INTEGER :: ios ! Local integer output status for namelist read 615 !!616 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,&617 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,&618 & nn_monocat, ln_it_qnsice573 NAMELIST/namicethd/ rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,ln_it_qnsice,nn_monocat, & 574 & ln_limdH, rn_betas, & 575 & ln_limdA, rn_beta, rn_dmin, & 576 & ln_limdO, rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, rn_himin 619 577 !!------------------------------------------------------------------- 620 !621 IF(lwp) THEN622 WRITE(numout,*)623 WRITE(numout,*) 'lim_thd : Ice Thermodynamics'624 WRITE(numout,*) '~~~~~~~'625 ENDIF626 578 ! 627 579 REWIND( numnam_ice_ref ) ! Namelist namicethd in reference namelist : Ice thermodynamics … … 642 594 IF(lwp) THEN ! control print 643 595 WRITE(numout,*) 644 WRITE(numout,*)' Namelist of ice parameters for ice thermodynamic computation ' 596 WRITE(numout,*) 'lim_thd_init : Ice Thermodynamics' 597 WRITE(numout,*) '~~~~~~~~~~~~~' 598 WRITE(numout,*)' -- limthd_dif --' 599 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i 600 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nn_conv_dif = ', nn_conv_dif 601 WRITE(numout,*)' maximal err. on T for heat diffusion computation rn_terr_dif = ', rn_terr_dif 602 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice nn_ice_thcon = ', nn_ice_thcon 603 WRITE(numout,*)' iterate the surface non-solar flux (T) or not (F) ln_it_qnsice = ', ln_it_qnsice 604 WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat 605 WRITE(numout,*)' -- limthd_dh --' 606 WRITE(numout,*)' activate ice thick change from top/bot (T) or not (F) ln_limdH = ', ln_limdH 607 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas 608 WRITE(numout,*)' -- limthd_da --' 609 WRITE(numout,*)' activate lateral melting (T) or not (F) ln_limdA = ', ln_limdA 610 WRITE(numout,*)' Coef. beta for lateral melting param. rn_beta = ', rn_beta 611 WRITE(numout,*)' Minimum floe diameter for lateral melting param. rn_dmin = ', rn_dmin 612 WRITE(numout,*)' -- limthd_lac --' 613 WRITE(numout,*)' activate ice growth in open-water (T) or not (F) ln_limdO = ', ln_limdO 645 614 WRITE(numout,*)' ice thick. for lateral accretion rn_hnewice = ', rn_hnewice 646 615 WRITE(numout,*)' Frazil ice thickness as a function of wind or not ln_frazil = ', ln_frazil … … 648 617 WRITE(numout,*)' Thresold relative drift speed for collection of frazil rn_vfrazb = ', rn_vfrazb 649 618 WRITE(numout,*)' Squeezing coefficient for collection of frazil rn_Cfrazb = ', rn_Cfrazb 619 WRITE(numout,*)' -- limitd_th --' 650 620 WRITE(numout,*)' minimum ice thickness rn_himin = ', rn_himin 651 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice '652 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas653 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i654 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nn_conv_dif = ', nn_conv_dif655 WRITE(numout,*)' maximal err. on T for heat diffusion computation rn_terr_dif = ', rn_terr_dif656 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice nn_ice_thcon = ', nn_ice_thcon657 621 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 658 WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat659 WRITE(numout,*)' iterate the surface non-solar flux (T) or not (F) ln_it_qnsice = ', ln_it_qnsice660 622 ENDIF 661 623 ! -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r6470 r7309 76 76 REAL(wp) :: zdum 77 77 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 78 REAL(wp) :: zs_snic ! snow-ice salinity79 78 REAL(wp) :: zswi1 ! switch for computation of bottom salinity 80 79 REAL(wp) :: zswi12 ! switch for computation of bottom salinity … … 116 115 117 116 ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 118 SELECT CASE( nn_icesal ) 117 SELECT CASE( nn_icesal ) ! varying salinity or not 119 118 CASE( 1, 3 ) ; zswitch_sal = 0 ! prescribed salinity profile 120 119 CASE( 2 ) ; zswitch_sal = 1 ! varying salinity profile … … 126 125 CALL wrk_alloc( jpij, nlay_i, icount ) 127 126 128 dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp ; dh_i_sub(:) = 0._wp129 dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp130 131 127 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt(:) = 0._wp 132 128 zq_rema (:) = 0._wp ; zsnw (:) = 0._wp ; zevap_rema(:) = 0._wp ; … … 135 131 zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp 136 132 icount (:,:) = 0 137 138 133 139 134 ! Initialize enthalpy at nlay_i+1 … … 618 613 hfx_out(ii,ij) = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 619 614 620 IF( ln_ icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)615 IF( ln_limctl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 621 616 END DO 622 617 … … 634 629 ht_s_1d(ji) = ht_s_1d(ji) - dh_snowice(ji) 635 630 636 ! Salinity of snow ice637 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1638 zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)639 640 ! entrapment during snow ice formation641 ! new salinity difference stored (to be used in limthd_sal.F90)642 IF ( nn_icesal == 2 ) THEN643 rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )644 ! salinity dif due to snow-ice formation645 dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch646 ! salinity dif due to bottom growth647 IF ( zf_tt(ji) < 0._wp ) THEN648 dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch649 ENDIF650 ENDIF651 652 631 ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 653 632 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 654 zfmdt = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp) ! <0633 zfmdt = ( rhosn - rhoic ) * dh_snowice(ji) ! <0 655 634 zsstK = sst_m(ii,ij) + rt0 656 635 zEw = rcp * ( zsstK - rt0 ) … … 662 641 ! Contribution to salt flux 663 642 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice 664 643 665 644 ! virtual salt flux to keep salinity constant 666 645 IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN 667 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice & ! put back sss_m into the ocean668 & - sm_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice ! and get sm_ifrom the ocean646 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice & ! put back sss_m into the ocean 647 & - sm_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice ! and get rn_icesal from the ocean 669 648 ENDIF 670 649 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r5512 r7309 734 734 END DO ! End of the do while iterative procedure 735 735 736 IF( ln_ icectl .AND. lwp ) THEN736 IF( ln_limctl .AND. lwp ) THEN 737 737 WRITE(numout,*) ' zerritmax : ', zerritmax 738 738 WRITE(numout,*) ' nconv : ', nconv -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r6416 r7309 21 21 USE sbc_ice ! Surface boundary condition: ice fields 22 22 USE thd_ice ! LIM thermodynamics 23 USE dom_ice ! LIM domain24 23 USE ice ! LIM variables 25 24 USE limtab ! LIM 2D <==> 1D … … 71 70 !! update ht_s_1d, ht_i_1d and tbif_1d(:,:) 72 71 !!------------------------------------------------------------------------ 73 INTEGER :: ji,jj,jk,jl ! dummy loop indices74 INTEGER :: nbpac ! local integers75 INTEGER :: ii, ij, iter ! - -76 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zde! local scalars72 INTEGER :: ji,jj,jk,jl ! dummy loop indices 73 INTEGER :: nbpac ! local integers 74 INTEGER :: ii, ij, iter ! - - 75 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zde ! local scalars 77 76 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf ! - - 78 77 REAL(wp) :: ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit ! - - … … 154 153 155 154 ! Default new ice thickness 156 WHERE( qlead(:,:) < 0._wp ) ; hicol = rn_hnewice157 ELSEWHERE ; hicol = 0._wp155 WHERE( qlead(:,:) < 0._wp ) ; hicol(:,:) = rn_hnewice 156 ELSEWHERE ; hicol(:,:) = 0._wp 158 157 END WHERE 159 158 … … 170 169 zgamafr = 0.03 171 170 172 DO jj = 2, jpj 173 DO ji = 2, jpi 174 IF ( qlead(ji,jj) < 0._wp ) THEN171 DO jj = 2, jpjm1 172 DO ji = 2, jpim1 173 IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast 175 174 !------------- 176 175 ! Wind stress … … 195 194 !------------------- 196 195 ! C-grid ice velocity 197 rswitch = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) ) ) 198 zvgx = rswitch * ( u_ice(ji-1,jj ) * umask(ji-1,jj ,1) + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 199 zvgy = rswitch * ( v_ice(ji ,jj-1) * vmask(ji ,jj-1,1) + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 196 zvgx = ( u_ice(ji-1,jj ) * umask(ji-1,jj ,1) + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 197 zvgy = ( v_ice(ji ,jj-1) * vmask(ji ,jj-1,1) + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 200 198 201 199 !----------------------------------- … … 203 201 !----------------------------------- 204 202 ! absolute relative velocity 205 zvrel2 = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) & 206 & + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) 203 rswitch = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 204 zvrel2 = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) & 205 & + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch 207 206 zvrel(ji,jj) = SQRT( zvrel2 ) 208 207 … … 219 218 zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0 * hicol(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2 220 219 221 hicol(ji,jj) = hicol(ji,jj) - zf /zfp220 hicol(ji,jj) = hicol(ji,jj) - zf / MAX( zfp, epsi20 ) 222 221 iter = iter + 1 223 222 END DO … … 228 227 END DO 229 228 ! 230 CALL lbc_lnk( zvrel (:,:), 'T', 1. )231 CALL lbc_lnk( hicol (:,:), 'T', 1. )229 CALL lbc_lnk( zvrel, 'T', 1. ) 230 CALL lbc_lnk( hicol, 'T', 1. ) 232 231 233 232 ENDIF ! End of computation of frazil ice collection thickness … … 240 239 ! Select points for new ice formation 241 240 !------------------------------------- 242 ! This occurs if open water energy budget is negative 241 ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice 243 242 nbpac = 0 244 243 npac(:) = 0 … … 246 245 DO jj = 1, jpj 247 246 DO ji = 1, jpi 248 IF ( qlead(ji,jj) < 0._wp ) THEN247 IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN 249 248 nbpac = nbpac + 1 250 249 npac( nbpac ) = (jj - 1) * jpi + ji … … 255 254 ! debug point to follow 256 255 jiindex_1d = 0 257 IF( ln_ icectl ) THEN256 IF( ln_limctl ) THEN 258 257 DO ji = mi0(iiceprt), mi1(iiceprt) 259 258 DO jj = mj0(jiceprt), mj1(jiceprt) … … 265 264 ENDIF 266 265 267 IF( ln_ icectl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac266 IF( ln_limctl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 268 267 269 268 !------------------------------ -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r6470 r7309 51 51 INTEGER, INTENT(in) :: kideb, kiut ! thickness category index 52 52 ! 53 INTEGER :: ji, jk ! dummy loop indices 54 REAL(wp) :: iflush, igravdr ! local scalars 53 INTEGER :: ii, ij, ji, jk ! dummy loop indices 54 REAL(wp) :: iflush, igravdr ! local scalars 55 REAL(wp) :: zs_sni, zsm_i_gd, zsm_i_fl, zsm_i_si, zsm_i_bg ! local scalars 55 56 !!--------------------------------------------------------------------- 56 57 57 !---------------------------------------------------------58 ! 0) Update ice salinity from snow-ice and bottom growth59 !---------------------------------------------------------60 DO ji = kideb, kiut61 sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji)62 END DO63 64 58 !--------------------------------------------------------------------| 65 59 ! 1) salinity constant in time | … … 73 67 74 68 DO ji = kideb, kiut 75 !76 ! Switches77 !----------78 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 ) ) ! =1 if summer79 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) ) ! =1 if t_su < t_bo80 69 81 !--------------------- 82 ! Salinity tendencies 83 !--------------------- 84 ! drainage by gravity drainage 85 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice 86 ! drainage by flushing 87 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice 70 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 71 !--------------------------------------------------------- 72 ! Update ice salinity from snow-ice and bottom growth 73 !--------------------------------------------------------- 74 zs_sni = sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic ! Salinity of snow ice 75 rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 76 zsm_i_si = ( zs_sni - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! snow-ice 77 zsm_i_bg = ( s_i_new(ji) - sm_i_1d(ji) ) * MAX( 0._wp, dh_i_bott(ji) ) / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! bottom growth 88 78 89 !----------------- 90 ! Update salinity 91 !----------------- 92 ! only drainage terms ( gravity drainage and flushing ) 93 ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 94 sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 79 ! Update salinity (nb: salt flux already included in limthd_dh) 80 sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_bg + zsm_i_si 95 81 96 !---------------------------- 97 ! Salt flux - brine drainage 98 !---------------------------- 99 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 100 82 IF( ln_limdS ) THEN 83 !--------------------------------------------------------- 84 ! Update ice salinity from brine drainage and flushing 85 !--------------------------------------------------------- 86 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 ) ) ! =1 if summer 87 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) ) ! =1 if t_su < t_bo 88 zsm_i_gd = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice ! gravity drainage 89 zsm_i_fl = - iflush * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice ! flushing 90 91 ! Update salinity 92 sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_fl + zsm_i_gd 93 94 ! Salt flux 95 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( zsm_i_fl + zsm_i_gd ) * r1_rdtice 96 ENDIF 101 97 END DO 102 98 … … 127 123 !!------------------------------------------------------------------- 128 124 INTEGER :: ios ! Local integer output status for namelist read 129 NAMELIST/namicesal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl, &130 & rn_s imax, rn_simin125 NAMELIST/namicesal/ ln_limdS, nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, & 126 & rn_sal_fl, rn_time_fl, rn_simax, rn_simin 131 127 !!------------------------------------------------------------------- 132 128 ! … … 144 140 WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity ' 145 141 WRITE(numout,*) '~~~~~~~~~~~~~~~~' 146 WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal 147 WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 = ', rn_icesal 148 WRITE(numout,*) ' restoring salinity for GD = ', rn_sal_gd 149 WRITE(numout,*) ' restoring time for GD = ', rn_time_gd 150 WRITE(numout,*) ' restoring salinity for flushing = ', rn_sal_fl 151 WRITE(numout,*) ' restoring time for flushing = ', rn_time_fl 152 WRITE(numout,*) ' Maximum tolerated ice salinity = ', rn_simax 153 WRITE(numout,*) ' Minimum tolerated ice salinity = ', rn_simin 142 WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_limdS = ', ln_limdS 143 WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal 144 WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 rn_icesal = ', rn_icesal 145 WRITE(numout,*) ' restoring salinity for gravity drainage rn_sal_gd = ', rn_sal_gd 146 WRITE(numout,*) ' restoring time for for gravity drainage rn_time_gd = ', rn_time_gd 147 WRITE(numout,*) ' restoring salinity for flushing rn_sal_fl = ', rn_sal_fl 148 WRITE(numout,*) ' restoring time for flushing rn_time_fl = ', rn_time_fl 149 WRITE(numout,*) ' Maximum tolerated ice salinity rn_simax = ', rn_simax 150 WRITE(numout,*) ' Minimum tolerated ice salinity rn_simin = ', rn_simin 154 151 ENDIF 155 152 ! -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r6490 r7309 17 17 USE dom_oce ! ocean domain 18 18 USE sbc_oce ! ocean surface boundary condition 19 USE dom_ice ! ice domain20 19 USE ice ! ice variables 21 USE limadv ! ice advection22 20 USE limhdf ! ice horizontal diffusion 23 21 USE limvar ! 22 USE limadv_prather ! advection scheme (Prather) 23 USE limadv_umx ! advection scheme (ultimate-macho) 24 24 ! 25 25 USE in_out_manager ! I/O manager … … 57 57 !! ** method : variables included in the process are scalar, 58 58 !! other values are considered as second order. 59 !! For advection, a second order Prather scheme is used. 59 !! For advection, one can choose between 60 !! a) an Ultimate-Macho scheme (whose order is defined by nn_limadv_ord) => nn_limadv=0 61 !! b) and a second order Prather scheme => nn_limadv=-1 60 62 !! 61 63 !! ** action : 62 64 !!--------------------------------------------------------------------- 63 INTEGER, INTENT(in) :: kt 65 INTEGER, INTENT(in) :: kt ! number of iteration 64 66 ! 65 INTEGER :: ji, jj, jk, jm , jl, jt! dummy loop indices67 INTEGER :: ji, jj, jk, jm, jl, jt ! dummy loop indices 66 68 INTEGER :: initad ! number of sub-timestep for the advection 67 69 REAL(wp) :: zcfl , zusnit ! - - 68 CHARACTER(len=80) :: 70 CHARACTER(len=80) :: cltmp 69 71 ! 70 REAL(wp), POINTER, DIMENSION(:,:) :: zsm 72 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 73 REAL(wp) :: zdv, zda 74 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold, zsmvold 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax, zviold, zvsold 76 ! --- diffusion --- ! 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhdfptab 78 INTEGER , PARAMETER :: ihdf_vars = 6 ! Number of variables in which we apply horizontal diffusion 79 ! inside limtrp for each ice category , not counting the 80 ! variables corresponding to ice_layers 81 ! --- ultimate macho only --- ! 82 REAL(wp) :: zdt 83 REAL(wp), POINTER, DIMENSION(:,:) :: zudy, zvdx, zcu_box, zcv_box 84 ! --- prather only --- ! 85 REAL(wp), POINTER, DIMENSION(:,:) :: zarea 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0opw 71 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0ice, z0snw, z0ai, z0es , z0smi , z0oi 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0opw73 88 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: z0ei 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume... 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax ! old ice thickness 76 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold ! old concentration, enthalpies 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhdfptab 78 REAL(wp) :: zdv, zvi, zvs, zsmv, zes, zei 79 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 80 !!--------------------------------------------------------------------- 81 INTEGER :: ihdf_vars = 6 !!Number of variables in which we apply horizontal diffusion 82 !! inside limtrp for each ice category , not counting the 83 !! variables corresponding to ice_layers 89 !! 84 90 !!--------------------------------------------------------------------- 85 91 IF( nn_timing == 1 ) CALL timing_start('limtrp') 86 92 87 CALL wrk_alloc( jpi,jpj, zsm, zatold, zeiold, zesold ) 88 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 89 CALL wrk_alloc( jpi,jpj,1, z0opw ) 90 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 91 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold, zsmvold ) 92 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1,zhdfptab) 93 94 IF( numit == nstart .AND. lwp ) THEN 95 WRITE(numout,*) 96 IF( ln_limdyn ) THEN ; WRITE(numout,*) 'lim_trp : Ice transport ' 97 ELSE ; WRITE(numout,*) 'lim_trp : No ice advection as ln_limdyn = ', ln_limdyn 98 ENDIF 99 WRITE(numout,*) '~~~~~~~~~~~~' 93 CALL wrk_alloc( jpi,jpj, zatold, zeiold, zesold, zsmvold ) 94 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold ) 95 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab) 96 97 IF( kt == nit000 .AND. lwp ) THEN 98 WRITE(numout,*)'' 99 WRITE(numout,*)'limtrp' 100 WRITE(numout,*)'~~~~~~' 100 101 ncfl = 0 ! nb of time step with CFL > 1/2 101 102 ENDIF 102 103 zsm(:,:) = e1e2t(:,:) 104 105 ! !-------------------------------------! 106 IF( ln_limdyn ) THEN ! Advection of sea ice properties ! 107 ! !-------------------------------------! 108 109 ! conservation test 110 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 111 112 ! mass and salt flux init 113 zviold(:,:,:) = v_i(:,:,:) 114 zvsold(:,:,:) = v_s(:,:,:) 115 zsmvold(:,:,:) = smv_i(:,:,:) 116 zeiold(:,:) = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 117 zesold(:,:) = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 118 119 !--- Thickness correction init. ------------------------------- 120 zatold(:,:) = SUM( a_i(:,:,:), dim=3 ) 121 DO jl = 1, jpl 122 DO jj = 1, jpj 123 DO ji = 1, jpi 124 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 125 ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 126 ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 103 104 CALL lim_var_agg( 1 ) ! integrated values + ato_i 105 106 !-------------------------------------! 107 ! Advection of sea ice properties ! 108 !-------------------------------------! 109 110 ! conservation test 111 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 112 113 ! store old values for diag 114 zviold = v_i 115 zvsold = v_s 116 zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 ) 117 zeiold (:,:) = et_i 118 zesold (:,:) = et_s 119 120 !--- Thickness correction init. --- ! 121 zatold(:,:) = at_i 122 DO jl = 1, jpl 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 126 ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 127 ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 128 END DO 129 END DO 130 END DO 131 ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- ! 132 zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 133 DO jl = 1, jpl 134 DO jj = 2, jpjm1 135 DO ji = 2, jpim1 136 zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) ) 137 END DO 138 END DO 139 CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 140 END DO 141 142 ! --- If ice drift field is too fast, use an appropriate time step for advection --- ! 143 zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) ! CFL test for stability 144 zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 145 IF( lk_mpp ) CALL mpp_max( zcfl ) 146 147 IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 148 ELSE ; initad = 1 ; zusnit = 1.0_wp 149 ENDIF 150 151 !! IF( zcfl > 0.5_wp .AND. lwp ) THEN 152 !! ncfl = ncfl + 1 153 !! IF( ncfl > 0 ) THEN 154 !! WRITE(cltmp,'(i6.1)') ncfl 155 !! CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 156 !! ENDIF 157 !! ENDIF 158 159 SELECT CASE ( nn_limadv ) 160 161 !=============================! 162 CASE ( 0 ) !== Ultimate-MACHO scheme ==! 163 !=============================! 164 165 CALL wrk_alloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) 166 167 IF( kt == nit000 .AND. lwp ) THEN 168 WRITE(numout,*)'' 169 WRITE(numout,*)'lim_adv_umx : Ultimate-MACHO advection scheme' 170 WRITE(numout,*)'~~~~~~~~~~~' 171 ENDIF 172 ! 173 zdt = rdt_ice / REAL(initad) 174 175 ! transport 176 zudy(:,:) = u_ice(:,:) * e2u(:,:) 177 zvdx(:,:) = v_ice(:,:) * e1v(:,:) 178 179 ! define velocity for advection: u*grad(H) 180 DO jj = 2, jpjm1 181 DO ji = fs_2, fs_jpim1 182 IF ( u_ice(ji,jj) * u_ice(ji-1,jj) <= 0._wp ) THEN ; zcu_box(ji,jj) = 0._wp 183 ELSEIF( u_ice(ji,jj) > 0._wp ) THEN ; zcu_box(ji,jj) = u_ice(ji-1,jj) 184 ELSE ; zcu_box(ji,jj) = u_ice(ji ,jj) 185 ENDIF 186 187 IF ( v_ice(ji,jj) * v_ice(ji,jj-1) <= 0._wp ) THEN ; zcv_box(ji,jj) = 0._wp 188 ELSEIF( v_ice(ji,jj) > 0._wp ) THEN ; zcv_box(ji,jj) = v_ice(ji,jj-1) 189 ELSE ; zcv_box(ji,jj) = v_ice(ji,jj ) 190 ENDIF 191 END DO 192 END DO 193 194 ! advection 195 DO jt = 1, initad 196 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, ato_i(:,:) ) ! Open water area 197 DO jl = 1, jpl 198 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, a_i(:,:,jl) ) ! Ice area 199 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_i(:,:,jl) ) ! Ice volume 200 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, smv_i(:,:,jl) ) ! Salt content 201 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, oa_i (:,:,jl) ) ! Age content 202 DO jk = 1, nlay_i 203 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_i(:,:,jk,jl) ) ! Ice heat content 127 204 END DO 128 END DO 129 END DO 130 !--------------------------------------------------------------------- 131 ! Record max of the surrounding ice thicknesses for correction 132 ! in case advection creates ice too thick. 133 !--------------------------------------------------------------------- 134 zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 135 DO jl = 1, jpl 136 DO jj = 2, jpjm1 137 DO ji = 2, jpim1 138 zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) ) 139 END DO 140 END DO 141 CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 142 END DO 143 144 !=============================! 145 !== Prather scheme ==! 146 !=============================! 147 148 ! If ice drift field is too fast, use an appropriate time step for advection. 149 zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) ! CFL test for stability 150 zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 151 IF(lk_mpp ) CALL mpp_max( zcfl ) 152 153 IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 154 ELSE ; initad = 1 ; zusnit = 1.0_wp 205 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_s(:,:,jl) ) ! Snow volume 206 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_s(:,:,1,jl) ) ! Snow heat content 207 END DO 208 END DO 209 ! 210 at_i(:,:) = a_i(:,:,1) ! total ice fraction 211 DO jl = 2, jpl 212 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 213 END DO 214 ! 215 CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) 216 217 !=============================! 218 CASE ( -1 ) !== Prather scheme ==! 219 !=============================! 220 221 CALL wrk_alloc( jpi,jpj, zarea ) 222 CALL wrk_alloc( jpi,jpj,1, z0opw ) 223 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 224 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 225 226 IF( kt == nit000 .AND. lwp ) THEN 227 WRITE(numout,*)'' 228 WRITE(numout,*)'lim_adv_xy : Prather advection scheme' 229 WRITE(numout,*)'~~~~~~~~~~~' 155 230 ENDIF 156 157 IF( zcfl > 0.5_wp .AND. lwp ) ncfl = ncfl + 1 158 !! IF( lwp ) THEN 159 !! IF( ncfl > 0 ) THEN 160 !! WRITE(cltmp,'(i6.1)') ncfl 161 !! CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 162 !! ELSE 163 !! ! WRITE(numout,*) 'lim_trp : CFL criterion for ice advection is always smaller than 1/2 ' 164 !! ENDIF 165 !! ENDIF 166 231 232 zarea(:,:) = e1e2t(:,:) 233 167 234 !------------------------- 168 235 ! transported fields … … 176 243 z0oi (:,:,jl) = oa_i (:,:, jl) * e1e2t(:,:) ! Age content 177 244 z0es (:,:,jl) = e_s (:,:,1,jl) * e1e2t(:,:) ! Snow heat content 178 DO jk = 1, nlay_i245 DO jk = 1, nlay_i 179 246 z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 180 247 END DO … … 184 251 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! 185 252 DO jt = 1, initad 186 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area187 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )188 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0opw (:,:,1), sxopw(:,:), &189 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )253 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area 254 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 255 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:), & 256 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 190 257 DO jl = 1, jpl 191 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---192 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )193 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0ice (:,:,jl), sxice(:,:,jl), &194 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )195 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---196 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )197 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0snw (:,:,jl), sxsn (:,:,jl), &198 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )199 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---200 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )201 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0smi (:,:,jl), sxsal(:,:,jl), &202 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )203 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---204 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )205 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0oi (:,:,jl), sxage(:,:,jl), &206 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )207 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---208 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )209 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0ai (:,:,jl), sxa (:,:,jl), &210 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )211 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---212 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )213 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0es (:,:,jl), sxc0 (:,:,jl), &214 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )258 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume --- 259 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 260 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & 261 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 262 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 263 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 264 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & 265 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 266 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 267 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 268 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & 269 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 270 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 271 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 272 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & 273 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 274 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 275 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 276 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & 277 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 278 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 279 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 280 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0es (:,:,jl), sxc0 (:,:,jl), & 281 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 215 282 DO jk = 1, nlay_i !--- ice heat contents --- 216 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &217 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), &218 & syye(:,:,jk,jl), sxye(:,:,jk,jl) )219 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &220 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), &221 & syye(:,:,jk,jl), sxye(:,:,jk,jl) )283 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), & 284 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 285 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 286 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), & 287 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 288 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 222 289 END DO 223 290 END DO … … 225 292 ELSE 226 293 DO jt = 1, initad 227 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area228 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )229 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0opw (:,:,1), sxopw(:,:), &230 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )294 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area 295 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 296 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:), & 297 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 231 298 DO jl = 1, jpl 232 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---233 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )234 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0ice (:,:,jl), sxice(:,:,jl), &235 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )236 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---237 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )238 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0snw (:,:,jl), sxsn (:,:,jl), &239 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )240 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---241 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )242 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0smi (:,:,jl), sxsal(:,:,jl), &243 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )244 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---245 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )246 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0oi (:,:,jl), sxage(:,:,jl), &247 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )248 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---249 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )250 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0ai (:,:,jl), sxa (:,:,jl), &251 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )252 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---253 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )254 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0es (:,:,jl), sxc0 (:,:,jl), &255 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )299 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume --- 300 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 301 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & 302 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 303 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 304 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 305 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & 306 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 307 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 308 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 309 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & 310 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 311 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 312 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 313 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & 314 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 315 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 316 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 317 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & 318 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 319 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 320 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 321 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0es (:,:,jl), sxc0 (:,:,jl), & 322 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 256 323 DO jk = 1, nlay_i !--- ice heat contents --- 257 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &258 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), &259 & syye(:,:,jk,jl), sxye(:,:,jk,jl) )260 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &261 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), &262 & syye(:,:,jk,jl), sxye(:,:,jk,jl) )324 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), & 325 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 326 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 327 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), & 328 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 329 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 263 330 END DO 264 331 END DO … … 286 353 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 287 354 END DO 288 289 !------------------------------------------------------------------------------! 290 ! Diffusion of Ice fields 291 !------------------------------------------------------------------------------! 292 !------------------------------------ 293 ! Diffusion of other ice variables 294 !------------------------------------ 355 356 CALL wrk_dealloc( jpi,jpj, zarea ) 357 CALL wrk_dealloc( jpi,jpj,1, z0opw ) 358 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 359 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 360 361 END SELECT 362 363 !------------------------------! 364 ! Diffusion of Ice fields 365 !------------------------------! 366 IF( nn_ahi0 /= -1 .AND. nn_limdyn == 2 ) THEN 367 ! 368 ! --- Prepare diffusion for variables with categories --- ! 369 ! mask eddy diffusivity coefficient at ocean U- and V-points 295 370 jm=1 296 371 DO jl = 1, jpl 297 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points298 ! DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row299 ! DO ji = 1 , fs_jpim1 ! vector opt.300 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj,jl) ) ) ) &301 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)302 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj ,jl) ) ) ) &303 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)304 ! END DO305 ! END DO306 372 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 307 DO ji = 1 , fs_jpim1 ! vector opt.373 DO ji = 1 , fs_jpim1 308 374 pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj, jl ) ) ) ) & 309 375 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj, jl ) ) ) ) * ahiu(ji,jj) … … 313 379 END DO 314 380 315 zhdfptab(:,:,jm)= a_i (:,:, jl); jm = jm + 1 381 zhdfptab(:,:,jm)= a_i (:,:, jl); jm = jm + 1 316 382 zhdfptab(:,:,jm)= v_i (:,:, jl); jm = jm + 1 317 zhdfptab(:,:,jm)= v_s (:,:, jl); jm = jm + 1 383 zhdfptab(:,:,jm)= v_s (:,:, jl); jm = jm + 1 318 384 zhdfptab(:,:,jm)= smv_i(:,:, jl); jm = jm + 1 319 385 zhdfptab(:,:,jm)= oa_i (:,:, jl); jm = jm + 1 320 386 zhdfptab(:,:,jm)= e_s (:,:,1,jl); jm = jm + 1 321 ! Sample of adding more variables to apply lim_hdf using lim_hdf optimization--- 322 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 323 ! zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 324 ! 325 ! and in this example the parameter ihdf_vars musb be changed to 8 (necessary for allocation) 326 !---------------------------------------------------------------------------------------- 387 ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 388 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 389 ! zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 327 390 DO jk = 1, nlay_i 328 391 zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 329 392 END DO 330 393 END DO 331 ! 332 !-------------------------------- 333 ! diffusion of open water area 334 !-------------------------------- 335 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 336 !DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 337 ! DO ji = 1 , fs_jpim1 ! vector opt. 338 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 339 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 340 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) & 341 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 342 ! END DO 343 !END DO 344 394 395 ! --- Prepare diffusion for open water area --- ! 396 ! mask eddy diffusivity coefficient at ocean U- and V-points 345 397 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 346 DO ji = 1 , fs_jpim1 ! vector opt.398 DO ji = 1 , fs_jpim1 347 399 pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 348 400 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) … … 353 405 ! 354 406 zhdfptab(:,:,jm)= ato_i (:,:); 355 CALL lim_hdf( zhdfptab, ihdf_vars, jpl, nlay_i) 356 407 408 ! --- Apply diffusion --- ! 409 CALL lim_hdf( zhdfptab, ihdf_vars ) 410 411 ! --- Recover properties --- ! 357 412 jm=1 358 413 DO jl = 1, jpl 359 a_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 360 v_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 361 v_s (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 362 smv_i(:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 363 oa_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 364 e_s (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 365 ! Sample of adding more variables to apply lim_hdf--------- 366 ! variable_1 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 367 ! variable_2 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 368 !----------------------------------------------------------- 414 a_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 415 v_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 416 v_s (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 417 smv_i(:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 418 oa_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 419 e_s (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 420 ! Sample of adding more variables to apply lim_hdf 421 ! variable_1 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 422 ! variable_2 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 369 423 DO jk = 1, nlay_i 370 e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 371 END DO 372 END DO 373 424 e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 425 END DO 426 END DO 374 427 ato_i (:,:) = zhdfptab(:,:,jm) 375 376 !------------------------------------------------------------------------------! 377 ! limit ice properties after transport 378 !------------------------------------------------------------------------------! 379 !!gm & cr : MAX should not be active if adv scheme is positive ! 428 429 ENDIF 430 431 ! --- diags --- 432 DO jj = 1, jpj 433 DO ji = 1, jpi 434 diag_trp_ei (ji,jj) = ( SUM( e_i (ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 435 diag_trp_es (ji,jj) = ( SUM( e_s (ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 436 diag_trp_smv(ji,jj) = ( SUM( smv_i(ji,jj,:) ) - zsmvold(ji,jj) ) * r1_rdtice 437 diag_trp_vi (ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice 438 diag_trp_vs (ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice 439 END DO 440 END DO 441 442 IF( nn_limdyn == 2) THEN 443 444 ! zap small areas 445 CALL lim_var_zapsmall 446 447 !--- Thickness correction in case too high --- ! 380 448 DO jl = 1, jpl 381 449 DO jj = 1, jpj 382 450 DO ji = 1, jpi 383 v_s (ji,jj,jl) = MAX( 0._wp, v_s (ji,jj,jl) ) 384 v_i (ji,jj,jl) = MAX( 0._wp, v_i (ji,jj,jl) ) 385 smv_i(ji,jj,jl) = MAX( 0._wp, smv_i(ji,jj,jl) ) 386 oa_i (ji,jj,jl) = MAX( 0._wp, oa_i (ji,jj,jl) ) 387 a_i (ji,jj,jl) = MAX( 0._wp, a_i (ji,jj,jl) ) 388 e_s (ji,jj,1,jl) = MAX( 0._wp, e_s (ji,jj,1,jl) ) 389 END DO 390 END DO 391 392 DO jk = 1, nlay_i 393 DO jj = 1, jpj 394 DO ji = 1, jpi 395 e_i(ji,jj,jk,jl) = MAX( 0._wp, e_i(ji,jj,jk,jl) ) 396 END DO 397 END DO 398 END DO 399 END DO 400 !!gm & cr 401 402 ! --- diags --- 403 DO jj = 1, jpj 404 DO ji = 1, jpi 405 diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 406 diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 407 408 diag_trp_vi (ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice 409 diag_trp_vs (ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice 410 diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice 411 END DO 412 END DO 413 414 ! zap small areas 415 CALL lim_var_zapsmall 416 417 !--- Thickness correction in case too high -------------------------------------------------------- 418 DO jl = 1, jpl 419 DO jj = 1, jpj 420 DO ji = 1, jpi 421 451 422 452 IF ( v_i(ji,jj,jl) > 0._wp ) THEN 423 453 424 454 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 425 455 ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 426 456 ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 427 457 428 zvi = v_i (ji,jj,jl)429 zvs = v_s (ji,jj,jl)430 zsmv = smv_i(ji,jj,jl)431 zes = e_s (ji,jj,1,jl)432 zei = SUM( e_i(ji,jj,1:nlay_i,jl) )433 434 458 zdv = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl) 435 459 436 460 IF ( ( zdv > 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. & 437 461 & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN 438 462 439 463 rswitch = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) ) 440 464 a_i(ji,jj,jl) = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 ) 441 465 442 466 ! small correction due to *rswitch for a_i 443 467 v_i (ji,jj,jl) = rswitch * v_i (ji,jj,jl) … … 446 470 e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl) 447 471 e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl) 448 449 ! Update mass fluxes 450 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 451 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 452 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 453 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0 454 hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * r1_rdtice ! W.m-2 <0 455 472 456 473 ENDIF 457 474 458 475 ENDIF 459 476 460 477 END DO 461 478 END DO … … 463 480 ! ------------------------------------------------- 464 481 465 !-------------------------------------- 466 ! Impose a_i < amax in mono-category 467 !-------------------------------------- 468 ! 469 IF ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) THEN ! simple conservative piling, comparable with LIM2 470 DO jj = 1, jpj 471 DO ji = 1, jpi 472 a_i(ji,jj,1) = MIN( a_i(ji,jj,1), rn_amax_2d(ji,jj) ) 473 END DO 474 END DO 475 ENDIF 476 477 ! --- agglomerate variables ----------------- 478 vt_i (:,:) = 0._wp 479 vt_s (:,:) = 0._wp 480 at_i (:,:) = 0._wp 482 ! Force the upper limit of ht_i to always be < hi_max (99 m). 483 DO jj = 1, jpj 484 DO ji = 1, jpi 485 rswitch = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) ) 486 ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) ) 487 a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch 488 END DO 489 END DO 490 491 ENDIF 492 493 !------------------------------------------------------------ 494 ! Impose a_i < amax if no ridging/rafting or in mono-category 495 !------------------------------------------------------------ 496 ! 497 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 498 IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 481 499 DO jl = 1, jpl 482 500 DO jj = 1, jpj 483 501 DO ji = 1, jpi 484 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) 485 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) 486 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 502 rswitch = MAX( 0._wp, SIGN( 1._wp, at_i(ji,jj) - epsi20 ) ) 503 zda = rswitch * MIN( rn_amax_2d(ji,jj) - at_i(ji,jj), 0._wp ) & 504 & * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi20 ) 505 a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda 487 506 END DO 488 507 END DO 489 508 END DO 490 491 ! --- open water = 1 if at_i=0 --------------------------------492 DO jj = 1, jpj493 DO ji = 1, jpi494 rswitch = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )495 ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)496 END DO497 END DO498 499 ! conservation test500 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)501 502 509 ENDIF 503 510 511 ! --- agglomerate variables ----------------- 512 vt_i(:,:) = SUM( v_i(:,:,:), dim=3 ) 513 vt_s(:,:) = SUM( v_s(:,:,:), dim=3 ) 514 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 515 516 ! --- open water = 1 if at_i=0 -------------------------------- 517 WHERE( at_i == 0._wp ) ato_i = 1._wp 518 519 ! conservation test 520 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 521 504 522 ! ------------------------------------------------- 505 523 ! control prints 506 524 ! ------------------------------------------------- 507 IF( ln_ icectl ) CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' )525 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 508 526 ! 509 CALL wrk_dealloc( jpi,jpj, zsm, zatold, zeiold, zesold ) 510 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 511 CALL wrk_dealloc( jpi,jpj,1, z0opw ) 512 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 513 CALL wrk_dealloc( jpi,jpj,jpl, zviold, zvsold, zhimax, zsmvold ) 514 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars+nlay_i)+1,zhdfptab) 527 CALL wrk_dealloc( jpi,jpj, zatold, zeiold, zesold, zsmvold ) 528 CALL wrk_dealloc( jpi,jpj,jpl, zhimax, zviold, zvsold ) 529 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab) 515 530 ! 516 531 IF( nn_timing == 1 ) CALL timing_stop('limtrp') 517 532 ! 518 533 END SUBROUTINE lim_trp 519 534 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r6403 r7309 15 15 USE sbc_oce ! Surface boundary condition: ocean fields 16 16 USE sbc_ice ! Surface boundary condition: ice fields 17 USE dom_ice18 17 USE dom_oce 19 18 USE phycst ! physical constants … … 22 21 USE limitd_th 23 22 USE limvar 24 USE prtctl ! Print control25 23 USE wrk_nemo ! work arrays 26 24 USE timing ! Timing 27 25 USE limcons ! conservation tests 26 USE limctl ! control prints 28 27 USE lib_mpp ! MPP library 29 28 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 59 58 IF( nn_timing == 1 ) CALL timing_start('limupdate1') 60 59 61 IF( ln_limdyn ) THEN62 63 60 IF( kt == nit000 .AND. lwp ) THEN 64 WRITE(numout,*) ' lim_update1 ' 65 WRITE(numout,*) ' ~~~~~~~~~~~ ' 61 WRITE(numout,*)'' 62 WRITE(numout,*)' lim_update1 ' 63 WRITE(numout,*)' ~~~~~~~~~~~ ' 66 64 ENDIF 67 65 68 66 ! conservation test 69 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)67 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 70 68 71 69 !---------------------------------------------------- … … 137 135 138 136 ! conservation test 139 IF( ln_limdia hsb) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)137 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 140 138 141 ! -------------------------------------------------142 139 ! control prints 143 ! ------------------------------------------------- 144 IF(ln_ctl) THEN ! Control print 145 CALL prt_ctl_info(' ') 146 CALL prt_ctl_info(' - Cell values : ') 147 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 148 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_update1 : cell area :') 149 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update1 : at_i :') 150 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update1 : vt_i :') 151 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_update1 : vt_s :') 152 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_update1 : strength :') 153 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update1 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 154 CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update1 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :') 140 IF( ln_ctl ) CALL lim_prt3D( 'limupdate1' ) 141 142 IF( nn_timing == 1 ) CALL timing_stop('limupdate1') 155 143 156 DO jl = 1, jpl 157 CALL prt_ctl_info(' ') 158 CALL prt_ctl_info(' - Category : ', ivar1=jl) 159 CALL prt_ctl_info(' ~~~~~~~~~~') 160 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_update1 : ht_i : ') 161 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_update1 : ht_s : ') 162 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_update1 : t_su : ') 163 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_update1 : t_snow : ') 164 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_update1 : sm_i : ') 165 CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' lim_update1 : o_i : ') 166 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update1 : a_i : ') 167 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update1 : a_i_b : ') 168 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update1 : v_i : ') 169 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update1 : v_i_b : ') 170 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update1 : v_s : ') 171 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update1 : v_s_b : ') 172 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' lim_update1 : e_i1 : ') 173 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_i1_b : ') 174 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl) , clinfo1= ' lim_update1 : e_i2 : ') 175 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl) , clinfo1= ' lim_update1 : e_i2_b : ') 176 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow : ') 177 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow_b : ') 178 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update1 : smv_i : ') 179 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update1 : smv_i_b : ') 180 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update1 : oa_i : ') 181 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update1 : oa_i_b : ') 144 END SUBROUTINE lim_update1 182 145 183 DO jk = 1, nlay_i184 CALL prt_ctl_info(' - Layer : ', ivar1=jk)185 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_update1 : t_i : ')186 END DO187 END DO188 189 CALL prt_ctl_info(' ')190 CALL prt_ctl_info(' - Heat / FW fluxes : ')191 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ')192 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update1 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ')193 194 CALL prt_ctl_info(' ')195 CALL prt_ctl_info(' - Stresses : ')196 CALL prt_ctl_info(' ~~~~~~~~~~ ')197 CALL prt_ctl(tab2d_1=utau , clinfo1= ' lim_update1 : utau : ', tab2d_2=vtau , clinfo2= ' vtau : ')198 CALL prt_ctl(tab2d_1=utau_ice , clinfo1= ' lim_update1 : utau_ice : ', tab2d_2=vtau_ice , clinfo2= ' vtau_ice : ')199 CALL prt_ctl(tab2d_1=u_oce , clinfo1= ' lim_update1 : u_oce : ', tab2d_2=v_oce , clinfo2= ' v_oce : ')200 ENDIF201 202 ENDIF ! ln_limdyn203 204 IF( nn_timing == 1 ) CALL timing_stop('limupdate1')205 END SUBROUTINE lim_update1206 146 #else 207 147 !!---------------------------------------------------------------------- -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r6403 r7309 15 15 USE sbc_oce ! Surface boundary condition: ocean fields 16 16 USE sbc_ice ! Surface boundary condition: ice fields 17 USE dom_ice18 17 USE dom_oce 19 18 USE phycst ! physical constants … … 22 21 USE limitd_th 23 22 USE limvar 24 USE prtctl ! Print control25 23 USE lbclnk ! lateral boundary condition - MPP exchanges 26 24 USE wrk_nemo ! work arrays … … 62 60 63 61 IF( kt == nit000 .AND. lwp ) THEN 64 WRITE(numout,*) ' lim_update2 ' 65 WRITE(numout,*) ' ~~~~~~~~~~~ ' 62 WRITE(numout,*)'' 63 WRITE(numout,*)' lim_update2 ' 64 WRITE(numout,*)' ~~~~~~~~~~~ ' 66 65 ENDIF 67 66 68 67 ! conservation test 69 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)68 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 70 69 71 70 !---------------------------------------------------------------------- … … 176 175 177 176 ! conservation test 178 IF( ln_limdia hsb) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)177 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 179 178 180 ! necessary calls (at least for coupling)181 CALL lim_var_glo2eqv182 CALL lim_var_agg(2)183 184 ! -------------------------------------------------185 179 ! control prints 186 ! ------------------------------------------------- 187 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) ! control print 188 189 IF(ln_ctl) THEN ! Control print 190 CALL prt_ctl_info(' ') 191 CALL prt_ctl_info(' - Cell values : ') 192 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 193 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_update2 : cell area :') 194 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update2 : at_i :') 195 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update2 : vt_i :') 196 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_update2 : vt_s :') 197 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_update2 : strength :') 198 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update2 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 199 CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update2 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :') 200 201 DO jl = 1, jpl 202 CALL prt_ctl_info(' ') 203 CALL prt_ctl_info(' - Category : ', ivar1=jl) 204 CALL prt_ctl_info(' ~~~~~~~~~~') 205 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_update2 : ht_i : ') 206 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_update2 : ht_s : ') 207 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_update2 : t_su : ') 208 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_update2 : t_snow : ') 209 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_update2 : sm_i : ') 210 CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' lim_update2 : o_i : ') 211 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update2 : a_i : ') 212 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update2 : a_i_b : ') 213 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update2 : v_i : ') 214 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update2 : v_i_b : ') 215 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update2 : v_s : ') 216 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update2 : v_s_b : ') 217 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1 : ') 218 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1_b : ') 219 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2 : ') 220 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2_b : ') 221 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow : ') 222 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow_b : ') 223 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update2 : smv_i : ') 224 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update2 : smv_i_b : ') 225 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update2 : oa_i : ') 226 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update2 : oa_i_b : ') 227 228 DO jk = 1, nlay_i 229 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 230 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_update2 : t_i : ') 231 END DO 232 END DO 233 234 CALL prt_ctl_info(' ') 235 CALL prt_ctl_info(' - Heat / FW fluxes : ') 236 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 237 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update2 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 238 239 CALL prt_ctl_info(' ') 240 CALL prt_ctl_info(' - Stresses : ') 241 CALL prt_ctl_info(' ~~~~~~~~~~ ') 242 CALL prt_ctl(tab2d_1=utau , clinfo1= ' lim_update2 : utau : ', tab2d_2=vtau , clinfo2= ' vtau : ') 243 CALL prt_ctl(tab2d_1=utau_ice , clinfo1= ' lim_update2 : utau_ice : ', tab2d_2=vtau_ice , clinfo2= ' vtau_ice : ') 244 CALL prt_ctl(tab2d_1=u_oce , clinfo1= ' lim_update2 : u_oce : ', tab2d_2=v_oce , clinfo2= ' v_oce : ') 245 ENDIF 180 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) 181 IF( ln_ctl ) CALL lim_prt3D( 'limupdate2' ) 246 182 247 183 IF( nn_timing == 1 ) CALL timing_stop('limupdate2') 248 184 249 185 END SUBROUTINE lim_update2 186 250 187 #else 251 188 !!---------------------------------------------------------------------- -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r6470 r7309 27 27 !! - et_i(jpi,jpj) !total ice thermal content 28 28 !! - smt_i(jpi,jpj) !mean ice salinity 29 !! - ot_i(jpi,jpj) !average ice age29 !! - tm_i (jpi,jpj) !mean ice temperature 30 30 !!====================================================================== 31 31 !! History : - ! 2006-01 (M. Vancoppenolle) Original code … … 41 41 USE ice ! ice variables 42 42 USE thd_ice ! ice variables (thermodynamics) 43 USE dom_ice ! ice domain44 43 USE in_out_manager ! I/O manager 45 44 USE lib_mpp ! MPP library … … 54 53 PUBLIC lim_var_eqv2glo 55 54 PUBLIC lim_var_salprof 56 PUBLIC lim_var_icetm57 55 PUBLIC lim_var_bv 58 56 PUBLIC lim_var_salprof1d … … 86 84 !!------------------------------------------------------------------ 87 85 88 !-------------------- 89 ! Compute variables 90 !-------------------- 91 vt_i (:,:) = 0._wp 92 vt_s (:,:) = 0._wp 93 at_i (:,:) = 0._wp 94 ato_i(:,:) = 1._wp 95 ! 96 DO jl = 1, jpl 86 ! integrated values 87 vt_i (:,:) = SUM( v_i, dim=3 ) 88 vt_s (:,:) = SUM( v_s, dim=3 ) 89 at_i (:,:) = SUM( a_i, dim=3 ) 90 et_s(:,:) = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 91 et_i(:,:) = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 92 93 ! open water fraction 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp ) 97 END DO 98 END DO 99 100 IF( kn > 1 ) THEN 101 102 ! mean ice/snow thickness 97 103 DO jj = 1, jpj 98 104 DO ji = 1, jpi 99 ! 100 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 101 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 102 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 103 ! 104 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 105 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch ! ice thickness 106 END DO 107 END DO 108 END DO 109 110 DO jj = 1, jpj 111 DO ji = 1, jpi 112 ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp ) ! open water fraction 113 END DO 114 END DO 115 116 IF( kn > 1 ) THEN 117 et_s (:,:) = 0._wp 118 ot_i (:,:) = 0._wp 105 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 106 htm_i(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 107 htm_s(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 108 ENDDO 109 ENDDO 110 111 ! mean temperature (K), salinity and age 119 112 smt_i(:,:) = 0._wp 120 et_i (:,:) = 0._wp 121 ! 113 tm_i(:,:) = 0._wp 114 tm_su(:,:) = 0._wp 115 om_i (:,:) = 0._wp 122 116 DO jl = 1, jpl 117 123 118 DO jj = 1, jpj 124 119 DO ji = 1, jpi 125 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content 126 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) ) 127 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch ! ice salinity 128 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) ) 129 ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi20 ) * rswitch ! ice age 130 END DO 131 END DO 132 END DO 133 ! 134 DO jl = 1, jpl 120 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 121 tm_su(ji,jj) = tm_su(ji,jj) + rswitch * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) 122 om_i (ji,jj) = om_i (ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) 123 END DO 124 END DO 125 135 126 DO jk = 1, nlay_i 136 et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl) ! ice heat content 137 END DO 138 END DO 127 DO jj = 1, jpj 128 DO ji = 1, jpi 129 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 130 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 131 & / MAX( vt_i(ji,jj) , epsi10 ) 132 smt_i(ji,jj) = smt_i(ji,jj) + r1_nlay_i * rswitch * s_i(ji,jj,jk,jl) * v_i(ji,jj,jl) & 133 & / MAX( vt_i(ji,jj) , epsi10 ) 134 END DO 135 END DO 136 END DO 137 END DO 138 tm_i = tm_i + rt0 139 tm_su = tm_su + rt0 139 140 ! 140 141 ENDIF … … 243 244 END DO 244 245 245 !------------------- 246 ! Mean temperature 247 !------------------- 248 vt_i (:,:) = 0._wp 249 DO jl = 1, jpl 250 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 251 END DO 252 253 tm_i(:,:) = 0._wp 254 DO jl = 1, jpl 255 DO jk = 1, nlay_i 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 259 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 260 & / MAX( vt_i(ji,jj) , epsi10 ) 261 END DO 262 END DO 263 END DO 264 END DO 265 tm_i = tm_i + rt0 246 ! integrated values 247 vt_i (:,:) = SUM( v_i, dim=3 ) 248 vt_s (:,:) = SUM( v_s, dim=3 ) 249 at_i (:,:) = SUM( a_i, dim=3 ) 250 266 251 ! 267 252 END SUBROUTINE lim_var_glo2eqv … … 398 383 399 384 400 SUBROUTINE lim_var_icetm 401 !!------------------------------------------------------------------ 402 !! *** ROUTINE lim_var_icetm *** 403 !! 404 !! ** Purpose : computes mean sea ice temperature 385 SUBROUTINE lim_var_bv 386 !!------------------------------------------------------------------ 387 !! *** ROUTINE lim_var_bv *** 388 !! 389 !! ** Purpose : computes mean brine volume (%) in sea ice 390 !! 391 !! ** Method : e = - 0.054 * S (ppt) / T (C) 392 !! 393 !! References : Vancoppenolle et al., JGR, 2007 405 394 !!------------------------------------------------------------------ 406 395 INTEGER :: ji, jj, jk, jl ! dummy loop indices 407 396 !!------------------------------------------------------------------ 408 409 ! Mean sea ice temperature 410 vt_i (:,:) = 0._wp 411 DO jl = 1, jpl 412 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 413 END DO 414 415 tm_i(:,:) = 0._wp 397 ! 398 bvm_i(:,:) = 0._wp 399 bv_i (:,:,:) = 0._wp 416 400 DO jl = 1, jpl 417 401 DO jk = 1, nlay_i 418 402 DO jj = 1, jpj 419 403 DO ji = 1, jpi 420 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 421 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 422 & / MAX( vt_i(ji,jj) , epsi10 ) 423 END DO 424 END DO 425 END DO 426 END DO 427 tm_i = tm_i + rt0 428 429 END SUBROUTINE lim_var_icetm 430 431 432 SUBROUTINE lim_var_bv 433 !!------------------------------------------------------------------ 434 !! *** ROUTINE lim_var_bv *** 435 !! 436 !! ** Purpose : computes mean brine volume (%) in sea ice 437 !! 438 !! ** Method : e = - 0.054 * S (ppt) / T (C) 439 !! 440 !! References : Vancoppenolle et al., JGR, 2007 441 !!------------------------------------------------------------------ 442 INTEGER :: ji, jj, jk, jl ! dummy loop indices 443 REAL(wp) :: zbvi ! local scalars 444 !!------------------------------------------------------------------ 445 ! 446 vt_i (:,:) = 0._wp 447 DO jl = 1, jpl 448 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 449 END DO 450 451 bv_i(:,:) = 0._wp 452 DO jl = 1, jpl 453 DO jk = 1, nlay_i 454 DO jj = 1, jpj 455 DO ji = 1, jpi 456 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) ) ) 457 zbvi = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) & 458 & * v_i(ji,jj,jl) * r1_nlay_i 459 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) ) ) 460 bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi / MAX( vt_i(ji,jj) , epsi20 ) 461 END DO 404 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) ) ) 405 bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rswitch * tmut * s_i(ji,jj,jk,jl) * r1_nlay_i & 406 & / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) 407 END DO 408 END DO 409 END DO 410 411 DO jj = 1, jpj 412 DO ji = 1, jpi 413 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 414 bvm_i(ji,jj) = bvm_i(ji,jj) + rswitch * bv_i(ji,jj,jl) * v_i(ji,jj,jl) / MAX( vt_i(ji,jj), epsi10 ) 462 415 END DO 463 416 END DO … … 683 636 INTEGER :: ji, jk, jl ! dummy loop indices 684 637 INTEGER :: ijpij, i_fill, jl0 685 REAL(wp) :: zarg, zV, zconv, zdh 638 REAL(wp) :: zarg, zV, zconv, zdh, zdv 686 639 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zai ! input ice/snow variables 687 640 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zht_i, zht_s, za_i ! output ice/snow variables … … 704 657 IF( zhti(ji) > 0._wp ) THEN 705 658 706 ! initialisation of tests 707 itest(:) = 0 659 ! find which category (jl0) the input ice thickness falls into 660 jl0 = jpl 661 DO jl = 1, jpl 662 IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 663 jl0 = jl 664 CYCLE 665 ENDIF 666 END DO 667 668 ! initialisation of tests 669 itest(:) = 0 708 670 709 i_fill = jpl + 1 !==================================== 710 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 711 ! iteration !==================================== 712 i_fill = i_fill - 1 671 i_fill = jpl + 1 !==================================== 672 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 673 ! iteration !==================================== 674 i_fill = i_fill - 1 675 676 ! initialisation of ice variables for each try 677 zht_i(ji,1:jpl) = 0._wp 678 za_i (ji,1:jpl) = 0._wp 679 itest(:) = 0 680 681 ! *** case very thin ice: fill only category 1 682 IF ( i_fill == 1 ) THEN 683 zht_i(ji,1) = zhti(ji) 684 za_i (ji,1) = zai (ji) 685 686 ! *** case ice is thicker: fill categories >1 687 ELSE 688 689 ! Fill ice thicknesses in the (i_fill-1) cat by hmean 690 DO jl = 1, i_fill - 1 691 zht_i(ji,jl) = hi_mean(jl) 692 END DO 693 694 ! Concentrations in the (i_fill-1) categories 695 za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl)) 696 DO jl = 1, i_fill - 1 697 IF ( jl /= jl0 ) THEN 698 zarg = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 699 za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2) 700 ENDIF 701 END DO 702 703 ! Concentration in the last (i_fill) category 704 za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) ) 705 706 ! Ice thickness in the last (i_fill) category 707 zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) ) 708 zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 ) 709 710 ! clem: correction if concentration of upper cat is greater than lower cat 711 ! (it should be a gaussian around jl0 but sometimes it is not) 712 IF ( jl0 /= jpl ) THEN 713 DO jl = jpl, jl0+1, -1 714 IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN 715 zdv = zht_i(ji,jl) * za_i(ji,jl) 716 zht_i(ji,jl ) = 0._wp 717 za_i (ji,jl ) = 0._wp 718 za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 ) 719 END IF 720 ENDDO 721 ENDIF 722 723 ENDIF ! case ice is thick or thin 724 725 !--------------------- 726 ! Compatibility tests 727 !--------------------- 728 ! Test 1: area conservation 729 zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) ) 730 IF ( zconv < epsi06 ) itest(1) = 1 713 731 714 ! initialisation of ice variables for each try 715 zht_i(ji,1:jpl) = 0._wp 716 za_i (ji,1:jpl) = 0._wp 717 718 ! *** case very thin ice: fill only category 1 719 IF ( i_fill == 1 ) THEN 720 zht_i(ji,1) = zhti(ji) 721 za_i (ji,1) = zai (ji) 722 723 ! *** case ice is thicker: fill categories >1 724 ELSE 725 726 ! Fill ice thicknesses except the last one (i_fill) by hmean 727 DO jl = 1, i_fill - 1 728 zht_i(ji,jl) = hi_mean(jl) 729 END DO 732 ! Test 2: volume conservation 733 zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) ) 734 IF ( zconv < epsi06 ) itest(2) = 1 730 735 731 ! find which category (jl0) the input ice thickness falls into 732 jl0 = i_fill 736 ! Test 3: thickness of the last category is in-bounds ? 737 IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 738 739 ! Test 4: positivity of ice concentrations 740 itest(4) = 1 733 741 DO jl = 1, i_fill 734 IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 735 jl0 = jl 736 CYCLE 737 ENDIF 738 END DO 739 740 ! Concentrations in the (i_fill-1) categories 741 za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl)) 742 DO jl = 1, i_fill - 1 743 IF ( jl == jl0 ) CYCLE 744 zarg = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 745 za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2) 746 END DO 747 748 ! Concentration in the last (i_fill) category 749 za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) ) 750 751 ! Ice thickness in the last (i_fill) category 752 zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) ) 753 zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / za_i(ji,i_fill) 754 755 ENDIF ! case ice is thick or thin 756 757 !--------------------- 758 ! Compatibility tests 759 !--------------------- 760 ! Test 1: area conservation 761 zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) ) 762 IF ( zconv < epsi06 ) itest(1) = 1 763 764 ! Test 2: volume conservation 765 zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) ) 766 IF ( zconv < epsi06 ) itest(2) = 1 767 768 ! Test 3: thickness of the last category is in-bounds ? 769 IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 770 771 ! Test 4: positivity of ice concentrations 772 itest(4) = 1 773 DO jl = 1, i_fill 774 IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 775 END DO 776 !============================ 777 END DO ! end iteration on categories 778 !============================ 742 IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 743 END DO 744 ! !============================ 745 END DO ! end iteration on categories 746 ! !============================ 779 747 ENDIF ! if zhti > 0 780 748 END DO ! i loop 781 749 782 750 ! ------------------------------------------------ 783 751 ! Adding Snow in each category where za_i is not 0 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r6418 r7309 17 17 USE sbc_oce ! Surface boundary condition: ocean fields 18 18 USE sbc_ice ! Surface boundary condition: ice fields 19 USE dom_ice20 19 USE ice 21 20 USE limvar … … 56 55 INTEGER :: ji, jj, jk, jl ! dummy loop indices 57 56 REAL(wp) :: z1_365 58 REAL(wp) :: z tmp59 REAL(wp), POINTER, DIMENSION(:,:,:) :: z oi, zei, zt_i, zt_s60 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, z 2da, z2db, zswi ! 2D workspace57 REAL(wp) :: z2da, z2db, ztmp 58 REAL(wp), POINTER, DIMENSION(:,:,:) :: zswi2 59 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, zswi ! 2D workspace 61 60 !!------------------------------------------------------------------- 62 61 63 62 IF( nn_timing == 1 ) CALL timing_start('limwri') 64 63 65 CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s)66 CALL wrk_alloc( jpi, jpj , z2d, z2da, z2db, zswi )64 CALL wrk_alloc( jpi,jpj,jpl, zswi2 ) 65 CALL wrk_alloc( jpi,jpj , z2d, zswi ) 67 66 68 67 !----------------------------- … … 71 70 z1_365 = 1._wp / 365._wp 72 71 73 CALL lim_var_icetm ! mean sea ice temperature74 75 CALL lim_var_bv ! brine volume 76 77 DO jj = 1, jpj ! presence indicator of ice72 ! brine volume 73 CALL lim_var_bv 74 75 ! tresholds for outputs 76 DO jj = 1, jpj 78 77 DO ji = 1, jpi 79 78 zswi(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 80 79 END DO 81 80 END DO 82 ! 83 ! 84 ! 85 IF ( iom_use( "icethic_cea" ) ) THEN ! mean ice thickness 86 DO jj = 1, jpj 81 DO jl = 1, jpl 82 DO jj = 1, jpj 87 83 DO ji = 1, jpi 88 z 2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj)84 zswi2(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 89 85 END DO 90 86 END DO 91 CALL iom_put( "icethic_cea" , z2d ) 92 ENDIF 93 94 IF ( iom_use( "snowthic_cea" ) ) THEN ! snow thickness = mean snow thickness over the cell 95 DO jj = 1, jpj 96 DO ji = 1, jpi 97 z2d(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 98 END DO 99 END DO 100 CALL iom_put( "snowthic_cea" , z2d ) 101 ENDIF 87 END DO 102 88 ! 89 ! fluxes 90 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 91 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 92 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 93 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 94 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 95 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 96 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 97 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 98 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 99 IF( iom_use('qemp_oce') ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 100 IF( iom_use('qemp_ice') ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 101 IF( iom_use('emp_oce' ) ) CALL iom_put( "emp_oce" , emp_oce(:,:) ) ! emp over ocean (taking into account the snow blown away from the ice) 102 IF( iom_use('emp_ice' ) ) CALL iom_put( "emp_ice" , emp_ice(:,:) ) ! emp over ice (taking into account the snow blown away from the ice) 103 104 ! velocity 103 105 IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN 104 106 DO jj = 2 , jpjm1 105 107 DO ji = 2 , jpim1 106 z2da(ji,jj) = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 107 z2db(ji,jj) = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 108 z2da = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 109 z2db = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 110 z2d(ji,jj) = SQRT( z2da * z2da + z2db * z2db ) 108 111 END DO 109 112 END DO 110 CALL lbc_lnk( z2da, 'T', -1. ) 111 CALL lbc_lnk( z2db, 'T', -1. ) 112 CALL iom_put( "uice_ipa" , z2da ) ! ice velocity u component 113 CALL iom_put( "vice_ipa" , z2db ) ! ice velocity v component 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 z2d(ji,jj) = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) ) 117 END DO 118 END DO 119 CALL iom_put( "icevel" , z2d ) ! ice velocity module 113 CALL lbc_lnk( z2d, 'T', 1. ) 114 CALL iom_put( "uice_ipa" , u_ice ) ! ice velocity u component 115 CALL iom_put( "vice_ipa" , v_ice ) ! ice velocity v component 116 CALL iom_put( "icevel" , z2d ) ! ice velocity module 120 117 ENDIF 118 119 IF ( iom_use( "tau_icebfr" ) ) CALL iom_put( "tau_icebfr" , tau_icebfr ) ! ice friction with ocean bottom (landfast ice) 121 120 ! 122 IF ( iom_use( "miceage" ) ) THEN 123 z2d(:,:) = 0.e0 124 DO jl = 1, jpl 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 128 z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 ) 129 END DO 130 END DO 131 END DO 132 CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age 133 ENDIF 134 135 IF ( iom_use( "micet" ) ) THEN 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj) 139 END DO 140 END DO 141 CALL iom_put( "micet" , z2d ) ! mean ice temperature 142 ENDIF 121 IF ( iom_use( "miceage" ) ) CALL iom_put( "miceage" , om_i * zswi * z1_365 ) ! mean ice age 122 IF ( iom_use( "icethic_cea" ) ) CALL iom_put( "icethic_cea" , htm_i * zswi ) ! ice thickness mean 123 IF ( iom_use( "snowthic_cea" ) ) CALL iom_put( "snowthic_cea", htm_s * zswi ) ! snow thickness mean 124 IF ( iom_use( "micet" ) ) CALL iom_put( "micet" , ( tm_i - rt0 ) * zswi ) ! ice mean temperature 125 IF ( iom_use( "icest" ) ) CALL iom_put( "icest" , ( tm_su - rt0 ) * zswi ) ! ice surface temperature 126 IF ( iom_use( "icecolf" ) ) CALL iom_put( "icecolf" , hicol ) ! frazil ice collection thickness 143 127 ! 144 IF ( iom_use( "icest" ) ) THEN145 z2d(:,:) = 0.e0146 DO jl = 1, jpl147 DO jj = 1, jpj148 DO ji = 1, jpi149 z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )150 END DO151 END DO152 END DO153 CALL iom_put( "icest" , z2d ) ! ice surface temperature154 ENDIF155 156 IF ( iom_use( "icecolf" ) ) CALL iom_put( "icecolf", hicol ) ! frazil ice collection thickness157 158 128 CALL iom_put( "isst" , sst_m ) ! sea surface temperature 159 129 CALL iom_put( "isss" , sss_m ) ! sea surface salinity 160 CALL iom_put( "iceconc" , at_i 161 CALL iom_put( "icevolu" , vt_i 162 CALL iom_put( "icehc" , et_i 163 CALL iom_put( "isnowhc" , et_s 164 CALL iom_put( "ibrinv" , bv _i * 100._wp) ! brine volume130 CALL iom_put( "iceconc" , at_i * zswi ) ! ice concentration 131 CALL iom_put( "icevolu" , vt_i * zswi ) ! ice volume = mean ice thickness over the cell 132 CALL iom_put( "icehc" , et_i * zswi ) ! ice total heat content 133 CALL iom_put( "isnowhc" , et_s * zswi ) ! snow total heat content 134 CALL iom_put( "ibrinv" , bvm_i * zswi * 100. ) ! brine volume 165 135 CALL iom_put( "utau_ice" , utau_ice ) ! wind stress over ice along i-axis at I-point 166 136 CALL iom_put( "vtau_ice" , vtau_ice ) ! wind stress over ice along j-axis at I-point 167 137 CALL iom_put( "snowpre" , sprecip * 86400. ) ! snow precipitation 168 CALL iom_put( "micesalt" , smt_i 169 170 CALL iom_put( "icestr" , strength * 0.001 )! ice strength171 CALL iom_put( "idive" , divu_i * 1.0e8 ) 172 CALL iom_put( "ishear" , shear_i * 1.0e8 ) 173 CALL iom_put( "snowvol" , vt_s 138 CALL iom_put( "micesalt" , smt_i * zswi ) ! mean ice salinity 139 140 CALL iom_put( "icestr" , strength * zswi ) ! ice strength 141 CALL iom_put( "idive" , divu_i * 1.0e8 ) ! divergence 142 CALL iom_put( "ishear" , shear_i * 1.0e8 ) ! shear 143 CALL iom_put( "snowvol" , vt_s * zswi ) ! snow volume 174 144 175 145 CALL iom_put( "icetrp" , diag_trp_vi * rday ) ! ice volume transport … … 180 150 181 151 CALL iom_put( "sfxbog" , sfx_bog * rday ) ! salt flux from bottom growth 182 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from bottom melt 183 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from surface melt 152 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from bottom melting 153 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from surface melting 154 CALL iom_put( "sfxlam" , sfx_lam * rday ) ! salt flux from lateral melting 184 155 CALL iom_put( "sfxsni" , sfx_sni * rday ) ! salt flux from snow ice formation 185 156 CALL iom_put( "sfxopw" , sfx_opw * rday ) ! salt flux from open water formation 186 157 CALL iom_put( "sfxdyn" , sfx_dyn * rday ) ! salt flux from ridging rafting 187 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from residual158 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from limupdate (resultant) 188 159 CALL iom_put( "sfxbri" , sfx_bri * rday ) ! salt flux from brines 189 160 CALL iom_put( "sfxsub" , sfx_sub * rday ) ! salt flux from sublimation … … 198 169 CALL iom_put( "vfxsum" , wfx_sum * ztmp ) ! surface melt 199 170 CALL iom_put( "vfxbom" , wfx_bom * ztmp ) ! bottom melt 171 CALL iom_put( "vfxlam" , wfx_lam * ztmp ) ! lateral melt 200 172 CALL iom_put( "vfxice" , wfx_ice * ztmp ) ! total ice growth/melt 173 174 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations 175 WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog 176 ELSEWHERE ; z2d = 0._wp 177 END WHERE 178 CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp ) 179 ENDIF 180 181 ztmp = rday / rhosn 182 CALL iom_put( "vfxspr" , wfx_spr * ztmp ) ! precip (snow) 201 183 CALL iom_put( "vfxsnw" , wfx_snw * ztmp ) ! total snw growth/melt 202 CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow )203 CALL iom_put( "vfxs pr" , wfx_spr * ztmp ) ! precip (snow)184 CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow/ice) 185 CALL iom_put( "vfxsub_err" , wfx_err_sub * ztmp ) ! "excess" of sublimation sent to ocean 204 186 205 187 CALL iom_put( "afxtot" , afx_tot * rday ) ! concentration tendency (total) … … 222 204 CALL iom_put ('hfxdif' , hfx_dif(:,:) ) ! 223 205 CALL iom_put ('hfxopw' , hfx_opw(:,:) ) ! 224 CALL iom_put ('hfxtur' , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base206 CALL iom_put ('hfxtur' , fhtur(:,:) * at_i_b(:,:) ) ! turbulent heat flux at ice base 225 207 CALL iom_put ('hfxdhc' , diag_heat(:,:) ) ! Heat content variation in snow and ice 226 208 CALL iom_put ('hfxspr' , hfx_spr(:,:) ) ! Heat content of snow precip 227 228 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations 229 DO jj = 1, jpj 230 DO ji = 1, jpi 231 z2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) ! mean ice thickness 232 END DO 233 END DO 234 WHERE( z2d(:,:) < 0.2 .AND. z2d(:,:) > 0. ) ; z2da = wfx_bog 235 ELSEWHERE ; z2da = 0._wp 236 END WHERE 237 CALL iom_put( "vfxthin", ( wfx_opw + z2da ) * ztmp ) 238 ENDIF 239 209 210 240 211 !-------------------------------- 241 212 ! Output values for each category 242 213 !-------------------------------- 243 CALL iom_put( "iceconc_cat" , a_i ) ! area for categories 244 CALL iom_put( "icethic_cat" , ht_i ) ! thickness for categories 245 CALL iom_put( "snowthic_cat" , ht_s ) ! snow depth for categories 246 CALL iom_put( "salinity_cat" , sm_i ) ! salinity for categories 247 214 IF ( iom_use( "iceconc_cat" ) ) CALL iom_put( "iceconc_cat" , a_i * zswi2 ) ! area for categories 215 IF ( iom_use( "icethic_cat" ) ) CALL iom_put( "icethic_cat" , ht_i * zswi2 ) ! thickness for categories 216 IF ( iom_use( "snowthic_cat" ) ) CALL iom_put( "snowthic_cat" , ht_s * zswi2 ) ! snow depth for categories 217 IF ( iom_use( "salinity_cat" ) ) CALL iom_put( "salinity_cat" , sm_i * zswi2 ) ! salinity for categories 248 218 ! ice temperature 249 IF ( iom_use( "icetemp_cat" ) ) THEN 250 zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i 251 CALL iom_put( "icetemp_cat" , zt_i - rt0 ) 252 ENDIF 253 219 IF ( iom_use( "icetemp_cat" ) ) CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 ) 254 220 ! snow temperature 255 IF ( iom_use( "snwtemp_cat" ) ) THEN 256 zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s 257 CALL iom_put( "snwtemp_cat" , zt_s - rt0 ) 258 ENDIF 259 260 ! Compute ice age 261 IF ( iom_use( "iceage_cat" ) ) THEN 262 DO jl = 1, jpl 263 DO jj = 1, jpj 264 DO ji = 1, jpi 265 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 266 rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) ) 267 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch 268 END DO 269 END DO 270 END DO 271 CALL iom_put( "iceage_cat" , zoi * z1_365 ) ! ice age for categories 272 ENDIF 273 274 ! Compute brine volume 275 IF ( iom_use( "brinevol_cat" ) ) THEN 276 zei(:,:,:) = 0._wp 277 DO jl = 1, jpl 278 DO jk = 1, nlay_i 279 DO jj = 1, jpj 280 DO ji = 1, jpi 281 rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 282 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 * & 283 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 284 rswitch * r1_nlay_i 285 END DO 286 END DO 287 END DO 288 END DO 289 CALL iom_put( "brinevol_cat" , zei ) ! brine volume for categories 290 ENDIF 221 IF ( iom_use( "snwtemp_cat" ) ) CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 ) 222 ! ice age 223 IF ( iom_use( "iceage_cat" ) ) CALL iom_put( "iceage_cat" , o_i * zswi2 * z1_365 ) 224 ! brine volume 225 IF ( iom_use( "brinevol_cat" ) ) CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 ) 291 226 292 227 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s … … 294 229 ! not yet implemented 295 230 296 CALL wrk_dealloc( jpi, jpj, jpl, z oi, zei, zt_i, zt_s)297 CALL wrk_dealloc( jpi, jpj , z2d, zswi , z2da, z2db)231 CALL wrk_dealloc( jpi, jpj, jpl, zswi2 ) 232 CALL wrk_dealloc( jpi, jpj , z2d, zswi ) 298 233 299 234 IF( nn_timing == 1 ) CALL timing_stop('limwri') … … 312 247 !! 313 248 !! History : 314 !! 4. 1! 2013-06 (C. Rousset)249 !! 4.0 ! 2013-06 (C. Rousset) 315 250 !!---------------------------------------------------------------------- 316 INTEGER, INTENT( in ) :: kt ! ocean time-step index) 317 INTEGER, INTENT( in ) :: kid , kh_i 251 INTEGER, INTENT( in ) :: kt ! ocean time-step index) 252 INTEGER, INTENT( in ) :: kid , kh_i 253 INTEGER :: nz_i, jl 254 REAL(wp), DIMENSION(jpl) :: jcat 318 255 !!---------------------------------------------------------------------- 319 320 CALL histdef( kid, "iicethic", "Ice thickness" , "m" , & 321 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 322 CALL histdef( kid, "iiceconc", "Ice concentration" , "%" , & 323 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 324 CALL histdef( kid, "iicetemp", "Ice temperature" , "C" , & 325 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 326 CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)" , "m/s" , & 327 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 328 CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)" , "m/s" , & 329 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 330 CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", & 331 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 332 CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", & 333 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 334 CALL histdef( kid, "iicesflx", "Solar flux over ocean" , "w/m2" , & 335 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 336 CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" , & 256 DO jl = 1, jpl 257 jcat(jl) = REAL(jl) 258 ENDDO 259 260 CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up") 261 262 CALL histdef( kid, "sithic", "Ice thickness" , "m" , & 263 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 264 CALL histdef( kid, "siconc", "Ice concentration" , "%" , & 265 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 266 CALL histdef( kid, "sitemp", "Ice temperature" , "C" , & 267 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 268 CALL histdef( kid, "sivelu", "i-Ice speed " , "m/s" , & 269 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 270 CALL histdef( kid, "sivelv", "j-Ice speed " , "m/s" , & 271 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 272 CALL histdef( kid, "sistru", "i-Wind stress over ice " , "Pa" , & 273 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 274 CALL histdef( kid, "sistrv", "j-Wind stress over ice " , "Pa" , & 275 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 276 CALL histdef( kid, "sisflx", "Solar flux over ocean" , "w/m2" , & 277 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 278 CALL histdef( kid, "sinflx", "Non-solar flux over ocean" , "w/m2" , & 337 279 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 338 280 CALL histdef( kid, "isnowpre", "Snow precipitation" , "kg/m2/s", & 339 281 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 340 CALL histdef( kid, "iicesali", "Ice salinity" , "PSU" , & 341 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 342 CALL histdef( kid, "iicevolu", "Ice volume" , "m" , & 343 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 344 CALL histdef( kid, "iicedive", "Ice divergence" , "10-8s-1", & 345 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 346 CALL histdef( kid, "iicebopr", "Ice bottom production" , "m/s" , & 347 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 348 CALL histdef( kid, "iicedypr", "Ice dynamic production" , "m/s" , & 349 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 350 CALL histdef( kid, "iicelapr", "Ice open water prod" , "m/s" , & 282 CALL histdef( kid, "sisali", "Ice salinity" , "PSU" , & 283 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 284 CALL histdef( kid, "sivolu", "Ice volume" , "m" , & 285 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 286 CALL histdef( kid, "sidive", "Ice divergence" , "10-8s-1", & 287 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 288 289 CALL histdef( kid, "vfxbog", "Ice bottom production" , "m/s" , & 290 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 291 CALL histdef( kid, "vfxdyn", "Ice dynamic production" , "m/s" , & 292 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 293 CALL histdef( kid, "vfxopw", "Ice open water prod" , "m/s" , & 351 294 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 352 CALL histdef( kid, "iicesipr", "Snow ice production " , "m/s" , & 353 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 354 CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s" , & 355 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 356 CALL histdef( kid, "iicebome", "Ice bottom melt" , "m/s" , & 357 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 358 CALL histdef( kid, "iicesume", "Ice surface melt" , "m/s" , & 359 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 360 CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics" , "" , & 361 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 362 CALL histdef( kid, "iisfxres", "Salt flux from limupdate", "" , & 363 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 295 CALL histdef( kid, "vfxsni", "Snow ice production " , "m/s" , & 296 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 297 CALL histdef( kid, "vfxres", "Ice prod from limupdate" , "m/s" , & 298 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 299 CALL histdef( kid, "vfxbom", "Ice bottom melt" , "m/s" , & 300 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 301 CALL histdef( kid, "vfxsum", "Ice surface melt" , "m/s" , & 302 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 303 304 CALL histdef( kid, "sithicat", "Ice thickness" , "m" , & 305 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 306 CALL histdef( kid, "siconcat", "Ice concentration" , "%" , & 307 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 308 CALL histdef( kid, "sisalcat", "Ice salinity" , "" , & 309 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 310 CALL histdef( kid, "sitemcat", "Ice temperature" , "C" , & 311 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 312 CALL histdef( kid, "snthicat", "Snw thickness" , "m" , & 313 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 314 CALL histdef( kid, "sntemcat", "Snw temperature" , "C" , & 315 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 364 316 365 317 CALL histend( kid, snc4set ) ! end of the file definition 366 318 367 CALL histwrite( kid, " iicethic", kt, icethi, jpi*jpj, (/1/) )368 CALL histwrite( kid, " iiceconc", kt, at_i , jpi*jpj, (/1/) )369 CALL histwrite( kid, " iicetemp", kt, tm_i - rt0 , jpi*jpj, (/1/) )370 CALL histwrite( kid, " iicevelu", kt, u_ice , jpi*jpj, (/1/) )371 CALL histwrite( kid, " iicevelv", kt, v_ice , jpi*jpj, (/1/) )372 CALL histwrite( kid, " iicestru", kt, utau_ice , jpi*jpj, (/1/) )373 CALL histwrite( kid, " iicestrv", kt, vtau_ice , jpi*jpj, (/1/) )374 CALL histwrite( kid, " iicesflx", kt, qsr , jpi*jpj, (/1/) )375 CALL histwrite( kid, " iicenflx", kt, qns , jpi*jpj, (/1/) )319 CALL histwrite( kid, "sithic", kt, htm_i , jpi*jpj, (/1/) ) 320 CALL histwrite( kid, "siconc", kt, at_i , jpi*jpj, (/1/) ) 321 CALL histwrite( kid, "sitemp", kt, tm_i - rt0 , jpi*jpj, (/1/) ) 322 CALL histwrite( kid, "sivelu", kt, u_ice , jpi*jpj, (/1/) ) 323 CALL histwrite( kid, "sivelv", kt, v_ice , jpi*jpj, (/1/) ) 324 CALL histwrite( kid, "sistru", kt, utau_ice , jpi*jpj, (/1/) ) 325 CALL histwrite( kid, "sistrv", kt, vtau_ice , jpi*jpj, (/1/) ) 326 CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) ) 327 CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) ) 376 328 CALL histwrite( kid, "isnowpre", kt, sprecip , jpi*jpj, (/1/) ) 377 CALL histwrite( kid, "iicesali", kt, smt_i , jpi*jpj, (/1/) ) 378 CALL histwrite( kid, "iicevolu", kt, vt_i , jpi*jpj, (/1/) ) 379 CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 380 381 CALL histwrite( kid, "iicebopr", kt, wfx_bog , jpi*jpj, (/1/) ) 382 CALL histwrite( kid, "iicedypr", kt, wfx_dyn , jpi*jpj, (/1/) ) 383 CALL histwrite( kid, "iicelapr", kt, wfx_opw , jpi*jpj, (/1/) ) 384 CALL histwrite( kid, "iicesipr", kt, wfx_sni , jpi*jpj, (/1/) ) 385 CALL histwrite( kid, "iicerepr", kt, wfx_res , jpi*jpj, (/1/) ) 386 CALL histwrite( kid, "iicebome", kt, wfx_bom , jpi*jpj, (/1/) ) 387 CALL histwrite( kid, "iicesume", kt, wfx_sum , jpi*jpj, (/1/) ) 388 CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn , jpi*jpj, (/1/) ) 389 CALL histwrite( kid, "iisfxres", kt, sfx_res , jpi*jpj, (/1/) ) 329 CALL histwrite( kid, "sisali", kt, smt_i , jpi*jpj, (/1/) ) 330 CALL histwrite( kid, "sivolu", kt, vt_i , jpi*jpj, (/1/) ) 331 CALL histwrite( kid, "sidive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 332 333 CALL histwrite( kid, "vfxbog", kt, wfx_bog , jpi*jpj, (/1/) ) 334 CALL histwrite( kid, "vfxdyn", kt, wfx_dyn , jpi*jpj, (/1/) ) 335 CALL histwrite( kid, "vfxopw", kt, wfx_opw , jpi*jpj, (/1/) ) 336 CALL histwrite( kid, "vfxsni", kt, wfx_sni , jpi*jpj, (/1/) ) 337 CALL histwrite( kid, "vfxres", kt, wfx_res , jpi*jpj, (/1/) ) 338 CALL histwrite( kid, "vfxbom", kt, wfx_bom , jpi*jpj, (/1/) ) 339 CALL histwrite( kid, "vfxsum", kt, wfx_sum , jpi*jpj, (/1/) ) 340 341 CALL histwrite( kid, "sithicat", kt, ht_i , jpi*jpj*jpl, (/1/) ) 342 CALL histwrite( kid, "siconcat", kt, a_i , jpi*jpj*jpl, (/1/) ) 343 CALL histwrite( kid, "sisalcat", kt, sm_i , jpi*jpj*jpl, (/1/) ) 344 CALL histwrite( kid, "sitemcat", kt, tm_i - rt0 , jpi*jpj*jpl, (/1/) ) 345 CALL histwrite( kid, "snthicat", kt, ht_s , jpi*jpj*jpl, (/1/) ) 346 CALL histwrite( kid, "sntemcat", kt, tm_su - rt0 , jpi*jpj*jpl, (/1/) ) 390 347 391 348 ! Close the file -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r6416 r7309 14 14 15 15 PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90 16 17 !!---------------------------18 !! * Share Module variables19 !!---------------------------20 ! !!! ** ice-thermo namelist (namicethd) **21 REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness22 REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom23 REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice24 REAL(wp), PUBLIC :: rn_Cfrazb !: squeezing coefficient for collection of bottom frazil ice25 REAL(wp), PUBLIC :: rn_hnewice !: thickness for new ice formation (m)26 27 LOGICAL , PUBLIC :: ln_frazil !: use of frazil ice collection as function of wind (T) or not (F)28 16 29 17 !!----------------------------- … … 97 85 ! ! to reintegrate longwave flux inside the ice thermodynamics 98 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_fl_1d !: Ice salinity variations due to flushing100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_gd_1d !: Ice salinity variations due to gravity drainage101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_se_1d !: Ice salinity variations due to basal salt entrapment102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_si_1d !: Ice salinity variations due to lateral accretion103 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hicol_1d !: Ice collection thickness accumulated in leads 104 88 … … 140 124 !!---------------------------------------------------------------------! 141 125 INTEGER :: thd_ice_alloc ! return value 142 INTEGER :: ierr( 3)126 INTEGER :: ierr(4), ii 143 127 !!---------------------------------------------------------------------! 128 ierr(:) = 0 144 129 130 ii = 1 145 131 ALLOCATE( npb (jpij) , nplm (jpij) , npac (jpij) , & 146 132 & qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) , & … … 152 138 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 153 139 & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 154 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr( 1) )140 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(ii) ) 155 141 ! 142 ii = ii + 1 156 143 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , & 157 144 & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , & … … 162 149 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij), & 163 150 & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij), & 164 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 165 & dsm_i_si_1d(jpij) , hicol_1d (jpij) , STAT=ierr(2) ) 151 & hicol_1d (jpij) , STAT=ierr(ii) ) 166 152 ! 167 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , & 168 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 169 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_sub (jpij) , & 170 & dh_i_bott (jpij) ,dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 171 & t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) , & 172 & q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) , & 173 & qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 153 ii = ii + 1 154 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , & 155 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 156 & dh_s_tot (jpij) , dh_i_surf (jpij) , dh_i_sub (jpij) , & 157 & dh_i_bott (jpij) , dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 158 & STAT=ierr(ii) ) 174 159 ! 175 thd_ice_alloc = MAXVAL( ierr ) 176 160 ii = ii + 1 161 ALLOCATE( t_s_1d (jpij,nlay_s) , t_i_1d (jpij,nlay_i) , s_i_1d(jpij,nlay_i) , & 162 & q_i_1d (jpij,nlay_i+1) , q_s_1d (jpij,nlay_s) , & 163 & qh_i_old(jpij,0:nlay_i+1) , h_i_old(jpij,0:nlay_i+1) , STAT=ierr(ii) ) 164 ! 165 thd_ice_alloc = MAXVAL( ierr(:) ) 177 166 IF( thd_ice_alloc /= 0 ) CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' ) 178 167 ! -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90
r3680 r7309 5 5 !!---------------------------------------------------------------------- 6 6 !! History : 3.4 ! 2012-08 (R. Benshila) Original code 7 !! 3.6 ! 2016-05 (C. Rousset) Add LIM3 compatibility 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_agrif && defined key_lim2 … … 59 60 END FUNCTION agrif_ice_alloc 60 61 62 #elif defined key_agrif && defined key_lim3 63 !!---------------------------------------------------------------------- 64 !! 'key_agrif' AGRIF zoom 65 !!---------------------------------------------------------------------- 66 IMPLICIT NONE 67 PRIVATE 68 69 INTEGER, PUBLIC :: u_ice_id, v_ice_id, tra_ice_id 70 INTEGER, PUBLIC :: lim_nbstep = 0 ! child time position in sea-ice model 71 72 !!---------------------------------------------------------------------- 73 !! NEMO/NST 3.6 , NEMO Consortium (2016) 74 !! $Id$ 75 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 76 !!---------------------------------------------------------------------- 77 61 78 #endif 62 79 !!====================================================================== -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r5836 r7309 27 27 #elif defined key_lim3 28 28 USE ice ! LIM_3 ice variables 29 USE dom_ice ! sea-ice domain30 29 USE limvar 30 USE limctl 31 31 #endif 32 32 USE par_oce ! ocean parameters … … 82 82 ! 83 83 #if defined key_lim3 84 CALL lim_var_zapsmall 85 CALL lim_var_agg(1) 84 CALL lim_var_zapsmall 85 CALL lim_var_agg(1) 86 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 86 87 #endif 87 88 ! … … 121 122 ! 122 123 #if defined key_lim2 123 DO jb = 1, idx%nblen (jgrd)124 DO jb = 1, idx%nblenrim(jgrd) 124 125 ji = idx%nbi(jb,jgrd) 125 126 jj = idx%nbj(jb,jgrd) … … 141 142 142 143 DO jl = 1, jpl 143 DO jb = 1, idx%nblen (jgrd)144 DO jb = 1, idx%nblenrim(jgrd) 144 145 ji = idx%nbi(jb,jgrd) 145 146 jj = idx%nbj(jb,jgrd) … … 177 178 178 179 DO jl = 1, jpl 179 DO jb = 1, idx%nblen (jgrd)180 DO jb = 1, idx%nblenrim(jgrd) 180 181 ji = idx%nbi(jb,jgrd) 181 182 jj = idx%nbj(jb,jgrd) … … 236 237 END SELECT 237 238 ! 238 IF( nn_icesal == 1 ) THEN ! constant salinity : overwrite rn_ice _sal239 IF( nn_icesal == 1 ) THEN ! constant salinity : overwrite rn_icesal 239 240 sm_i(ji,jj ,jl) = rn_icesal 240 241 s_i (ji,jj,:,jl) = rn_icesal … … 325 326 CASE ( 'U' ) 326 327 jgrd = 2 ! u velocity 327 DO jb = 1, idx_bdy(ib_bdy)%nblen (jgrd)328 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 328 329 ji = idx_bdy(ib_bdy)%nbi(jb,jgrd) 329 330 jj = idx_bdy(ib_bdy)%nbj(jb,jgrd) … … 352 353 CASE ( 'V' ) 353 354 jgrd = 3 ! v velocity 354 DO jb = 1, idx_bdy(ib_bdy)%nblen (jgrd)355 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 355 356 ji = idx_bdy(ib_bdy)%nbi(jb,jgrd) 356 357 jj = idx_bdy(ib_bdy)%nbj(jb,jgrd) -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r6140 r7309 38 38 PUBLIC dia_hsb ! routine called by step.F90 39 39 PUBLIC dia_hsb_init ! routine called by nemogcm.F90 40 PUBLIC dia_hsb_rst ! routine called by step.F9041 40 42 41 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets … … 86 85 !!--------------------------------------------------------------------------- 87 86 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 87 ! 88 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 89 89 ! … … 171 171 ENDDO 172 172 173 ! Substract forcing from heat content, salt content and volume variations 173 ! ------------------------ ! 174 ! 3 - Drifts ! 175 ! ------------------------ ! 174 176 zdiff_v1 = zdiff_v1 - frc_v 175 177 IF( .NOT.ln_linssh ) zdiff_v2 = zdiff_v2 - frc_v … … 184 186 185 187 ! ----------------------- ! 186 ! 3- Diagnostics writing !188 ! 4 - Diagnostics writing ! 187 189 ! ----------------------- ! 188 190 zvol_tot = 0._wp ! total ocean volume (calculated with scale factors) … … 197 199 !!gm end 198 200 199 IF( ln_linssh ) THEN 200 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content variation (C) 201 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu) 202 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 203 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content variation (psu*km3) 204 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 205 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 206 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 207 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 201 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 202 CALL iom_put( 'bgfrctem' , frc_t * rau0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 203 CALL iom_put( 'bgfrchfx' , frc_t * rau0 * rcp / & ! hc - surface forcing (W/m2) 204 & ( surf_tot * kt * rdt ) ) 205 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 206 207 IF( .NOT. ln_linssh ) THEN 208 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 209 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (pss) 210 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 211 CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp / & ! Heat flux drift (W/m2) 212 & ( surf_tot * kt * rdt ) ) 213 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3) 214 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 215 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3) 216 ELSE 217 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 218 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (pss) 219 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 220 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp / & ! Heat flux drift (W/m2) 221 & ( surf_tot * kt * rdt ) ) 222 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3) 223 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 208 224 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C) 209 225 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu) 210 ELSE211 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C)212 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity variation (psu)213 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J)214 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content variation (psu*km3)215 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3)216 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t variation (km3)217 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3)218 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C)219 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu)220 226 ENDIF 221 227 ! … … 231 237 SUBROUTINE dia_hsb_rst( kt, cdrw ) 232 238 !!--------------------------------------------------------------------- 233 !! *** ROUTINE limdia_rst ***239 !! *** ROUTINE dia_hsb_rst *** 234 240 !! 235 241 !! ** Purpose : Read or write DIA file in restart file … … 241 247 ! 242 248 INTEGER :: ji, jj, jk ! dummy loop indices 243 INTEGER :: id1 ! local integers244 249 !!---------------------------------------------------------------------- 245 250 ! 246 251 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 247 252 IF( ln_rstart ) THEN !* Read the restart file 248 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. )249 253 ! 250 254 IF(lwp) WRITE(numout,*) '~~~~~~~' … … 259 263 ENDIF 260 264 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 261 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini )262 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini )263 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini )264 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini )265 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 266 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 267 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 268 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 265 269 IF( ln_linssh ) THEN 266 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini )267 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini )270 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 271 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 268 272 ENDIF 269 273 ELSE … … 313 317 ENDIF 314 318 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling 315 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini )316 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini )317 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini )318 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini )319 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 320 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 321 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 322 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 319 323 IF( ln_linssh ) THEN 320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini )321 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini )324 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 325 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 322 326 ENDIF 323 327 ! … … 339 343 !! - Compute coefficients for conversion 340 344 !!--------------------------------------------------------------------------- 341 INTEGER :: jk ! dummy loop indice342 345 INTEGER :: ierror ! local integer 343 346 INTEGER :: ios … … 345 348 NAMELIST/namhsb/ ln_diahsb 346 349 !!---------------------------------------------------------------------- 347 348 IF(lwp) THEN349 WRITE(numout,*)350 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets'351 WRITE(numout,*) '~~~~~~~~ '352 ENDIF353 350 354 351 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist … … 361 358 IF(lwm) WRITE ( numond, namhsb ) 362 359 363 ! 364 IF(lwp) THEN ! Control print 360 IF(lwp) THEN 365 361 WRITE(numout,*) 366 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 367 WRITE(numout,*) '~~~~~~~~~~~~' 368 WRITE(numout,*) ' Namelist namhsb : set hsb parameters' 369 WRITE(numout,*) ' Switch for hsb diagnostic (T) or not (F) ln_diahsb = ', ln_diahsb 370 WRITE(numout,*) 371 ENDIF 372 362 WRITE(numout,*) 'dia_hsb_init' 363 WRITE(numout,*) '~~~~~~~~ ' 364 WRITE(numout,*) ' check the heat and salt budgets (T) or not (F) ln_diahsb = ', ln_diahsb 365 ENDIF 366 ! 373 367 IF( .NOT. ln_diahsb ) RETURN 374 368 ! IF( .NOT. lk_mpp_rep ) & … … 388 382 IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 389 383 IF( ierror > 0 ) THEN 390 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN384 CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' ) ; RETURN 391 385 ENDIF 392 386 … … 394 388 ! 2 - Time independant variables and file opening ! 395 389 ! ----------------------------------------------- ! 396 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated"397 IF(lwp) WRITE(numout,*) '~~~~~~~'398 390 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 399 surf_tot = glob_sum( surf(:,:) ) 391 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 400 392 401 393 IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r6140 r7309 166 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point 167 167 ! 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor 169 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor at F_point [1/s] 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff_t !: coriolis factor at T-point [1/s] 170 170 !!---------------------------------------------------------------------- 171 171 !! vertical coordinate and scale factors … … 289 289 !!---------------------------------------------------------------------- 290 290 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 291 !! $Id$ 291 !! $Id$ 292 292 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 293 293 !!---------------------------------------------------------------------- … … 309 309 INTEGER FUNCTION dom_oce_alloc() 310 310 !!---------------------------------------------------------------------- 311 INTEGER, DIMENSION(1 3) :: ierr311 INTEGER, DIMENSION(12) :: ierr 312 312 !!---------------------------------------------------------------------- 313 313 ierr(:) = 0 … … 332 332 & e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj) , & 333 333 & e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj) , & 334 & ff (jpi,jpj) 334 & ff (jpi,jpj) , ff_t (jpi,jpj) , STAT=ierr(3) ) 335 335 ! 336 336 ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) , & -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r6981 r7309 92 92 IF( ln_sco ) CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency 93 93 ! 94 ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)! Reference ocean thickness95 hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1)96 hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1)97 DO jk = 2, jpk94 ht_0(:,:) = 0._wp ! Reference ocean thickness 95 hu_0(:,:) = 0._wp 96 hv_0(:,:) = 0._wp 97 DO jk = 1, jpk 98 98 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 99 99 hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90
r6140 r7309 56 56 IF( jperio == 5 ) WRITE(numout,*) ' jperio= 5, north fold with F-point pivot' 57 57 IF( jperio == 6 ) WRITE(numout,*) ' jperio= 6, cyclic east-west and north fold with F-point pivot' 58 ENDIF 59 ! 60 IF( jperio < 0 .OR. jperio > 6 ) CALL ctl_stop( 'jperio is out of range' ) 58 IF( jperio == 7 ) WRITE(numout,*) ' jperio= 7, cyclic east-west and north-south' 59 ENDIF 60 ! 61 IF( jperio < 0 .OR. jperio > 7 ) CALL ctl_stop( 'jperio is out of range' ) 61 62 ! 62 63 CALL dom_glo ! global domain versus zoom and/or local domain -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r6140 r7309 38 38 39 39 !!---------------------------------------------------------------------- 40 !! NEMO/OPA 3.7 , NEMO Consortium (2014)40 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 41 41 !! $Id$ 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 321 321 e1v(:,:) = ze1 ; e2v(:,:) = ze1 322 322 e1f(:,:) = ze1 ; e2f(:,:) = ze1 323 ! 323 324 CASE ( 6 ) ! clem: f-plane with irregular grid-spacing 325 326 IF(lwp) WRITE(numout,*) 327 IF(lwp) WRITE(numout,*) ' f-plane with irregular grid-spacing (+- 10%)' 328 IF(lwp) WRITE(numout,*) ' the max is given by ppe1_m and ppe2_m' 329 330 ! Position coordinates (in kilometers) 331 ! ========== 332 glam0 = 0._wp 333 gphi0 = 0._wp 334 335 #if defined key_agrif 336 IF( .NOT. Agrif_Root() ) THEN 337 glam0 = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-5 338 gphi0 = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-5 339 ppe1_m = Agrif_Parent(ppe1_m)/Agrif_Rhox() 340 ppe2_m = Agrif_Parent(ppe2_m)/Agrif_Rhoy() 341 ENDIF 342 #endif 343 344 DO jj = 1, jpj 345 DO ji = 1, jpi 346 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 347 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = FLOAT( jj - 1 + njmpp - 1 ) 348 zvi = FLOAT( ji - 1 + nimpp - 1 ) ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5 349 zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5 350 351 glamt(ji,jj) = glam0 + ppe1_m * 1.e-5 * zti 352 glamu(ji,jj) = glam0 + ppe1_m * 1.e-5 * zui 353 glamv(ji,jj) = glam0 + ppe1_m * 1.e-5 * zvi 354 glamf(ji,jj) = glam0 + ppe1_m * 1.e-5 * zfi 355 356 gphit(ji,jj) = gphi0 + ppe2_m * 1.e-5 * ztj 357 gphiu(ji,jj) = gphi0 + ppe2_m * 1.e-5 * zuj 358 gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-5 * zvj 359 gphif(ji,jj) = gphi0 + ppe2_m * 1.e-5 * zfj 360 END DO 361 END DO 362 363 ! Horizontal scale factors (in meters) 364 ! ====== 365 !! ==> EITHER 1) variable scale factors 366 DO jj = 1, jpj 367 DO ji = 1, jpi 368 !!e1t(ji,jj) = ppe1_m * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape 369 !!e2t(ji,jj) = ppe2_m * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape 370 e1t(ji,jj) = ppe1_m * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape 371 e2t(ji,jj) = ppe2_m * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape 372 END DO 373 END DO 374 #if defined key_agrif 375 IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 e1t(ji,jj) = ppe1_m * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) & 379 & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid 380 e2t(ji,jj) = ppe2_m * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) & 381 & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid 382 END DO 383 END DO 384 ENDIF 385 #endif 386 !! ==> OR 2) constant scale factors 387 !! e1t(:,:) = ppe1_m 388 !! e2t(:,:) = ppe2_m 389 390 e1u(:,:) = e1t(:,:) ; e2u(:,:) = e2t(:,:) 391 e1v(:,:) = e1t(:,:) ; e2v(:,:) = e2t(:,:) 392 e1f(:,:) = e1t(:,:) ; e2f(:,:) = e2t(:,:) 393 324 394 CASE DEFAULT 325 395 WRITE(ctmp1,*) ' bad flag value for jphgr_msh = ', jphgr_msh … … 377 447 CASE ( 0, 1, 4 ) ! mesh on the sphere 378 448 ! 379 ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 449 ff (:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 450 ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) ) 380 451 ! 381 452 CASE ( 2 ) ! f-plane at ppgphi0 382 453 ! 383 ff(:,:) = 2. * omega * SIN( rad * ppgphi0 ) 454 ff (:,:) = 2. * omega * SIN( rad * ppgphi0 ) 455 ff_t(:,:) = 2. * omega * SIN( rad * ppgphi0 ) ! clem: coriolis at T-point 384 456 ! 385 457 IF(lwp) WRITE(numout,*) ' f-plane: Coriolis parameter = constant = ', ff(1,1) … … 399 471 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 400 472 ! 401 ff(:,:) = ( zf0 + zbeta * gphif(:,:) * 1.e+3 ) ! f = f0 +beta* y ( y=0 at south) 473 ff (:,:) = ( zf0 + zbeta * gphif(:,:) * 1.e+3 ) ! f = f0 +beta* y ( y=0 at south) 474 ff_t(:,:) = ( zf0 + zbeta * gphit(:,:) * 1.e+3 ) ! clem: coriolis at T-point 402 475 ! 403 476 IF(lwp) THEN … … 420 493 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 421 494 ! 422 ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 495 ff (:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 496 ff_t(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra ) ! clem: coriolis at T-point 423 497 ! 424 498 IF(lwp) THEN -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r6492 r7309 145 145 ! Build the vertical coordinate system 146 146 ! ------------------------------------ 147 #if defined key_sas2D 148 WRITE(numout,*) ' domzgr: we use SAS2D (i.e. no ocean) with jpk=',jpk 149 mbathy(:,:) = 1 ; bathy(:,:) = rn_hmin 150 151 gdept_0 (:,:,:) = rn_hmin 152 gdepw_0 (:,:,:) = rn_hmin ; gdep3w_0(:,:,:) = rn_hmin 153 gdept_1d(:) = rn_hmin ; gdepw_1d(:) = rn_hmin 154 155 e3t_0 (:,:,:) = rn_hmin 156 e3u_0 (:,:,:) = rn_hmin ; e3v_0 (:,:,:) = rn_hmin 157 e3f_0 (:,:,:) = rn_hmin ; e3w_0 (:,:,:) = rn_hmin 158 e3uw_0(:,:,:) = rn_hmin ; e3vw_0(:,:,:) = rn_hmin 159 e3t_1d(:) = rn_hmin ; e3w_1d(:) = rn_hmin 160 161 mikt(:,:) = 1 ; mikv(:,:) = 1 162 miku(:,:) = 1 ; mikf(:,:) = 1 163 #else 147 164 CALL zgr_z ! Reference z-coordinate system (always called) 148 165 CALL zgr_bat ! Bathymetry fields (levels and meters) … … 164 181 END IF 165 182 ! 183 #endif 184 166 185 IF( nprint == 1 .AND. lwp ) THEN 167 186 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) … … 476 495 idta( 1 , : ) = 0 ; zdta( 1 , : ) = 0._wp 477 496 idta(jpidta, : ) = 0 ; zdta(jpidta, : ) = 0._wp 497 ELSEIF( jperio == 7 ) THEN 498 ! Nothing to do here 478 499 ELSE 479 500 ih = 0 ; zh = 0._wp … … 738 759 IF( lk_mpp ) THEN 739 760 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 740 IF( jperio /= 1 ) mbathy(1,:) = 0761 IF( jperio /= 1 .AND. jperio /= 7 ) mbathy(1,:) = 0 741 762 ENDIF 742 763 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 743 IF( jperio /= 1 ) mbathy(nlci,:) = 0764 IF( jperio /= 1 .AND. jperio /= 7 ) mbathy(nlci,:) = 0 744 765 ENDIF 745 766 ELSE … … 756 777 mbathy( 1 ,:) = mbathy(jpim1,:) 757 778 mbathy(jpi,:) = mbathy( 2 ,:) 779 IF (jperio == 7) THEN 780 IF(lwp) WRITE(numout,*)' north south boundary conditions on mbathy: jperio = ', jperio 781 mbathy( : ,1) = mbathy(:, jpjm1) 782 mbathy(:, jpj)= mbathy(:,2) 783 ENDIF 758 784 ELSEIF( nperio == 2 ) THEN 759 785 IF(lwp) WRITE(numout,*) ' equatorial boundary conditions on mbathy: nperio = ', nperio -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r6519 r7309 96 96 CHARACTER(len=19) :: cldate 97 97 CHARACTER(len=10) :: clname 98 INTEGER :: ji98 INTEGER :: ji, jkmin 99 99 ! 100 100 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds … … 169 169 170 170 ! Add vertical grid bounds 171 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 171 172 z_bnds(: ,1) = gdepw_1d(:) 172 z_bnds(1:jpkm1,2) = gdepw_1d( 2:jpk)173 z_bnds(1:jpkm1,2) = gdepw_1d(jkmin:jpk) 173 174 z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 174 175 CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 175 176 CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 176 177 CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 177 z_bnds(: ,2) = gdept_1d(:)178 z_bnds( 2:jpk,1) = gdept_1d(1:jpkm1)179 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1)178 z_bnds(: ,2) = gdept_1d(:) 179 z_bnds(jkmin:jpk,1) = gdept_1d(1:jpkm1) 180 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 180 181 CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 181 182 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r6140 r7309 39 39 INTEGER, PARAMETER, PUBLIC :: jp_i1 = 204 !: write INTEGER(1) 40 40 41 INTEGER, PARAMETER, PUBLIC :: jpmax_files = 100 42 INTEGER, PARAMETER, PUBLIC :: jpmax_vars = 600!: maximum number of variables in one file41 INTEGER, PARAMETER, PUBLIC :: jpmax_files = 100 !: maximum number of simultaneously opened file 42 INTEGER, PARAMETER, PUBLIC :: jpmax_vars = 1200 !: maximum number of variables in one file 43 43 INTEGER, PARAMETER, PUBLIC :: jpmax_dims = 4 !: maximum number of dimensions for one variable 44 44 INTEGER, PARAMETER, PUBLIC :: jpmax_digits = 5 !: maximum number of digits for the cpu number in the file name -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r6918 r7309 405 405 ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north 406 406 ENDIF 407 ! ! North-South boundaries (always closed) 408 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point 409 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 407 ! North-south cyclic 408 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south only with no mpp split in latitude 409 ptab(:,1 , :) = ptab(:, jpjm1,:) 410 ptab(:,jpj,:) = ptab(:, 2,:) 411 ELSE ! ! North-South boundaries (closed) 412 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point 413 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 414 ENDIF 410 415 ! 411 416 ENDIF … … 608 613 pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi ,:) = zland ! north 609 614 ENDIF 610 ! ! North-South boundaries (always closed) 615 ! Noth-South boundaries 616 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 617 pt2d_array(ii)%pt2d(:, 1 ) = pt2d_array(ii)%pt2d(:, jpjm1 ) 618 pt2d_array(ii)%pt2d(:, jpj ) = pt2d_array(ii)%pt2d(:, 2 ) 619 ELSE ! 620 ! ! North-South boundaries (closed) 611 621 IF( .NOT. type_array(ii) == 'F' ) pt2d_array(ii)%pt2d(:, 1:jprecj ) = zland ! south except F-point 612 622 pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj ) = zland ! north 613 623 ! 614 ENDIF 624 ENDIF 625 ENDIF 615 626 END DO 616 627 … … 888 899 pt2d(nlci-jpreci+1:jpi ,:) = zland ! north 889 900 ENDIF 890 ! ! North-South boundaries (always closed) 901 ! North-South boudaries 902 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 903 pt2d(:, 1 ) = pt2d(:,jpjm1) 904 pt2d(:, jpj) = pt2d(:, 2) 905 ELSE 906 ! ! North-South boundaries (closed) 891 907 IF( .NOT. cd_type == 'F' ) pt2d(:, 1 :jprecj) = zland !south except F-point 892 908 pt2d(:,nlcj-jprecj+1:jpj ) = zland ! north 893 !909 ENDIF 894 910 ENDIF 895 911 … … 1071 1087 ptab2(nlci-jpreci+1:jpi ,:,:) = 0.e0 1072 1088 ENDIF 1073 1074 1075 ! ! North-South boundaries 1089 ! North-South boundaries 1090 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 1091 ptab1(:, 1 ,:) = ptab1(: , jpjm1 , :) 1092 ptab1(:, jpj ,:) = ptab1(: , 2 , :) 1093 ptab2(:, 1 ,:) = ptab2(: , jpjm1 , :) 1094 ptab2(:, jpj ,:) = ptab2(: , 2 , :) 1095 ELSE 1096 ! ! North-South boundaries closed 1076 1097 IF( .NOT. cd_type1 == 'F' ) ptab1(:, 1 :jprecj,:) = 0.e0 ! south except at F-point 1077 1098 IF( .NOT. cd_type2 == 'F' ) ptab2(:, 1 :jprecj,:) = 0.e0 1078 1099 ptab1(:,nlcj-jprecj+1:jpj ,:) = 0.e0 ! north 1079 1100 ptab2(:,nlcj-jprecj+1:jpj ,:) = 0.e0 1080 1101 ENDIF 1081 1102 1082 1103 ! 2. East and west directions exchange … … 1267 1288 ! Order matters Here !!!! 1268 1289 ! 1269 ! !* North-South boundaries (always colsed) 1290 ! North-South cyclic 1291 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 1292 pt2d(:, 1-jprj: 1 ) = pt2d ( :, jpjm1-jprj:jpjm1) 1293 pt2d(:, jpj :jpj+jprj) = pt2d ( :, 2 :2+jprj) 1294 ELSE 1295 1296 ! !* North-South boundaries (closed) 1270 1297 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-jprj : jprecj ) = 0.e0 ! south except at F-point 1271 1298 pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0 ! north 1272 1299 ENDIF 1300 1273 1301 ! ! East-West boundaries 1274 1302 ! !* Cyclic east-west -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r6412 r7309 76 76 & 'the domain is lay out for distributed memory computing! ' ) 77 77 78 IF( jperio == 7 ) CALL ctl_stop( ' jperio = 7 needs distributed memory computing ', & 79 & ' with 1 process. Add key_mpp_mpi in the list of active cpp keys ' ) 78 80 END SUBROUTINE mpp_init 79 81 … … 379 381 ! w a r n i n g narea (zone) /= nproc (processors)! 380 382 381 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN383 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 382 384 IF( jpni == 1 )THEN 383 385 nbondi = 2 … … 446 448 ENDIF 447 449 450 IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) & 451 & CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' ) 448 452 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' ) 449 453 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
r6140 r7309 4 4 !! Ocean forcing: analytical momentum, heat and freshwater forcings 5 5 !!===================================================================== 6 !! History : 3.0 ! 2006-06 (G. Madec) Original code 7 !! 3.2 ! 2009-07 (G. Madec) Style only 6 !! History : 3.0 ! 2006-06 (G. Madec) Original code 7 !! 3.2 ! 2009-07 (G. Madec) Style only 8 !! 3.7 ! 2016-10 (C. Rousset) Add analytic for LIM3 (ana_ice) 8 9 !!---------------------------------------------------------------------- 9 10 … … 15 16 USE dom_oce ! ocean space and time domain 16 17 USE sbc_oce ! Surface boundary condition: ocean fields 18 USE sbc_ice ! Surface boundary condition: ice fields 17 19 USE phycst ! physical constants 18 20 USE in_out_manager ! I/O manager … … 20 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 23 USE lib_fortran 22 24 USE wrk_nemo 25 #if defined key_lim3 26 USE ice, ONLY : pfrld, a_i_b 27 USE limthd_dh ! for CALL lim_thd_snwblow 28 #endif 29 23 30 IMPLICIT NONE 24 31 PRIVATE 25 32 26 PUBLIC sbc_ana ! routine called in sbcmod module 27 PUBLIC sbc_gyre ! routine called in sbcmod module 33 PUBLIC sbc_ana ! routine called in sbcmod module 34 PUBLIC sbc_gyre ! routine called in sbcmod module 35 #if defined key_lim3 36 PUBLIC ana_ice_tau ! routine called in sbc_ice_lim module 37 PUBLIC ana_ice_flx ! routine called in sbc_ice_lim module 38 #endif 28 39 29 40 ! !!* Namelist namsbc_ana * 30 INTEGER :: nn_tau000 ! nb of time-step during which the surface stress 31 ! ! increase from 0 to its nominal value 32 REAL(wp) :: rn_utau0 ! constant wind stress value in i-direction 33 REAL(wp) :: rn_vtau0 ! constant wind stress value in j-direction 34 REAL(wp) :: rn_qns0 ! non solar heat flux 35 REAL(wp) :: rn_qsr0 ! solar heat flux 36 REAL(wp) :: rn_emp0 ! net freshwater flux 41 ! --- oce variables --- ! 42 INTEGER :: nn_tau000 ! nb of time-step during which the surface stress 43 ! ! increase from 0 to its nominal value 44 REAL(wp) :: rn_utau0 ! constant wind stress value in i-direction 45 REAL(wp) :: rn_vtau0 ! constant wind stress value in j-direction 46 REAL(wp) :: rn_qns0 ! non solar heat flux 47 REAL(wp) :: rn_qsr0 ! solar heat flux 48 REAL(wp) :: rn_emp0 ! net freshwater flux 49 ! --- ice variables --- ! 50 REAL(wp) :: rn_iutau0 ! constant wind stress value in i-direction over ice 51 REAL(wp) :: rn_ivtau0 ! constant wind stress value in j-direction over ice 52 REAL(wp) :: rn_iqns0 ! non solar heat flux over ice 53 REAL(wp) :: rn_iqsr0 ! solar heat flux over ice 54 REAL(wp) :: rn_sprec0 ! snow precip 55 REAL(wp) :: rn_ievap0 ! sublimation 37 56 38 57 !! * Substitutions … … 68 87 REAL(wp) :: zcoef, zty, zmod ! - - 69 88 !! 70 NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0 89 NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0, & 90 & rn_iutau0, rn_ivtau0, rn_iqsr0, rn_iqns0, rn_sprec0, rn_ievap0 71 91 !!--------------------------------------------------------------------- 72 92 ! … … 85 105 IF(lwp) WRITE(numout,*)' sbc_ana : Constant surface fluxes read in namsbc_ana namelist' 86 106 IF(lwp) WRITE(numout,*)' ~~~~~~~ ' 87 IF(lwp) WRITE(numout,*)' spin up of the stress nn_tau000 = ', nn_tau000, ' time-steps' 88 IF(lwp) WRITE(numout,*)' constant i-stress rn_utau0 = ', rn_utau0 , ' N/m2' 89 IF(lwp) WRITE(numout,*)' constant j-stress rn_vtau0 = ', rn_vtau0 , ' N/m2' 90 IF(lwp) WRITE(numout,*)' non solar heat flux rn_qns0 = ', rn_qns0 , ' W/m2' 91 IF(lwp) WRITE(numout,*)' solar heat flux rn_qsr0 = ', rn_qsr0 , ' W/m2' 92 IF(lwp) WRITE(numout,*)' net heat flux rn_emp0 = ', rn_emp0 , ' Kg/m2/s' 107 IF(lwp) WRITE(numout,*)' spin up of the stress nn_tau000 = ', nn_tau000 , ' time-steps' 108 IF(lwp) WRITE(numout,*)' constant i-stress rn_utau0 = ', rn_utau0 , ' N/m2' 109 IF(lwp) WRITE(numout,*)' constant j-stress rn_vtau0 = ', rn_vtau0 , ' N/m2' 110 IF(lwp) WRITE(numout,*)' non solar heat flux rn_qns0 = ', rn_qns0 , ' W/m2' 111 IF(lwp) WRITE(numout,*)' solar heat flux rn_qsr0 = ', rn_qsr0 , ' W/m2' 112 IF(lwp) WRITE(numout,*)' net freshwater flux rn_emp0 = ', rn_emp0 , ' Kg/m2/s' 113 IF(lwp) WRITE(numout,*)' constant ice-atm stress rn_iutau0 = ', rn_iutau0 , ' N/m2' 114 IF(lwp) WRITE(numout,*)' constant ice-atm stress rn_ivtau0 = ', rn_ivtau0 , ' N/m2' 115 IF(lwp) WRITE(numout,*)' solar heat flux over ice rn_iqsr0 = ', rn_iqsr0 , ' W/m2' 116 IF(lwp) WRITE(numout,*)' non solar heat flux over ice rn_iqns0 = ', rn_iqns0 , ' W/m2' 117 IF(lwp) WRITE(numout,*)' snow precip rn_sprec0 = ', rn_sprec0 , ' Kg/m2/s' 118 IF(lwp) WRITE(numout,*)' sublimation rn_ievap0 = ', rn_ievap0 , ' Kg/m2/s' 93 119 ! 94 120 nn_tau000 = MAX( nn_tau000, 1 ) ! must be >= 1 … … 132 158 END SUBROUTINE sbc_ana 133 159 134 160 #if defined key_lim3 161 SUBROUTINE ana_ice_tau 162 !!--------------------------------------------------------------------- 163 !! *** ROUTINE ana_ice_tau *** 164 !! 165 !! ** Purpose : provide the surface boundary (momentum) condition over sea-ice 166 !!--------------------------------------------------------------------- 167 utau_ice(:,:) = rn_iutau0 168 vtau_ice(:,:) = rn_ivtau0 169 170 END SUBROUTINE ana_ice_tau 171 172 SUBROUTINE ana_ice_flx 173 !!--------------------------------------------------------------------- 174 !! *** ROUTINE ana_ice_flx *** 175 !! 176 !! ** Purpose : provide the surface boundary (flux) condition over sea-ice 177 !!--------------------------------------------------------------------- 178 REAL(wp), DIMENSION(:,:), POINTER :: zsnw ! snw distribution after wind blowing 179 !!--------------------------------------------------------------------- 180 CALL wrk_alloc( jpi,jpj, zsnw ) 181 182 ! ocean variables (renaming) 183 emp_oce (:,:) = rn_emp0 184 qsr_oce (:,:) = rn_qsr0 185 qns_oce (:,:) = rn_qns0 186 187 ! ice variables 188 alb_ice (:,:,:) = 0.7_wp ! useless 189 qsr_ice (:,:,:) = rn_iqsr0 190 qns_ice (:,:,:) = rn_iqns0 191 sprecip (:,:) = rn_sprec0 192 evap_ice(:,:,:) = rn_ievap0 193 194 ! ice variables deduced from above 195 zsnw(:,:) = 1._wp 196 !!CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing 197 emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:) 198 emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) ) 199 qevap_ice(:,:,:) = 0._wp 200 qprec_ice(:,:) = rhosn * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) ! in J/m3 201 qemp_oce (:,:) = - emp_oce(:,:) * sst_m(:,:) * rcp 202 qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) ! solid precip (only) 203 204 ! total fluxes 205 emp_tot (:,:) = emp_ice + emp_oce 206 qns_tot (:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 207 qsr_tot (:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 208 209 !-------------------------------------------------------------------- 210 ! FRACTIONs of net shortwave radiation which is not absorbed in the 211 ! thin surface layer and penetrates inside the ice cover 212 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 213 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 214 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 215 216 CALL wrk_dealloc( jpi,jpj, zsnw ) 217 218 END SUBROUTINE ana_ice_flx 219 #endif 220 221 135 222 SUBROUTINE sbc_gyre( kt ) 136 223 !!--------------------------------------------------------------------- -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r6813 r7309 16 16 !! 3.4 ! 2011-11 (C. Harris) Fill arrays required by CICE 17 17 !! 3.7 ! 2014-06 (L. Brodeau) simplification and optimization of CORE bulk 18 !! 4.0 ! 2016-06 (C. Rousset) Add new param of drags with sea-ice (Lupkes at al 2012) 18 19 !!---------------------------------------------------------------------- 19 20 … … 38 39 USE lib_fortran ! to use key_nosignedzero 39 40 #if defined key_lim3 40 USE ice , ONLY : u_ice, v_ice, jpl, pfrld, a_i_b41 USE ice, ONLY : u_ice, v_ice, jpl, pfrld, a_i_b, at_i_b 41 42 USE limthd_dh ! for CALL lim_thd_snwblow 42 43 #elif defined key_lim2 43 USE ice_2 , ONLY :u_ice, v_ice44 USE par_ice_2 ! LIM-2 parameters44 USE ice_2, ONLY : u_ice, v_ice 45 USE par_ice_2 45 46 #endif 46 47 ! … … 61 62 PUBLIC blk_ice_core_flx ! routine called in sbc_ice_lim module 62 63 #endif 63 PUBLIC turb_core_2z ! routine calle sin sbcblk_mfs module64 PUBLIC turb_core_2z ! routine called in sbcblk_mfs module 64 65 65 66 INTEGER , PARAMETER :: jpfld = 9 ! maximum number of files to read … … 77 78 78 79 ! !!! CORE bulk parameters 79 REAL(wp), PARAMETER :: rhoa = 1.22 ! air density80 REAL(wp), PARAMETER :: cpa = 1000.5 ! specific heat of air81 REAL(wp), PARAMETER :: Lv = 2.5e6 ! latent heat of vaporization82 REAL(wp), PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation83 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant84 REAL(wp), PARAMETER :: C ice = 1.4e-3 ! iovi 1.63e-3! transfer coefficient over ice85 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant80 REAL(wp), PARAMETER :: rhoa = 1.22 ! air density 81 REAL(wp), PARAMETER :: cpa = 1000.5 ! specific heat of air 82 REAL(wp), PARAMETER :: Lv = 2.5e6 ! latent heat of vaporization 83 REAL(wp), PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation 84 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 85 REAL(wp), PARAMETER :: Cd_ice = 1.4e-3 ! transfer coefficient over ice 86 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 86 87 87 88 ! !!* Namelist namsbc_core : CORE bulk parameters … … 92 93 REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements 93 94 REAL(wp) :: rn_zu ! z(u) : height of wind measurements 94 95 LOGICAL :: ln_Cd_L12 = .FALSE. ! Modify the drag ice-atm and oce-atm depending on ice concentration (from Lupkes et al. JGR2012) 96 97 ! 98 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Cd_oce ! air-ocean drag (clem) 99 95 100 !! * Substitutions 96 101 # include "vectopt_loop_substitute.h90" … … 102 107 CONTAINS 103 108 109 INTEGER FUNCTION sbc_blk_core_alloc() 110 !!------------------------------------------------------------------- 111 !! *** ROUTINE sbc_blk_core_alloc (clem) *** 112 !!------------------------------------------------------------------- 113 ALLOCATE( Cd_oce(jpi,jpj) , STAT=sbc_blk_core_alloc ) 114 ! 115 IF( lk_mpp ) CALL mpp_sum( sbc_blk_core_alloc ) 116 IF( sbc_blk_core_alloc /= 0 ) CALL ctl_warn('sbc_blk_core_alloc: failed to allocate arrays') 117 END FUNCTION sbc_blk_core_alloc 118 119 104 120 SUBROUTINE sbc_blk_core( kt ) 105 121 !!--------------------------------------------------------------------- … … 149 165 TYPE(FLD_N) :: sn_tdif ! " " 150 166 NAMELIST/namsbc_core/ cn_dir , ln_taudif, rn_pfac, rn_efac, rn_vfac, & 151 & sn_wndi, sn_wndj , sn_humi, sn_qsr , &152 & sn_qlw , sn_tair , sn_prec, sn_snow, &153 & sn_tdif, rn_zqt , rn_zu167 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & 168 & sn_qlw , sn_tair, sn_prec , sn_snow, & 169 & sn_tdif, rn_zqt, rn_zu , ln_Cd_L12 154 170 !!--------------------------------------------------------------------- 155 171 ! … … 157 173 IF( kt == nit000 ) THEN ! First call kt=nit000 ! 158 174 ! ! ====================== ! 175 ! 176 ! ! allocate sbc_blk_core array (clem) 177 IF( sbc_blk_core_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_core : unable to allocate standard arrays' ) 159 178 ! 160 179 REWIND( numnam_ref ) ! Namelist namsbc_core in reference namelist : CORE bulk parameters … … 321 340 & Cd, Ch, Ce, zt_zu, zq_zu ) 322 341 342 Cd_oce(:,:) = Cd(:,:) ! record value of pure ocean-atm. drag (clem) 343 323 344 ! ... tau module, i and j component 324 345 DO jj = 1, jpj … … 439 460 !!--------------------------------------------------------------------- 440 461 INTEGER :: ji, jj ! dummy loop indices 441 REAL(wp) :: zcoef_wnorm, zcoef_wnorm2442 462 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 443 463 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 464 REAL(wp), DIMENSION(:,:), POINTER :: Cd ! transfer coefficient for momentum (tau) 444 465 !!--------------------------------------------------------------------- 445 466 ! 446 467 IF( nn_timing == 1 ) CALL timing_start('blk_ice_core_tau') 447 468 ! 448 ! local scalars ( place there for vector optimisation purposes) 449 zcoef_wnorm = rhoa * Cice 450 zcoef_wnorm2 = rhoa * Cice * 0.5 469 CALL wrk_alloc( jpi,jpj, Cd ) 470 471 Cd(:,:) = Cd_ice 472 473 ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 474 #if defined key_lim3 475 IF( ln_Cd_L12 ) THEN 476 CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 477 ENDIF 478 #endif 451 479 452 480 !!gm brutal.... … … 469 497 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) & 470 498 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * v_ice(ji,jj) 471 zwnorm_f = zcoef_wnorm* SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )499 zwnorm_f = rhoa * Cd(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 472 500 ! ... ice stress at I-point 473 501 utau_ice(ji,jj) = zwnorm_f * zwndi_f … … 478 506 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( v_ice(ji,jj+1) + v_ice(ji+1,jj+1) & 479 507 & + v_ice(ji,jj ) + v_ice(ji+1,jj ) ) 480 wndm_ice(ji,jj) 508 wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 481 509 END DO 482 510 END DO … … 495 523 DO jj = 2, jpjm1 496 524 DO ji = fs_2, fs_jpim1 ! vect. opt. 497 utau_ice(ji,jj) = zcoef_wnorm2* ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) ) &525 utau_ice(ji,jj) = rhoa * Cd(ji,jj) * 0.5_wp * ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) ) & 498 526 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 499 vtau_ice(ji,jj) = zcoef_wnorm2* ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) ) &527 vtau_ice(ji,jj) = rhoa * Cd(ji,jj) * 0.5_wp * ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) ) & 500 528 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 501 529 END DO … … 511 539 CALL prt_ctl(tab2d_1=wndm_ice , clinfo1=' blk_ice_core: wndm_ice : ') 512 540 ENDIF 541 542 CALL wrk_dealloc( jpi,jpj, Cd ) 513 543 514 544 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core_tau') … … 542 572 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqsb ! sensible heat sensitivity over ice 543 573 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3) 574 REAL(wp), DIMENSION(:,:) , POINTER :: Cd ! transfer coefficient for momentum (tau) 544 575 !!--------------------------------------------------------------------- 545 576 ! … … 547 578 ! 548 579 CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 580 CALL wrk_alloc( jpi,jpj, Cd ) 581 582 Cd(:,:) = Cd_ice 583 584 ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 585 #if defined key_lim3 586 IF( ln_Cd_L12 ) THEN 587 CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 588 ENDIF 589 #endif 549 590 550 591 ! local scalars ( place there for vector optimisation purposes) 551 592 zcoef_dqlw = 4.0 * 0.95 * Stef 552 zcoef_dqla = -Ls * Cice *11637800. * (-5897.8)553 zcoef_dqsb = rhoa * cpa * Cice593 zcoef_dqla = -Ls * 11637800. * (-5897.8) 594 zcoef_dqsb = rhoa * cpa 554 595 555 596 zztmp = 1. / ( 1. - albo ) … … 577 618 ! ... turbulent heat fluxes 578 619 ! Sensible Heat 579 z_qsb(ji,jj,jl) = rhoa * cpa * C ice* wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )620 z_qsb(ji,jj,jl) = rhoa * cpa * Cd(ji,jj) * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 580 621 ! Latent Heat 581 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls * C ice* wndm_ice(ji,jj) &622 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls * Cd(ji,jj) * wndm_ice(ji,jj) & 582 623 & * ( 11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) ) 583 624 ! Latent heat sensitivity for ice (Dqla/Dt) 584 625 IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 585 dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) )626 dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Cd(ji,jj) * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) ) 586 627 ELSE 587 628 dqla_ice(ji,jj,jl) = 0._wp … … 589 630 590 631 ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 591 z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj)632 z_dqsb(ji,jj,jl) = zcoef_dqsb * Cd(ji,jj) * wndm_ice(ji,jj) 592 633 593 634 ! ----------------------------! … … 668 709 669 710 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 711 CALL wrk_dealloc( jpi,jpj, Cd ) 670 712 ! 671 713 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core_flx') … … 905 947 END FUNCTION psi_h 906 948 949 950 #if defined key_lim3 951 SUBROUTINE Cdn10_Lupkes2012( Cd ) 952 !!---------------------------------------------------------------------- 953 !! *** ROUTINE Cdn10_Lupkes2012 *** 954 !! 955 !! ** Purpose : Recompute the ice-atm drag at 10m height to make 956 !! it dependent on edges at leads, melt ponds and flows. 957 !! After some approximations, this can be resumed to a dependency 958 !! on ice concentration. 959 !! 960 !! ** Method : The parameterization is taken from Lupkes et al. (2012) eq.(50) 961 !! with the highest level of approximation: level4, eq.(59) 962 !! The generic drag over a cell partly covered by ice can be re-written as follows: 963 !! 964 !! Cd = Cdw * (1-A) + Cdi * A + Ce * (1-A)**(nu+1/(10*beta)) * A**mu 965 !! 966 !! Ce = 2.23e-3 , as suggested by Lupkes (eq. 59) 967 !! nu = mu = beta = 1 , as suggested by Lupkes (eq. 59) 968 !! A is the concentration of ice minus melt ponds (if any) 969 !! 970 !! This new drag has a parabolic shape (as a function of A) starting at 971 !! Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 972 !! and going down to Cdi(say 1.4e-3) for A=1 973 !! 974 !! It is theoretically applicable to all ice conditions (not only MIZ) 975 !! => see Lupkes et al (2013) 976 !! 977 !! ** References : Lupkes et al. JGR 2012 (theory) 978 !! Lupkes et al. GRL 2013 (application to GCM) 979 !! 980 !!---------------------------------------------------------------------- 981 REAL(wp), DIMENSION(:,:), INTENT(inout) :: Cd 982 REAL(wp), PARAMETER :: zCe = 2.23e-03_wp 983 REAL(wp), PARAMETER :: znu = 1._wp 984 REAL(wp), PARAMETER :: zmu = 1._wp 985 REAL(wp), PARAMETER :: zbeta = 1._wp 986 REAL(wp) :: zcoef 987 !!---------------------------------------------------------------------- 988 zcoef = znu + 1._wp / ( 10._wp * zbeta ) 989 990 ! generic drag over a cell partly covered by ice 991 !!Cd(:,:) = Cd_oce(:,:) * ( 1._wp - at_i_b(:,:) ) + & ! pure ocean drag 992 !! & Cd_ice * at_i_b(:,:) + & ! pure ice drag 993 !! & zCe * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**zmu ! change due to sea-ice morphology 994 995 ! ice-atm drag 996 Cd(:,:) = Cd_ice + & ! pure ice drag 997 & zCe * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp) ! change due to sea-ice morphology 998 999 END SUBROUTINE Cdn10_Lupkes2012 1000 #endif 1001 907 1002 !!====================================================================== 908 1003 END MODULE sbcblk_core -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6722 r7309 168 168 # include "vectopt_loop_substitute.h90" 169 169 !!---------------------------------------------------------------------- 170 !! NEMO/OPA 3. 7 , NEMO Consortium (2015)170 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 171 171 !! $Id$ 172 172 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 1599 1599 ENDIF 1600 1600 1601 !! clem: we should output qemp_oce and qemp_ice (at least) 1602 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1603 !! these diags are not outputed yet 1604 !! IF( iom_use('hflx_rain_cea') ) CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) ) ! heat flux from rain (cell average) 1605 !! IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put( 'hflx_snow_ao_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 1606 !! IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 1601 ! some more outputs 1602 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1603 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) ) ! heat flux from rain (cell average) 1604 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 1605 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 1607 1606 1608 1607 #else -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r6416 r7309 24 24 USE ice ! LIM-3: ice variables 25 25 USE thd_ice ! LIM-3: thermodynamical variables 26 USE dom_ice ! LIM-3: ice domain27 26 ! 28 27 USE sbc_oce ! Surface boundary condition: ocean fields … … 31 30 USE sbcblk_clio ! Surface boundary condition: CLIO bulk 32 31 USE sbccpl ! Surface boundary condition: coupled interface 32 USE sbcana ! Surface boundary condition: analytic formulation 33 33 USE albedo ! ocean & ice albedo 34 34 ! … … 48 48 USE limvar ! Ice variables switch 49 49 USE limctl ! 50 USE limmsh ! LIM mesh51 50 USE limistate ! LIM initial state 52 51 USE limthd_sal ! LIM ice thermodynamics: salinity … … 65 64 USE bdyice_lim ! unstructured open boundary data (bdy_ice_lim routine) 66 65 #endif 66 # if defined key_agrif 67 USE agrif_ice 68 USE agrif_lim3_update 69 USE agrif_lim3_interp 70 # endif 67 71 68 72 IMPLICIT NONE … … 102 106 !!--------------------------------------------------------------------- 103 107 INTEGER, INTENT(in) :: kt ! ocean time step 104 INTEGER, INTENT(in) :: kblk ! type of bulk (= 3 CLIO, =4 CORE, =5 COUPLED)105 !! 106 INTEGER :: 108 INTEGER, INTENT(in) :: kblk ! type of bulk (=1 ANALYTIC, =3 CLIO, =4 CORE, =5 COUPLED) 109 !! 110 INTEGER :: jl ! dummy loop index 107 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 108 112 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice … … 110 114 111 115 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 116 117 ! clem: it is important to initialize agrif_lim3 variables here and not in sbc_lim_init 118 # if defined key_agrif 119 IF( kt == nit000 ) THEN 120 IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim3 121 ENDIF 122 # endif 112 123 113 124 !-----------------------! … … 115 126 !-----------------------! 116 127 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 128 129 # if defined key_agrif 130 IF( .NOT. Agrif_Root() ) lim_nbstep = MOD( lim_nbstep, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1 131 # endif 117 132 118 133 ! mean surface ocean current at ice velocity point (C-grid dynamics : U- & V-points as the ocean) … … 136 151 !----------------------------------------------------------------- 137 152 SELECT CASE( kblk ) 138 CASE( jp_clio ) ; CALL blk_ice_clio_tau ! CLIO bulk formulation 139 CASE( jp_core ) ; CALL blk_ice_core_tau ! CORE bulk formulation 140 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 153 CASE( jp_ana ) ; CALL ana_ice_tau ! analytic formulation 154 CASE( jp_clio ) ; CALL blk_ice_clio_tau ! CLIO bulk formulation 155 CASE( jp_core ) ; CALL blk_ice_core_tau ! CORE bulk formulation 156 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 141 157 END SELECT 142 158 143 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation159 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 144 160 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 145 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )161 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 146 162 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 147 163 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) … … 154 170 numit = numit + nn_fsbc ! Ice model time step 155 171 ! 156 CALL sbc_lim_bef ! Store previous ice values 157 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 158 CALL lim_rst_opn( kt ) ! Open Ice restart file 159 ! 160 IF( .NOT. lk_c1d ) THEN 172 CALL sbc_lim_bef ! Store previous ice values 173 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 174 CALL lim_rst_opn( kt ) ! Open Ice restart file 175 ! 176 ! --- zap this if no ice dynamics --- ! 177 IF( .NOT. lk_c1d .AND. ln_limdyn ) THEN 161 178 ! 162 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 163 ! 164 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 165 ! 166 IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 167 ! 168 #if defined key_bdy 169 CALL bdy_ice_lim( kt ) ! bdy ice thermo 170 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 171 #endif 172 ! 173 CALL lim_update1( kt ) ! Corrections 179 IF( nn_limdyn /= 0 ) THEN ! -- Ice dynamics 180 CALL lim_dyn( kt ) ! rheology 181 ELSE 182 u_ice(:,:) = rn_uice * umask(:,:,1) ! or prescribed velocity 183 v_ice(:,:) = rn_vice * vmask(:,:,1) 184 ENDIF 185 CALL lim_trp( kt ) ! -- Ice transport (Advection/diffusion) 186 IF( nn_limdyn == 2 .AND. nn_monocat /= 2 ) & ! -- Mechanical redistribution (ridging/rafting) 187 & CALL lim_itd_me 188 IF( nn_limdyn == 2 ) CALL lim_update1( kt ) ! -- Corrections 174 189 ! 175 190 ENDIF 176 191 192 ! --- 193 #if defined key_agrif 194 IF( .NOT. Agrif_Root() ) CALL agrif_interp_lim3('T') 195 #endif 196 #if defined key_bdy 197 IF( ln_limthd ) CALL bdy_ice_lim( kt ) ! -- bdy ice thermo 198 #endif 199 177 200 ! previous lead fraction and ice volume for flux calculations 178 CALL sbc_lim_bef 179 CALL lim_var_glo2eqv ! ht_i and ht_s for ice albedo calculation 180 CALL lim_var_agg(1) ! at_i for coupling (via pfrld) 201 CALL sbc_lim_bef 202 CALL lim_var_glo2eqv ! ht_i and ht_s for ice albedo calculation 203 CALL lim_var_agg(1) ! at_i for coupling (via pfrld) 204 ! 181 205 pfrld(:,:) = 1._wp - at_i(:,:) 182 206 phicif(:,:) = vt_i(:,:) … … 193 217 !---------------------------------------------------------------------------------------- 194 218 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 195 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos196 219 220 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 197 221 SELECT CASE( kblk ) 198 CASE( jp_clio ) ! CLIO bulk formulation 199 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 200 ! (alb_ice) is computed within the bulk routine 201 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 202 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 203 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 204 CASE( jp_core ) ! CORE bulk formulation 205 ! albedo depends on cloud fraction because of non-linear spectral effects 206 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 207 CALL blk_ice_core_flx( t_su, alb_ice ) 208 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 209 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 210 CASE ( jp_purecpl ) 211 ! albedo depends on cloud fraction because of non-linear spectral effects 212 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 213 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 214 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 222 223 CASE( jp_ana ) ! analytic formulation 224 CALL ana_ice_flx 225 226 CASE( jp_clio ) ! CLIO bulk formulation 227 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 228 ! (alb_ice) is computed within the bulk routine 229 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 230 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 231 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 232 233 CASE( jp_core ) ! CORE bulk formulation 234 ! albedo depends on cloud fraction because of non-linear spectral effects 235 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 236 CALL blk_ice_core_flx( t_su, alb_ice ) 237 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 238 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 239 240 CASE ( jp_purecpl ) ! Coupled formulation 241 ! albedo depends on cloud fraction because of non-linear spectral effects 242 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 243 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 244 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 245 215 246 END SELECT 247 216 248 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 217 249 … … 219 251 ! --- ice thermodynamics --- ! 220 252 !----------------------------! 221 CALL lim_thd( kt ) ! Ice thermodynamics 222 ! 223 CALL lim_update2( kt ) ! Corrections 224 ! 225 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 226 ! 227 IF(ln_limdiaout) CALL lim_diahsb ! Diagnostics and outputs 228 ! 229 CALL lim_wri( 1 ) ! Ice outputs 253 ! --- zap this if no ice thermo --- ! 254 IF( ln_limthd ) CALL lim_thd( kt ) ! -- Ice thermodynamics 255 IF( ln_limthd ) CALL lim_update2( kt ) ! -- Corrections 256 ! --- 257 # if defined key_agrif 258 IF( .NOT. Agrif_Root() ) CALL agrif_update_lim3( kt ) 259 # endif 260 CALL lim_var_glo2eqv ! necessary calls (at least for coupling) 261 CALL lim_var_agg( 2 ) ! necessary calls (at least for coupling) 262 ! 263 # if defined key_agrif 264 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ChildGrid_To_ParentGrid() ! clem: should be called at the update frequency only (cf agrif_lim3_update) 265 # endif 266 CALL lim_sbc_flx( kt ) ! -- Update surface ocean mass, heat and salt fluxes 267 # if defined key_agrif 268 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ParentGrid_To_ChildGrid() ! clem: should be called at the update frequency only (cf agrif_lim3_update) 269 # endif 270 IF( ln_limdiahsb ) CALL lim_diahsb( kt ) ! -- Diagnostics and outputs 271 ! 272 CALL lim_wri( 1 ) ! -- Ice outputs 230 273 ! 231 274 IF( kt == nit000 .AND. ln_rstart ) & 232 & CALL iom_close( numrir ) ! close input ice restart file233 ! 234 IF( lrst_ice ) CALL lim_rst_write( kt ) !Ice restart file235 ! 236 IF( ln_ icectl )CALL lim_ctl( kt ) ! alerts in case of model crash275 & CALL iom_close( numrir ) ! close input ice restart file 276 ! 277 IF( lrst_ice ) CALL lim_rst_write( kt ) ! -- Ice restart file 278 ! 279 IF( ln_limctl ) CALL lim_ctl( kt ) ! alerts in case of model crash 237 280 ! 238 281 ENDIF ! End sea-ice time step only … … 242 285 !-------------------------! 243 286 ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere 244 IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 287 ! using before instantaneous surf. currents 288 IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) 245 289 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 246 290 ! … … 259 303 !!---------------------------------------------------------------------- 260 304 IF(lwp) WRITE(numout,*) 261 IF(lwp) WRITE(numout,*) 'sbc_ ice_lim: update ocean surface boudary condition'305 IF(lwp) WRITE(numout,*) 'sbc_lim_init : update ocean surface boudary condition' 262 306 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 263 307 ! … … 271 315 ! ! Allocate the ice arrays 272 316 ierr = ice_alloc () ! ice variables 273 ierr = ierr + dom_ice_alloc () ! domain274 317 ierr = ierr + sbc_ice_alloc () ! surface forcing 275 318 ierr = ierr + thd_ice_alloc () ! thermodynamics 276 ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics319 IF( ln_limdyn ) ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics 277 320 ! 278 321 IF( lk_mpp ) CALL mpp_sum( ierr ) 279 322 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays') 280 323 ! 281 ! ! adequation jpk versus ice/snow layers/categories 282 IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk ) & 283 & CALL ctl_stop( 'STOP', & 284 & 'sbc_lim_init: the 3rd dimension of workspace arrays is too small.', & 285 & 'use more ocean levels or less ice/snow layers/categories.' ) 324 CALL lim_dyn_init ! set ice dynamics parameters 286 325 ! 287 326 CALL lim_itd_init ! ice thickness distribution initialization … … 293 332 CALL lim_thd_sal_init ! set ice salinity parameters 294 333 ! 295 CALL lim_msh ! ice mesh initialization 296 ! 297 CALL lim_itd_me_init ! ice thickness distribution initialization for mecanical deformation 334 IF( ln_limdyn ) CALL lim_itd_me_init ! ice thickness distribution initialization for mecanical deformation 298 335 ! ! Initial sea-ice state 299 336 IF( .NOT. ln_rstart ) THEN ! start from rest: sea-ice deduced from sst … … 305 342 numit = nit000 - 1 306 343 ENDIF 307 CALL lim_var_agg( 1)344 CALL lim_var_agg(2) 308 345 CALL lim_var_glo2eqv 309 346 ! 310 347 CALL lim_sbc_init ! ice surface boundary condition 348 ! 349 IF( ln_limdiahsb) CALL lim_diahsb_init ! initialization for diags 311 350 ! 312 351 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction … … 342 381 !!------------------------------------------------------------------- 343 382 INTEGER :: ios ! Local integer output status for namelist read 344 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, & 345 & ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt 383 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, rn_amax_n, rn_amax_s, cn_icerst_in, cn_icerst_indir, & 384 & cn_icerst_out, cn_icerst_outdir, ln_limthd, ln_limdyn, nn_limdyn, rn_uice, rn_vice 385 NAMELIST/namicediag/ ln_limdiachk, ln_limdiahsb, ln_limctl, iiceprt, jiceprt 346 386 !!------------------------------------------------------------------- 347 387 ! 348 388 REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice 349 389 READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 350 901 IF( ios /= 0 ) 351 ! 390 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 391 352 392 REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice 353 393 READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 354 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 355 IF(lwm) WRITE( numoni, namicerun ) 394 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 395 IF(lwm) WRITE ( numoni, namicerun ) 396 ! 397 REWIND( numnam_ice_ref ) ! Namelist namicediag in reference namelist : Parameters for ice 398 READ ( numnam_ice_ref, namicediag, IOSTAT = ios, ERR = 903) 399 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in reference namelist', lwp ) 400 401 REWIND( numnam_ice_cfg ) ! Namelist namicediag in configuration namelist : Parameters for ice 402 READ ( numnam_ice_cfg, namicediag, IOSTAT = ios, ERR = 904 ) 403 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in configuration namelist', lwp ) 404 IF(lwm) WRITE ( numoni, namicediag ) 356 405 ! 357 406 IF(lwp) THEN ! control print … … 362 411 WRITE(numout,*) ' number of ice layers = ', nlay_i 363 412 WRITE(numout,*) ' number of snow layers = ', nlay_s 364 WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn365 413 WRITE(numout,*) ' maximum ice concentration for NH = ', rn_amax_n 366 414 WRITE(numout,*) ' maximum ice concentration for SH = ', rn_amax_s 367 WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb 368 WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout 369 WRITE(numout,*) ' control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 370 WRITE(numout,*) ' i-index for control prints (ln_icectl=true) = ', iiceprt 371 WRITE(numout,*) ' j-index for control prints (ln_icectl=true) = ', jiceprt 415 WRITE(numout,*) ' Ice thermodynamics (T) or not (F) ln_limthd = ', ln_limthd 416 WRITE(numout,*) ' Ice dynamics (T) or not (F) ln_limdyn = ', ln_limdyn 417 WRITE(numout,*) ' (ln_limdyn=T) Ice dynamics switch nn_limdyn = ', nn_limdyn 418 WRITE(numout,*) ' 2: total' 419 WRITE(numout,*) ' 1: advection only (no diffusion, no ridging/rafting)' 420 WRITE(numout,*) ' 0: advection only (as 1 + prescribed velocity, bypass rheology)' 421 WRITE(numout,*) ' (ln_limdyn=T) prescribed u-vel (case nn_limdyn=0) = ', rn_uice 422 WRITE(numout,*) ' (ln_limdyn=T) prescribed v-vel (case nn_limdyn=0) = ', rn_vice 423 WRITE(numout,*) 424 WRITE(numout,*) '...and ice diagnostics' 425 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~' 426 WRITE(numout,*) ' Diagnose online heat/mass/salt budget ln_limdiachk = ', ln_limdiachk 427 WRITE(numout,*) ' Output heat/mass/salt budget ln_limdiahsb = ', ln_limdiahsb 428 WRITE(numout,*) ' control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_limctl 429 WRITE(numout,*) ' i-index for control prints (ln_limctl=true) = ', iiceprt 430 WRITE(numout,*) ' j-index for control prints (ln_limctl=true) = ', jiceprt 372 431 ENDIF 373 432 ! 374 433 ! sea-ice timestep and inverse 375 rdt_ice = nn_fsbc* rdt434 rdt_ice = REAL(nn_fsbc) * rdt 376 435 r1_rdtice = 1._wp / rdt_ice 377 436 … … 381 440 ! 382 441 #if defined key_bdy 383 IF( lwp .AND. ln_limdia hsb) CALL ctl_warn('online conservation check activated but it does not work with BDY')442 IF( lwp .AND. ln_limdiachk ) CALL ctl_warn('online conservation check activated but it does not work with BDY') 384 443 #endif 444 ! 445 IF( lwp ) WRITE(numout,*) ' ice timestep rdt_ice = ', rdt_ice 385 446 ! 386 447 END SUBROUTINE ice_run … … 404 465 ! 405 466 REWIND( numnam_ice_ref ) ! Namelist namiceitd in reference namelist : Parameters for ice 406 READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 90 3)407 90 3 IF( ios /= 0 )CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )408 ! 467 READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 905) 468 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 469 409 470 REWIND( numnam_ice_cfg ) ! Namelist namiceitd in configuration namelist : Parameters for ice 410 READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 90 4)411 90 4 IF( ios /= 0 )CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp )412 IF(lwm) WRITE ( numoni, namiceitd )471 READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 906 ) 472 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 473 IF(lwm) WRITE ( numoni, namiceitd ) 413 474 ! 414 475 IF(lwp) THEN ! control print 415 476 WRITE(numout,*) 416 WRITE(numout,*) ' ice_itd : ice cat distribution'417 WRITE(numout,*) ' 418 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd419 WRITE(numout,*) ' mean ice thickness in the domain ( used if nn_catbnd=2)rn_himean = ', rn_himean477 WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 478 WRITE(numout,*) '~~~~~~~~~~~~' 479 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 480 WRITE(numout,*) ' mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean 420 481 ENDIF 421 482 ! … … 423 484 !- Thickness categories boundaries 424 485 !---------------------------------- 425 IF(lwp) WRITE(numout,*)426 IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution '427 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'428 !429 486 hi_max(:) = 0._wp 430 487 ! … … 463 520 464 521 465 SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice , & 466 & pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 522 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 467 523 !!--------------------------------------------------------------------- 468 524 !! *** ROUTINE ice_lim_flx *** … … 557 613 u_ice_b(:,:) = u_ice(:,:) 558 614 v_ice_b(:,:) = v_ice(:,:) 559 ! 615 at_i_b (:,:) = SUM( a_i_b(:,:,:), dim=3 ) 616 560 617 END SUBROUTINE sbc_lim_bef 561 618 … … 569 626 !!---------------------------------------------------------------------- 570 627 sfx (:,:) = 0._wp ; 571 sfx_bri(:,:) = 0._wp ; 628 sfx_bri(:,:) = 0._wp ; sfx_lam(:,:) = 0._wp 572 629 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 573 630 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp … … 580 637 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 581 638 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 582 wfx_spr(:,:) = 0._wp ; 583 !639 wfx_spr(:,:) = 0._wp ; wfx_lam(:,:) = 0._wp 640 584 641 hfx_thd(:,:) = 0._wp ; 585 642 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp … … 597 654 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp ; 598 655 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp ; 599 ! 656 657 tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here) 658 600 659 END SUBROUTINE sbc_lim_diag0 601 660 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r6460 r7309 115 115 ! 116 116 ! ! overwrite namelist parameter using CPP key information 117 IF( Agrif_Root() ) THEN ! AGRIF zoom 118 IF( lk_lim2 ) nn_ice = 2 119 IF( lk_lim3 ) nn_ice = 3 120 IF( lk_cice ) nn_ice = 4 121 ENDIF 122 IF( cp_cfg == 'gyre' ) THEN ! GYRE configuration 123 ln_ana = .TRUE. 124 nn_ice = 0 125 ENDIF 126 ! 117 #if defined key_agrif 118 IF( Agrif_Root() ) THEN ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid) 119 IF( lk_lim2 ) nn_ice = 2 120 IF( lk_lim3 ) nn_ice = 3 121 IF( lk_cice ) nn_ice = 4 122 ENDIF 123 #else 124 IF( lk_lim2 ) nn_ice = 2 125 IF( lk_lim3 ) nn_ice = 3 126 IF( lk_cice ) nn_ice = 4 127 #endif 128 129 IF( cp_cfg == 'gyre' ) ln_ana = .TRUE. ! GYRE configuration 130 127 131 IF(lwp) THEN ! Control print 128 132 WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)' … … 200 204 201 205 ! ! restartability 202 IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) ) &203 & CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' )204 206 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) ) & 205 207 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r7048 r7309 205 205 DO jj = 2, jpjm1 206 206 DO ji = fs_2, fs_jpim1 207 IF( fsdept(ji,jj,jk) < ekm_dep(ji,jj) ) THEN207 IF( gdept_n(ji,jj,jk) < ekm_dep(ji,jj) ) THEN 208 208 avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix ) 209 209 avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), rn_wvmix ) -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r6140 r7309 25 25 26 26 PUBLIC glob_sum ! used in many places (masked with tmask_i) 27 PUBLIC glob_sum_full ! used in many places (masked with tmask_h, ie o mly over the halos)27 PUBLIC glob_sum_full ! used in many places (masked with tmask_h, ie only over the halos) 28 28 PUBLIC DDPDD ! also used in closea module 29 29 PUBLIC glob_min, glob_max -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r6152 r7309 104 104 105 105 !!---------------------------------------------------------------------- 106 !! NEMO/OPA 3.7 , NEMO Consortium (201 5)106 !! NEMO/OPA 3.7 , NEMO Consortium (2016) 107 107 !! $Id$ 108 108 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 141 141 # endif 142 142 # if defined key_lim2 143 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 143 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM2 144 # endif 145 # if defined key_lim3 146 CALL Agrif_Declare_Var_lim3 ! " " " " " LIM3 144 147 # endif 145 148 #endif -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/OPA_SRC/step.F90
r6464 r7309 295 295 IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 296 296 ! 297 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 297 298 298 299 !!gm : This does not only concern the dynamics ==>>> add a new title … … 316 317 ENDIF 317 318 #endif 318 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics319 319 IF( ln_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 320 320 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r6140 r7309 268 268 269 269 ! since we no longer call rst_opn, need to define nitrst here, used by ice restart routine 270 IF( kt == nit000 ) nitrst = nitend 270 IF( kt == nit000 ) THEN 271 nitrst = nitend 272 lrst_oce = .FALSE. ! init restart ocean (done in rst_opn when not SAS) 273 ENDIF 274 271 275 IF( MOD( kt - 1, nstock ) == 0 ) THEN 272 276 ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r6165 r7309 49 49 USE step ! NEMO time-stepping (stp routine) 50 50 USE lib_mpp ! distributed memory computing 51 #if defined key_nosignedzero52 51 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 53 #endif54 52 #if defined key_iomput 55 53 USE xios … … 58 56 USE sbcssm 59 57 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 58 USE icbini ! handle bergs, initialisation 60 59 USE icbstp ! handle bergs, calving, themodynamics and transport 61 #if defined key_bdy 60 62 61 USE bdyini ! open boundary cond. setting (bdy_init routine). clem: mandatory for LIM3 63 USE bdydta ! open boundary cond. setting (bdy_dta_init routine). clem: mandatory for LIM3 64 #endif 62 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) - - 65 63 USE bdy_par 66 64 67 65 IMPLICIT NONE 68 66 PRIVATE … … 98 96 ! 99 97 #if defined key_agrif 100 101 #endif 102 98 CALL Agrif_Init_Grids() ! AGRIF: set the meshes 99 #endif 100 103 101 ! !-----------------------! 104 102 CALL nemo_init !== Initialisations ==! … … 113 111 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 114 112 # endif 113 # if defined key_lim3 114 CALL Agrif_Declare_Var_lim3 ! " " " " " LIM3 115 # endif 115 116 #endif 116 117 ! check that all process are still there... If some process have an error, … … 124 125 ! !-----------------------! 125 126 istp = nit000 127 128 #if defined key_agrif 129 CALL Agrif_Regrid() 130 #endif 126 131 127 132 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 128 133 #if defined key_agrif 129 CALL Agrif_Step( stp )! AGRIF: time stepping134 CALL stp ! AGRIF: time stepping 130 135 #else 131 136 CALL stp( istp ) ! standard time stepping … … 148 153 ! 149 154 #if defined key_agrif 150 CALL Agrif_ParentGrid_To_ChildGrid() 151 IF( nn_timing == 1 ) CALL timing_finalize 152 CALL Agrif_ChildGrid_To_ParentGrid() 155 IF( .NOT. Agrif_Root() ) THEN 156 CALL Agrif_ParentGrid_To_ChildGrid() 157 IF( nn_timing == 1 ) CALL timing_finalize 158 CALL Agrif_ChildGrid_To_ParentGrid() 159 ENDIF 153 160 #endif 154 161 IF( nn_timing == 1 ) CALL timing_finalize … … 287 294 jpnij = jpni*jpnj 288 295 #endif 289 END 296 ENDIF 290 297 291 298 ! Calculate domain dimensions given calculated jpni and jpnj … … 301 308 #endif 302 309 ENDIF 303 jpk = jpkdta ! third dim 310 #if defined key_sas2D 311 jpk = 1 ! third dim 312 jpkm1 = 1 ! " " 313 #else 314 jpk = jpkdta ! third dim 315 jpkm1 = jpk-1 ! " " 316 #endif 317 #if defined key_agrif 318 ! simple trick to use same vertical grid as parent 319 ! but different number of levels: 320 ! Save maximum number of levels in jpkdta, then define all vertical grids 321 ! with this number. 322 ! Suppress once vertical online interpolation is ok 323 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta) 324 #endif 304 325 jpim1 = jpi-1 ! inner domain indices 305 326 jpjm1 = jpj-1 ! " " 306 jpkm1 = jpk-1 ! " "307 327 jpij = jpi*jpj ! jpi x j 308 328 … … 330 350 ENDIF 331 351 332 ! Now we know the dimensions of the grid and numout has been set we can 333 ! allocate arrays 352 ! Now we know the dimensions of the grid and numout has been set we can allocate arrays 334 353 CALL nemo_alloc() 335 354 … … 353 372 CALL dom_init ! Domain 354 373 355 IF( ln_nnogather )CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined)356 357 IF( ln_ctl )CALL prt_ctl_init ! Print control374 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 375 376 IF( ln_ctl ) CALL prt_ctl_init ! Print control 358 377 CALL day_init ! model calendar (using both namelist and restart infos) 359 378 360 379 CALL sbc_init ! Forcings : surface module 361 380 362 381 ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from 363 382 ! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. … … 366 385 IF( lk_bdy ) CALL bdy_dta_init 367 386 ! ==> 387 CALL icb_init( rdt, nit000) ! initialise icebergs instance 368 388 369 389 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler … … 514 534 USE diawri , ONLY: dia_wri_alloc 515 535 USE dom_oce , ONLY: dom_oce_alloc 536 USE oce 516 537 #if defined key_bdy 517 538 USE bdy_oce , ONLY: bdy_oce_alloc 518 USE oce ! clem: mandatory for LIM3 because needed for bdy arrays 519 #else 520 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 521 #endif 522 ! 523 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7,ierr8 524 INTEGER :: jpm 539 #endif 540 ! 541 INTEGER :: ierr 525 542 !!---------------------------------------------------------------------- 526 543 ! 527 544 ierr = dia_wri_alloc () 528 545 ierr = ierr + dom_oce_alloc () ! ocean domain 546 ierr = ierr + oce_alloc () ! (tsn...) needed for agrif and/or lim3 and bdy 529 547 #if defined key_bdy 530 548 ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization) 531 ierr = ierr + oce_alloc () ! (tsn...)532 #endif533 534 #if ! defined key_bdy535 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), &536 & snwice_fmass(jpi,jpj) , STAT= ierr1 )537 !538 ! lim code currently uses surface temperature and salinity in tsn array for initialisation539 ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use540 ! clem: should not be needed. To be checked out541 jpm = MAX(jp_tem, jp_sal)542 ALLOCATE( tsn(jpi,jpj,1,jpm) , STAT=ierr2 )543 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr3 )544 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr4 )545 ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 )546 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 )547 ALLOCATE( un(jpi,jpj,1) , STAT=ierr7 )548 ALLOCATE( vn(jpi,jpj,1) , STAT=ierr8 )549 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 + ierr7 + ierr8550 549 #endif 551 550 ! … … 618 617 INTEGER :: ifac, jl, inu 619 618 INTEGER, PARAMETER :: ntest = 14 620 INTEGER :: ilfax(ntest) 619 INTEGER, DIMENSION(ntest) :: ilfax 620 !!---------------------------------------------------------------------- 621 621 ! 622 622 ! lfax contains the set of allowed factors. 623 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & 624 & 128, 64, 32, 16, 8, 4, 2 / 625 !!---------------------------------------------------------------------- 623 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 626 624 627 625 ! Clear the error flag and initialise output vars … … 721 719 nsndto = nsndto + 1 722 720 isendto(nsndto) = jn 723 END 721 ENDIF 724 722 END DO 725 723 nfsloop = 1 -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r6140 r7309 39 39 LOGICAL :: ln_3d_uve !: specify whether input velocity data is 3D 40 40 LOGICAL :: ln_read_frq !: specify whether we must read frq or not 41 LOGICAL :: l_sasread !: Ice intilisation: read a file (.TRUE.) or anaytical initilaistion in namelist &namsbc_sas 41 42 LOGICAL :: l_initdone = .false. 42 43 INTEGER :: nfld_3d … … 81 82 ! 82 83 IF( nn_timing == 1 ) CALL timing_start( 'sbc_ssm') 83 84 IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d ) !== read data at kt time step ==! 85 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 86 ! 87 IF( ln_3d_uve ) THEN 88 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 89 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 90 IF( .NOT.ln_linssh ) e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 84 85 IF ( l_sasread ) THEN 86 IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d ) !== read data at kt time step ==! 87 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 88 ! 89 IF( ln_3d_uve ) THEN 90 IF( .NOT. ln_linssh ) e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 91 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 92 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 93 ELSE 94 IF( .NOT. ln_linssh ) e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 95 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 96 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 97 ENDIF 98 ! 99 sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1) ! temperature 100 sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity 101 ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 102 IF( ln_read_frq ) THEN 103 frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! solar penetration 104 ELSE 105 frq_m(:,:) = 1._wp 106 ENDIF 91 107 ELSE 92 ss u_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity93 ss v_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity94 IF( .NOT.ln_linssh ) e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity95 ENDIF96 !97 sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1) ! temperature98 sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity99 ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height100 IF( ln_read_frq ) frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height101 !108 sst_m(:,:) = 0._wp 109 sss_m(:,:) = 0._wp 110 ssu_m(:,:) = 0._wp 111 ssv_m(:,:) = 0._wp 112 ssh_m(:,:) = 0._wp 113 e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D 114 frq_m(:,:) = 1._wp ! - - 115 sshn (:,:) = 0._wp ! - - 116 ENDIF 117 102 118 IF ( nn_ice == 1 ) THEN 103 119 tsn(:,:,1,jp_tem) = sst_m(:,:) … … 108 124 ub (:,:,1) = ssu_m(:,:) 109 125 vb (:,:,1) = ssv_m(:,:) 110 126 111 127 IF(ln_ctl) THEN ! print control 112 128 CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m - : ', mask1=tmask, ovlap=1 ) … … 155 171 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 156 172 ! 157 NAMELIST/namsbc_sas/ cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq173 NAMELIST/namsbc_sas/l_sasread, cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 158 174 !!---------------------------------------------------------------------- 159 175 … … 176 192 WRITE(numout,*) '~~~~~~~~~~~ ' 177 193 WRITE(numout,*) ' Namelist namsbc_sas' 194 WRITE(numout,*) ' Initialisation using an input file = ',l_sasread 178 195 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 179 196 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq … … 204 221 nn_closea = 0 205 222 ENDIF 223 IF (l_sasread) THEN 206 224 ! 207 225 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and … … 285 303 IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 286 304 305 ENDIF 306 287 307 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate 288 308 IF( .NOT. ln_read_frq ) frq_m(:,:) = 1. -
branches/2016/dev_CNRS_AGRIF_2016/NEMOGCM/NEMO/SAS_SRC/step.F90
r6140 r7309 24 24 USE diawri ! Standard run outputs (dia_wri routine) 25 25 USE bdy_par ! clem: mandatory for LIM3 26 #if defined key_bdy27 26 USE bdydta ! clem: mandatory for LIM3 28 #endif29 27 USE stpctl ! time stepping control (stp_ctl routine) 30 28 ! … … 38 36 #endif 39 37 38 #if defined key_agrif 39 USE agrif_oce, ONLY: lk_agrif_debug !clem 40 #endif 41 40 42 IMPLICIT NONE 41 43 PRIVATE … … 70 72 #if defined key_agrif 71 73 kstp = nit000 + Agrif_Nb_Step() 74 IF ( lk_agrif_debug ) THEN 75 IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 76 IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 77 ENDIF 78 79 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 80 72 81 # if defined key_iomput 73 82 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 74 83 # endif 75 84 #endif 85 indic = 0 ! although indic is not changed in stp_ctl 86 ! need to keep the same interface 76 87 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 77 88 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) … … 90 101 CALL dia_wri( kstp ) ! ocean model: outputs 91 102 92 indic = 0 ! although indic is not changed in stp_ctl 93 ! need to keep the same interface 103 #if defined key_agrif 104 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 105 ! AGRIF 106 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 107 CALL Agrif_Integrate_ChildGrids( stp ) 108 #endif 109 110 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 111 ! Control 112 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 94 113 CALL stp_ctl( kstp, indic ) 114 IF( indic < 0 ) THEN 115 CALL ctl_stop( 'step: indic < 0' ) 116 CALL dia_wri_state( 'output.abort', kstp ) 117 ENDIF 118 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file (clem: not sure...) 119 95 120 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 96 121 ! Coupled mode
Note: See TracChangeset
for help on using the changeset viewer.