Changeset 11916
- Timestamp:
- 2019-11-15T16:44:47+01:00 (5 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl
- Files:
-
- 7 edited
-
cfgs/SHARED/field_def_nemo-ice.xml (modified) (2 diffs)
-
src/ICE/ice.F90 (modified) (2 diffs)
-
src/ICE/icethd_zdf_bl99.F90 (modified) (4 diffs)
-
src/ICE/iceupdate.F90 (modified) (1 diff)
-
src/ICE/icewri.F90 (modified) (1 diff)
-
src/OCE/SBC/sbc_ice.F90 (modified) (1 diff)
-
src/OCE/SBC/sbccpl.F90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/cfgs/SHARED/field_def_nemo-ice.xml
r11575 r11916 158 158 <field id="hfxcndtop" long_name="Net conductive heat flux at the ice surface (neg = ice cooling)" standard_name="conductive_heat_flux_at_sea_ice_surface" unit="W/m2" /> 159 159 <field id="hfxcndbot" long_name="Net conductive heat flux at the ice bottom (neg = ice cooling)" standard_name="conductive_heat_flux_at_sea_ice_bottom" unit="W/m2" /> 160 <field id="hfxcndcpl" long_name="Conductive heat flux coming through the coupler" standard_name="conductive_heat_flux_from_coupler" unit="W/m2" /> 160 161 161 162 <!-- diags --> … … 245 246 <field id="iceconc_cat" long_name="Sea-ice concentration per category" unit="" /> 246 247 <field id="icethic_cat" long_name="Sea-ice thickness per category" unit="m" detect_missing_value="true" /> 248 <field id="icevol_cat" long_name="Sea-ice volume per category" unit="m" detect_missing_value="true" /> 247 249 <field id="snwthic_cat" long_name="Snow thickness per category" unit="m" detect_missing_value="true" /> 248 250 <field id="icesalt_cat" long_name="Sea-Ice Bulk salinity per category" unit="g/kg" detect_missing_value="true" /> -
NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/ice.F90
r11715 r11916 295 295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i !: Ice thickness (m) 296 296 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration) 297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Ice fractional area at last coupling time 297 298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m) 298 299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area (m) … … 435 436 436 437 ii = ii + 1 438 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(ii) ) 439 440 ii = ii + 1 437 441 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , & 438 442 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , st_i(jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) , & -
NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/icethd_zdf_bl99.F90
r11715 r11916 31 31 !!---------------------------------------------------------------------- 32 32 !! NEMO/ICE 4.0 , NEMO Consortium (2018) 33 !! $Id $33 !! $Id: icethd_zdf_bl99.F90 10926 2019-05-03 12:32:10Z clem $ 34 34 !! Software governed by the CeCILL license (see ./LICENSE) 35 35 !!---------------------------------------------------------------------- … … 89 89 REAL(wp) :: zg1 = 2._wp ! 90 90 REAL(wp) :: zgamma = 18009._wp ! for specific heat 91 REAL(wp) :: zbeta = 0.1 17_wp ! for thermal conductivity (could be 0.13)91 REAL(wp) :: zbeta = 0.13_wp ! for thermal conductivity (could be 0.13) 92 92 REAL(wp) :: zraext_s = 10._wp ! extinction coefficient of radiation in the snow 93 93 REAL(wp) :: zkimin = 0.10_wp ! minimum ice thermal conductivity … … 769 769 ! 770 770 ! --- calculate conduction fluxes (positive downward) 771 771 ! bottom ice conduction flux 772 772 DO ji = 1, npti 773 ! ! surface ice conduction flux 774 qcn_ice_top_1d(ji) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) ) & 775 & - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * ( t_i_1d(ji,1) - t_su_1d(ji) ) 776 ! ! bottom ice conduction flux 777 qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1 * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 773 qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1 * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 778 774 END DO 779 775 ! surface ice conduction flux 776 IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_EMU ) THEN 777 ! 778 DO ji = 1, npti 779 qcn_ice_top_1d(ji) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) ) & 780 & - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * ( t_i_1d(ji,1) - t_su_1d(ji) ) 781 END DO 782 ! 783 ELSEIF( k_cnd == np_cnd_ON ) THEN 784 ! 785 DO ji = 1, npti 786 qcn_ice_top_1d(ji) = qcn_ice_1d(ji) 787 ! 788 t_su_1d(ji) = ( qcn_ice_top_1d(ji) & ! calculate surface temperature 789 & + isnow(ji) * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) & 790 & + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * t_i_1d(ji,1) & 791 & ) / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 ) 792 t_su_1d(ji) = MAX( MIN( t_su_1d(ji), rt0 ), rt0 - 100._wp ) ! cap t_su 793 END DO 794 ! 795 ENDIF 780 796 ! 781 797 ! --- Diagnose the heat loss due to changing non-solar / conduction flux --- ! … … 785 801 DO ji = 1, npti 786 802 hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji) 787 END DO788 !789 ELSEIF( k_cnd == np_cnd_ON ) THEN790 !791 DO ji = 1, npti792 hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qcn_ice_top_1d(ji) - qcn_ice_1d(ji) ) * a_i_1d(ji)793 803 END DO 794 804 ! -
NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/iceupdate.F90
r11715 r11916 279 279 IF( iom_use('hfxcndbot' ) ) CALL iom_put( 'hfxcndbot' , SUM( qcn_ice_bot * a_i_b, dim=3 ) ) ! Bottom conduction flux 280 280 IF( iom_use('hfxcndtop' ) ) CALL iom_put( 'hfxcndtop' , SUM( qcn_ice_top * a_i_b, dim=3 ) ) ! Surface conduction flux 281 IF( iom_use('hfxcndcpl' ) ) CALL iom_put( "hfxcndcpl" , SUM( qcn_ice * a_i_b, dim=3 ) ) ! Conduction flux we are giving it 281 282 282 283 ! controls -
NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/ICE/icewri.F90
r11715 r11916 152 152 IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i * zmsk00l ) ! area for categories 153 153 IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! thickness for categories 154 IF( iom_use('icevol_cat' ) ) CALL iom_put( "icevol_cat" , v_i * zmsk00l ) ! volume for categories 154 155 IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow depth for categories 155 156 IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! salinity for categories -
NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/OCE/SBC/sbc_ice.F90
r11715 r11916 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.1_fix_cpl/src/OCE/SBC/sbccpl.F90
r11715 r11916 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 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 ! … … 2193 2249 ENDIF 2194 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 2260 2195 2261 IF( ssnd(jps_fice1)%laction ) THEN 2196 2262 SELECT CASE( sn_snd_thick1%clcat ) … … 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.
