- Timestamp:
- 2019-12-14T13:46:52+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbccpl.F90
r12202 r12251 571 571 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl 572 572 573 #if defined key_si3 574 IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN 575 IF( .NOT.srcv(jpr_ts_ice)%laction ) & 576 & CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' ) 577 ENDIF 578 #endif 573 579 ! ! ------------------------- ! 574 580 ! ! Wave breaking ! … … 860 866 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 861 867 CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 862 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid863 868 ENDIF 864 869 ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send … … 1038 1043 ENDIF 1039 1044 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 1040 !1041 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )1042 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) &1043 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )1044 IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq1045 1045 ! 1046 1046 END SUBROUTINE sbc_cpl_init … … 1108 1108 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 1109 1109 !!---------------------------------------------------------------------- 1110 ! 1111 IF( kt == nit000 ) THEN 1112 ! cannot be done in the init phase when we use agrif as cpl_freq requires that oasis_enddef is done 1113 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 1114 IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 ) & 1115 & CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 1116 ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 1117 ENDIF 1110 1118 ! 1111 1119 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1241 1249 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1242 1250 ! 1243 ! ! ================== !1244 ! ! ice skin temp. !1245 ! ! ================== !1246 #if defined key_si31247 ! needed by Met Office1248 IF( srcv(jpr_ts_ice)%laction ) THEN1249 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; tsfc_ice(:,:,:) = 0.01250 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; tsfc_ice(:,:,:) = -60.1251 ELSEWHERE ; tsfc_ice(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:)1252 END WHERE1253 ENDIF1254 #endif1255 1251 ! ! ========================= ! 1256 1252 ! ! Mean Sea Level Pressure ! (taum) … … 1632 1628 !! sprecip solid precipitation over the ocean 1633 1629 !!---------------------------------------------------------------------- 1634 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1]1635 ! !! ! optional arguments, used only in 'mixed oce-ice' case1636 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo1637 REAL(wp), INTENT(in) , DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius]1638 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]1639 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m]1640 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m]1630 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1631 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling 1632 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1633 REAL(wp), INTENT(in) , DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1634 REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] => inout for Met-Office 1635 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] 1636 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] 1641 1637 ! 1642 1638 INTEGER :: ji, jj, jl ! dummy loop index … … 1645 1641 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1646 1642 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1647 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i1643 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 1648 1644 !!---------------------------------------------------------------------- 1649 1645 ! … … 1813 1809 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1814 1810 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1815 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1816 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) & 1817 & + pist(:,:,1) * picefr(:,:) ) ) 1811 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1812 DO jl = 1, jpl 1813 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl) & 1814 & + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1815 & + pist(:,:,jl) * picefr(:,:) ) ) 1816 END DO 1817 ELSE 1818 DO jl = 1, jpl 1819 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1) & 1820 & + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1821 & + pist(:,:,jl) * picefr(:,:) ) ) 1822 END DO 1823 ENDIF 1818 1824 END SELECT 1819 1825 ! … … 1929 1935 END DO 1930 1936 ENDIF 1931 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1932 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1933 1937 CASE( 'oce and ice' ) 1934 1938 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) … … 1950 1954 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1951 1955 ! ( see OASIS3 user guide, 5th edition, p39 ) 1952 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1953 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1954 & + palbi (:,:,1) * picefr(:,:) ) ) 1956 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1957 DO jl = 1, jpl 1958 zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) ) & 1959 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1960 & + palbi (:,:,jl) * picefr(:,:) ) ) 1961 END DO 1962 ELSE 1963 DO jl = 1, jpl 1964 zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) ) & 1965 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1966 & + palbi (:,:,jl) * picefr(:,:) ) ) 1967 END DO 1968 ENDIF 1955 1969 CASE( 'none' ) ! Not available as for now: needs additional coding 1956 1970 ! ! since fields received, here zqsr_tot, are not defined with none option … … 2012 2026 ! ! ========================= ! 2013 2027 CASE ('coupled') 2014 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2015 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2028 IF( ln_mixcpl ) THEN 2029 DO jl=1,jpl 2030 qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 2031 qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 2032 ENDDO 2033 ELSE 2034 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2035 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2036 ENDIF 2016 2037 END SELECT 2017 !2018 2038 ! ! ========================= ! 2019 2039 ! ! Transmitted Qsr ! [W/m2] … … 2022 2042 ! 2023 2043 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2024 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter(Grenfell Maykut 77)2044 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission when hi>10cm (Grenfell Maykut 77) 2025 2045 ! 2026 qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 2027 WHERE( phs(:,:,:) >= 0.0_wp ) qtr_ice_top(:,:,:) = 0._wp ! snow fully opaque 2028 WHERE( phi(:,:,:) <= 0.1_wp ) qtr_ice_top(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 2046 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2047 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 2048 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2049 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 2050 ELSEWHERE ! zero when hs>0 2051 zqtr_ice_top(:,:,:) = 0._wp 2052 END WHERE 2029 2053 ! 2030 2054 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! … … 2032 2056 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2033 2057 ! for now just assume zero (fully opaque ice) 2034 qtr_ice_top(:,:,:) = 0._wp 2058 zqtr_ice_top(:,:,:) = 0._wp 2059 ! 2060 ENDIF 2061 ! 2062 IF( ln_mixcpl ) THEN 2063 DO jl=1,jpl 2064 qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:) 2065 ENDDO 2066 ELSE 2067 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2068 ENDIF 2069 ! ! ================== ! 2070 ! ! ice skin temp. ! 2071 ! ! ================== ! 2072 ! needed by Met Office 2073 IF( srcv(jpr_ts_ice)%laction ) THEN 2074 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; ztsu(:,:,:) = 0. + rt0 2075 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; ztsu(:,:,:) = -60. + rt0 2076 ELSEWHERE ; ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0 2077 END WHERE 2078 ! 2079 IF( ln_mixcpl ) THEN 2080 DO jl=1,jpl 2081 pist(:,:,jl) = pist(:,:,jl) * xcplmask(:,:,0) + ztsu(:,:,jl) * zmsk(:,:) 2082 ENDDO 2083 ELSE 2084 pist(:,:,:) = ztsu(:,:,:) 2085 ENDIF 2035 2086 ! 2036 2087 ENDIF … … 2195 2246 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 2196 2247 END SELECT 2197 IF( ssnd(jps_fice)%laction )CALL cpl_snd( jps_fice, isec, ztmp3, info )2248 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2198 2249 ENDIF 2199 2250 … … 2255 2306 ! ! Ice melt ponds ! 2256 2307 ! ! ------------------------- ! 2257 ! needed by Met Office 2308 ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth 2258 2309 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2259 2310 SELECT CASE( sn_snd_mpnd%cldes) … … 2261 2312 SELECT CASE( sn_snd_mpnd%clcat ) 2262 2313 CASE( 'yes' ) 2263 ztmp3(:,:,1:jpl) = a_ip (:,:,1:jpl)2264 ztmp4(:,:,1:jpl) = v_ip(:,:,1:jpl)2314 ztmp3(:,:,1:jpl) = a_ip_frac(:,:,1:jpl) 2315 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2265 2316 CASE( 'no' ) 2266 2317 ztmp3(:,:,:) = 0.0 2267 2318 ztmp4(:,:,:) = 0.0 2268 2319 DO jl=1,jpl 2269 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip (:,:,jpl)2270 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl)2320 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2321 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2271 2322 ENDDO 2272 2323 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )
Note: See TracChangeset
for help on using the changeset viewer.
