Changeset 12370
- Timestamp:
- 2020-02-12T13:09:31+01:00 (5 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0_add_pond_lids_prints/src/OCE/SBC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0_add_pond_lids_prints/src/OCE/SBC/sbc_ice.F90
r10888 r12370 93 93 94 94 ! already defined in ice.F90 for SI3 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i ! Sea ice fraction on categories 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple ! Sea ice fraction on categories at the last coupling point 96 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i, h_s 97 98 -
NEMO/branches/UKMO/NEMO_4.0_add_pond_lids_prints/src/OCE/SBC/sbccpl.F90
r10888 r12370 48 48 USE lib_mpp ! distribued memory computing library 49 49 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 50 51 #if defined key_oasis3 52 USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 53 #endif 50 54 51 55 IMPLICIT NONE … … 152 156 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 153 157 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 154 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area 158 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area fraction 155 159 INTEGER, PARAMETER :: jps_ht_p = 35 ! meltpond thickness 156 160 INTEGER, PARAMETER :: jps_kice = 36 ! sea ice effective conductivity … … 159 163 160 164 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 165 166 #if ! defined key_oasis3 167 ! Dummy variables to enable compilation when oasis3 is not being used 168 INTEGER :: OASIS_Sent = -1 169 INTEGER :: OASIS_SentOut = -1 170 INTEGER :: OASIS_ToRest = -1 171 INTEGER :: OASIS_ToRestOut = -1 172 #endif 161 173 162 174 ! !!** namelist namsbc_cpl ** … … 184 196 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 185 197 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 198 LOGICAL :: ln_scale_ice_fluxes ! Scale sea ice fluxes by the sea ice fractions at the previous coupling point 186 199 TYPE :: DYNARR 187 200 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 256 269 & sn_rcv_iceflx, sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp , & 257 270 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl , & 258 & sn_rcv_ts_ice 271 & sn_rcv_ts_ice, ln_scale_ice_fluxes 259 272 260 273 !!--------------------------------------------------------------------- … … 330 343 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 331 344 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl 345 WRITE(numout,*)' ln_scale_ice_fluxes = ', ln_scale_ice_fluxes 332 346 ENDIF 333 347 … … 815 829 END SELECT 816 830 831 ! Initialise ice fractions from last coupling time to zero 832 a_i_last_couple(:,:,:) = 0._wp 833 834 817 835 ! ! ------------------------- ! 818 836 ! ! Ice Meltponds ! … … 1643 1661 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1644 1662 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1663 REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total, ztmp1 1645 1664 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i 1646 1665 !!---------------------------------------------------------------------- … … 1663 1682 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1664 1683 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1665 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:)1666 1684 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1667 1685 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1668 1686 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 1669 1687 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1670 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1688 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1671 1689 CASE( 'none' ) ! Not available as for now: needs additional coding below when computing zevap_oce 1672 1690 ! ! since fields received are not defined with none option … … 1675 1693 1676 1694 #if defined key_si3 1695 1696 ! --- evaporation over ice (kg/m2/s) --- ! 1697 zevap_ice_total(:,:) = 0._wp 1698 IF (sn_rcv_emp%clcat == 'yes') THEN 1699 DO jl=1,jpl 1700 IF (ln_scale_ice_fluxes) THEN 1701 zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) * a_i_last_couple(:,:,jl) 1702 ELSE 1703 zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1704 ENDIF 1705 zevap_ice_total(:,:) = zevap_ice_total(:,:) + zevap_ice(:,:,jl) 1706 ENDDO 1707 ELSE 1708 zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1 ) 1709 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1710 ENDIF 1711 1712 IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 1713 ! For conservative case zemp_ice has not been defined yet. Do it now. 1714 zemp_ice(:,:) = zevap_ice_total(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 1715 END IF 1716 1677 1717 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1678 1718 zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw ) … … 1683 1723 1684 1724 ! --- evaporation over ocean (used later for qemp) --- ! 1685 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1686 1687 ! --- evaporation over ice (kg/m2/s) --- ! 1688 DO jl=1,jpl 1689 IF (sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1690 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1691 ENDDO 1725 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) 1726 1727 1728 1692 1729 1693 1730 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1727 1764 sprecip (:,:) = zsprecip (:,:) 1728 1765 tprecip (:,:) = ztprecip (:,:) 1729 evap_ice(:,:,:) = zevap_ice(:,:,:) 1766 IF (ln_scale_ice_fluxes) THEN 1767 ! Convert from grid box means to sea ice means 1768 WHERE( a_i(:,:,:) > 0.0_wp ) evap_ice(:,:,:) = zevap_ice(:,:,:) / a_i(:,:,:) 1769 WHERE( a_i(:,:,:) <= 0.0_wp ) evap_ice(:,:,:) = 0.0 1770 ELSE 1771 evap_ice(:,:,:) = zevap_ice(:,:,:) 1772 ENDIF 1730 1773 DO jl = 1, jpl 1731 1774 devap_ice(:,:,jl) = zdevap_ice(:,:) … … 1774 1817 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1775 1818 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1776 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)1819 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1777 1820 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1778 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)1821 & - zevap_ice_total(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1779 1822 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1780 1823 ! … … 1784 1827 CASE( 'oce only' ) ! the required field is directly provided 1785 1828 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1829 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1830 ! here so the only flux is the ocean only one. 1831 zqns_ice(:,:,:) = 0._wp 1786 1832 CASE( 'conservative' ) ! the required fields are directly provided 1787 1833 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1847 1893 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip over ocean + snow melting 1848 1894 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - rLfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1849 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap1850 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos ! solid precip over ice1851 1895 1852 1896 ! --- total non solar flux (including evap/precip) --- ! … … 1900 1944 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1901 1945 IF ( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1902 IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1)&1903 & * picefr(:,:) )* zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average)1946 IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) ) & 1947 * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1904 1948 IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1905 1949 IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & … … 1914 1958 CASE( 'oce only' ) 1915 1959 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1960 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 1961 ! here so the only flux is the ocean only one. 1962 zqsr_ice(:,:,:) = 0._wp 1916 1963 CASE( 'conservative' ) 1917 1964 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) … … 1992 2039 ENDDO 1993 2040 ENDIF 2041 CASE( 'none' ) 2042 zdqns_ice(:,:,:) = 0._wp 1994 2043 END SELECT 1995 2044 … … 2007 2056 ! ! ========================= ! 2008 2057 CASE ('coupled') 2009 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2010 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2058 IF (ln_scale_ice_fluxes) THEN 2059 WHERE( a_i(:,:,:) > 0.0_wp ) qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2060 WHERE( a_i(:,:,:) <= 0.0_wp ) qml_ice(:,:,:) = 0.0_wp 2061 WHERE( a_i(:,:,:) > 0.0_wp ) qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2062 WHERE( a_i(:,:,:) <= 0.0_wp ) qcn_ice(:,:,:) = 0.0_wp 2063 ELSE 2064 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2065 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2066 ENDIF 2011 2067 END SELECT 2012 2068 ! … … 2098 2154 SELECT CASE( sn_snd_temp%clcat ) 2099 2155 CASE( 'yes' ) 2100 ztmp3(:,:,1:jpl) = t n_ice(:,:,1:jpl) * a_i(:,:,1:jpl)2156 ztmp3(:,:,1:jpl) = t_i(:,:,1,1:jpl) * a_i(:,:,1:jpl) 2101 2157 CASE( 'no' ) 2102 2158 ztmp3(:,:,:) = 0.0 … … 2192 2248 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2193 2249 ENDIF 2250 2251 ! If this coupling was successful then save ice fraction for use between coupling points. 2252 ! This is needed for some calculations where the ice fraction at the last coupling point 2253 ! is needed. 2254 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2255 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2256 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2257 a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 2258 ENDIF 2259 ENDIF 2194 2260 2195 2261 IF( ssnd(jps_fice1)%laction ) THEN … … 2250 2316 ! ! Ice melt ponds ! 2251 2317 ! ! ------------------------- ! 2252 ! needed by Met Office 2318 ! needed by Met Office - 1) fraction of ponded ice; 2) local/actual pond depth 2253 2319 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2254 2320 SELECT CASE( sn_snd_mpnd%cldes) … … 2256 2322 SELECT CASE( sn_snd_mpnd%clcat ) 2257 2323 CASE( 'yes' ) 2258 ztmp3(:,:,1:jpl) = a_ip (:,:,1:jpl)2259 ztmp4(:,:,1:jpl) = v_ip(:,:,1:jpl)2324 ztmp3(:,:,1:jpl) = a_ip_frac(:,:,1:jpl) 2325 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2260 2326 CASE( 'no' ) 2261 2327 ztmp3(:,:,:) = 0.0 2262 2328 ztmp4(:,:,:) = 0.0 2263 2329 DO jl=1,jpl 2264 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip (:,:,jpl)2265 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl)2330 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2331 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2266 2332 ENDDO 2267 2333 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.