Changeset 12276 for NEMO/trunk/src/OCE/SBC/sbccpl.F90
- Timestamp:
- 2019-12-20T12:14:26+01:00 (4 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/SBC/sbccpl.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r12171 r12276 573 573 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl 574 574 575 #if defined key_si3576 IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN577 IF( .NOT.srcv(jpr_ts_ice)%laction ) &578 & CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' )579 ENDIF580 #endif581 575 ! ! ------------------------- ! 582 576 ! ! Wave breaking ! … … 868 862 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 869 863 CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 864 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid 870 865 ENDIF 871 866 ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send … … 1045 1040 ENDIF 1046 1041 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 1042 ! 1043 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 1044 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) & 1045 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 1046 IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq 1047 1047 ! 1048 1048 END SUBROUTINE sbc_cpl_init … … 1110 1110 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 1111 1111 !!---------------------------------------------------------------------- 1112 !1113 IF( kt == nit000 ) THEN1114 ! cannot be done in the init phase when we use agrif as cpl_freq requires that oasis_enddef is done1115 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )1116 IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 ) &1117 & CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )1118 ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top1119 ENDIF1120 1112 ! 1121 1113 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1251 1243 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1252 1244 ! 1245 ! ! ================== ! 1246 ! ! ice skin temp. ! 1247 ! ! ================== ! 1248 #if defined key_si3 1249 ! needed by Met Office 1250 IF( srcv(jpr_ts_ice)%laction ) THEN 1251 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; tsfc_ice(:,:,:) = 0.0 1252 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; tsfc_ice(:,:,:) = -60. 1253 ELSEWHERE ; tsfc_ice(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) 1254 END WHERE 1255 ENDIF 1256 #endif 1253 1257 ! ! ========================= ! 1254 1258 ! ! Mean Sea Level Pressure ! (taum) … … 1626 1630 !! sprecip solid precipitation over the ocean 1627 1631 !!---------------------------------------------------------------------- 1628 REAL(wp), INTENT(in) 1629 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling1630 REAL(wp), INTENT(in) 1631 REAL(wp), INTENT(in) 1632 REAL(wp), INTENT(in out), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] => inout for Met-Office1633 REAL(wp), INTENT(in) 1634 REAL(wp), INTENT(in) 1632 REAL(wp), INTENT(in), DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1633 ! !! ! optional arguments, used only in 'mixed oce-ice' case 1634 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1635 REAL(wp), INTENT(in), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1636 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1637 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] 1638 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] 1635 1639 ! 1636 1640 INTEGER :: ji, jj, jl ! dummy loop index … … 1639 1643 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1640 1644 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1641 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice , zqtr_ice_top, ztsu1645 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i 1642 1646 !!---------------------------------------------------------------------- 1643 1647 ! … … 1770 1774 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1771 1775 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1776 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average) 1772 1777 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1773 1778 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & … … 1806 1811 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1807 1812 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1808 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1809 DO jl = 1, jpl 1810 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl) & 1811 & + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1812 & + pist(:,:,jl) * picefr(:,:) ) ) 1813 END DO 1814 ELSE 1815 DO jl = 1, jpl 1816 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1) & 1817 & + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1818 & + pist(:,:,jl) * picefr(:,:) ) ) 1819 END DO 1820 ENDIF 1813 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1814 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) & 1815 & + pist(:,:,1) * picefr(:,:) ) ) 1821 1816 END SELECT 1822 1817 ! … … 1903 1898 #endif 1904 1899 ! outputs 1905 IF 1906 IF 1907 IF 1908 IF 1900 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1901 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1902 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1903 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1909 1904 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1910 IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1911 IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1905 IF( iom_use('hflx_prec_cea') ) CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) + & ! heat flux from all precip (cell avg) 1906 & ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) 1907 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1908 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1912 1909 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1913 IF 1910 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1914 1911 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1915 1912 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 1930 1927 END DO 1931 1928 ENDIF 1929 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1930 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1932 1931 CASE( 'oce and ice' ) 1933 1932 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) … … 1949 1948 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1950 1949 ! ( see OASIS3 user guide, 5th edition, p39 ) 1951 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1952 DO jl = 1, jpl 1953 zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) ) & 1954 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1955 & + palbi (:,:,jl) * picefr(:,:) ) ) 1956 END DO 1957 ELSE 1958 DO jl = 1, jpl 1959 zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) ) & 1960 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1961 & + palbi (:,:,jl) * picefr(:,:) ) ) 1962 END DO 1963 ENDIF 1950 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1951 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1952 & + palbi (:,:,1) * picefr(:,:) ) ) 1964 1953 CASE( 'none' ) ! Not available as for now: needs additional coding 1965 1954 ! ! since fields received, here zqsr_tot, are not defined with none option … … 2021 2010 ! ! ========================= ! 2022 2011 CASE ('coupled') 2023 IF( ln_mixcpl ) THEN 2024 DO jl=1,jpl 2025 qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 2026 qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 2027 ENDDO 2028 ELSE 2029 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2030 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2031 ENDIF 2012 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2013 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2032 2014 END SELECT 2015 ! 2033 2016 ! ! ========================= ! 2034 2017 ! ! Transmitted Qsr ! [W/m2] … … 2037 2020 ! 2038 2021 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2039 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission when hi>10cm(Grenfell Maykut 77)2022 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter (Grenfell Maykut 77) 2040 2023 ! 2041 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2042 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 2043 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2044 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 2045 ELSEWHERE ! zero when hs>0 2046 zqtr_ice_top(:,:,:) = 0._wp 2047 END WHERE 2024 qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 2025 WHERE( phs(:,:,:) >= 0.0_wp ) qtr_ice_top(:,:,:) = 0._wp ! snow fully opaque 2026 WHERE( phi(:,:,:) <= 0.1_wp ) qtr_ice_top(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 2048 2027 ! 2049 2028 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! … … 2051 2030 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2052 2031 ! for now just assume zero (fully opaque ice) 2053 zqtr_ice_top(:,:,:) = 0._wp 2054 ! 2055 ENDIF 2056 ! 2057 IF( ln_mixcpl ) THEN 2058 DO jl=1,jpl 2059 qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:) 2060 ENDDO 2061 ELSE 2062 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2063 ENDIF 2064 ! ! ================== ! 2065 ! ! ice skin temp. ! 2066 ! ! ================== ! 2067 ! needed by Met Office 2068 IF( srcv(jpr_ts_ice)%laction ) THEN 2069 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; ztsu(:,:,:) = 0. + rt0 2070 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; ztsu(:,:,:) = -60. + rt0 2071 ELSEWHERE ; ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0 2072 END WHERE 2073 ! 2074 IF( ln_mixcpl ) THEN 2075 DO jl=1,jpl 2076 pist(:,:,jl) = pist(:,:,jl) * xcplmask(:,:,0) + ztsu(:,:,jl) * zmsk(:,:) 2077 ENDDO 2078 ELSE 2079 pist(:,:,:) = ztsu(:,:,:) 2080 ENDIF 2032 qtr_ice_top(:,:,:) = 0._wp 2081 2033 ! 2082 2034 ENDIF … … 2241 2193 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 2242 2194 END SELECT 2243 CALL cpl_snd( jps_fice, isec, ztmp3, info )2195 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2244 2196 ENDIF 2245 2197 … … 2301 2253 ! ! Ice melt ponds ! 2302 2254 ! ! ------------------------- ! 2303 ! needed by Met Office : 1) fraction of ponded ice 2) local/actual pond depth2255 ! needed by Met Office 2304 2256 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2305 2257 SELECT CASE( sn_snd_mpnd%cldes) … … 2307 2259 SELECT CASE( sn_snd_mpnd%clcat ) 2308 2260 CASE( 'yes' ) 2309 ztmp3(:,:,1:jpl) = a_ip _frac(:,:,1:jpl)2310 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl)2261 ztmp3(:,:,1:jpl) = a_ip(:,:,1:jpl) 2262 ztmp4(:,:,1:jpl) = v_ip(:,:,1:jpl) 2311 2263 CASE( 'no' ) 2312 2264 ztmp3(:,:,:) = 0.0 2313 2265 ztmp4(:,:,:) = 0.0 2314 2266 DO jl=1,jpl 2315 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip _frac(:,:,jpl)2316 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl)2267 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip(:,:,jpl) 2268 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl) 2317 2269 ENDDO 2318 2270 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) … … 2352 2304 ! ! CO2 flux from PISCES ! 2353 2305 ! ! ------------------------- ! 2354 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 2306 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN 2307 ztmp1(:,:) = oce_co2(:,:) * 1000. ! conversion in molC/m2/s 2308 CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 2309 ENDIF 2355 2310 ! 2356 2311 ! ! ------------------------- !
Note: See TracChangeset
for help on using the changeset viewer.
