- Timestamp:
- 2020-10-22T20:49:56+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11842_SI3-10_EAP
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbcblk.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11842_SI3-10_EAP
- Property svn:externals
-
old new 1 ^/utils/build/arch@HEAD arch 2 ^/utils/build/makenemo@HEAD makenemo 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 ^/vendors/FCM@HEAD ext/FCM 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 1 ^/utils/build/arch@12130 arch 2 ^/utils/build/makenemo@12191 makenemo 3 ^/utils/build/mk@11662 mk 4 ^/utils/tools_r4.0-HEAD@12672 tools 5 ^/vendors/AGRIF/dev@10586 ext/AGRIF 6 ^/vendors/FCM@10134 ext/FCM 7 ^/vendors/IOIPSL@9655 ext/IOIPSL 8 9 # SETTE mapping (inactive) 10 #^/utils/CI/sette@12135 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/SBC/sbcblk.F90
r11536 r13662 46 46 USE lib_fortran ! to use key_nosignedzero 47 47 #if defined key_si3 48 USE ice , ONLY : u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif 49 USE ice thd_dh ! for CALL ice_thd_snwblow48 USE ice , ONLY : u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif, nn_qtrice 49 USE icevar ! for CALL ice_var_snwblow 50 50 #endif 51 51 USE sbcblk_algo_ncar ! => turb_ncar : NCAR - CORE (Large & Yeager, 2009) … … 78 78 REAL(wp), PARAMETER :: R_vap = 461.495_wp !: Specific gas constant for water vapor [J/K/kg] 79 79 REAL(wp), PARAMETER :: reps0 = R_dry/R_vap !: ratio of gas constant for dry air and water vapor => ~ 0.622 80 REAL(wp), PARAMETER :: rctv0 = R_vap/R_dry 81 82 INTEGER , PARAMETER :: jpfld =1 0! maximum number of files to read80 REAL(wp), PARAMETER :: rctv0 = R_vap/R_dry - 1._wp !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 81 82 INTEGER , PARAMETER :: jpfld =11 ! maximum number of files to read 83 83 INTEGER , PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 84 84 INTEGER , PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point … … 90 90 INTEGER , PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s) 91 91 INTEGER , PARAMETER :: jp_slp = 9 ! index of sea level pressure (Pa) 92 INTEGER , PARAMETER :: jp_tdif =10 ! index of tau diff associated to HF tau (N/m2) at T-point 92 INTEGER , PARAMETER :: jp_cc =10 ! index of cloud cover (-) range:0-1 93 INTEGER , PARAMETER :: jp_tdif =11 ! index of tau diff associated to HF tau (N/m2) at T-point 93 94 94 95 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) … … 161 162 !! 162 163 !!---------------------------------------------------------------------- 163 INTEGER :: ifpr, jfld ! dummy loop indice and argument164 INTEGER :: jfpr, jfld ! dummy loop indice and argument 164 165 INTEGER :: ios, ierror, ioptio ! Local integer 165 166 !! … … 168 169 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 169 170 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow ! " " 170 TYPE(FLD_N) :: sn_slp , sn_tdif 171 TYPE(FLD_N) :: sn_slp , sn_tdif, sn_cc ! " " 171 172 NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw , & ! input fields 172 & sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif, 173 & sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif, sn_cc, & 173 174 & ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF, & ! bulk algorithm 174 175 & cn_dir , ln_taudif, rn_zqt, rn_zu, & … … 214 215 slf_i(jp_tair) = sn_tair ; slf_i(jp_humi) = sn_humi 215 216 slf_i(jp_prec) = sn_prec ; slf_i(jp_snow) = sn_snow 216 slf_i(jp_slp) = sn_slp ; slf_i(jp_tdif) = sn_tdif 217 slf_i(jp_slp) = sn_slp ; slf_i(jp_cc) = sn_cc 218 slf_i(jp_tdif) = sn_tdif 217 219 ! 218 220 lhftau = ln_taudif !- add an extra field if HF stress is used … … 222 224 ALLOCATE( sf(jfld), STAT=ierror ) 223 225 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' ) 224 DO ifpr= 1, jfld 225 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 226 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 227 IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 ) & 228 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 229 & ' This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 230 231 END DO 226 232 227 ! !- fill the bulk structure with namelist informations 233 228 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 234 229 ! 230 DO jfpr = 1, jfld 231 ! 232 IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to zero) 233 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 234 sf(jfpr)%fnow(:,:,1) = 0._wp 235 ELSE !-- used field --! 236 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 237 IF( slf_i(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 238 IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 ) & 239 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 240 & ' This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 241 ENDIF 242 ENDDO 243 ! fill cloud cover array with constant value if "not used" 244 IF( TRIM(sf(jp_cc)%clrootname) == 'NOT USED' ) sf(jp_cc)%fnow(:,:,1) = pp_cldf 245 235 246 IF ( ln_wave ) THEN 236 247 !Activated wave module but neither drag nor stokes drift activated … … 259 270 WRITE(numout,*) ' "NCAR" algorithm (Large and Yeager 2008) ln_NCAR = ', ln_NCAR 260 271 WRITE(numout,*) ' "COARE 3.0" algorithm (Fairall et al. 2003) ln_COARE_3p0 = ', ln_COARE_3p0 261 WRITE(numout,*) ' "COARE 3.5" algorithm (Edson et al. 2013) ln_COARE_3p5 = ', ln_COARE_3p 0272 WRITE(numout,*) ' "COARE 3.5" algorithm (Edson et al. 2013) ln_COARE_3p5 = ', ln_COARE_3p5 262 273 WRITE(numout,*) ' "ECMWF" algorithm (IFS cycle 31) ln_ECMWF = ', ln_ECMWF 263 274 WRITE(numout,*) ' add High freq.contribution to the stress module ln_taudif = ', ln_taudif … … 383 394 ! local scalars ( place there for vector optimisation purposes) 384 395 zst(:,:) = pst(:,:) + rt0 ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 396 397 ! --- cloud cover --- ! 398 cloud_fra(:,:) = sf(jp_cc)%fnow(:,:,1) 385 399 386 400 ! ----------------------------------------------------------------------------- ! … … 706 720 REAL(wp) :: zwndi_f , zwndj_f, zwnorm_f ! relative wind module and components at F-point 707 721 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 722 REAL(wp) :: zztmp1 , zztmp2 ! temporary values 708 723 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa ! transfer coefficient for momentum (tau) 709 724 !!--------------------------------------------------------------------- … … 744 759 zrhoa (:,:) = rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 745 760 746 !!gm brutal....747 utau_ice (:,:) = 0._wp748 vtau_ice (:,:) = 0._wp749 !!gm end750 751 761 ! ------------------------------------------------------------ ! 752 762 ! Wind stress relative to the moving ice ( U10m - U_ice ) ! 753 763 ! ------------------------------------------------------------ ! 754 ! C-grid ice dynamics : U & V-points (same as ocean) 755 DO jj = 2, jpjm1 764 zztmp1 = rn_vfac * 0.5_wp 765 DO jj = 2, jpj ! at T point 766 DO ji = 2, jpi 767 zztmp2 = zrhoa(ji,jj) * Cd_atm(ji,jj) * wndm_ice(ji,jj) 768 utau_ice(ji,jj) = zztmp2 * ( sf(jp_wndi)%fnow(ji,jj,1) - zztmp1 * ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) ) 769 vtau_ice(ji,jj) = zztmp2 * ( sf(jp_wndj)%fnow(ji,jj,1) - zztmp1 * ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) ) 770 END DO 771 END DO 772 ! 773 DO jj = 2, jpjm1 ! U & V-points (same as ocean). 756 774 DO ji = fs_2, fs_jpim1 ! vect. opt. 757 utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) ) & 758 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 759 vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) ) & 760 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 775 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 776 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) 777 zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) ) 778 utau_ice(ji,jj) = zztmp1 * ( utau_ice(ji,jj) + utau_ice(ji+1,jj ) ) 779 vtau_ice(ji,jj) = zztmp2 * ( vtau_ice(ji,jj) + vtau_ice(ji ,jj+1) ) 761 780 END DO 762 781 END DO … … 792 811 REAL(wp) :: zst3 ! local variable 793 812 REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - - 794 REAL(wp) :: zztmp, z1_rLsub ! - - 795 REAL(wp) :: zfr1, zfr2 ! local variables 813 REAL(wp) :: zztmp, z1_rLsub ! - - 796 814 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_st ! inverse of surface temperature 797 815 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qlw ! long wave heat flux over ice … … 801 819 REAL(wp), DIMENSION(jpi,jpj) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3) 802 820 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa 821 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp2 822 REAL(wp), DIMENSION(jpi,jpj) :: ztri 803 823 !!--------------------------------------------------------------------- 804 824 ! … … 875 895 ! --- evaporation minus precipitation --- ! 876 896 zsnw(:,:) = 0._wp 877 CALL ice_ thd_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing897 CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing 878 898 emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 879 899 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw … … 902 922 END DO 903 923 904 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 905 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm 906 zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1 907 ! 908 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 909 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 910 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 911 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 912 ELSEWHERE ! zero when hs>0 913 qtr_ice_top(:,:,:) = 0._wp 914 END WHERE 924 ! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- ! 925 IF( nn_qtrice == 0 ) THEN 926 ! formulation derived from Grenfell and Maykut (1977), where transmission rate 927 ! 1) depends on cloudiness 928 ! 2) is 0 when there is any snow 929 ! 3) tends to 1 for thin ice 930 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 931 DO jl = 1, jpl 932 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 933 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 934 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 935 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 936 ELSEWHERE ! zero when hs>0 937 qtr_ice_top(:,:,jl) = 0._wp 938 END WHERE 939 ENDDO 940 ELSEIF( nn_qtrice == 1 ) THEN 941 ! formulation is derived from the thesis of M. Lebrun (2019). 942 ! It represents the best fit using several sets of observations 943 ! It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 944 qtr_ice_top(:,:,:) = 0.3_wp * qsr_ice(:,:,:) 945 ENDIF 946 ! 947 948 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN 949 ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) ) 950 CALL iom_put( 'evap_ao_cea' , ztmp(:,:) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 951 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * sst_m(:,:) * rcp * tmask(:,:,1) ) ! heat flux from evap (cell average) 952 ENDIF 953 IF( iom_use('hflx_rain_cea') ) THEN 954 ztmp(:,:) = rcp * ( SUM( (ptsu-rt0) * a_i_b, dim=3 ) + sst_m(:,:) * ( 1._wp - at_i_b(:,:) ) ) 955 CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * ztmp(:,:) ) ! heat flux from rain (cell average) 956 ENDIF 957 IF( iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea') ) THEN 958 WHERE( SUM( a_i_b, dim=3 ) > 1.e-10 ) ; ztmp(:,:) = rcpi * SUM( (ptsu-rt0) * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 959 ELSEWHERE ; ztmp(:,:) = rcp * sst_m(:,:) 960 ENDWHERE 961 ztmp2(:,:) = sprecip(:,:) * ( ztmp(:,:) - rLfus ) 962 CALL iom_put('hflx_snow_cea' , ztmp2(:,:) ) ! heat flux from snow (cell average) 963 CALL iom_put('hflx_snow_ao_cea', ztmp2(:,:) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 964 CALL iom_put('hflx_snow_ai_cea', ztmp2(:,:) * zsnw(:,:) ) ! heat flux from snow (over ice) 965 ENDIF 915 966 ! 916 967 IF(ln_ctl) THEN
Note: See TracChangeset
for help on using the changeset viewer.
