- Timestamp:
- 2016-11-28T18:21:42+01:00 (8 years ago)
- Location:
- branches/2016/dev_CNRS_2016/NEMOGCM
- Files:
-
- 20 added
- 1 deleted
- 59 edited
- 5 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ISOMIP/MY_SRC/usrdef_sbc.F90
r7164 r7355 26 26 PRIVATE 27 27 28 PUBLIC usr_def_sbc ! routine called by sbcmod.F90 28 PUBLIC usrdef_sbc_oce ! routine called by sbcmod.F90 29 PUBLIC usrdef_sbc_ice_tau ! routine called by sbcmod.F90 30 PUBLIC usrdef_sbc_ice_flx ! routine called by sbcmod.F90 29 31 30 32 !! * Substitutions … … 37 39 CONTAINS 38 40 39 SUBROUTINE usr _def_sbc( kt )41 SUBROUTINE usrdef_sbc_oce( kt ) 40 42 !!--------------------------------------------------------------------- 41 43 !! *** ROUTINE usr_def_sbc *** … … 71 73 ENDIF 72 74 ! 73 END SUBROUTINE usr_def_sbc 75 END SUBROUTINE usrdef_sbc_oce 76 77 SUBROUTINE usrdef_sbc_ice_tau( kt ) 78 INTEGER, INTENT(in) :: kt ! ocean time step 79 END SUBROUTINE usrdef_sbc_ice_tau 80 81 SUBROUTINE usrdef_sbc_ice_flx( kt ) 82 INTEGER, INTENT(in) :: kt ! ocean time step 83 END SUBROUTINE usrdef_sbc_ice_flx 74 84 75 85 !!====================================================================== -
branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/LOCK_EXCHANGE/MY_SRC/usrdef_sbc.F90
r7164 r7355 26 26 PRIVATE 27 27 28 PUBLIC usr_def_sbc ! routine called by sbcmod.F90 28 PUBLIC usrdef_sbc_oce ! routine called in sbcmod module 29 PUBLIC usrdef_sbc_ice_tau ! routine called by sbcice_lim.F90 for ice dynamics 30 PUBLIC usrdef_sbc_ice_flx ! routine called by sbcice_lim.F90 for ice thermo 29 31 30 32 !! * Substitutions … … 37 39 CONTAINS 38 40 39 SUBROUTINE usr _def_sbc( kt )41 SUBROUTINE usrdef_sbc_oce( kt ) 40 42 !!--------------------------------------------------------------------- 41 43 !! *** ROUTINE usr_def_sbc *** … … 71 73 ENDIF 72 74 ! 73 END SUBROUTINE usr_def_sbc 75 END SUBROUTINE usrdef_sbc_oce 76 77 SUBROUTINE usrdef_sbc_ice_tau( kt ) 78 INTEGER, INTENT(in) :: kt ! ocean time step 79 END SUBROUTINE usrdef_sbc_ice_tau 80 81 SUBROUTINE usrdef_sbc_ice_flx( kt ) 82 INTEGER, INTENT(in) :: kt ! ocean time step 83 END SUBROUTINE usrdef_sbc_ice_flx 74 84 75 85 !!====================================================================== -
branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
r5517 r7355 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_2016/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice_cfg
r4690 r7355 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_2016/NEMOGCM/CONFIG/OVERFLOW/MY_SRC/usrdef_sbc.F90
r7164 r7355 26 26 PRIVATE 27 27 28 PUBLIC usr_def_sbc ! routine called by sbcmod.F90 28 PUBLIC usrdef_sbc_oce ! routine called in sbcmod module 29 PUBLIC usrdef_sbc_ice_tau ! routine called by sbcice_lim.F90 for ice dynamics 30 PUBLIC usrdef_sbc_ice_flx ! routine called by sbcice_lim.F90 for ice thermo 29 31 30 32 !! * Substitutions … … 37 39 CONTAINS 38 40 39 SUBROUTINE usr _def_sbc( kt )41 SUBROUTINE usrdef_sbc_oce( kt ) 40 42 !!--------------------------------------------------------------------- 41 43 !! *** ROUTINE usr_def_sbc *** … … 71 73 ENDIF 72 74 ! 73 END SUBROUTINE usr_def_sbc 75 END SUBROUTINE usrdef_sbc_oce 76 77 SUBROUTINE usrdef_sbc_ice_tau( kt ) 78 INTEGER, INTENT(in) :: kt ! ocean time step 79 END SUBROUTINE usrdef_sbc_ice_tau 80 81 SUBROUTINE usrdef_sbc_ice_flx( kt ) 82 INTEGER, INTENT(in) :: kt ! ocean time step 83 END SUBROUTINE usrdef_sbc_ice_flx 74 84 75 85 !!====================================================================== -
branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/SHARED/field_def.xml
r7278 r7355 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_2016/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
r7278 r7355 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_2016/NEMOGCM/CONFIG/SHARED/namelist_ref
r7280 r7355 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) … … 219 219 / 220 220 !----------------------------------------------------------------------- 221 &namsbc_flx ! surface boundary condition : flux formulation (ln_ana = T)221 &namsbc_flx ! surface boundary condition : flux formulation 222 222 !----------------------------------------------------------------------- 223 223 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! … … 260 260 rn_vfac = 0. ! multiplicative factor for ocean/ice velocity 261 261 ! in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 262 ln_Cd_L12 = .false. ! Modify the drag ice-atm and oce-atm depending on ice concentration 263 ! This parameterization is from Lupkes et al. (JGR 2012) 262 264 / 263 265 !----------------------------------------------------------------------- … … 291 293 &namsbc_sas ! Stand Alone Surface boundary condition 292 294 !----------------------------------------------------------------------- 293 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 294 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 295 sn_usp = 'sas_grid_U' , 120 , 'vozocrtx' , .true. , .true. , 'yearly' , '' , '' , '' 296 sn_vsp = 'sas_grid_V' , 120 , 'vomecrty' , .true. , .true. , 'yearly' , '' , '' , '' 297 sn_tem = 'sas_grid_T' , 120 , 'sosstsst' , .true. , .true. , 'yearly' , '' , '' , '' 298 sn_sal = 'sas_grid_T' , 120 , 'sosaline' , .true. , .true. , 'yearly' , '' , '' , '' 299 sn_ssh = 'sas_grid_T' , 120 , 'sossheig' , .true. , .true. , 'yearly' , '' , '' , '' 300 sn_e3t = 'sas_grid_T' , 120 , 'e3t_m' , .true. , .true. , 'yearly' , '' , '' , '' 301 sn_frq = 'sas_grid_T' , 120 , 'frq_m' , .true. , .true. , 'yearly' , '' , '' , '' 295 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 296 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 297 l_sasread = .TRUE. ! Read fields in a file if .TRUE. , or initialize to 0. in sbcssm.F90 if .FALSE. 298 sn_usp = 'sas_grid_U', 120 , 'vozocrtx', .true. , .true. , 'yearly' , '' , '' , '' 299 sn_vsp = 'sas_grid_V', 120 , 'vomecrty', .true. , .true. , 'yearly' , '' , '' , '' 300 sn_tem = 'sas_grid_T', 120 , 'sosstsst', .true. , .true. , 'yearly' , '' , '' , '' 301 sn_sal = 'sas_grid_T', 120 , 'sosaline', .true. , .true. , 'yearly' , '' , '' , '' 302 sn_ssh = 'sas_grid_T', 120 , 'sossheig', .true. , .true. , 'yearly' , '' , '' , '' 303 sn_e3t = 'sas_grid_T', 120 , 'e3t_m' , .true. , .true. , 'yearly' , '' , '' , '' 304 sn_frq = 'sas_grid_T', 120 , 'frq_m' , .true. , .true. , 'yearly' , '' , '' , '' 302 305 303 306 ln_3d_uve = .true. ! specify whether we are supplying a 3D u,v and e3 field -
branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/cfg.txt
r7297 r7355 11 11 GYRE OPA_SRC 12 12 ISOMIP OPA_SRC 13 ORCA2_LIM3_PISCES OPA_SRC LIM_SRC_3 TOP_SRC NST_SRC 13 14 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 14 ORCA2_LIM3_PISCES OPA_SRC LIM_SRC_3 TOP_SRC NST_SRC 15 SAS_BIPER OPA_SRC SAS_SRC LIM_SRC_3 NST_SRC 16 GYRE_LONG OPA_SRC 17 GYRE_32 OPA_SRC 18 ORCA2LIM3_LONG OPA_SRC LIM_SRC_3 NST_SRC -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
r6140 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
r5836 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r5836 r7355 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_n(:,:) * 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r7280 r7355 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 ! … … 38 37 PUBLIC lim_istate ! routine called by lim_init.F90 39 38 40 ! !!** init namelist (namiceini) **41 REAL(wp) :: rn_thres_sst ! threshold water temperature for initial sea ice42 REAL(wp) :: rn_hts_ini_n ! initial snow thickness in the north43 REAL(wp) :: rn_hts_ini_s ! initial snow thickness in the south44 REAL(wp) :: rn_hti_ini_n ! initial ice thickness in the north45 REAL(wp) :: rn_hti_ini_s ! initial ice thickness in the south46 REAL(wp) :: rn_ati_ini_n ! initial leads area in the north47 REAL(wp) :: rn_ati_ini_s ! initial leads area in the south48 REAL(wp) :: rn_smi_ini_n ! initial salinity49 REAL(wp) :: rn_smi_ini_s ! initial salinity50 REAL(wp) :: rn_tmi_ini_n ! initial temperature51 REAL(wp) :: rn_tmi_ini_s ! initial temperature52 53 39 INTEGER , PARAMETER :: jpfldi = 6 ! maximum number of files to read 54 40 INTEGER , PARAMETER :: jp_hti = 1 ! index of ice thickness (m) at T-point … … 59 45 INTEGER , PARAMETER :: jp_smi = 6 ! index of ice sali at T-point 60 46 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 61 62 LOGICAL :: ln_iceini ! initialization or not63 LOGICAL :: ln_iceini_file ! Ice initialization state from 2D netcdf file64 47 !!---------------------------------------------------------------------- 65 48 !! LIM 3.0, UCL-LOCEAN-IPSL (2008) … … 98 81 REAL(wp) :: ztmelts, zdh 99 82 INTEGER :: i_hemis, i_fill, jl0 100 REAL(wp) :: z test_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv83 REAL(wp) :: zarg, zV, zconv, zdv 101 84 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 102 85 REAL(wp), POINTER, DIMENSION(:,:) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 103 86 REAL(wp), POINTER, DIMENSION(:,:) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 104 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini, zv_i_ini !data by cattegories to fill 105 !-------------------------------------------------------------------- 106 107 CALL wrk_alloc( jpi,jpj,jpl, zh_i_ini, za_i_ini, zv_i_ini ) 108 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 ) 109 CALL wrk_alloc( jpi,jpj, zswitch ) 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini !data by cattegories to fill 88 INTEGER , POINTER, DIMENSION(:) :: itest 89 !-------------------------------------------------------------------- 90 91 CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini, za_i_ini ) 92 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 ) 93 CALL wrk_alloc( jpi, jpj, zswitch ) 94 Call wrk_alloc( 4, itest ) 110 95 111 96 IF(lwp) WRITE(numout,*) … … 117 102 !-------------------------------------------------------------------- 118 103 ! 119 CALL lim_istate_init ! reading the initials parameters of the ice120 121 ! surface temperature122 DO jl = 1, jpl ! loop over categories104 CALL lim_istate_init 105 106 ! init surface temperature 107 DO jl = 1, jpl 123 108 t_su (:,:,jl) = rt0 * tmask(:,:,1) 124 109 tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 125 110 END DO 126 111 127 ! basal temperature (considered at freezing point)112 ! init basal temperature (considered at freezing point) 128 113 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 129 114 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 130 115 131 116 132 IF( ln_iceini ) THEN 117 !-------------------------------------------------------------------- 118 ! 2) Initialization of sea ice state variables 119 !-------------------------------------------------------------------- 120 IF( ln_limini ) THEN 133 121 ! 134 !-------------------------------------------------------------------- 135 ! 2) Basal temperature, ice mask and hemispheric index 136 !-------------------------------------------------------------------- 122 IF( ln_limini_file )THEN 137 123 ! 138 DO jj = 1, jpj ! ice if sst <= t-freez + ttest139 DO ji = 1, jpi140 IF( ( sst_m(ji,jj) - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN141 zswitch(ji,jj) = 0._wp * tmask(ji,jj,1) ! no ice142 ELSE143 zswitch(ji,jj) = 1._wp * tmask(ji,jj,1) ! ice144 ENDIF145 END DO146 END DO147 148 !--------------------------------------------------------------------149 ! 3) Initialization of sea ice state variables150 !--------------------------------------------------------------------151 IF( ln_iceini_file )THEN152 !153 124 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 154 125 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) … … 158 129 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 159 130 ! 160 ELSE ! ln_iceini_file = F 131 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 132 ELSEWHERE ; zswitch(:,:) = 0._wp 133 END WHERE 161 134 ! 135 ELSE ! ln_limini_file = F 136 137 !-------------------------------------------------------------------- 138 ! 3) Basal temperature, ice mask 139 !-------------------------------------------------------------------- 140 ! no ice if sst <= t-freez + ttest 141 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 142 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 143 END WHERE 144 162 145 !----------------------------- 163 146 ! 3.1) Hemisphere-dependent arrays … … 167 150 DO ji = 1, jpi 168 151 IF( ff_t(ji,jj) >= 0._wp ) THEN 169 zht_i_ini(ji,jj) = rn_hti_ini_n 170 zht_s_ini(ji,jj) = rn_hts_ini_n 171 zat_i_ini(ji,jj) = rn_ati_ini_n 172 zts_u_ini(ji,jj) = rn_tmi_ini_n 173 zsm_i_ini(ji,jj) = rn_smi_ini_n 174 ztm_i_ini(ji,jj) = rn_tmi_ini_n 152 zht_i_ini(ji,jj) = rn_hti_ini_n * zswitch(ji,jj) 153 zht_s_ini(ji,jj) = rn_hts_ini_n * zswitch(ji,jj) 154 zat_i_ini(ji,jj) = rn_ati_ini_n * zswitch(ji,jj) 155 zts_u_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 156 zsm_i_ini(ji,jj) = rn_smi_ini_n * zswitch(ji,jj) 157 ztm_i_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 175 158 ELSE 176 zht_i_ini(ji,jj) = rn_hti_ini_s 177 zht_s_ini(ji,jj) = rn_hts_ini_s 178 zat_i_ini(ji,jj) = rn_ati_ini_s 179 zts_u_ini(ji,jj) = rn_tmi_ini_s 180 zsm_i_ini(ji,jj) = rn_smi_ini_s 181 ztm_i_ini(ji,jj) = rn_tmi_ini_s 159 zht_i_ini(ji,jj) = rn_hti_ini_s * zswitch(ji,jj) 160 zht_s_ini(ji,jj) = rn_hts_ini_s * zswitch(ji,jj) 161 zat_i_ini(ji,jj) = rn_ati_ini_s * zswitch(ji,jj) 162 zts_u_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 163 zsm_i_ini(ji,jj) = rn_smi_ini_s * zswitch(ji,jj) 164 ztm_i_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 182 165 ENDIF 183 166 END DO 184 167 END DO 185 168 ! 186 ENDIF ! ln_ iceini_file187 169 ENDIF ! ln_limini_file 170 188 171 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) ! ice volume 189 190 172 !--------------------------------------------------------------------- 191 173 ! 3.2) Distribute ice concentration and thickness into the categories … … 196 178 zh_i_ini(:,:,:) = 0._wp 197 179 za_i_ini(:,:,:) = 0._wp 198 zv_i_ini(:,:,:) = 0._wp199 180 ! 200 181 DO jj = 1, jpj … … 202 183 ! 203 184 IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 185 186 !--- jl0: most likely index where cc will be maximum 187 jl0 = jpl 188 DO jl = 1, jpl 189 IF ( ( zht_i_ini(ji,jj) > hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 190 jl0 = jl 191 CYCLE 192 ENDIF 193 END DO 204 194 ! 205 ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0 206 ! ztests = 0 207 ! 208 DO i_fill = jpl, 1, -1 195 ! initialisation of tests 196 itest(:) = 0 197 198 i_fill = jpl + 1 !==================================== 199 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 200 ! iteration !==================================== 201 i_fill = i_fill - 1 202 203 ! initialisation of ice variables for each try 204 zh_i_ini(ji,jj,:) = 0._wp 205 za_i_ini(ji,jj,:) = 0._wp 206 itest(:) = 0 209 207 ! 210 ! IF( ztests /= 4 ) THEN 211 IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) /= 4) THEN212 !----------------------------213 ! fill the i_fill categories214 !---------------------------- 215 ! *** 1 category to fill216 IF ( i_fill .EQ. 1 ) THEN217 zh_i_ini(ji,jj, 1) = zht_i_ini(ji,jj) 218 za_i_ini(ji,jj, 1) = zat_i_ini(ji,jj)219 zh_i_ini(ji,jj,2:jpl) = 0._wp220 z a_i_ini(ji,jj,2:jpl) = 0._wp221 E LSE208 ! *** case very thin ice: fill only category 1 209 IF ( i_fill == 1 ) THEN 210 zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj) 211 za_i_ini(ji,jj,1) = zat_i_ini(ji,jj) 212 213 ! *** case ice is thicker: fill categories >1 214 ELSE 215 216 ! Fill ice thicknesses in the (i_fill-1) cat by hmean 217 DO jl = 1, i_fill-1 218 zh_i_ini(ji,jj,jl) = hi_mean(jl) 219 END DO 222 220 ! 223 ! *** >1 categores to fill 224 !--- Ice thicknesses in the i_fill - 1 first categories 225 DO jl = 1, i_fill - 1 226 zh_i_ini(ji,jj,jl) = hi_mean(jl) 227 END DO 221 !--- Concentrations 222 za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 223 DO jl = 1, i_fill - 1 224 IF( jl /= jl0 )THEN 225 zarg = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) ) 226 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 227 ENDIF 228 END DO 228 229 ! 229 !--- jl0: most likely index where cc will be maximum 230 DO jl = 1, jpl 231 IF ( ( zht_i_ini(ji,jj) > hi_max(jl-1) ) .AND. & 232 & ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 233 jl0 = jl 234 ENDIF 235 END DO 236 jl0 = MIN(jl0, i_fill) 237 ! 238 !--- Concentrations 239 za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 240 DO jl = 1, i_fill - 1 241 IF( jl /= jl0 )THEN 242 zsigma = 0.5 * zht_i_ini(ji,jj) 243 zarg = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / zsigma 244 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 245 ENDIF 246 END DO 247 ! 248 zA = 0. ! sum of the areas in the jpl categories 249 DO jl = 1, i_fill - 1 250 zA = zA + za_i_ini(ji,jj,jl) 251 END DO 252 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - zA ! ice conc in the last category 253 IF ( i_fill < jpl ) za_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 254 ! 255 !--- Ice thickness in the last category 256 zV = 0. ! sum of the volumes of the N-1 categories 257 DO jl = 1, i_fill - 1 258 zV = zV + za_i_ini(ji,jj,jl)*zh_i_ini(ji,jj,jl) 259 END DO 260 zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / za_i_ini(ji,jj,i_fill) 261 IF ( i_fill < jpl ) zh_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 262 ! 263 !--- volumes 264 zv_i_ini(ji,jj,:) = za_i_ini(ji,jj,:) * zh_i_ini(ji,jj,:) 265 IF ( i_fill < jpl ) zv_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 266 ! 267 ENDIF ! i_fill 268 ! 269 !--------------------- 270 ! Compatibility tests 271 !--------------------- 272 ! Test 1: area conservation 273 zA_cons = SUM(za_i_ini(ji,jj,:)) ; zconv = ABS(zat_i_ini(ji,jj) - zA_cons ) 274 IF( zconv < 1.0e-6 ) THEN ; ztest_1 = 1. 275 ELSE ; ztest_1 = 0. 230 ! Concentration in the last (i_fill) category 231 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) ) 232 233 ! Ice thickness in the last (i_fill) category 234 zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) ) 235 zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 236 237 ! clem: correction if concentration of upper cat is greater than lower cat 238 ! (it should be a gaussian around jl0 but sometimes it is not) 239 IF ( jl0 /= jpl ) THEN 240 DO jl = jpl, jl0+1, -1 241 IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN 242 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl) 243 zh_i_ini(ji,jj,jl ) = 0._wp 244 za_i_ini(ji,jj,jl ) = 0._wp 245 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1) & 246 & + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 ) 247 END IF 248 ENDDO 276 249 ENDIF 277 250 ! 278 ! Test 2: volume conservation 279 zV_cons = SUM(zv_i_ini(ji,jj,:)) 280 zconv = ABS(zvt_i_ini(ji,jj) - zV_cons) 281 IF( zconv < 1.0e-6 ) THEN ; ztest_2 = 1. 282 ELSE ; ztest_2 = 0. 283 ENDIF 251 ENDIF ! case ice is thick or thin 252 253 !--------------------- 254 ! Compatibility tests 255 !--------------------- 256 ! Test 1: area conservation 257 zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) ) 258 IF ( zconv < epsi06 ) itest(1) = 1 259 260 ! Test 2: volume conservation 261 zconv = ABS( zat_i_ini(ji,jj) * zht_i_ini(ji,jj) & 262 & - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) ) 263 IF ( zconv < epsi06 ) itest(2) = 1 264 265 ! Test 3: thickness of the last category is in-bounds ? 266 IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 267 268 ! Test 4: positivity of ice concentrations 269 itest(4) = 1 270 DO jl = 1, i_fill 271 IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0 272 END DO 273 ! !============================ 274 END DO ! end iteration on categories 275 ! !============================ 284 276 ! 285 ! Test 3: thickness of the last category is in-bounds ? 286 IF( zh_i_ini(ji,jj,i_fill) > hi_max(i_fill-1) ) THEN ; ztest_3 = 1. 287 ELSE ; ztest_3 = 0. 288 ENDIF 289 ! 290 ! Test 4: positivity of ice concentrations 291 ztest_4 = 1 292 DO jl = 1, jpl 293 IF( za_i_ini(ji,jj,jl) < 0._wp ) ztest_4 = 0 294 END DO 295 ! 296 ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4 297 ! 298 ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 299 ! 300 END DO ! i_fill 301 ! 302 IF(lwp) THEN 303 IF( ztests /= 4 ) THEN 304 WRITE(numout,*) 305 WRITE(numout,*) ' !!!! ALERT !!! ' 306 WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 307 WRITE(numout,*) 308 WRITE(numout,*) ' *** ztests is not equal to 4 : ztests : ', ztests 309 WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 310 WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 311 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 312 ENDIF ! ztests /= 4 277 IF( lwp .AND. SUM(itest) /= 4 ) THEN 278 WRITE(numout,*) 279 WRITE(numout,*) ' !!!! ALERT itest is not equal to 4 !!! ' 280 WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 281 WRITE(numout,*) 282 WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:) 283 WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 284 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 313 285 ENDIF 314 !315 ENDIF ! zat_i_ini(ji,jj) > 0._wp .AND. zh m_i_ini(ji,jj) > 0._wp286 287 ENDIF ! zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp 316 288 ! 317 289 END DO … … 360 332 smv_i = sm_i * v_i 361 333 ENDIF 362 334 363 335 ! Snow temperature and heat content 364 336 DO jk = 1, nlay_s … … 400 372 tn_ice (:,:,:) = t_su (:,:,:) 401 373 402 ELSE ! if ln_ iceini=false374 ELSE ! if ln_limini=false 403 375 a_i (:,:,:) = 0._wp 404 376 v_i (:,:,:) = 0._wp … … 423 395 END DO 424 396 425 ENDIF ! ln_ iceini397 ENDIF ! ln_limini 426 398 427 399 at_i (:,:) = 0.0_wp … … 473 445 sxyage (:,:,:) = 0._wp 474 446 475 476 CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini, za_i_ini, zv_i_ini ) 447 !!!clem 448 !! ! Output the initial state and forcings 449 !! CALL dia_wri_state( 'output.init', nit000 ) 450 !!! 451 452 CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini, za_i_ini ) 477 453 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 ) 478 454 CALL wrk_dealloc( jpi, jpj, zswitch ) 455 Call wrk_dealloc( 4, itest ) 479 456 480 457 END SUBROUTINE lim_istate … … 505 482 TYPE(FLD_N), DIMENSION(jpfldi) :: slf_i ! array of namelist informations on the fields to read 506 483 ! 507 NAMELIST/namiceini/ ln_ iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, &484 NAMELIST/namiceini/ ln_limini, ln_limini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, & 508 485 & rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, & 509 486 & rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s, & … … 531 508 WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 532 509 WRITE(numout,*) '~~~~~~~~~~~~~~~' 533 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_ iceini = ', ln_iceini534 WRITE(numout,*) ' ice initialization from a netcdf file ln_ iceini_file = ', ln_iceini_file510 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_limini = ', ln_limini 511 WRITE(numout,*) ' ice initialization from a netcdf file ln_limini_file = ', ln_limini_file 535 512 WRITE(numout,*) ' threshold water temp. for initial sea-ice rn_thres_sst = ', rn_thres_sst 536 513 WRITE(numout,*) ' initial snow thickness in the north rn_hts_ini_n = ', rn_hts_ini_n … … 546 523 ENDIF 547 524 548 IF( ln_ iceini_file ) THEN ! Ice initialization using input file525 IF( ln_limini_file ) THEN ! Ice initialization using input file 549 526 ! 550 527 ! set si structure -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r7280 r7355 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,*) 'lim_itd_me_init : ice parameters for mechanical ice redistribution '972 WRITE(numout,*) '~~~~~~~~~~~~~~~'973 WRITE(numout,*) ' Namelist namiceitdme :'974 WRITE(numout,*) ' Fraction of shear energy contributing to ridging rn_cs = ', rn_cs975 WRITE(numout,*) ' Fraction of snow volume conserved during ridging rn_fsnowrdg = ', rn_fsnowrdg976 WRITE(numout,*) ' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft977 WRITE(numout,*) ' Fraction of total ice coverage contributing to ridging rn_gstar = ', rn_gstar978 WRITE(numout,*) ' Equivalent to G* for an exponential part function rn_astar = ', rn_astar979 WRITE(numout,*) ' Quantity playing a role in max ridged ice thickness rn_hstar = ', rn_hstar980 WRITE(numout,*) ' Rafting of ice sheets or not ln_rafting = ', ln_rafting981 WRITE(numout,*) ' Parmeter thickness (threshold between ridge-raft) rn_hraft = ', rn_hraft982 WRITE(numout,*) ' Rafting hyperbolic tangent coefficient rn_craft = ', rn_craft983 WRITE(numout,*) ' Initial porosity of ridges rn_por_rdg = ', rn_por_rdg984 WRITE(numout,*) ' Switch for part. function (0) linear (1) exponential nn_partfun = ', nn_partfun931 WRITE(numout,*)'lim_itd_me_init : ice parameters for mechanical ice redistribution ' 932 WRITE(numout,*)'~~~~~~~~~~~~~~~' 933 WRITE(numout,*)' Fraction of shear energy contributing to ridging rn_cs = ', rn_cs 934 WRITE(numout,*)' Switch for part. function (0) linear (1) exponential nn_partfun = ', nn_partfun 935 WRITE(numout,*)' Fraction of total ice coverage contributing to ridging rn_gstar = ', rn_gstar 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 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 941 WRITE(numout,*)' Rafting of ice sheets or not ln_rafting = ', ln_rafting 942 WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) rn_hraft = ', rn_hraft 943 WRITE(numout,*)' Rafting hyperbolic tangent coefficient rn_craft = ', rn_craft 944 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft 985 945 ENDIF 986 946 ! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r5407 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r7278 r7355 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) * ff_t(ji,jj) + e1t(ji,jj) * ff_t(ji+1,jj) ) & 270 & / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi ) 271 zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * ff_t(ji,jj) + e2t(ji,jj) * ff_t(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_2016/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r6140 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r7278 r7355 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 … … 353 340 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 354 341 355 !!gm I really don't like this st aff here... Find a way to put that elsewhere or differently342 !!gm I really don't like this stuff here... Find a way to put that elsewhere or differently 356 343 !!gm 357 344 IF( .NOT.ln_linssh ) THEN -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r7280 r7355 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_init : Ice Thermodynamics initialization'624 WRITE(numout,*) '~~~~~~~~~~~~'625 ENDIF626 578 ! 627 579 REWIND( numnam_ice_ref ) ! Namelist namicethd in reference namelist : Ice thermodynamics … … 635 587 ! 636 588 IF(lwp) THEN ! control print 637 WRITE(numout,*)' Namelist of ice parameters for ice thermodynamic computation ' 589 WRITE(numout,*) 'lim_thd_init : Ice Thermodynamics' 590 WRITE(numout,*) '~~~~~~~~~~~~~' 591 WRITE(numout,*)' -- limthd_dif --' 592 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i 593 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nn_conv_dif = ', nn_conv_dif 594 WRITE(numout,*)' maximal err. on T for heat diffusion computation rn_terr_dif = ', rn_terr_dif 595 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice nn_ice_thcon = ', nn_ice_thcon 596 WRITE(numout,*)' iterate the surface non-solar flux (T) or not (F) ln_it_qnsice = ', ln_it_qnsice 597 WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat 598 WRITE(numout,*)' -- limthd_dh --' 599 WRITE(numout,*)' activate ice thick change from top/bot (T) or not (F) ln_limdH = ', ln_limdH 600 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas 601 WRITE(numout,*)' -- limthd_da --' 602 WRITE(numout,*)' activate lateral melting (T) or not (F) ln_limdA = ', ln_limdA 603 WRITE(numout,*)' Coef. beta for lateral melting param. rn_beta = ', rn_beta 604 WRITE(numout,*)' Minimum floe diameter for lateral melting param. rn_dmin = ', rn_dmin 605 WRITE(numout,*)' -- limthd_lac --' 606 WRITE(numout,*)' activate ice growth in open-water (T) or not (F) ln_limdO = ', ln_limdO 638 607 WRITE(numout,*)' ice thick. for lateral accretion rn_hnewice = ', rn_hnewice 639 608 WRITE(numout,*)' Frazil ice thickness as a function of wind or not ln_frazil = ', ln_frazil … … 641 610 WRITE(numout,*)' Thresold relative drift speed for collection of frazil rn_vfrazb = ', rn_vfrazb 642 611 WRITE(numout,*)' Squeezing coefficient for collection of frazil rn_Cfrazb = ', rn_Cfrazb 612 WRITE(numout,*)' -- limitd_th --' 643 613 WRITE(numout,*)' minimum ice thickness rn_himin = ', rn_himin 644 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice '645 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas646 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i647 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nn_conv_dif = ', nn_conv_dif648 WRITE(numout,*)' maximal err. on T for heat diffusion computation rn_terr_dif = ', rn_terr_dif649 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice nn_ice_thcon = ', nn_ice_thcon650 614 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 651 WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat652 WRITE(numout,*)' iterate the surface non-solar flux (T) or not (F) ln_it_qnsice = ', ln_it_qnsice653 615 ENDIF 654 616 IF( jpl > 1 .AND. nn_monocat == 1 ) THEN -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r5512 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r7280 r7355 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,*) ' Namelist namicesal :'147 WRITE(numout,*) ' switch for salinity nn_icesal= ', nn_icesal148 WRITE(numout,*) ' bulk salinity value if nn_icesal = 1= ', rn_icesal149 WRITE(numout,*) ' restoring salinity for GD= ', rn_sal_gd150 WRITE(numout,*) ' restoring time for GD= ', rn_time_gd151 WRITE(numout,*) ' restoring salinity for flushing= ', rn_sal_fl152 WRITE(numout,*) ' restoring time for flushing= ', rn_time_fl153 WRITE(numout,*) ' Maximum tolerated ice salinity= ', rn_simax154 WRITE(numout,*) ' Minimum tolerated ice salinity= ', rn_simin142 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 155 151 ENDIF 156 152 ! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r6403 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r6403 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r7278 r7355 18 18 19 19 PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90 20 21 !!---------------------------22 !! * Share Module variables23 !!---------------------------24 ! !!! ** ice-thermo namelist (namicethd) **25 REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness26 REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom27 REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice28 REAL(wp), PUBLIC :: rn_Cfrazb !: squeezing coefficient for collection of bottom frazil ice29 REAL(wp), PUBLIC :: rn_hnewice !: thickness for new ice formation (m)30 31 LOGICAL , PUBLIC :: ln_frazil !: use of frazil ice collection as function of wind (T) or not (F)32 20 33 21 !!----------------------------- … … 101 89 ! ! to reintegrate longwave flux inside the ice thermodynamics 102 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_fl_1d !: Ice salinity variations due to flushing104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_gd_1d !: Ice salinity variations due to gravity drainage105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_se_1d !: Ice salinity variations due to basal salt entrapment106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_si_1d !: Ice salinity variations due to lateral accretion107 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hicol_1d !: Ice collection thickness accumulated in leads 108 92 … … 144 128 !!---------------------------------------------------------------------! 145 129 INTEGER :: thd_ice_alloc ! return value 146 INTEGER :: ierr( 3)130 INTEGER :: ierr(4), ii 147 131 !!---------------------------------------------------------------------! 132 ierr(:) = 0 148 133 134 ii = 1 149 135 ALLOCATE( npb (jpij) , nplm (jpij) , npac (jpij) , & 150 136 & qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) , & … … 156 142 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 157 143 & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 158 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr( 1) )144 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(ii) ) 159 145 ! 146 ii = ii + 1 160 147 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , & 161 148 & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , & … … 166 153 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij), & 167 154 & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij), & 168 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 169 & dsm_i_si_1d(jpij) , hicol_1d (jpij) , STAT=ierr(2) ) 155 & hicol_1d (jpij) , STAT=ierr(ii) ) 170 156 ! 171 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , & 172 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 173 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_sub (jpij) , & 174 & dh_i_bott (jpij) ,dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 175 & t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) , & 176 & q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) , & 177 & qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 157 ii = ii + 1 158 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , & 159 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 160 & dh_s_tot (jpij) , dh_i_surf (jpij) , dh_i_sub (jpij) , & 161 & dh_i_bott (jpij) , dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 162 & STAT=ierr(ii) ) 178 163 ! 179 thd_ice_alloc = MAXVAL( ierr ) 180 164 ii = ii + 1 165 ALLOCATE( t_s_1d (jpij,nlay_s) , t_i_1d (jpij,nlay_i) , s_i_1d(jpij,nlay_i) , & 166 & q_i_1d (jpij,nlay_i+1) , q_s_1d (jpij,nlay_s) , & 167 & qh_i_old(jpij,0:nlay_i+1) , h_i_old(jpij,0:nlay_i+1) , STAT=ierr(ii) ) 168 ! 169 thd_ice_alloc = MAXVAL( ierr(:) ) 181 170 IF( thd_ice_alloc /= 0 ) CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' ) 182 171 ! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90
r3680 r7355 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_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r5836 r7355 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_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r7280 r7355 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 ! … … 230 236 231 237 SUBROUTINE dia_hsb_rst( kt, cdrw ) 232 !!--------------------------------------------------------------------- 233 !! *** ROUTINE limdia_rst *** 234 !! 235 !! ** Purpose : Read or write DIA file in restart file 236 !! 237 !! ** Method : use of IOM library 238 !!---------------------------------------------------------------------- 239 INTEGER , INTENT(in) :: kt ! ocean time-step 240 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 241 ! 242 INTEGER :: ji, jj, jk ! dummy loop indices 243 INTEGER :: id1 ! local integers 244 !!---------------------------------------------------------------------- 245 ! 246 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 247 IF( ln_rstart ) THEN !* Read the restart file 248 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. ) 249 ! 250 IF(lwp) WRITE(numout,*) 251 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : read restart at it= ', kt,' date= ', ndastp 252 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 253 CALL iom_get( numror, 'frc_v', frc_v ) 254 CALL iom_get( numror, 'frc_t', frc_t ) 255 CALL iom_get( numror, 'frc_s', frc_s ) 256 IF( ln_linssh ) THEN 257 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 258 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 259 ENDIF 260 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 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 ) 268 ENDIF 269 ELSE 270 IF(lwp) WRITE(numout,*) 271 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : no restart, set value at initial state ' 272 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 273 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 274 ssh_ini(:,:) = sshn(:,:) ! initial ssh 275 DO jk = 1, jpk 276 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 277 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors 278 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content 279 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content 280 END DO 281 frc_v = 0._wp ! volume trend due to forcing 282 frc_t = 0._wp ! heat content - - - - 283 frc_s = 0._wp ! salt content - - - - 284 IF( ln_linssh ) THEN 285 IF( ln_isfcav ) THEN 286 DO ji=1,jpi 287 DO jj=1,jpj 288 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh 289 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh 290 END DO 291 END DO 292 ELSE 293 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh 294 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh 295 END IF 296 frc_wn_t = 0._wp ! initial heat content misfit due to free surface 297 frc_wn_s = 0._wp ! initial salt content misfit due to free surface 298 ENDIF 299 ENDIF 300 ! 301 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 302 ! ! ------------------- 303 IF(lwp) WRITE(numout,*) 304 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : write restart at it= ', kt,' date= ', ndastp 305 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 306 307 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 308 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 309 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 310 IF( ln_linssh ) THEN 311 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 312 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 313 ENDIF 314 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 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 ) 322 ENDIF 323 ! 324 ENDIF 325 ! 238 !!--------------------------------------------------------------------- 239 !! *** ROUTINE dia_hsb_rst *** 240 !! 241 !! ** Purpose : Read or write DIA file in restart file 242 !! 243 !! ** Method : use of IOM library 244 !!---------------------------------------------------------------------- 245 INTEGER , INTENT(in) :: kt ! ocean time-step 246 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 247 ! 248 INTEGER :: ji, jj, jk ! dummy loop indices 249 !!---------------------------------------------------------------------- 250 ! 251 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 252 IF( ln_rstart ) THEN !* Read the restart file 253 ! 254 IF(lwp) WRITE(numout,*) '~~~~~~~' 255 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 256 IF(lwp) WRITE(numout,*) '~~~~~~~' 257 CALL iom_get( numror, 'frc_v', frc_v ) 258 CALL iom_get( numror, 'frc_t', frc_t ) 259 CALL iom_get( numror, 'frc_s', frc_s ) 260 IF( ln_linssh ) THEN 261 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 262 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 263 ENDIF 264 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 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(:,:,:) ) 269 IF( ln_linssh ) THEN 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(:,:) ) 272 ENDIF 273 ELSE 274 IF(lwp) WRITE(numout,*) '~~~~~~~' 275 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 276 IF(lwp) WRITE(numout,*) '~~~~~~~' 277 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 278 ssh_ini(:,:) = sshn(:,:) ! initial ssh 279 DO jk = 1, jpk 280 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 281 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors 282 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content 283 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content 284 END DO 285 frc_v = 0._wp ! volume trend due to forcing 286 frc_t = 0._wp ! heat content - - - - 287 frc_s = 0._wp ! salt content - - - - 288 IF( ln_linssh ) THEN 289 IF ( ln_isfcav ) THEN 290 DO ji=1,jpi 291 DO jj=1,jpj 292 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh 293 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh 294 ENDDO 295 ENDDO 296 ELSE 297 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh 298 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh 299 END IF 300 frc_wn_t = 0._wp ! initial heat content misfit due to free surface 301 frc_wn_s = 0._wp ! initial salt content misfit due to free surface 302 ENDIF 303 ENDIF 304 305 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 306 ! ! ------------------- 307 IF(lwp) WRITE(numout,*) '~~~~~~~' 308 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 309 IF(lwp) WRITE(numout,*) '~~~~~~~' 310 311 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 312 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 313 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 314 IF( ln_linssh ) THEN 315 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 316 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 317 ENDIF 318 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling 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(:,:,:) ) 323 IF( ln_linssh ) THEN 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(:,:) ) 326 ENDIF 327 ! 328 ENDIF 329 ! 326 330 END SUBROUTINE dia_hsb_rst 327 331 … … 339 343 !! - Compute coefficients for conversion 340 344 !!--------------------------------------------------------------------------- 341 INTEGER :: jk ! dummy loop indice342 345 INTEGER :: ierror ! local integer 343 346 INTEGER :: ios … … 355 358 IF(lwm) WRITE ( numond, namhsb ) 356 359 357 ! 358 IF(lwp) THEN ! Control print 360 IF(lwp) THEN 359 361 WRITE(numout,*) 360 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 361 WRITE(numout,*) '~~~~~~~~~~~~' 362 WRITE(numout,*) ' Namelist namhsb : set hsb parameters' 363 WRITE(numout,*) ' Switch for hsb diagnostic (T) or not (F) ln_diahsb = ', ln_diahsb 364 ENDIF 365 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 ! 366 367 IF( .NOT. ln_diahsb ) RETURN 367 368 … … 377 378 IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 378 379 IF( ierror > 0 ) THEN 379 CALL ctl_stop( 'dia_hsb _init: unable to allocatehc_loc_ini' ) ; RETURN380 CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' ) ; RETURN 380 381 ENDIF 381 382 … … 383 384 ! 2 - Time independant variables and file opening ! 384 385 ! ----------------------------------------------- ! 385 IF(lwp) WRITE(numout,*)386 IF(lwp) WRITE(numout,*) " heat salt volume budgets activated"387 386 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 388 surf_tot = glob_sum( surf(:,:) ) 387 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 389 388 390 389 IF( lk_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r7277 r7355 125 125 ! 126 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: ff_f, ff_t !: coriolis factor at f- and t-point [1/s] 127 128 127 !!---------------------------------------------------------------------- 129 128 !! vertical coordinate and scale factors … … 229 228 !!---------------------------------------------------------------------- 230 229 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 231 !! $Id$ 230 !! $Id$ 232 231 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 233 232 !!---------------------------------------------------------------------- … … 249 248 INTEGER FUNCTION dom_oce_alloc() 250 249 !!---------------------------------------------------------------------- 251 INTEGER, DIMENSION(1 3) :: ierr250 INTEGER, DIMENSION(12) :: ierr 252 251 !!---------------------------------------------------------------------- 253 252 ierr(:) = 0 -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r7303 r7355 139 139 END DO 140 140 ! 141 ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)! Reference ocean thickness142 hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1)143 hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1)144 DO jk = 2, jpk141 ht_0(:,:) = 0._wp ! Reference ocean thickness 142 hu_0(:,:) = 0._wp 143 hv_0(:,:) = 0._wp 144 DO jk = 1, jpk 145 145 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 146 146 hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r7277 r7355 126 126 ENDIF 127 127 ENDIF 128 128 129 ! 129 130 ! !== associated horizontal metrics ==! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r7277 r7355 146 146 ! 147 147 ! 148 148 149 IF( nprint == 1 .AND. lwp ) THEN 149 150 WRITE(numout,*) ' MIN val k_top ', MINVAL( k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) ) -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7278 r7355 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_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r7277 r7355 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_2016/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r7282 r7355 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_2016/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r7280 r7355 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 … … 374 376 ! w a r n i n g narea (zone) /= nproc (processors)! 375 377 376 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN378 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 377 379 IF( jpni == 1 )THEN 378 380 nbondi = 2 … … 438 440 ENDIF 439 441 442 IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) & 443 & CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' ) 440 444 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' ) 441 445 -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r7280 r7355 73 73 INTEGER , PUBLIC, PARAMETER :: jp_usr = 1 !: user defined formulation 74 74 INTEGER , PUBLIC, PARAMETER :: jp_flx = 2 !: flux formulation 75 INTEGER , PUBLIC, PARAMETER :: jp_blk = 4!: bulk formulation76 INTEGER , PUBLIC, PARAMETER :: jp_purecpl = 5!: Pure ocean-atmosphere Coupled formulation77 INTEGER , PUBLIC, PARAMETER :: jp_none = 7!: for OPA when doing coupling via SAS module75 INTEGER , PUBLIC, PARAMETER :: jp_blk = 3 !: bulk formulation 76 INTEGER , PUBLIC, PARAMETER :: jp_purecpl = 4 !: Pure ocean-atmosphere Coupled formulation 77 INTEGER , PUBLIC, PARAMETER :: jp_none = 5 !: for OPA when doing coupling via SAS module 78 78 79 79 !!---------------------------------------------------------------------- -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90
r7282 r7355 40 40 USE lib_fortran ! to use key_nosignedzero 41 41 #if defined key_lim3 42 USE ice , ONLY : u_ice, v_ice, jpl, pfrld, a_i_b 42 USE ice , ONLY : u_ice, v_ice, jpl, pfrld, a_i_b, at_i_b 43 43 USE limthd_dh ! for CALL lim_thd_snwblow 44 44 #elif defined key_lim2 … … 93 93 94 94 ! !!! Bulk parameters 95 REAL(wp), PARAMETER :: cpa = 1000.5 ! specific heat of air (only used for ice fluxes now...)96 REAL(wp), PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation97 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant98 REAL(wp), PARAMETER :: C ice = 1.4e-3 ! iovi 1.63e-3 ! transfer coefficient over ice99 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant95 REAL(wp), PARAMETER :: cpa = 1000.5 ! specific heat of air (only used for ice fluxes now...) 96 REAL(wp), PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation 97 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 98 REAL(wp), PARAMETER :: Cd_ice = 1.4e-3 ! iovi 1.63e-3 ! transfer coefficient over ice 99 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 100 100 ! 101 101 ! !!* Namelist namsbc_blk : bulk parameters … … 111 111 REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements 112 112 REAL(wp) :: rn_zu ! z(u) : height of wind measurements 113 LOGICAL :: ln_Cd_L12 = .FALSE. ! Modify the drag ice-atm and oce-atm depending on ice concentration (from Lupkes et al. JGR2012) 114 ! 115 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Cd_oce ! air-ocean drag (clem) 113 116 114 117 INTEGER :: nblk ! choice of the bulk algorithm … … 128 131 CONTAINS 129 132 133 INTEGER FUNCTION sbc_blk_alloc() 134 !!------------------------------------------------------------------- 135 !! *** ROUTINE sbc_blk_alloc *** 136 !!------------------------------------------------------------------- 137 ALLOCATE( Cd_oce(jpi,jpj) , STAT=sbc_blk_alloc ) 138 ! 139 IF( lk_mpp ) CALL mpp_sum ( sbc_blk_alloc ) 140 IF( sbc_blk_alloc /= 0 ) CALL ctl_warn('sbc_blk_alloc: failed to allocate arrays') 141 END FUNCTION sbc_blk_alloc 142 130 143 SUBROUTINE sbc_blk_init 131 144 !!--------------------------------------------------------------------- … … 153 166 & sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif, & 154 167 & ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF, & ! bulk algorithm 155 & cn_dir , ln_taudif, rn_zqt, rn_zu, rn_pfac, rn_efac, rn_vfac 156 !!--------------------------------------------------------------------- 168 & cn_dir , ln_taudif, rn_zqt, rn_zu, & 169 & rn_pfac, rn_efac, rn_vfac, ln_Cd_L12 170 !!--------------------------------------------------------------------- 171 ! 172 ! ! allocate sbc_blk_core array 173 IF( sbc_blk_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' ) 157 174 ! 158 175 ! !** read bulk namelist … … 425 442 END IF 426 443 444 Cd_oce(:,:) = Cd(:,:) ! record value of pure ocean-atm. drag (clem) 445 427 446 DO jj = 1, jpj ! tau module, i and j component 428 447 DO ji = 1, jpi … … 549 568 INTEGER :: ji, jj ! dummy loop indices 550 569 ! 551 REAL(wp), DIMENSION(:,:) , POINTER :: z coef_wnorm570 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa 552 571 ! 553 572 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 554 573 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 574 REAL(wp), DIMENSION(:,:), POINTER :: Cd ! transfer coefficient for momentum (tau) 555 575 !!--------------------------------------------------------------------- 556 576 ! 557 577 IF( nn_timing == 1 ) CALL timing_start('blk_ice_tau') 558 578 ! 559 CALL wrk_alloc( jpi,jpj, zcoef_wnorm ) 579 CALL wrk_alloc( jpi,jpj, zrhoa ) 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 560 590 561 591 ! local scalars ( place there for vector optimisation purposes) 562 592 ! Computing density of air! Way denser that 1.2 over sea-ice !!! 563 593 !! 564 zcoef_wnorm (:,:) = rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 565 zcoef_wnorm (:,:) = Cice * zcoef_wnorm (:,:) 594 zrhoa (:,:) = rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 566 595 567 596 !!gm brutal.... … … 584 613 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) & 585 614 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * v_ice(ji,jj) 586 zwnorm_f = z coef_wnorm(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )615 zwnorm_f = zrhoa(ji,jj) * Cd(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 587 616 ! ... ice stress at I-point 588 617 utau_ice(ji,jj) = zwnorm_f * zwndi_f … … 610 639 DO jj = 2, jpjm1 611 640 DO ji = fs_2, fs_jpim1 ! vect. opt. 612 utau_ice(ji,jj) = 0.5 *zcoef_wnorm(ji,jj) * ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) ) &641 utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd(ji,jj) * ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) ) & 613 642 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 614 vtau_ice(ji,jj) = 0.5 *zcoef_wnorm(ji,jj) * ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) ) &643 vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd(ji,jj) * ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) ) & 615 644 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 616 645 END DO … … 626 655 CALL prt_ctl(tab2d_1=wndm_ice , clinfo1=' blk_ice: wndm_ice : ') 627 656 ENDIF 628 629 CALL wrk_dealloc( jpi,jpj, zcoef_wnorm )630 657 631 658 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_tau') … … 659 686 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3) 660 687 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa 688 REAL(wp), DIMENSION(:,:) , POINTER :: Cd ! transfer coefficient for momentum (tau) 661 689 !!--------------------------------------------------------------------- 662 690 ! … … 665 693 CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 666 694 CALL wrk_alloc( jpi,jpj, zrhoa) 695 CALL wrk_alloc( jpi,jpj, Cd ) 696 697 Cd(:,:) = Cd_ice 698 699 ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 700 #if defined key_lim3 701 IF( ln_Cd_L12 ) THEN 702 CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 703 ENDIF 704 #endif 705 667 706 ! 668 707 ! local scalars ( place there for vector optimisation purposes) 669 708 zcoef_dqlw = 4.0 * 0.95 * Stef 670 zcoef_dqla = -Ls * Cice *11637800. * (-5897.8)709 zcoef_dqla = -Ls * 11637800. * (-5897.8) 671 710 ! 672 711 zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) … … 696 735 ! ... turbulent heat fluxes 697 736 ! Sensible Heat 698 z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * C ice* wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )737 z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Cd(ji,jj) * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 699 738 ! Latent Heat 700 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls * C ice* wndm_ice(ji,jj) &739 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls * Cd(ji,jj) * wndm_ice(ji,jj) & 701 740 & * ( 11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) ) ) 702 741 ! Latent heat sensitivity for ice (Dqla/Dt) … … 708 747 709 748 ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 710 z_dqsb(ji,jj,jl) = zrhoa(ji,jj) *cpa*Cice* wndm_ice(ji,jj)749 z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Cd(ji,jj) * wndm_ice(ji,jj) 711 750 712 751 ! ----------------------------! … … 782 821 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 783 822 CALL wrk_dealloc( jpi,jpj, zrhoa ) 823 CALL wrk_dealloc( jpi,jpj, Cd ) 784 824 ! 785 825 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_flx') … … 906 946 END FUNCTION L_vap 907 947 948 949 #if defined key_lim3 950 SUBROUTINE Cdn10_Lupkes2012( Cd ) 951 !!---------------------------------------------------------------------- 952 !! *** ROUTINE Cdn10_Lupkes2012 *** 953 !! 954 !! ** Purpose : Recompute the ice-atm drag at 10m height to make 955 !! it dependent on edges at leads, melt ponds and flows. 956 !! After some approximations, this can be resumed to a dependency 957 !! on ice concentration. 958 !! 959 !! ** Method : The parameterization is taken from Lupkes et al. (2012) eq.(50) 960 !! with the highest level of approximation: level4, eq.(59) 961 !! The generic drag over a cell partly covered by ice can be re-written as follows: 962 !! 963 !! Cd = Cdw * (1-A) + Cdi * A + Ce * (1-A)**(nu+1/(10*beta)) * A**mu 964 !! 965 !! Ce = 2.23e-3 , as suggested by Lupkes (eq. 59) 966 !! nu = mu = beta = 1 , as suggested by Lupkes (eq. 59) 967 !! A is the concentration of ice minus melt ponds (if any) 968 !! 969 !! This new drag has a parabolic shape (as a function of A) starting at 970 !! Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 971 !! and going down to Cdi(say 1.4e-3) for A=1 972 !! 973 !! It is theoretically applicable to all ice conditions !(not only MIZ) 974 !! => see Lupkes et al (2013) 975 !! 976 !! ** References : Lupkes et al. JGR 2012 (theory) 977 !! Lupkes et al. GRL 2013 (application to GCM) 978 !! 979 !!---------------------------------------------------------------------- 980 REAL(wp), DIMENSION(:,:), INTENT(inout) :: Cd 981 REAL(wp), PARAMETER :: zCe = 2.23e-03_wp 982 REAL(wp), PARAMETER :: znu = 1._wp 983 REAL(wp), PARAMETER :: zmu = 1._wp 984 REAL(wp), PARAMETER :: zbeta = 1._wp 985 REAL(wp) :: zcoef 986 !!---------------------------------------------------------------------- 987 zcoef = znu + 1._wp / ( 10._wp * zbeta ) 988 989 ! generic drag over a cell partly covered by ice 990 !!Cd(:,:) = Cd_oce(:,:) * ( 1._wp - at_i_b(:,:) ) + & !! pure ocean drag 991 !! & Cd_ice * at_i_b(:,:) + & !! pure ice drag 992 !! & zCe * ( 1._wp - at_i_b(:,:) )**zcoef * !at_i_b(:,:)**zmu ! change due to sea-ice morphology 993 994 ! ice-atm drag 995 Cd(:,:) = Cd_ice + & ! pure ice drag 996 & zCe * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp) ! change due to sea-ice morphology 997 998 END SUBROUTINE Cdn10_Lupkes2012 999 #endif 1000 1001 908 1002 !!====================================================================== 909 1003 END MODULE sbcblk -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r7282 r7355 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_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7280 r7355 25 25 USE ice ! LIM-3: ice variables 26 26 USE thd_ice ! LIM-3: thermodynamical variables 27 USE dom_ice ! LIM-3: ice domain28 27 ! 29 28 USE sbc_oce ! Surface boundary condition: ocean fields 30 29 USE sbc_ice ! Surface boundary condition: ice fields 30 USE usrdef_sbc ! user defined: surface boundary condition 31 31 USE sbcblk ! Surface boundary condition: bulk 32 32 USE sbccpl ! Surface boundary condition: coupled interface … … 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 … … 81 85 CONTAINS 82 86 83 SUBROUTINE sbc_ice_lim( kt, k blk)87 SUBROUTINE sbc_ice_lim( kt, ksbc ) 84 88 !!--------------------------------------------------------------------- 85 89 !! *** ROUTINE sbc_ice_lim *** … … 102 106 !!--------------------------------------------------------------------- 103 107 INTEGER, INTENT(in) :: kt ! ocean time step 104 INTEGER, INTENT(in) :: kblk ! type of bulk (=4 BULK, =5 COUPLED) 105 !! 106 INTEGER :: jl ! dummy loop index 108 INTEGER, INTENT(in) :: ksbc ! type of sbc flux ( 1 = user defined formulation, 109 ! 3 = bulk formulation, 110 ! 4 = Pure Coupled formulation) 111 !! 112 INTEGER :: jl ! dummy loop index 107 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 108 114 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice … … 110 116 111 117 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 118 119 ! clem: it is important to initialize agrif_lim3 variables here and not in sbc_lim_init 120 # if defined key_agrif 121 IF( kt == nit000 ) THEN 122 IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim3 123 ENDIF 124 # endif 112 125 113 126 !-----------------------! … … 115 128 !-----------------------! 116 129 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 130 131 # if defined key_agrif 132 IF( .NOT. Agrif_Root() ) lim_nbstep = MOD( lim_nbstep, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1 133 # endif 117 134 118 135 ! mean surface ocean current at ice velocity point (C-grid dynamics : U- & V-points as the ocean) … … 135 152 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] 136 153 !----------------------------------------------------------------- 137 SELECT CASE( kblk ) 138 CASE( jp_blk ) ; CALL blk_ice_tau ! Bulk formulation 139 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 154 SELECT CASE( ksbc ) 155 CASE( jp_usr ) ; CALL usrdef_sbc_ice_tau( kt ) ! user defined formulation 156 CASE( jp_blk ) ; CALL blk_ice_tau ! Bulk formulation 157 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 140 158 END SELECT 141 159 142 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation160 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 143 161 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 144 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )162 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 145 163 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 146 164 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) … … 153 171 numit = numit + nn_fsbc ! Ice model time step 154 172 ! 155 CALL sbc_lim_bef ! Store previous ice values 156 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 157 CALL lim_rst_opn( kt ) ! Open Ice restart file 158 ! 159 IF( .NOT. lk_c1d ) THEN 173 CALL sbc_lim_bef ! Store previous ice values 174 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 175 CALL lim_rst_opn( kt ) ! Open Ice restart file 176 ! 177 ! --- zap this if no ice dynamics --- ! 178 IF( .NOT. lk_c1d .AND. ln_limdyn ) THEN 160 179 ! 161 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 162 ! 163 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 164 ! 165 IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 166 ! 167 #if defined key_bdy 168 CALL bdy_ice_lim( kt ) ! bdy ice thermo 169 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 170 #endif 171 ! 172 CALL lim_update1( kt ) ! Corrections 180 IF( nn_limdyn /= 0 ) THEN ! -- Ice dynamics 181 CALL lim_dyn( kt ) ! rheology 182 ELSE 183 u_ice(:,:) = rn_uice * umask(:,:,1) ! or prescribed velocity 184 v_ice(:,:) = rn_vice * vmask(:,:,1) 185 ENDIF 186 CALL lim_trp( kt ) ! -- Ice transport (Advection/diffusion) 187 IF( nn_limdyn == 2 .AND. nn_monocat /= 2 ) & ! -- Mechanical redistribution (ridging/rafting) 188 & CALL lim_itd_me 189 IF( nn_limdyn == 2 ) CALL lim_update1( kt ) ! -- Corrections 173 190 ! 174 191 ENDIF 175 192 193 ! --- 194 #if defined key_agrif 195 IF( .NOT. Agrif_Root() ) CALL agrif_interp_lim3('T') 196 #endif 197 #if defined key_bdy 198 IF( ln_limthd ) CALL bdy_ice_lim( kt ) ! -- bdy ice thermo 199 #endif 176 200 ! previous lead fraction and ice volume for flux calculations 177 CALL sbc_lim_bef 178 CALL lim_var_glo2eqv ! ht_i and ht_s for ice albedo calculation 179 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 ! 180 205 pfrld(:,:) = 1._wp - at_i(:,:) 181 206 phicif(:,:) = vt_i(:,:) … … 192 217 !---------------------------------------------------------------------------------------- 193 218 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 194 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 195 196 SELECT CASE( kblk ) 197 CASE( jp_blk ) ! bulk formulation 198 ! albedo depends on cloud fraction because of non-linear spectral effects 199 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 200 CALL blk_ice_flx( t_su, alb_ice ) 201 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 202 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 203 CASE ( jp_purecpl ) 204 ! albedo depends on cloud fraction because of non-linear spectral effects 205 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 206 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 207 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 219 220 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 221 SELECT CASE( ksbc ) 222 CASE( jp_usr ) ; CALL usrdef_sbc_ice_flx( kt ) ! user defined formulation 223 CASE( jp_blk ) ! bulk formulation 224 ! albedo depends on cloud fraction because of non-linear spectral effects 225 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 226 CALL blk_ice_flx( t_su, alb_ice ) 227 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 228 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 229 CASE ( jp_purecpl ) 230 ! albedo depends on cloud fraction because of non-linear spectral effects 231 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 232 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 233 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 208 234 END SELECT 235 209 236 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 210 237 … … 212 239 ! --- ice thermodynamics --- ! 213 240 !----------------------------! 214 CALL lim_thd( kt ) ! Ice thermodynamics 215 ! 216 CALL lim_update2( kt ) ! Corrections 217 ! 218 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 219 ! 220 IF(ln_limdiaout) CALL lim_diahsb ! Diagnostics and outputs 221 ! 222 CALL lim_wri( 1 ) ! Ice outputs 241 ! --- zap this if no ice thermo --- ! 242 IF( ln_limthd ) CALL lim_thd( kt ) ! -- Ice thermodynamics 243 IF( ln_limthd ) CALL lim_update2( kt ) ! -- Corrections 244 ! --- 245 # if defined key_agrif 246 IF( .NOT. Agrif_Root() ) CALL agrif_update_lim3( kt ) 247 # endif 248 CALL lim_var_glo2eqv ! necessary calls (at least for coupling) 249 CALL lim_var_agg( 2 ) ! necessary calls (at least for coupling) 250 ! 251 # if defined key_agrif 252 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ChildGrid_To_ParentGrid() ! clem: should be called at the update frequency only (cf agrif_lim3_update) 253 # endif 254 CALL lim_sbc_flx( kt ) ! -- Update surface ocean mass, heat and salt fluxes 255 # if defined key_agrif 256 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ParentGrid_To_ChildGrid() ! clem: should be called at the update frequency only (cf agrif_lim3_update) 257 # endif 258 IF( ln_limdiahsb ) CALL lim_diahsb( kt ) ! -- Diagnostics and outputs 259 ! 260 CALL lim_wri( 1 ) ! -- Ice outputs 223 261 ! 224 262 IF( kt == nit000 .AND. ln_rstart ) & 225 & CALL iom_close( numrir ) ! close input ice restart file226 ! 227 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file228 ! 229 IF( ln_ icectl )CALL lim_ctl( kt ) ! alerts in case of model crash263 & CALL iom_close( numrir ) ! close input ice restart file 264 ! 265 IF( lrst_ice ) CALL lim_rst_write( kt ) ! -- Ice restart file 266 ! 267 IF( ln_limctl ) CALL lim_ctl( kt ) ! alerts in case of model crash 230 268 ! 231 269 ENDIF ! End sea-ice time step only … … 235 273 !-------------------------! 236 274 ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere 237 IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 275 ! using before instantaneous surf. currents 276 IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) 238 277 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 239 278 ! … … 252 291 !!---------------------------------------------------------------------- 253 292 IF(lwp) WRITE(numout,*) 254 IF(lwp) WRITE(numout,*) 'sbc_ ice_lim : update ocean surface boudary condition'293 IF(lwp) WRITE(numout,*) 'sbc_lim_init : update ocean surface boudary condition' 255 294 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 256 295 ! … … 264 303 ! ! Allocate the ice arrays 265 304 ierr = ice_alloc () ! ice variables 266 ierr = ierr + dom_ice_alloc () ! domain267 305 ierr = ierr + sbc_ice_alloc () ! surface forcing 268 306 ierr = ierr + thd_ice_alloc () ! thermodynamics 269 ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics307 IF( ln_limdyn ) ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics 270 308 ! 271 309 IF( lk_mpp ) CALL mpp_sum( ierr ) 272 310 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays') 273 311 ! 274 ! ! adequation jpk versus ice/snow layers/categories 275 IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk ) & 276 & CALL ctl_stop( 'STOP', & 277 & 'sbc_lim_init: the 3rd dimension of workspace arrays is too small.', & 278 & 'use more ocean levels or less ice/snow layers/categories.' ) 312 CALL lim_dyn_init ! set ice dynamics parameters 279 313 ! 280 314 CALL lim_itd_init ! ice thickness distribution initialization … … 286 320 CALL lim_thd_sal_init ! set ice salinity parameters 287 321 ! 288 CALL lim_msh ! ice mesh initialization 289 ! 290 CALL lim_itd_me_init ! ice thickness distribution initialization for mecanical deformation 322 IF( ln_limdyn ) CALL lim_itd_me_init ! ice thickness distribution initialization for mecanical deformation 291 323 ! ! Initial sea-ice state 292 324 IF( .NOT. ln_rstart ) THEN ! start from rest: sea-ice deduced from sst … … 298 330 numit = nit000 - 1 299 331 ENDIF 300 CALL lim_var_agg( 1)332 CALL lim_var_agg(2) 301 333 CALL lim_var_glo2eqv 302 334 ! 303 335 CALL lim_sbc_init ! ice surface boundary condition 336 ! 337 IF( ln_limdiahsb) CALL lim_diahsb_init ! initialization for diags 304 338 ! 305 339 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction … … 335 369 !!------------------------------------------------------------------- 336 370 INTEGER :: ios ! Local integer output status for namelist read 337 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, & 338 & ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt 371 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, rn_amax_n, rn_amax_s, cn_icerst_in, cn_icerst_indir, & 372 & cn_icerst_out, cn_icerst_outdir, ln_limthd, ln_limdyn, nn_limdyn, rn_uice, rn_vice 373 NAMELIST/namicediag/ ln_limdiachk, ln_limdiahsb, ln_limctl, iiceprt, jiceprt 339 374 !!------------------------------------------------------------------- 340 375 ! 341 376 REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice 342 377 READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 343 901 IF( ios /= 0 ) 344 ! 378 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 379 345 380 REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice 346 381 READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 347 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 348 IF(lwm) WRITE( numoni, namicerun ) 382 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 383 IF(lwm) WRITE ( numoni, namicerun ) 384 ! 385 REWIND( numnam_ice_ref ) ! Namelist namicediag in reference namelist : Parameters for ice 386 READ ( numnam_ice_ref, namicediag, IOSTAT = ios, ERR = 903) 387 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in reference namelist', lwp ) 388 389 REWIND( numnam_ice_cfg ) ! Namelist namicediag in configuration namelist : Parameters for ice 390 READ ( numnam_ice_cfg, namicediag, IOSTAT = ios, ERR = 904 ) 391 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in configuration namelist', lwp ) 392 IF(lwm) WRITE ( numoni, namicediag ) 349 393 ! 350 394 IF(lwp) THEN ! control print 351 395 WRITE(numout,*) 352 WRITE(numout,*) 'lim_run_init : ice share parameters for dynamics/advection/thermo of sea-ice' 353 WRITE(numout,*) '~~~~~~~~~~~~' 354 WRITE(numout,*) ' Namelist namicerun' 355 WRITE(numout,*) ' number of ice categories = ', jpl 356 WRITE(numout,*) ' number of ice layers = ', nlay_i 357 WRITE(numout,*) ' number of snow layers = ', nlay_s 358 WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn 359 WRITE(numout,*) ' maximum ice concentration for NH = ', rn_amax_n 360 WRITE(numout,*) ' maximum ice concentration for SH = ', rn_amax_s 361 WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb 362 WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout 363 WRITE(numout,*) ' control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 364 WRITE(numout,*) ' i-index for control prints (ln_icectl=true) = ', iiceprt 365 WRITE(numout,*) ' j-index for control prints (ln_icectl=true) = ', jiceprt 396 WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice' 397 WRITE(numout,*) ' ~~~~~~' 398 WRITE(numout,*) ' number of ice categories = ', jpl 399 WRITE(numout,*) ' number of ice layers = ', nlay_i 400 WRITE(numout,*) ' number of snow layers = ', nlay_s 401 WRITE(numout,*) ' maximum ice concentration for NH = ', rn_amax_n 402 WRITE(numout,*) ' maximum ice concentration for SH = ', rn_amax_s 403 WRITE(numout,*) ' Ice thermodynamics (T) or not (F) ln_limthd = ', ln_limthd 404 WRITE(numout,*) ' Ice dynamics (T) or not (F) ln_limdyn = ', ln_limdyn 405 WRITE(numout,*) ' (ln_limdyn=T) Ice dynamics switch nn_limdyn = ', nn_limdyn 406 WRITE(numout,*) ' 2: total' 407 WRITE(numout,*) ' 1: advection only (no diffusion, no ridging/rafting)' 408 WRITE(numout,*) ' 0: advection only (as 1 + prescribed velocity, bypass rheology)' 409 WRITE(numout,*) ' (ln_limdyn=T) prescribed u-vel (case nn_limdyn=0) = ', rn_uice 410 WRITE(numout,*) ' (ln_limdyn=T) prescribed v-vel (case nn_limdyn=0) = ', rn_vice 411 WRITE(numout,*) 412 WRITE(numout,*) '...and ice diagnostics' 413 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~' 414 WRITE(numout,*) ' Diagnose online heat/mass/salt budget ln_limdiachk = ', ln_limdiachk 415 WRITE(numout,*) ' Output heat/mass/salt budget ln_limdiahsb = ', ln_limdiahsb 416 WRITE(numout,*) ' control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_limctl 417 WRITE(numout,*) ' i-index for control prints (ln_limctl=true) = ', iiceprt 418 WRITE(numout,*) ' j-index for control prints (ln_limctl=true) = ', jiceprt 366 419 ENDIF 367 420 ! 368 421 ! sea-ice timestep and inverse 369 rdt_ice = nn_fsbc * rdt370 r1_rdtice = 1._wp / rdt_ice 422 rdt_ice = REAL(nn_fsbc) * rdt 423 r1_rdtice = 1._wp / rdt_ice 371 424 372 425 ! inverse of nlay_i and nlay_s … … 375 428 ! 376 429 #if defined key_bdy 377 IF( lwp .AND. ln_limdia hsb) CALL ctl_warn('online conservation check activated but it does not work with BDY')430 IF( lwp .AND. ln_limdiachk ) CALL ctl_warn('online conservation check activated but it does not work with BDY') 378 431 #endif 379 432 ! 380 END SUBROUTINE lim_run_init 433 IF( lwp ) WRITE(numout,*) ' ice timestep rdt_ice = ', rdt_ice 434 ! 435 END SUBROUTINE ice_run 381 436 382 437 … … 398 453 ! 399 454 REWIND( numnam_ice_ref ) ! Namelist namiceitd in reference namelist : Parameters for ice 400 READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 90 3)401 90 3 IF( ios /= 0 )CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )402 ! 455 READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 905) 456 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 457 403 458 REWIND( numnam_ice_cfg ) ! Namelist namiceitd in configuration namelist : Parameters for ice 404 READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 90 4)405 90 4 IF( ios /= 0 )CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp )406 IF(lwm) WRITE ( numoni, namiceitd )459 READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 906 ) 460 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 461 IF(lwm) WRITE ( numoni, namiceitd ) 407 462 ! 408 463 IF(lwp) THEN ! control print … … 410 465 WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 411 466 WRITE(numout,*) '~~~~~~~~~~~~' 412 WRITE(numout,*) ' Namelist namiceitd' 413 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 414 WRITE(numout,*) ' mean ice thickness in the domain (used if nn_catbnd=2) rn_himean = ', rn_himean 467 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 468 WRITE(numout,*) ' mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean 415 469 ENDIF 416 470 ! … … 456 510 457 511 458 SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice , & 459 & pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 512 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 460 513 !!--------------------------------------------------------------------- 461 514 !! *** ROUTINE ice_lim_flx *** … … 551 604 v_ice_b(:,:) = v_ice(:,:) 552 605 ! 606 at_i_b (:,:) = SUM( a_i_b(:,:,:), dim=3 ) 607 553 608 END SUBROUTINE sbc_lim_bef 554 609 … … 562 617 !!---------------------------------------------------------------------- 563 618 sfx (:,:) = 0._wp ; 564 sfx_bri(:,:) = 0._wp ; 619 sfx_bri(:,:) = 0._wp ; sfx_lam(:,:) = 0._wp 565 620 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 566 621 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp … … 573 628 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 574 629 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 575 wfx_spr(:,:) = 0._wp ; 576 !630 wfx_spr(:,:) = 0._wp ; wfx_lam(:,:) = 0._wp 631 577 632 hfx_thd(:,:) = 0._wp ; 578 633 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp … … 590 645 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp 591 646 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp 592 ! 647 648 tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here) 649 593 650 END SUBROUTINE sbc_lim_diag0 594 651 … … 627 684 !!---------------------------------------------------------------------- 628 685 CONTAINS 629 SUBROUTINE sbc_ice_lim ( kt, k blk) ! Dummy routine630 WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt , kblk686 SUBROUTINE sbc_ice_lim ( kt, ksbc ) ! Dummy routine 687 WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt 631 688 END SUBROUTINE sbc_ice_lim 632 689 SUBROUTINE sbc_lim_init ! Dummy routine -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r7280 r7355 114 114 ! 115 115 ! !* overwrite namelist parameter using CPP key information 116 IF( Agrif_Root() ) THEN ! AGRIF zoom 116 #if defined key_agrif 117 IF( Agrif_Root() ) THEN ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid) 117 118 IF( lk_lim2 ) nn_ice = 2 118 119 IF( lk_lim3 ) nn_ice = 3 119 120 IF( lk_cice ) nn_ice = 4 120 121 ENDIF 122 #else 123 IF( lk_lim2 ) nn_ice = 2 124 IF( lk_lim3 ) nn_ice = 3 125 IF( lk_cice ) nn_ice = 4 126 #endif 121 127 ! 122 128 IF(lwp) THEN !* Control print … … 150 156 ENDIF 151 157 ! 158 152 159 IF( .NOT.ln_usr ) THEN ! the model calendar needs some specificities (except in user defined case) 153 160 IF( MOD( rday , rdt ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' ) … … 247 254 & CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' ) 248 255 ENDIF 249 250 256 ! !* Choice of the Surface Boudary Condition 251 257 ! (set nsbc) … … 378 384 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition 379 385 ! ! (i.e. utau,vtau, qns, qsr, emp, sfx) 380 CASE( jp_usr ) ; CALL usr _def_sbc( kt ) ! user defined formulation381 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation386 CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt ) ! user defined formulation 387 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 382 388 CASE( jp_blk ) 383 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA384 CALL sbc_blk ( kt ) ! bulk formulation for the ocean389 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA 390 CALL sbc_blk ( kt ) ! bulk formulation for the ocean 385 391 ! 386 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation392 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation 387 393 CASE( jp_none ) 388 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS394 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS 389 395 END SELECT 390 396 391 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing397 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing 392 398 393 399 ! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90
r6923 r7355 11 11 12 12 !!---------------------------------------------------------------------- 13 !! usr _def_sbc : user defined surface bounday conditions in GYRE case13 !! usrdef_sbc : user defined surface bounday conditions in GYRE case 14 14 !!---------------------------------------------------------------------- 15 15 USE oce ! ocean dynamics and tracers … … 26 26 PRIVATE 27 27 28 PUBLIC usr_def_sbc ! routine called in sbcmod module 28 PUBLIC usrdef_sbc_oce ! routine called in sbcmod module 29 PUBLIC usrdef_sbc_ice_tau ! routine called by sbcice_lim.F90 for ice dynamics 30 PUBLIC usrdef_sbc_ice_flx ! routine called by sbcice_lim.F90 for ice thermo 29 31 30 32 !! * Substitutions … … 37 39 CONTAINS 38 40 39 SUBROUTINE usr _def_sbc( kt )41 SUBROUTINE usrdef_sbc_oce( kt ) 40 42 !!--------------------------------------------------------------------- 41 !! *** ROUTINE usr _def_sbc ***43 !! *** ROUTINE usrdef_sbc *** 42 44 !! 43 45 !! ** Purpose : provide at each time-step the GYRE surface boundary … … 133 135 !! Commented here as they change the GYRE results 134 136 !#if !defined key_mpp_rep 135 ! CALL ctl_stop( 'usr _def_sbc: key_mpp_rep is required to run GYRE configuration')137 ! CALL ctl_stop( 'usrdef_sbc_oce: key_mpp_rep is required to run GYRE configuration') 136 138 !#endif 137 139 !!gm … … 198 200 IF( kt == nit000 .AND. lwp ) THEN 199 201 WRITE(numout,*) 200 WRITE(numout,*)'usr _def_sbc: analytical surface fluxes for GYRE configuration'202 WRITE(numout,*)'usrdef_sbc_oce : analytical surface fluxes for GYRE configuration' 201 203 WRITE(numout,*)'~~~~~~~~~~~ ' 202 204 WRITE(numout,*)' nyear = ', nyear … … 228 230 ENDIF 229 231 ! 230 END SUBROUTINE usr_def_sbc 232 END SUBROUTINE usrdef_sbc_oce 233 234 SUBROUTINE usrdef_sbc_ice_tau( kt ) 235 INTEGER, INTENT(in) :: kt ! ocean time step 236 END SUBROUTINE usrdef_sbc_ice_tau 237 238 SUBROUTINE usrdef_sbc_ice_flx( kt ) 239 INTEGER, INTENT(in) :: kt ! ocean time step 240 END SUBROUTINE usrdef_sbc_ice_flx 231 241 232 242 !!====================================================================== -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r7282 r7355 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_2016/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r6140 r7355 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_2016/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r7280 r7355 106 106 107 107 !!---------------------------------------------------------------------- 108 !! NEMO/OPA 4.0, NEMO Consortium (2016)108 !! NEMO/OPA 3.7 , NEMO Consortium (2016) 109 109 !! $Id$ 110 110 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 143 143 # endif 144 144 # if defined key_lim2 145 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 145 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM2 146 # endif 147 # if defined key_lim3 148 CALL Agrif_Declare_Var_lim3 ! " " " " " LIM3 146 149 # endif 147 150 #endif -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/step.F90
r7278 r7355 294 294 IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 295 295 ! 296 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 296 297 297 298 !!gm : This does not only concern the dynamics ==>>> add a new title … … 315 316 ENDIF 316 317 #endif 317 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics318 318 IF( ln_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 319 319 -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r6140 r7355 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_2016/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r7277 r7355 28 28 USE cpl_oasis3 ! 29 29 USE sbcssm ! 30 USE icbini ! handle bergs, initialisation 30 31 USE icbstp ! handle bergs, calving, themodynamics and transport 31 #if defined key_bdy32 32 USE bdyini ! open boundary cond. setting (bdy_init routine). clem: mandatory for LIM3 33 33 USE bdydta ! open boundary cond. setting (bdy_dta_init routine). clem: mandatory for LIM3 34 #endif35 34 USE bdy_par 36 35 ! … … 76 75 ! 77 76 #if defined key_agrif 78 77 CALL Agrif_Init_Grids() ! AGRIF: set the meshes 79 78 #endif 80 79 ! … … 91 90 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 92 91 # endif 92 # if defined key_lim3 93 CALL Agrif_Declare_Var_lim3 ! " " " " " LIM3 94 # endif 93 95 #endif 94 96 ! check that all process are still there... If some process have an error, … … 133 135 ! 134 136 #if defined key_agrif 135 CALL Agrif_ParentGrid_To_ChildGrid() 136 IF( nn_timing == 1 ) CALL timing_finalize 137 CALL Agrif_ChildGrid_To_ParentGrid() 137 IF( .NOT. Agrif_Root() ) THEN 138 CALL Agrif_ParentGrid_To_ChildGrid() 139 IF( nn_timing == 1 ) CALL timing_finalize 140 CALL Agrif_ChildGrid_To_ParentGrid() 141 ENDIF 138 142 #endif 139 143 IF( nn_timing == 1 ) CALL timing_finalize … … 296 300 #endif 297 301 ENDIF 298 299 !!gm ??? why here it has already been done in line 301 !300 jpk = jpkglo ! third dim301 !!gm end302 302 303 303 #if defined key_agrif … … 361 361 CALL dom_init ! Domain 362 362 363 IF( ln_nnogather )CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined)364 365 IF( ln_ctl )CALL prt_ctl_init ! Print control363 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 364 365 IF( ln_ctl ) CALL prt_ctl_init ! Print control 366 366 CALL day_init ! model calendar (using both namelist and restart infos) 367 367 368 368 CALL sbc_init ! Forcings : surface module 369 369 370 370 ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from 371 371 ! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. … … 374 374 IF( lk_bdy ) CALL bdy_dta_init 375 375 ! ==> 376 CALL icb_init( rdt, nit000) ! initialise icebergs instance 376 377 377 378 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler … … 506 507 USE diawri , ONLY: dia_wri_alloc 507 508 USE dom_oce , ONLY: dom_oce_alloc 509 USE oce 508 510 #if defined key_bdy 509 511 USE bdy_oce , ONLY: bdy_oce_alloc 510 USE oce ! clem: mandatory for LIM3 because needed for bdy arrays 511 #else 512 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 513 #endif 514 ! 515 INTEGER :: ierr, ierr1, ierr2, ierr3, ierr4, ierr5, ierr6, ierr7, ierr8 516 INTEGER :: jpm 512 #endif 513 ! 514 INTEGER :: ierr 517 515 !!---------------------------------------------------------------------- 518 516 ! 519 517 ierr = dia_wri_alloc () 520 518 ierr = ierr + dom_oce_alloc () ! ocean domain 519 ierr = ierr + oce_alloc () ! (tsn...) needed for agrif and/or lim3 and bdy 521 520 #if defined key_bdy 522 521 ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization) 523 ierr = ierr + oce_alloc () ! (tsn...)524 #endif525 526 #if ! defined key_bdy527 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), &528 & snwice_fmass(jpi,jpj) , STAT= ierr1 )529 !530 ! lim code currently uses surface temperature and salinity in tsn array for initialisation531 ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use532 ! clem: should not be needed. To be checked out533 jpm = MAX(jp_tem, jp_sal)534 ALLOCATE( tsn (jpi,jpj,1,jpm) , STAT=ierr2 )535 ALLOCATE( ub (jpi,jpj,1) , STAT=ierr3 )536 ALLOCATE( vb (jpi,jpj,1) , STAT=ierr4 )537 ALLOCATE( tsb (jpi,jpj,1,jpm) , STAT=ierr5 )538 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 )539 ALLOCATE( un (jpi,jpj,1) , STAT=ierr7 )540 ALLOCATE( vn (jpi,jpj,1) , STAT=ierr8 )541 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 + ierr7 + ierr8542 522 #endif 543 523 ! … … 711 691 nsndto = nsndto + 1 712 692 isendto(nsndto) = jn 713 END 693 ENDIF 714 694 END DO 715 695 nfsloop = 1 -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r6140 r7355 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_2016/NEMOGCM/NEMO/SAS_SRC/step.F90
r6140 r7355 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 -
branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/param.cfg
r5836 r7355 1 1 #- forcing files storing 2 FORCING_DIR= ~/FORCING2 FORCING_DIR=/workgpfs/rech/gzi/rgzi011/FORCING 3 3 #- input files storing 4 4 INPUT_DIR=${CONFIG_DIR}/${NEW_CONF}/EXP00 … … 6 6 #TMPDIR=${CONFIG_DIR}/${NEW_CONF}/EXP00 7 7 #- VALIDATION files storing 8 NEMO_VALIDATION_DIR= ~/NEMO_VALIDATION8 NEMO_VALIDATION_DIR=/workgpfs/rech/gzi/rgzi011/agrif-lim3
Note: See TracChangeset
for help on using the changeset viewer.