Changeset 15560 for NEMO/branches/2021
- Timestamp:
- 2021-11-30T12:25:18+01:00 (2 years ago)
- Location:
- NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
- Files:
-
- 16 edited
-
cfgs/SHARED/namelist_ice_ref (modified) (3 diffs)
-
doc/latex/NEMO/subfiles/chap_SBC.tex (modified) (1 diff)
-
doc/latex/NEMO/subfiles/chap_ZDF.tex (modified) (1 diff)
-
src/ICE/icealb.F90 (modified) (8 diffs)
-
src/ICE/icedyn_rdgrft.F90 (modified) (7 diffs)
-
src/ICE/icedyn_rhg_evp.F90 (modified) (3 diffs)
-
src/OCE/DOM/dom_oce.F90 (modified) (5 diffs)
-
src/OCE/DOM/dommsk.F90 (modified) (2 diffs)
-
src/OCE/DOM/domzgr.F90 (modified) (10 diffs)
-
src/OCE/ZDF/zdfphy.F90 (modified) (2 diffs)
-
src/OCE/oce.F90 (modified) (1 diff)
-
tests/DOME/EXPREF/1_namelist_cfg (modified) (2 diffs)
-
tests/DOME/EXPREF/AGRIF_FixedGrids.in (modified) (1 diff)
-
tests/DOME/EXPREF/namelist_cfg (modified) (1 diff)
-
tests/DOME/MY_SRC/usrdef_istate.F90 (modified) (1 diff)
-
tests/DOME/cpp_DOME.fcm (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/cfgs/SHARED/namelist_ice_ref
r14247 r15560 73 73 !------------------------------------------------------------------------------ 74 74 ! -- ice_rdgrft_strength -- ! 75 ln_str_H79 = .true. ! ice strength param.: Hibler_79 => P = pstar*<h>*exp(-c_rhg*A) 75 ln_str_H79 = .true. ! ice strength param.: Hibler_79 => P = pstar*<h>*exp(-c_rhg*A) 76 76 rn_pstar = 2.0e+04 ! ice strength thickness parameter [N/m2] 77 77 rn_crhg = 20.0 ! ice strength conc. parameter (-) 78 ln_str_R75 = .false. ! ice strength param.: Rothrock_75 => P = fn of potential energy 79 rn_pe_rdg = 17.0 ! coef accouting for frictional dissipation 80 ln_str_CST = .false. ! ice strength param.: Constant 81 rn_str = 0.0 ! ice strength value 82 ln_str_smooth = .true. ! spatial smoothing of the ice strength 78 83 ! -- ice_rdgrft -- ! 84 ln_distf_lin = .true. ! redistribution function of ridged ice: linear (Hibler 1980) 85 ln_distf_exp = .false. ! redistribution function of ridged ice: exponential => not coded yet 86 rn_murdg = 3.0 ! e-folding scale of ridged ice (m**.5) 79 87 rn_csrdg = 0.5 ! fraction of shearing energy contributing to ridging 80 88 ! -- ice_rdgrft_prep -- ! … … 139 147 ln_cndflx = .false. ! Use conduction flux as surface boundary conditions (i.e. for Jules coupling) 140 148 ln_cndemulate = .false. ! emulate conduction flux (if not provided in the inputs) 141 nn_qtrice = 1! Solar flux transmitted thru the surface scattering layer:149 nn_qtrice = 0 ! Solar flux transmitted thru the surface scattering layer: 142 150 ! = 0 Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow) 143 151 ! = 1 Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities) … … 268 276 rn_alb_imlt = 0.50 ! bare puddled ice albedo : 0.49 -- 0.58 269 277 rn_alb_dpnd = 0.27 ! ponded ice albedo : 0.10 -- 0.30 278 rn_alb_hpiv = 1.00 ! pivotal ice thickness in m (above which albedo is constant) 270 279 / 271 280 !------------------------------------------------------------------------------ -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/doc/latex/NEMO/subfiles/chap_SBC.tex
r15548 r15560 14 14 Release & Author(s) & Modifications \\ 15 15 \hline 16 {\em next} & {\em A. Moulin, E. Clementi} & {\em Update of \autoref{sec:SBC_wave}}\\[2mm] 16 17 {\em next} & {\em Simon M{\" u}ller} & {\em Update of \autoref{sec:SBC_TDE}; revision of \autoref{subsec:SBC_fwb}}\\[2mm] 17 18 {\em next} & {\em Pierre Mathiot} & {\em update of the ice shelf section (2019 developments)}\\[2mm] -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/doc/latex/NEMO/subfiles/chap_ZDF.tex
r15548 r15560 14 14 Release & Author(s) & Modifications \\ 15 15 \hline 16 {\em next} & {\em A. Moulin, E. Clementi} & {\em Update of \autoref{subsec:ZDF_tke} in for wave coupling}\\[2mm] 16 17 {\em 4.0} & {\em ...} & {\em ...} \\ 17 18 {\em 3.6} & {\em ...} & {\em ...} \\ -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icealb.F90
r15548 r15560 38 38 REAL(wp) :: rn_alb_imlt ! bare puddled ice albedo 39 39 REAL(wp) :: rn_alb_dpnd ! ponded ice albedo 40 REAL(wp) :: rn_alb_hpiv ! pivotal ice thickness in meters (above which albedo is constant) 40 41 41 42 !! * Substitutions … … 59 60 !! which are an update of Allison et al. (JGR 1993) ; Brandt et al. 1999 60 61 !! 0-5cm : linear function of ice thickness 61 !! 5-1 50cm: log function of ice thickness62 !! > 1 50cm: constant62 !! 5-100cm: log function of ice thickness 63 !! > 100cm: constant 63 64 !! 2) Albedo dependency on snow thickness follows the findings from Grenfell & Perovich (2004) 64 65 !! i.e. it increases as -EXP(-snw_thick/0.02) during freezing and -EXP(-snw_thick/0.03) during melting … … 111 112 REAL(wp) :: zalb_snw, zafrac_snw ! snow-covered sea ice albedo & relative snow fraction 112 113 REAL(wp) :: zalb_cs, zalb_os ! albedo of ice under clear/overcast sky 113 !! clem114 REAL(wp), PARAMETER :: zhi_albcst = 1.5_wp ! pivotal thickness (should be in the namelist)115 114 !!--------------------------------------------------------------------- 116 115 ! … … 118 117 ! 119 118 z1_href_pnd = 1._wp / 0.05_wp 120 z1_c1 = 1._wp / ( LOG( zhi_albcst) - LOG(0.05_wp) )119 z1_c1 = 1._wp / ( LOG(rn_alb_hpiv) - LOG(0.05_wp) ) 121 120 z1_c2 = 1._wp / 0.05_wp 122 121 z1_c3 = 1._wp / 0.02_wp … … 142 141 !--- Albedos ---! 143 142 !---------------! 144 ! !--- Bare ice albedo (for hi > 1 50cm)143 ! !--- Bare ice albedo (for hi > 100cm) 145 144 IF( ld_pnd_alb ) THEN 146 145 zalb_ice = rn_alb_idry … … 149 148 ELSE ; zalb_ice = rn_alb_idry ; ENDIF 150 149 ENDIF 151 ! !--- Bare ice albedo (for hi < 1 50cm)152 IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= zhi_albcst ) THEN ! 5cm < hi < 150cm153 zalb_ice = zalb_ice + ( 0.18_wp - zalb_ice ) * z1_c1 * ( LOG( zhi_albcst) - LOG(ph_ice(ji,jj,jl)) )154 ELSEIF( ph_ice(ji,jj,jl) <= 0.05_wp ) THEN ! 0cm < hi < 5cm150 ! !--- Bare ice albedo (for hi < 100cm) 151 IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= rn_alb_hpiv ) THEN ! 5cm < hi < 100cm 152 zalb_ice = zalb_ice + ( 0.18_wp - zalb_ice ) * z1_c1 * ( LOG(rn_alb_hpiv) - LOG(ph_ice(ji,jj,jl)) ) 153 ELSEIF( ph_ice(ji,jj,jl) <= 0.05_wp ) THEN ! 0cm < hi < 5cm 155 154 zalb_ice = rn_alb_oce + ( 0.18_wp - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl) 156 155 ENDIF … … 193 192 INTEGER :: ios ! Local integer output status for namelist read 194 193 !! 195 NAMELIST/namalb/ rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt, rn_alb_dpnd 194 NAMELIST/namalb/ rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt, rn_alb_dpnd, rn_alb_hpiv 196 195 !!---------------------------------------------------------------------- 197 196 ! … … 212 211 WRITE(numout,*) ' albedo of bare puddled ice rn_alb_imlt = ', rn_alb_imlt 213 212 WRITE(numout,*) ' albedo of ponded ice rn_alb_dpnd = ', rn_alb_dpnd 213 WRITE(numout,*) ' pivotal ice thickness (m) rn_alb_hpiv = ', rn_alb_hpiv 214 214 ENDIF 215 215 ! -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedyn_rdgrft.F90
r15548 r15560 38 38 PUBLIC ice_strength ! called by icedyn_rhg_evp 39 39 40 INTEGER :: nice_str ! choice of the type of strength 41 ! ! associated indices: 42 INTEGER, PARAMETER :: np_strh79 = 1 ! Hibler 79 43 INTEGER, PARAMETER :: np_strr75 = 2 ! Rothrock 75 44 INTEGER, PARAMETER :: np_strcst = 3 ! Constant value 45 40 46 ! Variables shared among ridging subroutines 41 47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: closing_net ! net rate at which area is removed (1/s) … … 57 63 ! 58 64 ! ** namelist (namdyn_rdgrft) ** 65 LOGICAL :: ln_str_R75 ! ice strength parameterization: Rothrock 75 66 REAL(wp) :: rn_pe_rdg ! coef accounting for frictional dissipation 67 LOGICAL :: ln_str_CST ! ice strength parameterization: Constant 68 REAL(wp) :: rn_str ! constant value of ice strength 69 LOGICAL :: ln_str_smooth ! ice strength spatial smoothing 70 LOGICAL :: ln_distf_lin ! redistribution of ridged ice: linear (Hibler 1980) 71 LOGICAL :: ln_distf_exp ! redistribution of ridged ice: exponential 72 REAL(wp) :: rn_murdg ! gives e-folding scale of ridged ice (m^.5) 59 73 REAL(wp) :: rn_csrdg ! fraction of shearing energy contributing to ridging 60 74 LOGICAL :: ln_partf_lin ! participation function linear (Thorndike et al. (1975)) … … 774 788 !!---------------------------------------------------------------------- 775 789 INTEGER :: ji, jj, jl ! dummy loop indices 776 INTEGER :: ismooth ! smoothing the resistance to deformation 777 INTEGER :: itframe ! number of time steps for the P smoothing 778 REAL(wp) :: zp, z1_3 ! local scalars 790 REAL(wp) :: z1_3 ! local scalars 779 791 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 780 REAL(wp), DIMENSION(jpi,jpj) :: zstrp1, zstrp2 ! strength at previous time steps 792 !!clem 793 LOGICAL :: ln_str_R75 794 REAL(wp) :: zhi, zcp, rn_pe_rdg 795 REAL(wp), DIMENSION(jpij) :: zstrength, zaksum ! strength in 1D 781 796 !!---------------------------------------------------------------------- 782 ! !--------------------------------------------------! 783 IF( ln_str_H79 ) THEN ! Ice strength => Hibler (1979) method ! 784 ! !--------------------------------------------------! 797 ! 798 SELECT CASE( nice_str ) !--- Set which ice strength is chosen 799 800 CASE ( np_strr75 ) !== Rothrock(1975)'s method ==! 801 802 ! these 2 param should be defined once for all at the 1st time step 803 zcp = 0.5_wp * grav * (rho0-rhoi) * rhoi * r1_rho0 ! proport const for PE 804 ! 805 strength(:,:) = 0._wp 806 ! 807 ! Identify grid cells with ice 808 at_i(:,:) = SUM( a_i, dim=3 ) 809 npti = 0 ; nptidx(:) = 0 810 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 811 IF ( at_i(ji,jj) > epsi10 ) THEN 812 npti = npti + 1 813 nptidx( npti ) = (jj - 1) * jpi + ji 814 ENDIF 815 END_2D 816 817 IF( npti > 0 ) THEN 818 CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i ) 819 CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i ) 820 CALL tab_2d_1d( npti, nptidx(1:npti), ato_i_1d(1:npti) , ato_i ) 821 CALL tab_2d_1d( npti, nptidx(1:npti), zstrength(1:npti) , strength ) 822 823 CALL rdgrft_prep( a_i_2d, v_i_2d, ato_i_1d, closing_net ) 824 ! 825 zaksum(1:npti) = apartf(1:npti,0) !clem: aksum should be defined in the header => local to module 826 DO jl = 1, jpl 827 DO ji = 1, npti 828 IF ( apartf(ji,jl) > 0._wp ) THEN 829 zaksum(ji) = zaksum(ji) + aridge(ji,jl) * ( 1._wp - hi_hrdg(ji,jl) ) & 830 & + araft (ji,jl) * ( 1._wp - hi_hrft ) 831 ENDIF 832 END DO 833 END DO 834 ! 835 z1_3 = 1._wp / 3._wp 836 DO jl = 1, jpl 837 DO ji = 1, npti 838 ! 839 IF( apartf(ji,jl) > 0._wp ) THEN 840 ! 841 IF( a_i_2d(ji,jl) > epsi10 ) THEN ; zhi = v_i_2d(ji,jl) / a_i_2d(ji,jl) 842 ELSE ; zhi = 0._wp 843 ENDIF 844 zstrength(ji) = zstrength(ji) - apartf(ji,jl) * zhi * zhi ! PE loss from deforming ice 845 zstrength(ji) = zstrength(ji) + 2._wp * araft (ji,jl) * zhi * zhi ! PE gain from rafting ice 846 zstrength(ji) = zstrength(ji) + aridge(ji,jl) * hi_hrdg(ji,jl) * z1_3 * & ! PE gain from ridging ice 847 & ( hrmax(ji,jl) * hrmax(ji,jl) + & ! (a**3-b**3)/(a-b) = a*a+ab+b*b 848 & hrmin(ji,jl) * hrmin(ji,jl) + & 849 & hrmax(ji,jl) * hrmin(ji,jl) ) 850 ENDIF 851 ! 852 END DO 853 END DO 854 ! 855 zstrength(1:npti) = rn_pe_rdg * zcp * zstrength(1:npti) / zaksum(1:npti) 856 ! 857 CALL tab_1d_2d( npti, nptidx(1:npti), zstrength(1:npti), strength ) 858 ! 859 ENDIF 860 ! 861 CASE ( np_strh79 ) !== Hibler(1979)'s method ==! 785 862 strength(:,:) = rn_pstar * SUM( v_i(:,:,:), dim=3 ) * EXP( -rn_crhg * ( 1._wp - SUM( a_i(:,:,:), dim=3 ) ) ) 786 ismooth = 1 ! original code 787 ! ismooth = 0 ! try for EAP stability 788 ! !--------------------------------------------------! 789 ELSE ! Zero strength ! 790 ! !--------------------------------------------------! 791 strength(:,:) = 0._wp 792 ismooth = 0 793 ENDIF 794 ! !--------------------------------------------------! 795 SELECT CASE( ismooth ) ! Smoothing ice strength ! 796 ! !--------------------------------------------------! 797 CASE( 1 ) !--- Spatial smoothing 863 ! 864 CASE ( np_strcst ) !== Constant strength ==! 865 strength(:,:) = rn_str 866 ! 867 END SELECT 868 ! 869 IF( ln_str_smooth ) THEN !--- Spatial smoothing 798 870 DO_2D( 0, 0, 0, 0 ) 799 871 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 800 zworka(ji,jj) = ( 4. 0* strength(ji,jj) &801 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &802 & + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &803 & ) / ( 4. 0+ tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )872 zworka(ji,jj) = ( 4._wp * strength(ji,jj) & 873 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) & 874 & + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) & 875 & ) / ( 4._wp + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 804 876 ELSE 805 877 zworka(ji,jj) = 0._wp … … 812 884 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1.0_wp ) 813 885 ! 814 CASE( 2 ) !--- Temporal smoothing 815 IF ( kt_ice == nit000 ) THEN 816 zstrp1(:,:) = 0._wp 817 zstrp2(:,:) = 0._wp 818 ENDIF 819 ! 820 DO_2D( 0, 0, 0, 0 ) 821 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 822 itframe = 1 ! number of time steps for the running mean 823 IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1 824 IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1 825 zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe 826 zstrp2 (ji,jj) = zstrp1 (ji,jj) 827 zstrp1 (ji,jj) = strength(ji,jj) 828 strength(ji,jj) = zp 829 ENDIF 830 END_2D 831 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1.0_wp ) 832 ! 833 END SELECT 886 ENDIF 834 887 ! 835 888 END SUBROUTINE ice_strength … … 924 977 !! ** input : Namelist namdyn_rdgrft 925 978 !!------------------------------------------------------------------- 926 INTEGER :: ios ! Local integer output status for namelist read 927 !! 928 NAMELIST/namdyn_rdgrft/ ln_str_H79, rn_pstar, rn_crhg, & 929 & rn_csrdg , & 930 & ln_partf_lin, rn_gstar, & 931 & ln_partf_exp, rn_astar, & 979 INTEGER :: ios, ioptio ! Local integer output status for namelist read 980 !! 981 NAMELIST/namdyn_rdgrft/ ln_str_H79, rn_pstar, rn_crhg, ln_str_R75, rn_pe_rdg, ln_str_CST, rn_str, ln_str_smooth, & 982 & ln_distf_lin, ln_distf_exp, rn_murdg, rn_csrdg, & 983 & ln_partf_lin, rn_gstar, ln_partf_exp, rn_astar, & 932 984 & ln_ridging, rn_hstar, rn_porordg, rn_fsnwrdg, rn_fpndrdg, & 933 985 & ln_rafting, rn_hraft, rn_craft , rn_fsnwrft, rn_fpndrft … … 948 1000 WRITE(numout,*) ' 1st bulk-rheology parameter rn_pstar = ', rn_pstar 949 1001 WRITE(numout,*) ' 2nd bulk-rhelogy parameter rn_crhg = ', rn_crhg 1002 WRITE(numout,*) ' ice strength parameterization Rothrock (1975) ln_str_R75 = ', ln_str_R75 1003 WRITE(numout,*) ' coef accounting for frictional dissipation rn_pe_rdg = ', rn_pe_rdg 1004 WRITE(numout,*) ' ice strength parameterization Constant ln_str_CST = ', ln_str_CST 1005 WRITE(numout,*) ' ice strength value rn_str = ', rn_str 1006 WRITE(numout,*) ' spatial smoothing of the strength ln_str_smooth= ', ln_str_smooth 1007 WRITE(numout,*) ' redistribution of ridged ice: linear (Hibler 1980) ln_distf_lin = ', ln_distf_lin 1008 WRITE(numout,*) ' redistribution of ridged ice: exponential ln_distf_exp = ', ln_distf_exp 1009 WRITE(numout,*) ' e-folding scale of ridged ice rn_murdg = ', rn_murdg 950 1010 WRITE(numout,*) ' Fraction of shear energy contributing to ridging rn_csrdg = ', rn_csrdg 951 1011 WRITE(numout,*) ' linear ridging participation function ln_partf_lin = ', ln_partf_lin … … 965 1025 ENDIF 966 1026 ! 1027 ioptio = 0 1028 IF( ln_str_H79 ) THEN ; ioptio = ioptio + 1 ; nice_str = np_strh79 ; ENDIF 1029 IF( ln_str_R75 ) THEN ; ioptio = ioptio + 1 ; nice_str = np_strr75 ; ENDIF 1030 IF( ln_str_CST ) THEN ; ioptio = ioptio + 1 ; nice_str = np_strcst ; ENDIF 1031 IF( ioptio /= 1 ) CALL ctl_stop( 'ice_dyn_rdgrft_init: one and only one ice strength option has to be defined ' ) 1032 ! 1033 IF ( ( ln_distf_lin .AND. ln_distf_exp ) .OR. ( .NOT.ln_distf_lin .AND. .NOT.ln_distf_exp ) ) THEN 1034 CALL ctl_stop( 'ice_dyn_rdgrft_init: choose one and only one redistribution function (ln_distf_lin or ln_distf_exp)' ) 1035 ENDIF 1036 !!clem 1037 IF( ln_distf_exp ) CALL ctl_stop( 'ice_dyn_rdgrft_init: exponential redistribution function not coded yet (ln_distf_exp)' ) 1038 ! 967 1039 IF ( ( ln_partf_lin .AND. ln_partf_exp ) .OR. ( .NOT.ln_partf_lin .AND. .NOT.ln_partf_exp ) ) THEN 968 1040 CALL ctl_stop( 'ice_dyn_rdgrft_init: choose one and only one participation function (ln_partf_lin or ln_partf_exp)' ) -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedyn_rhg_evp.F90
r15548 r15560 179 179 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_yatrp ! Y-component of area transport (m2/s) 180 180 !! -- advect fields at the rheology time step for the calculation of strength 181 !! it seems that convergence is worse when ll_advups=true. So it not really a good idea181 !! it seems that convergence is worse when ll_advups=true. So it is not really a good idea 182 182 LOGICAL :: ll_advups = .FALSE. 183 183 REAL(wp) :: zdt_ups 184 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmp185 184 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: za_i_ups, zv_i_ups ! tracers advected upstream 186 185 !!------------------------------------------------------------------- … … 695 694 IF( jter == 1 ) THEN ! init 696 695 ALLOCATE( za_i_ups(jpi,jpj,jpl), zv_i_ups(jpi,jpj,jpl) ) 697 ALLOCATE( ztmp(jpi,jpj) )698 696 zdt_ups = rDt_ice / REAL( nn_nevp ) 699 697 za_i_ups(:,:,:) = a_i(:,:,:) … … 706 704 CALL rhg_upstream( jter, zdt_ups, u_ice, v_ice, zv_i_ups ) ! upstream advection: v_i 707 705 ! 708 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1) ! strength706 DO_2D( 0, 0, 0, 0 ) ! strength 709 707 strength(ji,jj) = rn_pstar * SUM( zv_i_ups(ji,jj,:) ) * EXP( -rn_crhg * ( 1._wp - SUM( za_i_ups(ji,jj,:) ) ) ) 710 708 END_2D 711 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_rhg_evp', strength, 'T', 1.0_wp )712 !713 DO_2D( 0, 0, 0, 0 ) ! strength smoothing714 IF( SUM( za_i_ups(ji,jj,:) ) > 0._wp ) THEN715 ztmp(ji,jj) = ( 4._wp * strength(ji,jj) + strength(ji-1,jj ) + strength(ji+1,jj ) &716 & + strength(ji ,jj-1) + strength(ji ,jj+1) &717 & ) / ( 4._wp + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )718 ELSE719 ztmp(ji,jj) = 0._wp720 ENDIF721 END_2D722 DO_2D( 0, 0, 0, 0 )723 strength(ji,jj) = ztmp(ji,jj)724 END_2D725 709 ! 726 710 IF( jter == nn_nevp ) THEN 727 711 DEALLOCATE( za_i_ups, zv_i_ups ) 728 DEALLOCATE( ztmp )729 712 ENDIF 730 713 ENDIF -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/DOM/dom_oce.F90
r15548 r15560 191 191 ! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-, and V-level 192 192 !!gm 193 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv !: bottom last wet T-, U- and V-level194 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior domain T-point mask193 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv, mbkf !: bottom last wet T-, U-, V- and F-level 194 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior domain T-point mask 195 195 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_h !: internal domain T-point mask (Figure 8.5 NEMO book) 196 196 … … 200 200 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts 201 201 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts 202 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts (qco only)202 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts 203 203 204 204 !!---------------------------------------------------------------------- … … 306 306 ! 307 307 ii = ii+1 308 ALLOCATE( fe3mask(jpi,jpj,jpk) , STAT=ierr(ii) )309 308 ! 310 309 #elif defined key_linssh … … 330 329 ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , & 331 330 & ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 332 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) 331 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , mbkf(jpi,jpj) , STAT=ierr(ii) ) 333 332 ! 334 333 ii = ii+1 … … 337 336 ii = ii+1 338 337 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) , & 339 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(ii) )338 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , fe3mask(jpi,jpj,jpk), STAT=ierr(ii) ) 340 339 ! 341 340 ii = ii+1 -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/DOM/dommsk.F90
r15548 r15560 157 157 & * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 158 158 END_3D 159 ! 160 ! In case of a coarsened grid, account her for possibly aditionnal 161 ! masked points; these have been read in the mesh file and stored in mbku, mbkv, mbkf 162 DO_2D( 0, 0, 0, 0 ) 163 IF (mbku(ji,jj)<=1 ) umask(ji,jj,:) = 0._wp 164 IF (mbkv(ji,jj)<=1 ) vmask(ji,jj,:) = 0._wp 165 IF (mbkf(ji,jj)<=1 ) fmask(ji,jj,:) = 0._wp 166 IF ( MAXVAL(umask(ji,jj,:))/=0._wp ) umask(ji,jj,mbku(ji,jj)+1:jpk) = 0._wp 167 IF ( MAXVAL(vmask(ji,jj,:))/=0._wp ) vmask(ji,jj,mbkv(ji,jj)+1:jpk) = 0._wp 168 IF ( MAXVAL(fmask(ji,jj,:))/=0._wp ) fmask(ji,jj,mbkf(ji,jj)+1:jpk) = 0._wp 169 END_2D 159 170 CALL lbc_lnk( 'dommsk', umask, 'U', 1.0_wp, vmask, 'V', 1.0_wp, fmask, 'F', 1.0_wp ) ! Lateral boundary conditions 160 171 … … 183 194 CALL lbc_lnk( 'dommsk', ssfmask, 'F', 1.0_wp ) 184 195 ENDIF 185 #if defined key_qco186 196 fe3mask(:,:,:) = fmask(:,:,:) 187 #endif188 197 189 198 ! Interior domain mask (used for global sum) -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/DOM/domzgr.F90
r15548 r15560 74 74 INTEGER :: ikt, ikb ! top/bot index 75 75 INTEGER :: ioptio, ibat, ios ! local integer 76 INTEGER :: is_mbkuvf ! ==0 if mbku, mbkv, mbkf to be computed 76 77 REAL(wp) :: zrefdep ! depth of the reference level (~10m) 77 78 REAL(wp), DIMENSION(jpi,jpj ) :: zmsk … … 97 98 & e3t_0 , e3u_0 , e3v_0 , e3f_0 , & ! vertical scale factors 98 99 & e3w_0 , e3uw_0 , e3vw_0 , & ! vertical scale factors 99 & k_top , k_bot ) ! 1st & last ocean level 100 & k_top , k_bot , & ! 1st & last ocean level 101 & is_mbkuvf, mbku, mbkv, mbkf ) ! U/V/F points bottom levels 100 102 ! 101 103 ELSE !== User defined configuration ==! 102 104 IF(lwp) WRITE(numout,*) 103 105 IF(lwp) WRITE(numout,*) ' User defined vertical mesh (usr_def_zgr)' 106 is_mbkuvf = 0 104 107 ! 105 108 CALL usr_def_zgr( ln_zco , ln_zps , ln_sco, ln_isfcav, & … … 177 180 178 181 ! ! top/bottom ocean level indices for t-, u- and v-points (f-point also for top) 179 CALL zgr_top_bot( k_top, k_bot ) ! with a minimum value set to 1182 CALL zgr_top_bot( k_top, k_bot, is_mbkuvf ) ! with a minimum value set to 1 180 183 ! 181 184 ! ! ice shelf draft and bathymetry … … 220 223 & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors 221 224 & pe3w , pe3uw , pe3vw , & ! - - - 222 & k_top , k_bot ) ! top & bottom ocean level 225 & k_top , k_bot , & ! top & bottom ocean level 226 & k_mbkuvf , k_bot_u , k_bot_v , k_bot_f ) ! U/V/F points bottom levels 223 227 !!--------------------------------------------------------------------- 224 228 !! *** ROUTINE zgr_read *** … … 235 239 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! - - - 236 240 INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top , k_bot ! first & last ocean level 241 INTEGER , INTENT(out) :: k_mbkuvf ! ==1 if mbku, mbkv, mbkf are in file 242 INTEGER , DIMENSION(:,:) , INTENT(out) :: k_bot_u , k_bot_v, k_bot_f ! bottom levels at U/V/F points 237 243 ! 238 244 INTEGER :: ji,jj,jk ! dummy loop index … … 322 328 ENDIF 323 329 ! 330 IF( iom_varid( inum, 'mbku', ldstop = .FALSE. ) > 0 ) THEN 331 IF(lwp) WRITE(numout,*) ' mbku, mbkv & mbkf read in ', TRIM(cn_domcfg), ' file' 332 CALL iom_get( inum, jpdom_global, 'mbku', z2d ) 333 k_bot_u(:,:) = NINT( z2d(:,:) ) 334 CALL iom_get( inum, jpdom_global, 'mbkv', z2d ) 335 k_bot_v(:,:) = NINT( z2d(:,:) ) 336 CALL iom_get( inum, jpdom_global, 'mbkf', z2d ) 337 k_bot_f(:,:) = NINT( z2d(:,:) ) 338 k_mbkuvf = 1 339 ELSE 340 k_mbkuvf = 0 341 ENDIF 342 ! 324 343 ! reference depth for negative bathy (wetting and drying only) 325 344 IF( ll_wd ) CALL iom_get( inum, 'rn_wd_ref_depth' , ssh_ref ) … … 330 349 331 350 332 SUBROUTINE zgr_top_bot( k_top, k_bot )351 SUBROUTINE zgr_top_bot( k_top, k_bot, k_mbkuvf ) 333 352 !!---------------------------------------------------------------------- 334 353 !! *** ROUTINE zgr_top_bot *** … … 342 361 !! (min value = 1) 343 362 !! ** Action : mbkt, mbku, mbkv : vertical indices of the deeptest 344 !! ocean level at t-, u- & v-points363 !! mbkf ocean level at t-, u-, v- & f-points 345 364 !! (min value = 1 over land) 346 365 !!---------------------------------------------------------------------- 347 366 INTEGER , DIMENSION(:,:), INTENT(in) :: k_top, k_bot ! top & bottom ocean level indices 367 INTEGER , INTENT(in) :: k_mbkuvf ! flag to recompute mbku, mbkv, mbkf 348 368 ! 349 369 INTEGER :: ji, jj ! dummy loop indices … … 365 385 mikv(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj) ) 366 386 mikf(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj), mikt(ji+1,jj ), mikt(ji+1,jj+1) ) 367 ! 368 mbku(ji,jj) = MIN( mbkt(ji+1,jj ) , mbkt(ji,jj) ) 369 mbkv(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj) ) 370 END_2D 371 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 387 END_2D 388 389 IF ( k_mbkuvf==0 ) THEN 390 IF(lwp) WRITE(numout,*) ' mbku, mbkv, mbkf computed from mbkt' 391 DO_2D( 0, 0, 0, 0 ) 392 mbku(ji,jj) = MIN( mbkt(ji+1,jj ) , mbkt(ji,jj) ) 393 mbkv(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj) ) 394 mbkf(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj), mbkt(ji+1,jj ), mbkt(ji+1,jj+1) ) 395 END_2D 396 ELSE 397 IF(lwp) WRITE(numout,*) ' mbku, mbkv, mbkf read from file' 398 ! Use mbku, mbkv, mbkf from file 399 ! Ensure these are lower than expected bottom level deduced from mbkt 400 DO_2D( 0, 0, 0, 0 ) 401 mbku(ji,jj) = MIN( mbku(ji,jj), mbkt(ji+1,jj ) , mbkt(ji,jj) ) 402 mbkv(ji,jj) = MIN( mbkv(ji,jj), mbkt(ji ,jj+1) , mbkt(ji,jj) ) 403 mbkf(ji,jj) = MIN( mbkf(ji,jj), mbkt(ji ,jj+1) , mbkt(ji,jj), mbkt(ji+1,jj ), mbkt(ji+1,jj+1) ) 404 END_2D 405 ENDIF 406 ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 372 407 DO_2D( 0, 0, 0, 0 ) 373 408 zk(ji,jj) = REAL( miku(ji,jj), wp ) … … 399 434 CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) 400 435 mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 436 437 DO_2D( 0, 0, 0, 0 ) 438 zk(ji,jj) = REAL( mbkf(ji,jj), wp ) 439 END_2D 440 CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp ) 441 mbkf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 401 442 ! 402 443 END SUBROUTINE zgr_top_bot -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/ZDF/zdfphy.F90
r15548 r15560 316 316 ! 317 317 ! !== ocean Kz ==! (avt, avs, avm) 318 #if defined key_agrif 319 ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 320 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 321 IF( l_zdfsh2 ) CALL Agrif_avm 322 ENDIF 323 #endif 318 324 ! 319 325 ! !* start from turbulent closure values … … 344 350 IF( ln_zdfiwm ) CALL zdf_iwm( kt, Kmm, avm, avt, avs ) ! internal wave (de Lavergne et al 2017) 345 351 346 #if defined key_agrif347 ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2)348 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile349 IF( l_zdfsh2 ) CALL Agrif_avm350 ENDIF351 #endif352 353 352 ! !* Lateral boundary conditions (sign unchanged) 354 353 IF(nn_hls==1) THEN -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/oce.F90
r14064 r15560 110 110 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT=ierr(4) ) 111 111 ! 112 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_bf(jpi,jpj), vn_bf(jpi,jpj) , STAT=ierr( 6) )112 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_bf(jpi,jpj), vn_bf(jpi,jpj) , STAT=ierr(5) ) 113 113 #if defined key_agrif 114 114 ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , STAT=ierr(6) ) -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/tests/DOME/EXPREF/1_namelist_cfg
r15548 r15560 8 8 !----------------------------------------------------------------------- 9 9 ln_vert_remap = .true. ! use vertical remapping 10 rn_sponge_tra = 0.0 ! coefficient for tracer sponge layer []11 10 / 12 11 !----------------------------------------------------------------------- … … 43 42 &namdom ! space and time domain (bathymetry, mesh, timestep) 44 43 !----------------------------------------------------------------------- 45 ln_linssh = . true.44 ln_linssh = .false. 46 45 rn_Dt = 150. ! time step for the dynamics (and tracer if nn_acc=0) 47 46 rn_atfp = 0.1 ! asselin time filter parameter -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/tests/DOME/EXPREF/AGRIF_FixedGrids.in
r15548 r15560 1 1 1 2 281 361 91 169 2 2 22 281 361 121 169 2 2 2 3 3 0 -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/tests/DOME/EXPREF/namelist_cfg
r15548 r15560 38 38 &namdom ! space and time domain (bathymetry, mesh, timestep) 39 39 !----------------------------------------------------------------------- 40 ln_linssh = . true.40 ln_linssh = .false. 41 41 rn_Dt = 300. ! time step for the dynamics (and tracer if nn_acc=0) 42 42 rn_atfp = 0.1 ! asselin time filter parameter -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/tests/DOME/MY_SRC/usrdef_istate.F90
r14254 r15560 103 103 pts(ji,jj,jk,jp_tem) = (15._wp - zrho1) * ptmask(ji,jj,jk) 104 104 ! Mass conserving initialization: 105 ztd = 15._wp*gdepw_0(ji,jj,jk+1)-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk+1)**2106 ztu = 15._wp*gdepw_0(ji,jj,jk )-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk )**2107 pts(ji,jj,jk,jp_tem) = (ztd - ztu)/e3t_0(ji,jj,jk) * ptmask(ji,jj,jk)105 ! ztd = 15._wp*gdepw_0(ji,jj,jk+1)-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk+1)**2 106 ! ztu = 15._wp*gdepw_0(ji,jj,jk )-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk )**2 107 ! pts(ji,jj,jk,jp_tem) = (ztd - ztu)/e3t_0(ji,jj,jk) * ptmask(ji,jj,jk) 108 108 IF (Agrif_root().AND.( mjg0(jj) == Nj0glo-2 ) ) THEN 109 109 pv(ji,jj,jk) = -sqrt(zdb*zh0)*exp(-zxw/zro)*(1._wp-zf) * ptmask(ji,jj,jk) -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/tests/DOME/cpp_DOME.fcm
r14239 r15560 1 bld::tool::fppkeys key_xios key_agrif key_linssh1 bld::tool::fppkeys key_xios key_agrif
Note: See TracChangeset
for help on using the changeset viewer.
