- Timestamp:
- 2017-09-07T20:08:11+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icerdgrft.F90
r8506 r8512 32 32 33 33 PUBLIC ice_rdgrft ! called by ice_stp 34 PUBLIC ice_rdgrft_ icestrength! called by icerhg_evp34 PUBLIC ice_rdgrft_strength ! called by icerhg_evp 35 35 PUBLIC ice_rdgrft_init ! called by ice_stp 36 36 PUBLIC ice_rdgrft_alloc ! called by ice_init … … 51 51 REAL(wp) :: zdrho ! 52 52 ! 53 ! ** namelist (namiceitdme) ** 54 REAL(wp) :: rn_cs !: fraction of shearing energy contributing to ridging 55 INTEGER :: nn_partfun !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 56 REAL(wp) :: rn_gstar !: fractional area of young ice contributing to ridging 57 REAL(wp) :: rn_astar !: equivalent of G* for an exponential participation function 58 LOGICAL :: ln_ridging !: ridging of ice or not 59 REAL(wp) :: rn_hstar !: thickness that determines the maximal thickness of ridged ice 60 REAL(wp) :: rn_por_rdg !: initial porosity of ridges (0.3 regular value) 61 REAL(wp) :: rn_fsnowrdg !: fractional snow loss to the ocean during ridging 62 REAL(wp) :: rn_fpondrdg !: fractional melt pond loss to the ocean during ridging 63 LOGICAL :: ln_rafting !: rafting of ice or not 64 REAL(wp) :: rn_hraft !: threshold thickness (m) for rafting / ridging 65 REAL(wp) :: rn_craft !: coefficient for smoothness of the hyperbolic tangent in rafting 66 REAL(wp) :: rn_fsnowrft !: fractional snow loss to the ocean during ridging 67 REAL(wp) :: rn_fpondrft !: fractional snow loss to the ocean during rafting 53 ! ** namelist (namice_rdgrft) ** 54 REAL(wp) :: rn_cs ! fraction of shearing energy contributing to ridging 55 LOGICAL :: ln_partf_lin ! participation function linear (Thorndike et al. (1975)) 56 REAL(wp) :: rn_gstar ! fractional area of young ice contributing to ridging 57 LOGICAL :: ln_partf_exp ! participation function exponential (Lipscomb et al. (2007)) 58 REAL(wp) :: rn_astar ! equivalent of G* for an exponential participation function 59 LOGICAL :: ln_ridging ! ridging of ice or not 60 REAL(wp) :: rn_hstar ! thickness that determines the maximal thickness of ridged ice 61 REAL(wp) :: rn_porordg ! initial porosity of ridges (0.3 regular value) 62 REAL(wp) :: rn_fsnwrdg ! fractional snow loss to the ocean during ridging 63 REAL(wp) :: rn_fpndrdg ! fractional pond loss to the ocean during ridging 64 LOGICAL :: ln_rafting ! rafting of ice or not 65 REAL(wp) :: rn_hraft ! threshold thickness (m) for rafting / ridging 66 REAL(wp) :: rn_craft ! coefficient for smoothness of the hyperbolic tangent in rafting 67 REAL(wp) :: rn_fsnwrft ! fractional snow loss to the ocean during rafting 68 REAL(wp) :: rn_fpndrft ! fractional pond loss to the ocean during rafting 68 69 ! 69 70 !!---------------------------------------------------------------------- … … 133 134 IF( kt == nit000 ) THEN 134 135 IF(lwp) WRITE(numout,*) 135 IF(lwp) WRITE(numout,*)'ice rdgrft: ice ridging and rafting'136 IF(lwp) WRITE(numout,*)'ice_rdgrft: ice ridging and rafting' 136 137 IF(lwp) WRITE(numout,*)'~~~~~~~~~~' 137 138 ! … … 146 147 !-----------------------------------------------------------------------------! 147 148 ! 148 CALL ice_rdgrft_ ridgeprep ! prepare ridging149 CALL ice_rdgrft_prep ! prepare ridging 149 150 ! 150 151 DO jj = 1, jpj ! Initialize arrays. … … 272 273 ! 273 274 IF( iterate_ridging == 1 ) THEN 274 CALL ice_rdgrft_ ridgeprep275 CALL ice_rdgrft_prep 275 276 IF( niter > nitermax ) THEN 276 277 WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' … … 297 298 298 299 299 SUBROUTINE ice_rdgrft_ ridgeprep300 SUBROUTINE ice_rdgrft_prep 300 301 !!---------------------------------------------------------------------! 301 !! *** ROUTINE ice_rdgrft_ ridgeprep ***302 !! *** ROUTINE ice_rdgrft_prep *** 302 303 !! 303 304 !! ** Purpose : preparation for ridging and strength calculations … … 352 353 !----------------------------------------------------------------- 353 354 ! 354 IF( nn_partfun == 0 ) THEN!--- Linear formulation (Thorndike et al., 1975)355 IF( ln_partf_lin ) THEN !--- Linear formulation (Thorndike et al., 1975) 355 356 DO jl = 0, jpl 356 357 DO jj = 1, jpj … … 369 370 END DO 370 371 ! 371 ELSE 372 ELSEIF( ln_partf_exp ) THEN !--- Exponential, more stable formulation (Lipscomb et al, 2007) 372 373 ! 373 374 zdummy = 1._wp / ( 1._wp - EXP(-z1_astar) ) ! precompute exponential terms using zGsum as a work array … … 453 454 END DO 454 455 ! 455 END SUBROUTINE ice_rdgrft_ ridgeprep456 END SUBROUTINE ice_rdgrft_prep 456 457 457 458 458 459 SUBROUTINE ice_rdgrft_ridgeshift( opning, closing_gross ) 459 460 !!---------------------------------------------------------------------- 460 !! *** ROUTINE ice_rdgrft_ icestrength ***461 !! *** ROUTINE ice_rdgrft_strength *** 461 462 !! 462 463 !! ** Purpose : shift ridging ice among thickness categories of ice thickness … … 565 566 !-------------------------------------------------------------------------- 566 567 vrdg1(ij) = v_i(ji,jj,jl1) * afrac(ij) 567 vrdg2(ij) = vrdg1(ij) * ( 1. + rn_por _rdg )568 vsw (ij) = vrdg1(ij) * rn_por _rdg568 vrdg2(ij) = vrdg1(ij) * ( 1. + rn_porordg ) 569 vsw (ij) = vrdg1(ij) * rn_porordg 569 570 570 571 vsrdg (ij) = v_s (ji,jj, jl1) * afrac(ij) … … 621 622 ! During the next time step, thermo_rates will determine whether 622 623 ! the ocean cools or new ice grows. 623 wfx_snw_dyn(ji,jj) = wfx_snw_dyn(ji,jj) + ( rhosn * vsrdg(ij) * ( 1._wp - rn_fsn owrdg ) &624 & + rhosn * vsrft(ij) * ( 1._wp - rn_fsn owrft ) ) * r1_rdtice ! fresh water source for ocean625 626 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsn owrdg ) &627 & - esrft(ij) * ( 1._wp - rn_fsn owrft ) ) * r1_rdtice ! heat sink for ocean (<0, W.m-2)624 wfx_snw_dyn(ji,jj) = wfx_snw_dyn(ji,jj) + ( rhosn * vsrdg(ij) * ( 1._wp - rn_fsnwrdg ) & 625 & + rhosn * vsrft(ij) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice ! fresh water source for ocean 626 627 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsnwrdg ) & 628 & - esrft(ij) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice ! heat sink for ocean (<0, W.m-2) 628 629 629 630 ! MV MP 2016 … … 633 634 ! Place part of the melt pond volume into the ocean. 634 635 IF ( ( nn_pnd_scheme > 0 ) .AND. ln_pnd_fw ) THEN 635 wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + ( rhofw * vprdg(ij) * ( 1._wp - rn_fp ondrdg ) &636 & + rhofw * vprft(ij) * ( 1._wp - rn_fp ondrft ) ) * r1_rdtice ! fresh water source for ocean636 wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + ( rhofw * vprdg(ij) * ( 1._wp - rn_fpndrdg ) & 637 & + rhofw * vprft(ij) * ( 1._wp - rn_fpndrft ) ) * r1_rdtice ! fresh water source for ocean 637 638 ENDIF 638 639 ! END MV MP 2016 … … 719 720 v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + ( vrdg2 (ij) * fvol(ij) + virft (ij) * zswitch(ij) ) 720 721 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + ( srdg2 (ij) * fvol(ij) + smrft (ij) * zswitch(ij) ) 721 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + ( vsrdg (ij) * rn_fsn owrdg * fvol(ij) + &722 & vsrft (ij) * rn_fsn owrft * zswitch(ij) )723 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + ( esrdg (ij) * rn_fsn owrdg * fvol(ij) + &724 & esrft (ij) * rn_fsn owrft * zswitch(ij) )722 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + ( vsrdg (ij) * rn_fsnwrdg * fvol(ij) + & 723 & vsrft (ij) * rn_fsnwrft * zswitch(ij) ) 724 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + ( esrdg (ij) * rn_fsnwrdg * fvol(ij) + & 725 & esrft (ij) * rn_fsnwrft * zswitch(ij) ) 725 726 ! MV MP 2016 726 727 IF ( nn_pnd_scheme > 0 ) THEN 727 v_ip (ji,jj,jl2) = v_ip(ji,jj,jl2) + ( vprdg (ij) * rn_fp ondrdg * fvol (ij) &728 & + vprft (ij) * rn_fp ondrft * zswitch(ij) )729 a_ip (ji,jj,jl2) = a_ip(ji,jj,jl2) + ( aprdg2(ij) * rn_fp ondrdg * farea &730 & + aprft2(ij) * rn_fp ondrft * zswitch(ji) )728 v_ip (ji,jj,jl2) = v_ip(ji,jj,jl2) + ( vprdg (ij) * rn_fpndrdg * fvol (ij) & 729 & + vprft (ij) * rn_fpndrft * zswitch(ij) ) 730 a_ip (ji,jj,jl2) = a_ip(ji,jj,jl2) + ( aprdg2(ij) * rn_fpndrdg * farea & 731 & + aprft2(ij) * rn_fpndrft * zswitch(ji) ) 731 732 ENDIF 732 733 ! END MV MP 2016 … … 748 749 749 750 750 SUBROUTINE ice_rdgrft_ icestrength( kstrngth )751 SUBROUTINE ice_rdgrft_strength 751 752 !!---------------------------------------------------------------------- 752 !! *** ROUTINE ice_rdgrft_ icestrength ***753 !! *** ROUTINE ice_rdgrft_strength *** 753 754 !! 754 755 !! ** Purpose : computes ice strength used in dynamics routines of ice thickness … … 759 760 !! by ridging. Note that only Hibler's formulation is stable and that 760 761 !! ice strength has to be smoothed 761 !!762 !! ** Inputs / Ouputs : kstrngth (what kind of ice strength we are using)763 762 !!---------------------------------------------------------------------- 764 INTEGER, INTENT(in) :: kstrngth ! = 1 for Rothrock formulation, 0 for Hibler (1979)765 !766 763 INTEGER :: ji,jj, jl ! dummy loop indices 767 764 INTEGER :: ismooth ! smoothing the resistance to deformation … … 773 770 774 771 ! !--------------------------------------------------! 775 CALL ice_rdgrft_ ridgeprep! Thickness distribution of ridging and ridged ice !772 CALL ice_rdgrft_prep ! Thickness distribution of ridging and ridged ice ! 776 773 ! !--------------------------------------------------! 777 774 778 775 ! !--------------------------------------------------! 779 IF( kstrngth == 1 ) THEN! Ice strength => Rothrock (1975) method !776 IF( ln_str_Rot ) THEN ! Ice strength => Rothrock (1975) method ! 780 777 ! !--------------------------------------------------! 781 778 z1_3 = 1._wp / 3._wp … … 792 789 END WHERE 793 790 END DO 794 strength(:,:) = rn_pe _rdg * zdrho * strength(:,:) / aksum(:,:) * tmask(:,:,1)795 ! where zdrho = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe _rdg accounts for frictional dissipation791 strength(:,:) = rn_perdg * zdrho * strength(:,:) / aksum(:,:) * tmask(:,:,1) 792 ! where zdrho = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_perdg accounts for frictional dissipation 796 793 ismooth = 1 797 794 ! !--------------------------------------------------! 798 ELSE 795 ELSEIF( ln_str_Hib ) THEN ! Ice strength => Hibler (1979) method ! 799 796 ! !--------------------------------------------------! 800 797 strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) ) ) * tmask(:,:,1) … … 802 799 ismooth = 1 803 800 ! 804 ENDIF805 ! !--------------------------------------------------!806 IF( ln_icestr_bvf ) THEN ! Impact of brine volume !807 ! !--------------------------------------------------!808 ! CAN BE REMOVED809 DO jj = 1, jpj810 DO ji = 1, jpi811 strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bvm_i(ji,jj),0.0)))812 END DO813 END DO814 801 ENDIF 815 802 ! !--------------------------------------------------! 816 803 SELECT CASE( ismooth ) ! Smoothing ice strength ! 817 804 ! !--------------------------------------------------! 818 !819 805 CASE( 1 ) !--- Spatial smoothing 820 806 DO jj = 2, jpjm1 … … 861 847 END SELECT 862 848 ! 863 END SUBROUTINE ice_rdgrft_ icestrength849 END SUBROUTINE ice_rdgrft_strength 864 850 865 851 … … 871 857 !! to the mechanical ice redistribution 872 858 !! 873 !! ** Method : Read the namice itdmenamelist859 !! ** Method : Read the namice_rdgrft namelist 874 860 !! and check the parameters values 875 861 !! called at the first timestep (nit000) 876 862 !! 877 !! ** input : Namelist namice itdme863 !! ** input : Namelist namice_rdgrft 878 864 !!------------------------------------------------------------------- 879 865 INTEGER :: ios ! Local integer output status for namelist read 880 866 !! 881 NAMELIST/namiceitdme/ rn_cs , nn_partfun, rn_gstar , rn_astar , & 882 & ln_ridging, rn_hstar , rn_por_rdg, rn_fsnowrdg, rn_fpondrdg, & 883 & ln_rafting, rn_hraft , rn_craft , rn_fsnowrft, rn_fpondrft 867 NAMELIST/namice_rdgrft/ ln_str_Hib, rn_pstar, rn_crhg, & 868 & ln_str_Rot, rn_perdg, & 869 & rn_cs , & 870 & ln_partf_lin, rn_gstar, & 871 & ln_partf_exp, rn_astar, & 872 & ln_ridging, rn_hstar, rn_porordg, rn_fsnwrdg, rn_fpndrdg, & 873 & ln_rafting, rn_hraft, rn_craft , rn_fsnwrft, rn_fpndrft 884 874 !!------------------------------------------------------------------- 885 875 ! 886 876 REWIND( numnam_ice_ref ) ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 887 READ ( numnam_ice_ref, namice itdme, IOSTAT = ios, ERR = 901)888 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice itdmein reference namelist', lwp )889 ! 890 REWIND( numnam_ice_cfg ) ! Namelist namice itdmein configuration namelist : Ice mechanical ice redistribution891 READ ( numnam_ice_cfg, namice itdme, IOSTAT = ios, ERR = 902 )892 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice itdmein configuration namelist', lwp )893 IF(lwm) WRITE ( numoni, namice itdme)877 READ ( numnam_ice_ref, namice_rdgrft, IOSTAT = ios, ERR = 901) 878 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_rdgrft in reference namelist', lwp ) 879 ! 880 REWIND( numnam_ice_cfg ) ! Namelist namice_rdgrft in configuration namelist : Ice mechanical ice redistribution 881 READ ( numnam_ice_cfg, namice_rdgrft, IOSTAT = ios, ERR = 902 ) 882 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_rdgrft in configuration namelist', lwp ) 883 IF(lwm) WRITE ( numoni, namice_rdgrft ) 894 884 ! 895 885 IF (lwp) THEN ! control print 896 886 WRITE(numout,*) 897 WRITE(numout,*) 'ice_rdgrft_init : ice parameters for mechanical ice redistribution'887 WRITE(numout,*) 'ice_rdgrft_init : ice parameters for ridging/rafting ' 898 888 WRITE(numout,*) '~~~~~~~~~~~~~~~' 899 WRITE(numout,*) ' Namelist namiceitdme' 900 WRITE(numout,*) ' Fraction of shear energy contributing to ridging rn_cs = ', rn_cs 901 WRITE(numout,*) ' Switch for part. function (0) linear (1) exponential nn_partfun = ', nn_partfun 902 WRITE(numout,*) ' Fraction of total ice coverage contributing to ridging rn_gstar = ', rn_gstar 903 WRITE(numout,*) ' Equivalent to G* for an exponential part function rn_astar = ', rn_astar 904 WRITE(numout,*) ' Ridging of ice sheets or not ln_ridging = ', ln_ridging 905 WRITE(numout,*) ' Quantity playing a role in max ridged ice thickness rn_hstar = ', rn_hstar 906 WRITE(numout,*) ' Initial porosity of ridges rn_por_rdg = ', rn_por_rdg 907 WRITE(numout,*) ' Fraction of snow volume conserved during ridging rn_fsnowrdg = ', rn_fsnowrdg 908 WRITE(numout,*) ' Fraction of pond volume conserved during ridging rn_fpondrdg = ', rn_fpondrdg 909 WRITE(numout,*) ' Rafting of ice sheets or not ln_rafting = ', ln_rafting 910 WRITE(numout,*) ' Parmeter thickness (threshold between ridge-raft) rn_hraft = ', rn_hraft 911 WRITE(numout,*) ' Rafting hyperbolic tangent coefficient rn_craft = ', rn_craft 912 WRITE(numout,*) ' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft 913 WRITE(numout,*) ' Fraction of pond volume conserved during rafting rn_fpondrft = ', rn_fpondrft 889 WRITE(numout,*) ' Namelist namice_rdgrft' 890 WRITE(numout,*) ' ice strength parameterization Hibler (1979) ln_str_Hib = ', ln_str_Hib 891 WRITE(numout,*) ' 1st bulk-rheology parameter rn_pstar = ', rn_pstar 892 WRITE(numout,*) ' 2nd bulk-rhelogy parameter rn_crhg = ', rn_crhg 893 WRITE(numout,*) ' ice strength parameterization Rothrock (1975) ln_str_Rot = ', ln_str_Rot 894 WRITE(numout,*) ' Ratio of ridging work to PotEner change in ridging rn_perdg = ', rn_perdg 895 WRITE(numout,*) ' Fraction of shear energy contributing to ridging rn_cs = ', rn_cs 896 WRITE(numout,*) ' linear ridging participation function ln_partf_lin = ', ln_partf_lin 897 WRITE(numout,*) ' Fraction of ice coverage contributing to ridging rn_gstar = ', rn_gstar 898 WRITE(numout,*) ' Exponential ridging participation function ln_partf_exp = ', ln_partf_exp 899 WRITE(numout,*) ' Equivalent to G* for an exponential function rn_astar = ', rn_astar 900 WRITE(numout,*) ' Ridging of ice sheets or not ln_ridging = ', ln_ridging 901 WRITE(numout,*) ' max ridged ice thickness rn_hstar = ', rn_hstar 902 WRITE(numout,*) ' Initial porosity of ridges rn_porordg = ', rn_porordg 903 WRITE(numout,*) ' Fraction of snow volume conserved during ridging rn_fsnwrdg = ', rn_fsnwrdg 904 WRITE(numout,*) ' Fraction of pond volume conserved during ridging rn_fpndrdg = ', rn_fpndrdg 905 WRITE(numout,*) ' Rafting of ice sheets or not ln_rafting = ', ln_rafting 906 WRITE(numout,*) ' Parmeter thickness (threshold between ridge-raft) rn_hraft = ', rn_hraft 907 WRITE(numout,*) ' Rafting hyperbolic tangent coefficient rn_craft = ', rn_craft 908 WRITE(numout,*) ' Fraction of snow volume conserved during rafting rn_fsnwrft = ', rn_fsnwrft 909 WRITE(numout,*) ' Fraction of pond volume conserved during rafting rn_fpndrft = ', rn_fpndrft 914 910 ENDIF 915 911 ! 916 END SUBROUTINE ice_rdgrft_init 912 IF ( ( ln_str_Hib .AND. ln_str_Rot ) .OR. ( .NOT.ln_str_Hib .AND. .NOT.ln_str_Rot ) ) THEN 913 CALL ctl_stop( 'ice_rdgrft_init: choose one and only one formulation for ice strength (ln_str_Hib or ln_str_Rot)' ) 914 ENDIF 915 ! 916 IF ( ( ln_partf_lin .AND. ln_partf_exp ) .OR. ( .NOT.ln_partf_lin .AND. .NOT.ln_partf_exp ) ) THEN 917 CALL ctl_stop( 'ice_rdgrft_init: choose one and only one participation function (ln_partf_lin or ln_partf_exp)' ) 918 ENDIF 919 ! 920 END SUBROUTINE ice_rdgrft_init 917 921 918 922 #else
Note: See TracChangeset
for help on using the changeset viewer.
