- Timestamp:
- 2017-07-11T14:05:05+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8313 r8316 54 54 55 55 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 56 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim (_2).F9056 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim.F90 57 57 PUBLIC sbc_cpl_snd ! routine called by step.F90 58 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim (_2).F9059 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim (_2).F9058 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim.F90 59 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim.F90 60 60 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 61 61 … … 500 500 ! 501 501 ! non solar sensitivity mandatory for LIM ice model 502 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4.AND. nn_components /= jp_iam_sas ) &502 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 3 .AND. nn_components /= jp_iam_sas ) & 503 503 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 504 504 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique … … 1524 1524 1525 1525 1526 SUBROUTINE sbc_cpl_ice_flx( p _frld, palbi, psst, pist )1526 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist ) 1527 1527 !!---------------------------------------------------------------------- 1528 1528 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1574 1574 !! sprecip solid precipitation over the ocean 1575 1575 !!---------------------------------------------------------------------- 1576 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! leadfraction [0 to 1]1576 REAL(wp), INTENT(in), DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1577 1577 ! optional arguments, used only in 'mixed oce-ice' case 1578 REAL(wp), INTENT(in 1579 REAL(wp), INTENT(in 1580 REAL(wp), INTENT(in 1578 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1579 REAL(wp), INTENT(in), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1580 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1581 1581 ! 1582 1582 INTEGER :: jl ! dummy loop index 1583 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, zice fr, zmsk, zsnw1583 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1584 1584 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1585 1585 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice … … 1589 1589 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1590 1590 ! 1591 CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zice fr, zmsk, zsnw )1591 CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 1592 1592 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1593 1593 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) … … 1595 1595 1596 1596 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1597 zice fr(:,:) = 1.- p_frld(:,:)1597 ziceld(:,:) = 1. - picefr(:,:) 1598 1598 zcptn(:,:) = rcp * sst_m(:,:) 1599 1599 ! … … 1611 1611 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1612 1612 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1613 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:)1613 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 1614 1614 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1615 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)1616 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:)1615 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1616 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 1617 1617 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1618 1618 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) … … 1620 1620 1621 1621 #if defined key_lim3 1622 ! zsnw = snow fraction over ice after wind blowing (= zicefr if no blowing)1623 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw )1622 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1623 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( ziceld, zsnw ) 1624 1624 1625 1625 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1626 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip1626 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1627 1627 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1628 1628 1629 1629 ! --- evaporation over ocean (used later for qemp) --- ! 1630 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)1630 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1631 1631 1632 1632 ! --- evaporation over ice (kg/m2/s) --- ! … … 1675 1675 1676 1676 #else 1677 zsnw(:,:) = zicefr(:,:)1677 zsnw(:,:) = picefr(:,:) 1678 1678 ! --- Continental fluxes --- ! 1679 1679 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) … … 1714 1714 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1715 1715 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1716 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)1716 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) 1717 1717 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1718 & - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)1718 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1719 1719 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1720 1720 ! … … 1734 1734 ENDIF 1735 1735 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1736 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1736 zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1737 1737 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1738 1738 DO jl=1,jpl … … 1741 1741 ENDDO 1742 1742 ELSE 1743 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1743 qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1744 1744 DO jl=1,jpl 1745 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1745 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1746 1746 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1747 1747 ENDDO … … 1751 1751 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1752 1752 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1753 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &1754 & + pist(:,:,1) * zicefr(:,:) ) )1753 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) & 1754 & + pist(:,:,1) * picefr(:,:) ) ) 1755 1755 END SELECT 1756 1756 ! … … 1763 1763 #if defined key_lim3 1764 1764 ! --- non solar flux over ocean --- ! 1765 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax1765 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1766 1766 zqns_oce = 0._wp 1767 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)1767 WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:) 1768 1768 1769 1769 ! Heat content per unit mass of snow (J/kg) … … 1772 1772 ENDWHERE 1773 1773 ! Heat content per unit mass of rain (J/kg) 1774 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )1774 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 1775 1775 1776 1776 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! … … 1787 1787 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus ) ! solid precip over ocean + snow melting 1788 1788 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - lfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1789 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptsnw (:,:) & ! ice evap1789 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap 1790 1790 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice 1791 1791 … … 1820 1820 ! clem: this formulation is certainly wrong... but better than it was... 1821 1821 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1822 & - ( p_frld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting1822 & - ( ziceld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting 1823 1823 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1824 1824 & - zemp_ice(:,:) ) * zcptn(:,:) 1825 1825 1826 1826 IF( ln_mixcpl ) THEN 1827 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk1827 qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1828 1828 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1829 1829 DO jl=1,jpl … … 1841 1841 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1842 1842 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1843 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) & ! heat flux from from evap (cell average)1843 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) & ! heat flux from from evap (cell average) 1844 1844 & ) * zcptn(:,:) * tmask(:,:,1) ) 1845 1845 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (over ocean) … … 1865 1865 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1866 1866 CASE( 'oce and ice' ) 1867 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1867 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1868 1868 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1869 1869 DO jl=1,jpl … … 1872 1872 ENDDO 1873 1873 ELSE 1874 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1874 qsr_tot(:,: ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1875 1875 DO jl=1,jpl 1876 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1876 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1877 1877 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1878 1878 ENDDO … … 1884 1884 ! ( see OASIS3 user guide, 5th edition, p39 ) 1885 1885 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1886 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) &1887 & + palbi (:,:,1) * zicefr(:,:) ) )1886 & / ( 1.- ( albedo_oce_mix(:,: ) * ziceld(:,:) & 1887 & + palbi (:,:,1) * picefr(:,:) ) ) 1888 1888 END SELECT 1889 1889 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle … … 1896 1896 #if defined key_lim3 1897 1897 ! --- solar flux over ocean --- ! 1898 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax1898 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1899 1899 zqsr_oce = 0._wp 1900 WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)1900 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 1901 1901 1902 1902 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) … … 1905 1905 1906 1906 IF( ln_mixcpl ) THEN 1907 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk1907 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1908 1908 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1909 1909 DO jl=1,jpl … … 1952 1952 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1953 1953 1954 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zice fr, zmsk, zsnw )1954 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 1955 1955 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1956 1956 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
Note: See TracChangeset
for help on using the changeset viewer.
