- Timestamp:
- 2016-04-27T16:01:22+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6488 r6498 1594 1594 ! 1595 1595 INTEGER :: jl ! dummy loop index 1596 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1597 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, z sprecip, ztprecip, zqns_tot, zqsr_tot1598 REAL(wp), POINTER, DIMENSION(:,: ,:) :: zqns_ice, zqsr_ice, zdqns_ice1599 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM31596 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1597 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice 1598 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1599 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1600 1600 !!---------------------------------------------------------------------- 1601 1601 ! 1602 1602 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1603 1603 ! 1604 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1605 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1604 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1605 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 1606 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1607 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1606 1608 1607 1609 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1666 1668 END SELECT 1667 1669 1668 IF( iom_use('subl_ai_cea') ) & 1669 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1670 ! 1671 ! ! runoffs and calving (put in emp_tot) 1670 #if defined key_lim3 1671 ! zsnw = snow percentage over ice after wind blowing 1672 zsnw(:,:) = 0._wp 1673 CALL lim_thd_snwblow( p_frld, zsnw ) 1674 1675 ! --- evaporation (kg/m2/s) --- ! 1676 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1677 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 1678 ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm. 1679 zdevap_ice(:,:) = 0._wp 1680 1681 ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 1682 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 1683 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw) 1684 1685 ! Sublimation over sea-ice (cell average) 1686 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) 1687 ! runoffs and calving (put in emp_tot) 1688 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1689 IF( srcv(jpr_cal)%laction ) THEN 1690 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1691 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1692 ENDIF 1693 1694 IF( ln_mixcpl ) THEN 1695 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1696 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1697 emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:) 1698 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1699 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1700 DO jl=1,jpl 1701 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 1702 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1703 ENDDO 1704 ELSE 1705 emp_tot(:,:) = zemp_tot(:,:) 1706 emp_ice(:,:) = zemp_ice(:,:) 1707 emp_oce(:,:) = zemp_oce(:,:) 1708 sprecip(:,:) = zsprecip(:,:) 1709 tprecip(:,:) = ztprecip(:,:) 1710 DO jl=1,jpl 1711 evap_ice (:,:,jl) = zevap_ice (:,:) 1712 devap_ice(:,:,jl) = zdevap_ice(:,:) 1713 ENDDO 1714 ENDIF 1715 1716 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1717 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) ) ! Snow over ice-free ocean (cell average) 1718 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw ) ! Snow over sea-ice (cell average) 1719 #else 1720 ! Sublimation over sea-ice (cell average) 1721 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) 1722 ! runoffs and calving (put in emp_tot) 1672 1723 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1673 1724 IF( srcv(jpr_cal)%laction ) THEN … … 1693 1744 IF( iom_use('snow_ai_cea') ) & 1694 1745 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1746 #endif 1695 1747 1696 1748 ! ! ========================= ! … … 1748 1800 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1749 1801 1750 #if defined key_lim3 1751 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1752 1802 #if defined key_lim3 1753 1803 ! --- evaporation --- ! 1754 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation1755 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice1756 ! but it is incoherent WITH the ice model1757 DO jl=1,jpl1758 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1)1759 ENDDO1760 1804 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1761 1762 ! --- evaporation minus precipitation --- !1763 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:)1764 1805 1765 1806 ! --- non solar flux over ocean --- ! … … 1768 1809 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1769 1810 1770 ! --- heat flux associated with emp --- ! 1771 zsnw(:,:) = 0._wp 1772 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing 1811 ! --- heat flux associated with emp (W/m2) --- ! 1773 1812 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap 1774 1813 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1775 1814 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1776 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1777 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1778 1815 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1816 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1817 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1818 ! qevap_ice=0 since we consider Tice=0°C 1819 1779 1820 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1780 1821 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1781 1822 1782 ! --- total non solar flux --- ! 1783 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1823 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1824 DO jl = 1, jpl 1825 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0°C 1826 END DO 1827 1828 ! --- total non solar flux (including evap/precip) --- ! 1829 zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 1784 1830 1785 1831 ! --- in case both coupled/forced are active, we must mix values --- ! … … 1788 1834 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1789 1835 DO jl=1,jpl 1790 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1836 qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:) 1837 qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:) 1791 1838 ENDDO 1792 1839 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1793 1840 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1794 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)1841 qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:) 1795 1842 ELSE 1796 1843 qns_tot (:,: ) = zqns_tot (:,: ) 1797 1844 qns_oce (:,: ) = zqns_oce (:,: ) 1798 1845 qns_ice (:,:,:) = zqns_ice (:,:,:) 1799 q prec_ice(:,:) = zqprec_ice(:,:)1800 q emp_oce (:,:) = zqemp_oce (:,:)1801 ENDIF1802 1803 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )1846 qevap_ice(:,:,:) = zqevap_ice(:,:,:) 1847 qprec_ice(:,: ) = zqprec_ice(:,: ) 1848 qemp_oce (:,: ) = zqemp_oce (:,: ) 1849 qemp_ice (:,: ) = zqemp_ice (:,: ) 1850 ENDIF 1804 1851 #else 1805 1806 1852 ! clem: this formulation is certainly wrong... but better than it was... 1807 1853 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: … … 1820 1866 qns_ice(:,:,:) = zqns_ice(:,:,:) 1821 1867 ENDIF 1822 1823 1868 #endif 1824 1869 … … 1871 1916 1872 1917 #if defined key_lim3 1873 CALL wrk_alloc( jpi,jpj, zqsr_oce )1874 1918 ! --- solar flux over ocean --- ! 1875 1919 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1879 1923 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 1880 1924 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 1881 1882 CALL wrk_dealloc( jpi,jpj, zqsr_oce )1883 1925 #endif 1884 1926 … … 1931 1973 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1932 1974 1933 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1934 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1975 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1976 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 1977 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1978 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1935 1979 ! 1936 1980 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')
Note: See TracChangeset
for help on using the changeset viewer.
