- Timestamp:
- 2021-05-07T13:44:43+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/SBC/sbccpl.F90
r14765 r14806 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 289 288 290 289 !!--------------------------------------------------------------------- … … 327 326 WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' 328 327 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 328 !! WRITE(numout,*)' transmitted solar thru sea-ice = ', TRIM(sn_rcv_qtrice%cldes), ' (', TRIM(sn_rcv_qtrice%clcat), ')' 329 329 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 330 330 WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' … … 602 602 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 603 603 ! 604 ! ! ------------------------- !605 ! ! ice topmelt and botmelt !606 ! ! ------------------------- !604 ! ! --------------------------------- ! 605 ! ! ice topmelt and conduction flux ! 606 ! ! --------------------------------- ! 607 607 srcv(jpr_topm )%clname = 'OTopMlt' 608 608 srcv(jpr_botm )%clname = 'OBotMlt' … … 615 615 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 616 616 ENDIF 617 !! ! ! --------------------------- ! 618 !! ! ! transmitted solar thru ice ! 619 !! ! ! --------------------------- ! 620 !! srcv(jpr_qtrice)%clname = 'OQtr' 621 !! IF( TRIM(sn_rcv_qtrice%cldes) == 'coupled' ) THEN 622 !! IF ( TRIM( sn_rcv_qtrice%clcat ) == 'yes' ) THEN 623 !! srcv(jpr_qtrice)%nct = nn_cats_cpl 624 !! ELSE 625 !! CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtrice%clcat should always be set to yes currently' ) 626 !! ENDIF 627 !! srcv(jpr_qtrice)%laction = .TRUE. 628 !! ENDIF 617 629 ! ! ------------------------- ! 618 630 ! ! ice skin temperature ! … … 888 900 END SELECT 889 901 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 902 ! ! ------------------------- ! 895 903 ! ! Ice Meltponds ! … … 1589 1597 !! ** Action : return ptau_i, ptau_j, the stress over the ice 1590 1598 !!---------------------------------------------------------------------- 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)1599 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2] 1600 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 1593 1601 !! 1594 1602 INTEGER :: ji, jj ! dummy loop indices … … 1597 1605 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1598 1606 !!---------------------------------------------------------------------- 1607 ! 1608 #if defined key_si3 || defined key_cice 1599 1609 ! 1600 1610 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1671 1681 ENDIF 1672 1682 ! 1683 #endif 1684 ! 1673 1685 END SUBROUTINE sbc_cpl_ice_tau 1674 1686 1675 1687 1676 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )1688 SUBROUTINE sbc_cpl_ice_flx( kt, picefr, palbi, psst, pist, phs, phi ) 1677 1689 !!---------------------------------------------------------------------- 1678 1690 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1716 1728 !! are provided but not included in emp here. Only runoff will 1717 1729 !! be included in emp in other parts of NEMO code 1730 !! 1731 !! ** Note : In case of the ice-atm coupling with conduction fluxes (such as Jules interface for the Met-Office), 1732 !! qsr_ice and qns_ice are not provided and they are not supposed to be used in the ice code. 1733 !! However, by precaution we also "fake" qns_ice and qsr_ice this way: 1734 !! qns_ice = qml_ice + qcn_ice ?? 1735 !! qsr_ice = qtr_ice_top ?? 1736 !! 1718 1737 !! ** Action : update at each nf_ice time step: 1719 1738 !! qns_tot, qsr_tot non-solar and solar total heat fluxes … … 1724 1743 !! sprecip solid precipitation over the ocean 1725 1744 !!---------------------------------------------------------------------- 1745 INTEGER, INTENT(in) :: kt ! ocean model time step index (only for a_i_last_couple) 1726 1746 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1727 1747 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling … … 1740 1760 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1741 1761 !!---------------------------------------------------------------------- 1762 ! 1763 #if defined key_si3 || defined key_cice 1764 ! 1765 IF( kt == nit000 ) THEN 1766 ! allocate ice fractions from last coupling time here and not in sbc_cpl_init because of jpl 1767 IF( .NOT.ALLOCATED(a_i_last_couple) ) ALLOCATE( a_i_last_couple(jpi,jpj,jpl) ) 1768 ! initialize to a_i for the 1st time step 1769 a_i_last_couple(:,:,:) = a_i(:,:,:) 1770 ENDIF 1742 1771 ! 1743 1772 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1767 1796 CALL ctl_stop('STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl') 1768 1797 END SELECT 1769 1770 #if defined key_si31771 1798 1772 1799 ! --- evaporation over ice (kg/m2/s) --- ! … … 1860 1887 ENDIF 1861 1888 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 1889 !! for CICE ?? 1890 !!$ zsnw(:,:) = picefr(:,:) 1891 !!$ ! --- Continental fluxes --- ! 1892 !!$ IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) 1893 !!$ rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1894 !!$ ENDIF 1895 !!$ IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) 1896 !!$ zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1897 !!$ ENDIF 1898 !!$ IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs 1899 !!$ fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1900 !!$ rnf(:,:) = rnf(:,:) + fwficb(:,:) 1901 !!$ ENDIF 1902 !!$ IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1903 !!$ fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1904 !!$ ENDIF 1905 !!$ ! 1906 !!$ IF( ln_mixcpl ) THEN 1907 !!$ emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1908 !!$ emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1909 !!$ sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1910 !!$ tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1911 !!$ ELSE 1912 !!$ emp_tot(:,:) = zemp_tot(:,:) 1913 !!$ emp_ice(:,:) = zemp_ice(:,:) 1914 !!$ sprecip(:,:) = zsprecip(:,:) 1915 !!$ tprecip(:,:) = ztprecip(:,:) 1916 !!$ ENDIF 1917 ! 1893 1918 ! 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 1919 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1897 1920 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs … … 1901 1924 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1902 1925 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)1926 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * ziceld(:,:) ) ! liquid precipitation over ocean (cell average) 1927 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 1928 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)1929 & - zevap_ice_total(:,:) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1907 1930 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1931 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff 1932 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf 1933 ! 1934 ! ! ========================= ! 1935 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt ! 1936 ! ! ========================= ! 1937 CASE ('coupled') 1938 IF (ln_scale_ice_flux) THEN 1939 WHERE( a_i(:,:,:) > 1.e-10_wp ) 1940 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1941 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1942 ELSEWHERE 1943 qml_ice(:,:,:) = 0.0_wp 1944 qcn_ice(:,:,:) = 0.0_wp 1945 END WHERE 1946 ELSE 1947 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 1948 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 1949 ENDIF 1950 END SELECT 1908 1951 ! 1909 1952 ! ! ========================= ! … … 1911 1954 ! ! ========================= ! 1912 1955 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 1956 ! Get the sea ice non solar heat flux from conductive, melting and sublimation fluxes 1957 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 1958 zqns_ice(:,:,:) = qml_ice(:,:,:) + qcn_ice(:,:,:) 1959 ELSE 1960 zqns_ice(:,:,:) = 0._wp 1961 ENDIF 1962 ! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE 1963 ! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1) 1964 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(:,:,:), dim=3 ) 1917 1965 CASE( 'conservative' ) ! the required fields are directly provided 1918 1966 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1961 2009 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting 1962 2010 1963 #if defined key_si31964 2011 ! --- non solar flux over ocean --- ! 1965 2012 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax … … 2014 2061 ENDIF 2015 2062 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 2063 !! for CICE ?? 2064 !!$ ! --- non solar flux over ocean --- ! 2065 !!$ zcptsnw (:,:) = zcptn(:,:) 2066 !!$ zcptrain(:,:) = zcptn(:,:) 2067 !!$ 2068 !!$ ! clem: this formulation is certainly wrong... but better than it was... 2069 !!$ zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 2070 !!$ & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 2071 !!$ & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 2072 !!$ & - zemp_ice(:,:) ) * zcptn(:,:) 2073 !!$ 2074 !!$ IF( ln_mixcpl ) THEN 2075 !!$ qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2076 !!$ qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 2077 !!$ DO jl=1,jpl 2078 !!$ qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 2079 !!$ ENDDO 2080 !!$ ELSE 2081 !!$ qns_tot(:,: ) = zqns_tot(:,: ) 2082 !!$ qns_ice(:,:,:) = zqns_ice(:,:,:) 2083 !!$ ENDIF 2084 2038 2085 ! outputs 2039 2086 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving … … 2053 2100 IF ( iom_use('hflx_snow_ai_cea') ) & ! heat flux from snow (over ice) 2054 2101 & CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * zsnw(:,:) ) 2102 IF( iom_use('hflx_subl_cea') ) & ! heat flux from sublimation 2103 & CALL iom_put('hflx_subl_cea' , SUM( qevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) * tmask(:,:,1) ) 2055 2104 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 2056 2105 ! 2106 ! ! ========================= ! 2107 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 2108 ! ! ========================= ! 2109 CASE ('coupled') 2110 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 2111 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 2112 ELSE 2113 ! Set all category values equal for the moment 2114 DO jl=1,jpl 2115 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 2116 ENDDO 2117 ENDIF 2118 CASE( 'none' ) 2119 zdqns_ice(:,:,:) = 0._wp 2120 END SELECT 2121 2122 IF( ln_mixcpl ) THEN 2123 DO jl=1,jpl 2124 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 2125 ENDDO 2126 ELSE 2127 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 2128 ENDIF 2057 2129 ! ! ========================= ! 2058 2130 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) … … 2060 2132 CASE( 'oce only' ) 2061 2133 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.2134 ! For the Met Office the only sea ice solar flux is the transmitted qsr which is added onto zqsr_ice 2135 ! further down. Therefore start zqsr_ice off at zero. 2064 2136 zqsr_ice(:,:,:) = 0._wp 2065 2137 CASE( 'conservative' ) … … 2114 2186 END DO 2115 2187 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 2188 ! ! ========================= ! 2181 2189 ! ! Transmitted Qsr ! [W/m2] … … 2209 2217 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2210 2218 ! 2211 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2212 ! for now just assume zero (fully opaque ice) 2219 !! SELECT CASE( TRIM( sn_rcv_qtrice%cldes ) ) 2220 !! ! 2221 !! ! ! ===> here we receive the qtr_ice_top array from the coupler 2222 !! CASE ('coupled') 2223 !! IF (ln_scale_ice_flux) THEN 2224 !! WHERE( a_i(:,:,:) > 1.e-10_wp ) 2225 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2226 !! ELSEWHERE 2227 !! zqtr_ice_top(:,:,:) = 0.0_wp 2228 !! ENDWHERE 2229 !! ELSE 2230 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) 2231 !! ENDIF 2232 !! 2233 !! ! Add retrieved transmitted solar radiation onto the ice and total solar radiation 2234 !! zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:) 2235 !! zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(:,:,:), dim=3 ) 2236 !! 2237 !! ! if we are not getting this data from the coupler then assume zero (fully opaque ice) 2238 !! CASE ('none') 2213 2239 zqtr_ice_top(:,:,:) = 0._wp 2214 ! 2215 ENDIF 2216 ! 2240 !! END SELECT 2241 ! 2242 ENDIF 2243 2217 2244 IF( ln_mixcpl ) THEN 2218 DO jl=1,jpl 2245 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2246 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:) * zmsk(:,:) 2247 DO jl = 1, jpl 2248 qsr_ice (:,:,jl) = qsr_ice (:,:,jl) * xcplmask(:,:,0) + zqsr_ice (:,:,jl) * zmsk(:,:) 2219 2249 qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:) 2220 END DO2250 END DO 2221 2251 ELSE 2252 qsr_tot (:,: ) = zqsr_tot (:,: ) 2253 qsr_ice (:,:,:) = zqsr_ice (:,:,:) 2222 2254 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2223 2255 ENDIF 2256 2257 ! --- solar flux over ocean --- ! 2258 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 2259 zqsr_oce = 0._wp 2260 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 2261 2262 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 2263 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 2264 2224 2265 ! ! ================== ! 2225 2266 ! ! ice skin temp. !
Note: See TracChangeset
for help on using the changeset viewer.