- Timestamp:
- 2021-12-03T20:32:50+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14318_RK3_stage1
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbccpl.F90 (modified) (34 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14318_RK3_stage1
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/SBC/sbccpl.F90
r14227 r15574 129 129 INTEGER, PARAMETER :: jpr_icb = 61 130 130 INTEGER, PARAMETER :: jpr_ts_ice = 62 ! Sea ice surface temp 131 !!INTEGER, PARAMETER :: jpr_qtrice = 63 ! Transmitted solar thru sea-ice 131 132 132 133 INTEGER, PARAMETER :: jprcv = 62 ! total number of fields received … … 202 203 & sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd 203 204 ! ! Other namelist parameters 205 !! TYPE(FLD_C) :: sn_rcv_qtrice 204 206 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 205 207 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models … … 237 239 !! *** FUNCTION sbc_cpl_alloc *** 238 240 !!---------------------------------------------------------------------- 239 INTEGER :: ierr( 5)241 INTEGER :: ierr(4) 240 242 !!---------------------------------------------------------------------- 241 243 ierr(:) = 0 … … 247 249 #endif 248 250 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 249 #if defined key_si3 || defined key_cice 250 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 251 #endif 252 ! 253 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) ) 251 ! 252 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 254 253 255 254 sbc_cpl_alloc = MAXVAL( ierr ) … … 286 285 & sn_rcv_charn , sn_rcv_taw , sn_rcv_bhd , sn_rcv_tusd , sn_rcv_tvsd, & 287 286 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 288 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice 287 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice, & !!, sn_rcv_qtrice 288 & sn_rcv_mslp 289 289 290 290 !!--------------------------------------------------------------------- … … 327 327 WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' 328 328 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 329 !! WRITE(numout,*)' transmitted solar thru sea-ice = ', TRIM(sn_rcv_qtrice%cldes), ' (', TRIM(sn_rcv_qtrice%clcat), ')' 329 330 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 330 331 WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' … … 528 529 IF(lwp) WRITE(numout,*) 529 530 IF(lwp) WRITE(numout,*) ' iceshelf received from oasis ' 530 CALL ctl_stop('STOP','not coded')531 ENDIF531 ENDIF 532 ! 532 533 ! 533 534 ! ! ------------------------- ! … … 602 603 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 603 604 ! 604 ! ! ------------------------- !605 ! ! ice topmelt and botmelt !606 ! ! ------------------------- !605 ! ! --------------------------------- ! 606 ! ! ice topmelt and conduction flux ! 607 ! ! --------------------------------- ! 607 608 srcv(jpr_topm )%clname = 'OTopMlt' 608 609 srcv(jpr_botm )%clname = 'OBotMlt' … … 615 616 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 616 617 ENDIF 618 !! ! ! --------------------------- ! 619 !! ! ! transmitted solar thru ice ! 620 !! ! ! --------------------------- ! 621 !! srcv(jpr_qtrice)%clname = 'OQtr' 622 !! IF( TRIM(sn_rcv_qtrice%cldes) == 'coupled' ) THEN 623 !! IF ( TRIM( sn_rcv_qtrice%clcat ) == 'yes' ) THEN 624 !! srcv(jpr_qtrice)%nct = nn_cats_cpl 625 !! ELSE 626 !! CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtrice%clcat should always be set to yes currently' ) 627 !! ENDIF 628 !! srcv(jpr_qtrice)%laction = .TRUE. 629 !! ENDIF 617 630 ! ! ------------------------- ! 618 631 ! ! ice skin temperature ! … … 888 901 END SELECT 889 902 890 ! Initialise ice fractions from last coupling time to zero (needed by Met-Office)891 #if defined key_si3 || defined key_cice892 a_i_last_couple(:,:,:) = 0._wp893 #endif894 903 ! ! ------------------------- ! 895 904 ! ! Ice Meltponds ! … … 1248 1257 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1249 1258 END_2D 1250 CALL lbc_lnk _multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp )1259 CALL lbc_lnk( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp ) 1251 1260 ENDIF 1252 1261 llnewtx = .TRUE. … … 1293 1302 IF( llnewtau ) THEN 1294 1303 zcoef = 1. / ( zrhoa * zcdrag ) 1295 DO_2D( 1, 1, 1, 1)1304 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 1296 1305 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1297 1306 END_2D … … 1512 1521 ! ice shelf fwf 1513 1522 IF( srcv(jpr_isf)%laction ) THEN 1514 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting)1523 fwfisf_oasis(:,:) = frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf to the ocean ( > 0 = melting ) 1515 1524 END IF 1516 1525 … … 1589 1598 !! ** Action : return ptau_i, ptau_j, the stress over the ice 1590 1599 !!---------------------------------------------------------------------- 1591 REAL(wp), INTENT( out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]1592 REAL(wp), INTENT( out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)1600 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2] 1601 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 1593 1602 !! 1594 1603 INTEGER :: ji, jj ! dummy loop indices … … 1597 1606 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1598 1607 !!---------------------------------------------------------------------- 1608 ! 1609 #if defined key_si3 || defined key_cice 1599 1610 ! 1600 1611 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1666 1677 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1667 1678 END_2D 1668 CALL lbc_lnk _multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. )1679 CALL lbc_lnk( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1669 1680 END SELECT 1670 1681 1671 1682 ENDIF 1672 1683 ! 1684 #endif 1685 ! 1673 1686 END SUBROUTINE sbc_cpl_ice_tau 1674 1687 1675 1688 1676 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )1689 SUBROUTINE sbc_cpl_ice_flx( kt, picefr, palbi, psst, pist, phs, phi ) 1677 1690 !!---------------------------------------------------------------------- 1678 1691 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1716 1729 !! are provided but not included in emp here. Only runoff will 1717 1730 !! be included in emp in other parts of NEMO code 1731 !! 1732 !! ** Note : In case of the ice-atm coupling with conduction fluxes (such as Jules interface for the Met-Office), 1733 !! qsr_ice and qns_ice are not provided and they are not supposed to be used in the ice code. 1734 !! However, by precaution we also "fake" qns_ice and qsr_ice this way: 1735 !! qns_ice = qml_ice + qcn_ice ?? 1736 !! qsr_ice = qtr_ice_top ?? 1737 !! 1718 1738 !! ** Action : update at each nf_ice time step: 1719 1739 !! qns_tot, qsr_tot non-solar and solar total heat fluxes … … 1724 1744 !! sprecip solid precipitation over the ocean 1725 1745 !!---------------------------------------------------------------------- 1746 INTEGER, INTENT(in) :: kt ! ocean model time step index (only for a_i_last_couple) 1726 1747 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1727 1748 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling … … 1740 1761 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1741 1762 !!---------------------------------------------------------------------- 1763 ! 1764 #if defined key_si3 || defined key_cice 1765 ! 1766 IF( kt == nit000 ) THEN 1767 ! allocate ice fractions from last coupling time here and not in sbc_cpl_init because of jpl 1768 IF( .NOT.ALLOCATED(a_i_last_couple) ) ALLOCATE( a_i_last_couple(jpi,jpj,jpl) ) 1769 ! initialize to a_i for the 1st time step 1770 a_i_last_couple(:,:,:) = a_i(:,:,:) 1771 ENDIF 1742 1772 ! 1743 1773 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1768 1798 END SELECT 1769 1799 1770 #if defined key_si31771 1772 1800 ! --- evaporation over ice (kg/m2/s) --- ! 1773 1801 IF (ln_scale_ice_flux) THEN ! typically met-office requirements … … 1834 1862 rnf(:,:) = rnf(:,:) + fwficb(:,:) 1835 1863 ENDIF 1836 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)1837 fwfisf_oasis(:,:) = -frcv(jpr_isf)%z3(:,:,1)1864 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf > 0 mean melting) 1865 fwfisf_oasis(:,:) = frcv(jpr_isf)%z3(:,:,1) 1838 1866 ENDIF 1839 1867 … … 1860 1888 ENDIF 1861 1889 1862 #else 1863 zsnw(:,:) = picefr(:,:) 1864 ! --- Continental fluxes --- ! 1865 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) 1866 rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1867 ENDIF 1868 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) 1869 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1870 ENDIF 1871 IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs 1872 fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1873 rnf(:,:) = rnf(:,:) + fwficb(:,:) 1874 ENDIF 1875 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1876 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1877 ENDIF 1878 ! 1879 IF( ln_mixcpl ) THEN 1880 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1881 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1882 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1883 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1884 ELSE 1885 emp_tot(:,:) = zemp_tot(:,:) 1886 emp_ice(:,:) = zemp_ice(:,:) 1887 sprecip(:,:) = zsprecip(:,:) 1888 tprecip(:,:) = ztprecip(:,:) 1889 ENDIF 1890 ! 1891 #endif 1892 1890 !! for CICE ?? 1891 !!$ zsnw(:,:) = picefr(:,:) 1892 !!$ ! --- Continental fluxes --- ! 1893 !!$ IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) 1894 !!$ rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1895 !!$ ENDIF 1896 !!$ IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) 1897 !!$ zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1898 !!$ ENDIF 1899 !!$ IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs 1900 !!$ fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1901 !!$ rnf(:,:) = rnf(:,:) + fwficb(:,:) 1902 !!$ ENDIF 1903 !!$ IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf >0 mean melting) 1904 !!$ fwfisf_oasis(:,:) = frcv(jpr_isf)%z3(:,:,1) 1905 !!$ ENDIF 1906 !!$ ! 1907 !!$ IF( ln_mixcpl ) THEN 1908 !!$ emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1909 !!$ emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1910 !!$ sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1911 !!$ tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1912 !!$ ELSE 1913 !!$ emp_tot(:,:) = zemp_tot(:,:) 1914 !!$ emp_ice(:,:) = zemp_ice(:,:) 1915 !!$ sprecip(:,:) = zsprecip(:,:) 1916 !!$ tprecip(:,:) = ztprecip(:,:) 1917 !!$ ENDIF 1918 ! 1893 1919 ! outputs 1894 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff1895 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf1896 1920 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1897 1921 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs … … 1901 1925 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1902 1926 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1903 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average)1904 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)1927 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * ziceld(:,:) ) ! liquid precipitation over ocean (cell average) 1928 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1905 1929 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1906 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )! ice-free oce evap (cell average)1930 & - zevap_ice_total(:,:) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1907 1931 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1932 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff 1933 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf 1934 ! 1935 ! ! ========================= ! 1936 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt ! 1937 ! ! ========================= ! 1938 CASE ('coupled') 1939 IF (ln_scale_ice_flux) THEN 1940 WHERE( a_i(:,:,:) > 1.e-10_wp ) 1941 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1942 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1943 ELSEWHERE 1944 qml_ice(:,:,:) = 0.0_wp 1945 qcn_ice(:,:,:) = 0.0_wp 1946 END WHERE 1947 ELSE 1948 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 1949 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 1950 ENDIF 1951 END SELECT 1908 1952 ! 1909 1953 ! ! ========================= ! … … 1911 1955 ! ! ========================= ! 1912 1956 CASE( 'oce only' ) ! the required field is directly provided 1913 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1914 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1915 ! here so the only flux is the ocean only one. 1916 zqns_ice(:,:,:) = 0._wp 1957 ! Get the sea ice non solar heat flux from conductive, melting and sublimation fluxes 1958 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 1959 zqns_ice(:,:,:) = qml_ice(:,:,:) + qcn_ice(:,:,:) 1960 ELSE 1961 zqns_ice(:,:,:) = 0._wp 1962 ENDIF 1963 ! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE 1964 ! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1) 1965 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(:,:,:), dim=3 ) 1917 1966 CASE( 'conservative' ) ! the required fields are directly provided 1918 1967 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1961 2010 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting 1962 2011 1963 #if defined key_si31964 2012 ! --- non solar flux over ocean --- ! 1965 2013 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax … … 2014 2062 ENDIF 2015 2063 2016 #else 2017 zcptsnw (:,:) = zcptn(:,:) 2018 zcptrain(:,:) = zcptn(:,:)2019 2020 ! clem: this formulation is certainly wrong... but better than it was... 2021 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 2022 & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 2023 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 2024 & - zemp_ice(:,:) ) * zcptn(:,:)2025 2026 IF( ln_mixcpl ) THEN 2027 qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2028 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 2029 DO jl=1,jpl 2030 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 2031 ENDDO 2032 ELSE 2033 qns_tot(:,: ) = zqns_tot(:,: ) 2034 qns_ice(:,:,:) = zqns_ice(:,:,:)2035 ENDIF 2036 2037 #endif 2064 !! for CICE ?? 2065 !!$ ! --- non solar flux over ocean --- ! 2066 !!$ zcptsnw (:,:) = zcptn(:,:) 2067 !!$ zcptrain(:,:) = zcptn(:,:) 2068 !!$ 2069 !!$ ! clem: this formulation is certainly wrong... but better than it was... 2070 !!$ zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 2071 !!$ & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 2072 !!$ & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 2073 !!$ & - zemp_ice(:,:) ) * zcptn(:,:) 2074 !!$ 2075 !!$ IF( ln_mixcpl ) THEN 2076 !!$ qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2077 !!$ qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 2078 !!$ DO jl=1,jpl 2079 !!$ qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 2080 !!$ ENDDO 2081 !!$ ELSE 2082 !!$ qns_tot(:,: ) = zqns_tot(:,: ) 2083 !!$ qns_ice(:,:,:) = zqns_ice(:,:,:) 2084 !!$ ENDIF 2085 2038 2086 ! outputs 2039 2087 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving … … 2053 2101 IF ( iom_use('hflx_snow_ai_cea') ) & ! heat flux from snow (over ice) 2054 2102 & CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * zsnw(:,:) ) 2103 IF( iom_use('hflx_subl_cea') ) & ! heat flux from sublimation 2104 & CALL iom_put('hflx_subl_cea' , SUM( qevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) * tmask(:,:,1) ) 2055 2105 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 2056 2106 ! 2107 ! ! ========================= ! 2108 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 2109 ! ! ========================= ! 2110 CASE ('coupled') 2111 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 2112 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 2113 ELSE 2114 ! Set all category values equal for the moment 2115 DO jl=1,jpl 2116 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 2117 ENDDO 2118 ENDIF 2119 CASE( 'none' ) 2120 zdqns_ice(:,:,:) = 0._wp 2121 END SELECT 2122 2123 IF( ln_mixcpl ) THEN 2124 DO jl=1,jpl 2125 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 2126 ENDDO 2127 ELSE 2128 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 2129 ENDIF 2057 2130 ! ! ========================= ! 2058 2131 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) … … 2060 2133 CASE( 'oce only' ) 2061 2134 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 2062 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero2063 ! here so the only flux is the ocean only one.2135 ! For the Met Office the only sea ice solar flux is the transmitted qsr which is added onto zqsr_ice 2136 ! further down. Therefore start zqsr_ice off at zero. 2064 2137 zqsr_ice(:,:,:) = 0._wp 2065 2138 CASE( 'conservative' ) … … 2114 2187 END DO 2115 2188 ENDIF 2116 2117 #if defined key_si32118 ! --- solar flux over ocean --- !2119 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax2120 zqsr_oce = 0._wp2121 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)2122 2123 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)2124 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF2125 #endif2126 2127 IF( ln_mixcpl ) THEN2128 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk2129 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)2130 DO jl = 1, jpl2131 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)2132 END DO2133 ELSE2134 qsr_tot(:,: ) = zqsr_tot(:,: )2135 qsr_ice(:,:,:) = zqsr_ice(:,:,:)2136 ENDIF2137 2138 ! ! ========================= !2139 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !2140 ! ! ========================= !2141 CASE ('coupled')2142 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN2143 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)2144 ELSE2145 ! Set all category values equal for the moment2146 DO jl=1,jpl2147 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)2148 ENDDO2149 ENDIF2150 CASE( 'none' )2151 zdqns_ice(:,:,:) = 0._wp2152 END SELECT2153 2154 IF( ln_mixcpl ) THEN2155 DO jl=1,jpl2156 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)2157 ENDDO2158 ELSE2159 dqns_ice(:,:,:) = zdqns_ice(:,:,:)2160 ENDIF2161 2162 #if defined key_si32163 ! ! ========================= !2164 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt !2165 ! ! ========================= !2166 CASE ('coupled')2167 IF (ln_scale_ice_flux) THEN2168 WHERE( a_i(:,:,:) > 1.e-10_wp )2169 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2170 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2171 ELSEWHERE2172 qml_ice(:,:,:) = 0.0_wp2173 qcn_ice(:,:,:) = 0.0_wp2174 END WHERE2175 ELSE2176 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)2177 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)2178 ENDIF2179 END SELECT2180 2189 ! ! ========================= ! 2181 2190 ! ! Transmitted Qsr ! [W/m2] … … 2209 2218 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2210 2219 ! 2211 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2212 ! for now just assume zero (fully opaque ice) 2220 !! SELECT CASE( TRIM( sn_rcv_qtrice%cldes ) ) 2221 !! ! 2222 !! ! ! ===> here we receive the qtr_ice_top array from the coupler 2223 !! CASE ('coupled') 2224 !! IF (ln_scale_ice_flux) THEN 2225 !! WHERE( a_i(:,:,:) > 1.e-10_wp ) 2226 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2227 !! ELSEWHERE 2228 !! zqtr_ice_top(:,:,:) = 0.0_wp 2229 !! ENDWHERE 2230 !! ELSE 2231 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) 2232 !! ENDIF 2233 !! 2234 !! ! Add retrieved transmitted solar radiation onto the ice and total solar radiation 2235 !! zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:) 2236 !! zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(:,:,:), dim=3 ) 2237 !! 2238 !! ! if we are not getting this data from the coupler then assume zero (fully opaque ice) 2239 !! CASE ('none') 2213 2240 zqtr_ice_top(:,:,:) = 0._wp 2214 ! 2215 ENDIF 2216 ! 2241 !! END SELECT 2242 ! 2243 ENDIF 2244 2217 2245 IF( ln_mixcpl ) THEN 2218 DO jl=1,jpl 2246 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2247 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:) * zmsk(:,:) 2248 DO jl = 1, jpl 2249 qsr_ice (:,:,jl) = qsr_ice (:,:,jl) * xcplmask(:,:,0) + zqsr_ice (:,:,jl) * zmsk(:,:) 2219 2250 qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:) 2220 END DO2251 END DO 2221 2252 ELSE 2253 qsr_tot (:,: ) = zqsr_tot (:,: ) 2254 qsr_ice (:,:,:) = zqsr_ice (:,:,:) 2222 2255 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2223 2256 ENDIF 2257 2258 ! --- solar flux over ocean --- ! 2259 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 2260 zqsr_oce = 0._wp 2261 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 2262 2263 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 2264 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 2265 2224 2266 ! ! ================== ! 2225 2267 ! ! ice skin temp. ! … … 2560 2602 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2561 2603 END_2D 2562 CALL lbc_lnk _multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )2604 CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2563 2605 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2564 2606 DO_2D( 0, 0, 0, 0 ) … … 2569 2611 END_2D 2570 2612 END SELECT 2571 CALL lbc_lnk _multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )2613 CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 2572 2614 ! 2573 2615 ENDIF … … 2637 2679 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2638 2680 END_2D 2639 CALL lbc_lnk _multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )2681 CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2640 2682 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2641 2683 DO_2D( 0, 0, 0, 0 ) … … 2646 2688 END_2D 2647 2689 END SELECT 2648 CALL lbc_lnk _multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )2690 CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 2649 2691 ! 2650 2692 !
Note: See TracChangeset
for help on using the changeset viewer.
