Changeset 2753
- Timestamp:
- Jan 16, 2018 2:16:49 PM (7 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 3 edited
-
flow_statistics.f90 (modified) (4 diffs)
-
radiation_model_mod.f90 (modified) (16 diffs)
-
surface_mod.f90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/flow_statistics.f90
r2718 r2753 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Tile approach for spectral albedo implemented. 28 ! 29 ! 2718 2018-01-02 08:49:38Z maronga 27 30 ! Corrected "Former revisions" section 28 31 ! … … 1165 1168 m = surf_def_h(0)%start_index(j,i) 1166 1169 sums_l(nzb,108,tn) = sums_l(nzb,108,tn) + & 1167 surf_def_h(0)%rrtm_aldif(m) * rmask(j,i,sr)1170 surf_def_h(0)%rrtm_aldif(0,m) * rmask(j,i,sr) 1168 1171 sums_l(nzb,109,tn) = sums_l(nzb,109,tn) + & 1169 surf_def_h(0)%rrtm_aldir(m) * rmask(j,i,sr)1172 surf_def_h(0)%rrtm_aldir(0,m) * rmask(j,i,sr) 1170 1173 sums_l(nzb,110,tn) = sums_l(nzb,110,tn) + & 1171 surf_def_h(0)%rrtm_asdif(m) * rmask(j,i,sr)1174 surf_def_h(0)%rrtm_asdif(0,m) * rmask(j,i,sr) 1172 1175 sums_l(nzb,111,tn) = sums_l(nzb,111,tn) + & 1173 surf_def_h(0)%rrtm_asdir(m) * rmask(j,i,sr)1176 surf_def_h(0)%rrtm_asdir(0,m) * rmask(j,i,sr) 1174 1177 ENDIF 1175 1178 IF ( surf_lsm_h%end_index(j,i) >= & … … 1177 1180 m = surf_lsm_h%start_index(j,i) 1178 1181 sums_l(nzb,108,tn) = sums_l(nzb,108,tn) + & 1179 surf_lsm_h%rrtm_aldif(m) * rmask(j,i,sr) 1182 SUM( surf_lsm_h%frac(:,m) * & 1183 surf_lsm_h%rrtm_aldif(:,m) ) * rmask(j,i,sr) 1180 1184 sums_l(nzb,109,tn) = sums_l(nzb,109,tn) + & 1181 surf_lsm_h%rrtm_aldir(m) * rmask(j,i,sr) 1185 SUM( surf_lsm_h%frac(:,m) * & 1186 surf_lsm_h%rrtm_aldir(:,m) ) * rmask(j,i,sr) 1182 1187 sums_l(nzb,110,tn) = sums_l(nzb,110,tn) + & 1183 surf_lsm_h%rrtm_asdif(m) * rmask(j,i,sr) 1188 SUM( surf_lsm_h%frac(:,m) * & 1189 surf_lsm_h%rrtm_asdif(:,m) ) * rmask(j,i,sr) 1184 1190 sums_l(nzb,111,tn) = sums_l(nzb,111,tn) + & 1185 surf_lsm_h%rrtm_asdir(m) * rmask(j,i,sr) 1191 SUM( surf_lsm_h%frac(:,m) * & 1192 surf_lsm_h%rrtm_asdir(:,m) ) * rmask(j,i,sr) 1186 1193 ENDIF 1187 1194 IF ( surf_usm_h%end_index(j,i) >= & … … 1189 1196 m = surf_usm_h%start_index(j,i) 1190 1197 sums_l(nzb,108,tn) = sums_l(nzb,108,tn) + & 1191 surf_usm_h%rrtm_aldif(m) * rmask(j,i,sr) 1198 SUM( surf_usm_h%frac(:,m) * & 1199 surf_usm_h%rrtm_aldif(:,m) ) * rmask(j,i,sr) 1192 1200 sums_l(nzb,109,tn) = sums_l(nzb,109,tn) + & 1193 surf_usm_h%rrtm_aldir(m) * rmask(j,i,sr) 1201 SUM( surf_usm_h%frac(:,m) * & 1202 surf_usm_h%rrtm_aldir(:,m) ) * rmask(j,i,sr) 1194 1203 sums_l(nzb,110,tn) = sums_l(nzb,110,tn) + & 1195 surf_usm_h%rrtm_asdif(m) * rmask(j,i,sr) 1204 SUM( surf_usm_h%frac(:,m) * & 1205 surf_usm_h%rrtm_asdif(:,m) ) * rmask(j,i,sr) 1196 1206 sums_l(nzb,111,tn) = sums_l(nzb,111,tn) + & 1197 surf_usm_h%rrtm_asdir(m) * rmask(j,i,sr) 1207 SUM( surf_usm_h%frac(:,m) * & 1208 surf_usm_h%rrtm_asdir(:,m) ) * rmask(j,i,sr) 1198 1209 ENDIF 1199 1210 -
palm/trunk/SOURCE/radiation_model_mod.f90
r2746 r2753 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Tile approach for spectral albedo implemented. 28 ! 29 ! 2746 2018-01-15 12:06:04Z suehring 27 30 ! Move flag plant canopy to modules 28 31 ! … … 1245 1248 1246 1249 INTEGER(iwp) :: i !< running index x-direction 1247 INTEGER(iwp) :: ind_type !< index of natural land-surface type with respect to albedo array1250 INTEGER(iwp) :: ind_type !< running index for subgrid-surface tiles 1248 1251 INTEGER(iwp) :: ioff !< offset in x between surface element reference grid point in atmosphere and actual surface 1249 1252 INTEGER(iwp) :: j !< running index y-direction … … 1669 1672 #if defined ( __rrtmg ) 1670 1673 ! 1671 !-- Allocate albedos for short/longwave radiation, horizontal surfaces. 1672 ALLOCATE ( surf_def_h(0)%aldif(1:surf_def_h(0)%ns) ) 1673 ALLOCATE ( surf_def_h(0)%aldir(1:surf_def_h(0)%ns) ) 1674 ALLOCATE ( surf_def_h(0)%asdif(1:surf_def_h(0)%ns) ) 1675 ALLOCATE ( surf_def_h(0)%asdir(1:surf_def_h(0)%ns) ) 1676 ALLOCATE ( surf_def_h(0)%rrtm_aldif(1:surf_def_h(0)%ns) ) 1677 ALLOCATE ( surf_def_h(0)%rrtm_aldir(1:surf_def_h(0)%ns) ) 1678 ALLOCATE ( surf_def_h(0)%rrtm_asdif(1:surf_def_h(0)%ns) ) 1679 ALLOCATE ( surf_def_h(0)%rrtm_asdir(1:surf_def_h(0)%ns) ) 1680 1681 ALLOCATE ( surf_lsm_h%aldif(1:surf_lsm_h%ns) ) 1682 ALLOCATE ( surf_lsm_h%aldir(1:surf_lsm_h%ns) ) 1683 ALLOCATE ( surf_lsm_h%asdif(1:surf_lsm_h%ns) ) 1684 ALLOCATE ( surf_lsm_h%asdir(1:surf_lsm_h%ns) ) 1685 ALLOCATE ( surf_lsm_h%rrtm_aldif(1:surf_lsm_h%ns) ) 1686 ALLOCATE ( surf_lsm_h%rrtm_aldir(1:surf_lsm_h%ns) ) 1687 ALLOCATE ( surf_lsm_h%rrtm_asdif(1:surf_lsm_h%ns) ) 1688 ALLOCATE ( surf_lsm_h%rrtm_asdir(1:surf_lsm_h%ns) ) 1689 1690 ALLOCATE ( surf_usm_h%aldif(1:surf_usm_h%ns) ) 1691 ALLOCATE ( surf_usm_h%aldir(1:surf_usm_h%ns) ) 1692 ALLOCATE ( surf_usm_h%asdif(1:surf_usm_h%ns) ) 1693 ALLOCATE ( surf_usm_h%asdir(1:surf_usm_h%ns) ) 1694 ALLOCATE ( surf_usm_h%rrtm_aldif(1:surf_usm_h%ns) ) 1695 ALLOCATE ( surf_usm_h%rrtm_aldir(1:surf_usm_h%ns) ) 1696 ALLOCATE ( surf_usm_h%rrtm_asdif(1:surf_usm_h%ns) ) 1697 ALLOCATE ( surf_usm_h%rrtm_asdir(1:surf_usm_h%ns) ) 1674 !-- Allocate albedos for short/longwave radiation, horizontal surfaces 1675 !-- for wall/green/window (USM) or vegetation/pavement/water surfaces 1676 !-- (LSM). Please note, for default-type surfaces no tile approach is 1677 !-- applied. 1678 ALLOCATE ( surf_def_h(0)%aldif(0:0,1:surf_def_h(0)%ns) ) 1679 ALLOCATE ( surf_def_h(0)%aldir(0:0,1:surf_def_h(0)%ns) ) 1680 ALLOCATE ( surf_def_h(0)%asdif(0:0,1:surf_def_h(0)%ns) ) 1681 ALLOCATE ( surf_def_h(0)%asdir(0:0,1:surf_def_h(0)%ns) ) 1682 ALLOCATE ( surf_def_h(0)%rrtm_aldif(0:0,1:surf_def_h(0)%ns) ) 1683 ALLOCATE ( surf_def_h(0)%rrtm_aldir(0:0,1:surf_def_h(0)%ns) ) 1684 ALLOCATE ( surf_def_h(0)%rrtm_asdif(0:0,1:surf_def_h(0)%ns) ) 1685 ALLOCATE ( surf_def_h(0)%rrtm_asdir(0:0,1:surf_def_h(0)%ns) ) 1686 1687 ALLOCATE ( surf_lsm_h%aldif(0:2,1:surf_lsm_h%ns) ) 1688 ALLOCATE ( surf_lsm_h%aldir(0:2,1:surf_lsm_h%ns) ) 1689 ALLOCATE ( surf_lsm_h%asdif(0:2,1:surf_lsm_h%ns) ) 1690 ALLOCATE ( surf_lsm_h%asdir(0:2,1:surf_lsm_h%ns) ) 1691 ALLOCATE ( surf_lsm_h%rrtm_aldif(0:2,1:surf_lsm_h%ns) ) 1692 ALLOCATE ( surf_lsm_h%rrtm_aldir(0:2,1:surf_lsm_h%ns) ) 1693 ALLOCATE ( surf_lsm_h%rrtm_asdif(0:2,1:surf_lsm_h%ns) ) 1694 ALLOCATE ( surf_lsm_h%rrtm_asdir(0:2,1:surf_lsm_h%ns) ) 1695 1696 ALLOCATE ( surf_usm_h%aldif(0:2,1:surf_usm_h%ns) ) 1697 ALLOCATE ( surf_usm_h%aldir(0:2,1:surf_usm_h%ns) ) 1698 ALLOCATE ( surf_usm_h%asdif(0:2,1:surf_usm_h%ns) ) 1699 ALLOCATE ( surf_usm_h%asdir(0:2,1:surf_usm_h%ns) ) 1700 ALLOCATE ( surf_usm_h%rrtm_aldif(0:2,1:surf_usm_h%ns) ) 1701 ALLOCATE ( surf_usm_h%rrtm_aldir(0:2,1:surf_usm_h%ns) ) 1702 ALLOCATE ( surf_usm_h%rrtm_asdif(0:2,1:surf_usm_h%ns) ) 1703 ALLOCATE ( surf_usm_h%rrtm_asdir(0:2,1:surf_usm_h%ns) ) 1698 1704 1699 1705 ! … … 1710 1716 !-- Allocate albedos for short/longwave radiation, vertical surfaces 1711 1717 DO l = 0, 3 1712 ALLOCATE ( surf_def_v(l)%aldif( 1:surf_def_v(l)%ns) )1713 ALLOCATE ( surf_def_v(l)%aldir( 1:surf_def_v(l)%ns) )1714 ALLOCATE ( surf_def_v(l)%asdif( 1:surf_def_v(l)%ns) )1715 ALLOCATE ( surf_def_v(l)%asdir( 1:surf_def_v(l)%ns) )1716 1717 ALLOCATE ( surf_def_v(l)%rrtm_aldif( 1:surf_def_v(l)%ns) )1718 ALLOCATE ( surf_def_v(l)%rrtm_aldir( 1:surf_def_v(l)%ns) )1719 ALLOCATE ( surf_def_v(l)%rrtm_asdif( 1:surf_def_v(l)%ns) )1720 ALLOCATE ( surf_def_v(l)%rrtm_asdir( 1:surf_def_v(l)%ns) )1721 1722 ALLOCATE ( surf_lsm_v(l)%aldif( 1:surf_lsm_v(l)%ns) )1723 ALLOCATE ( surf_lsm_v(l)%aldir( 1:surf_lsm_v(l)%ns) )1724 ALLOCATE ( surf_lsm_v(l)%asdif( 1:surf_lsm_v(l)%ns) )1725 ALLOCATE ( surf_lsm_v(l)%asdir( 1:surf_lsm_v(l)%ns) )1726 1727 ALLOCATE ( surf_lsm_v(l)%rrtm_aldif( 1:surf_lsm_v(l)%ns) )1728 ALLOCATE ( surf_lsm_v(l)%rrtm_aldir( 1:surf_lsm_v(l)%ns) )1729 ALLOCATE ( surf_lsm_v(l)%rrtm_asdif( 1:surf_lsm_v(l)%ns) )1730 ALLOCATE ( surf_lsm_v(l)%rrtm_asdir( 1:surf_lsm_v(l)%ns) )1731 1732 ALLOCATE ( surf_usm_v(l)%aldif( 1:surf_usm_v(l)%ns) )1733 ALLOCATE ( surf_usm_v(l)%aldir( 1:surf_usm_v(l)%ns) )1734 ALLOCATE ( surf_usm_v(l)%asdif( 1:surf_usm_v(l)%ns) )1735 ALLOCATE ( surf_usm_v(l)%asdir( 1:surf_usm_v(l)%ns) )1736 1737 ALLOCATE ( surf_usm_v(l)%rrtm_aldif( 1:surf_usm_v(l)%ns) )1738 ALLOCATE ( surf_usm_v(l)%rrtm_aldir( 1:surf_usm_v(l)%ns) )1739 ALLOCATE ( surf_usm_v(l)%rrtm_asdif( 1:surf_usm_v(l)%ns) )1740 ALLOCATE ( surf_usm_v(l)%rrtm_asdir( 1:surf_usm_v(l)%ns) )1718 ALLOCATE ( surf_def_v(l)%aldif(0:0,1:surf_def_v(l)%ns) ) 1719 ALLOCATE ( surf_def_v(l)%aldir(0:0,1:surf_def_v(l)%ns) ) 1720 ALLOCATE ( surf_def_v(l)%asdif(0:0,1:surf_def_v(l)%ns) ) 1721 ALLOCATE ( surf_def_v(l)%asdir(0:0,1:surf_def_v(l)%ns) ) 1722 1723 ALLOCATE ( surf_def_v(l)%rrtm_aldif(0:0,1:surf_def_v(l)%ns) ) 1724 ALLOCATE ( surf_def_v(l)%rrtm_aldir(0:0,1:surf_def_v(l)%ns) ) 1725 ALLOCATE ( surf_def_v(l)%rrtm_asdif(0:0,1:surf_def_v(l)%ns) ) 1726 ALLOCATE ( surf_def_v(l)%rrtm_asdir(0:0,1:surf_def_v(l)%ns) ) 1727 1728 ALLOCATE ( surf_lsm_v(l)%aldif(0:2,1:surf_lsm_v(l)%ns) ) 1729 ALLOCATE ( surf_lsm_v(l)%aldir(0:2,1:surf_lsm_v(l)%ns) ) 1730 ALLOCATE ( surf_lsm_v(l)%asdif(0:2,1:surf_lsm_v(l)%ns) ) 1731 ALLOCATE ( surf_lsm_v(l)%asdir(0:2,1:surf_lsm_v(l)%ns) ) 1732 1733 ALLOCATE ( surf_lsm_v(l)%rrtm_aldif(0:2,1:surf_lsm_v(l)%ns) ) 1734 ALLOCATE ( surf_lsm_v(l)%rrtm_aldir(0:2,1:surf_lsm_v(l)%ns) ) 1735 ALLOCATE ( surf_lsm_v(l)%rrtm_asdif(0:2,1:surf_lsm_v(l)%ns) ) 1736 ALLOCATE ( surf_lsm_v(l)%rrtm_asdir(0:2,1:surf_lsm_v(l)%ns) ) 1737 1738 ALLOCATE ( surf_usm_v(l)%aldif(0:2,1:surf_usm_v(l)%ns) ) 1739 ALLOCATE ( surf_usm_v(l)%aldir(0:2,1:surf_usm_v(l)%ns) ) 1740 ALLOCATE ( surf_usm_v(l)%asdif(0:2,1:surf_usm_v(l)%ns) ) 1741 ALLOCATE ( surf_usm_v(l)%asdir(0:2,1:surf_usm_v(l)%ns) ) 1742 1743 ALLOCATE ( surf_usm_v(l)%rrtm_aldif(0:2,1:surf_usm_v(l)%ns) ) 1744 ALLOCATE ( surf_usm_v(l)%rrtm_aldir(0:2,1:surf_usm_v(l)%ns) ) 1745 ALLOCATE ( surf_usm_v(l)%rrtm_asdif(0:2,1:surf_usm_v(l)%ns) ) 1746 ALLOCATE ( surf_usm_v(l)%rrtm_asdir(0:2,1:surf_usm_v(l)%ns) ) 1741 1747 ! 1742 1748 !-- Allocate broadband albedo (temporary for the current radiation 1743 1749 !-- implementations) 1744 1750 IF ( .NOT. ALLOCATED( surf_def_v(l)%albedo ) ) & 1745 ALLOCATE( surf_def_v(l)%albedo(0 ,1:surf_def_v(l)%ns) )1751 ALLOCATE( surf_def_v(l)%albedo(0:0,1:surf_def_v(l)%ns) ) 1746 1752 IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) ) & 1747 1753 ALLOCATE( surf_lsm_v(l)%albedo(0:2,1:surf_lsm_v(l)%ns) ) … … 1752 1758 ! 1753 1759 !-- Level 1 initialization of spectral albedos via namelist 1754 !-- paramters 1760 !-- paramters. Please note, this case all surface tiles are initialized 1761 !-- the same. 1755 1762 IF ( surf_def_h(0)%ns > 0 ) THEN 1756 1763 surf_def_h(0)%aldif = albedo_lw_dif … … 1803 1810 ! 1804 1811 !-- Level 2 initialization of spectral albedos via albedo_type. 1805 !-- Only diffusive albedos (why?) 1812 !-- Please note, for natural- and urban-type surfaces, a tile approach 1813 !-- is applied so that the resulting albedo is calculated via the weighted 1814 !-- average of respective surface fractions. 1806 1815 DO m = 1, surf_def_h(0)%ns 1807 1816 IF ( surf_def_h(0)%albedo_type(0,m) /= 0 ) THEN 1808 surf_def_h(0)%aldif( m) =&1817 surf_def_h(0)%aldif(0,m) = & 1809 1818 albedo_pars(0,surf_def_h(0)%albedo_type(0,m)) 1810 surf_def_h(0)%asdif( m) =&1819 surf_def_h(0)%asdif(0,m) = & 1811 1820 albedo_pars(1,surf_def_h(0)%albedo_type(0,m)) 1812 surf_def_h(0)%aldir( m) =&1821 surf_def_h(0)%aldir(0,m) = & 1813 1822 albedo_pars(0,surf_def_h(0)%albedo_type(0,m)) 1814 surf_def_h(0)%asdir( m) =&1823 surf_def_h(0)%asdir(0,m) = & 1815 1824 albedo_pars(1,surf_def_h(0)%albedo_type(0,m)) 1816 1825 surf_def_h(0)%albedo(0,m) = & … … 1818 1827 ENDIF 1819 1828 ENDDO 1829 1820 1830 DO m = 1, surf_lsm_h%ns 1821 1831 ! 1822 !-- Determine surface type 1823 IF ( surf_lsm_h%vegetation_surface(m) ) ind_type = 0 1824 IF ( surf_lsm_h%pavement_surface(m) ) ind_type = 1 1825 IF ( surf_lsm_h%water_surface(m) ) ind_type = 2 1826 1827 IF ( surf_lsm_h%albedo_type(ind_type,m) /= 0 ) THEN 1828 surf_lsm_h%aldif(m) = & 1832 !-- Spectral albedos for vegetation/pavement/water surfaces 1833 DO ind_type = 0, 2 1834 IF ( surf_lsm_h%albedo_type(ind_type,m) /= 0 ) THEN 1835 surf_lsm_h%aldif(ind_type,m) = & 1829 1836 albedo_pars(0,surf_lsm_h%albedo_type(ind_type,m)) 1830 surf_lsm_h%asdif(m) =&1837 surf_lsm_h%asdif(ind_type,m) = & 1831 1838 albedo_pars(1,surf_lsm_h%albedo_type(ind_type,m)) 1832 surf_lsm_h%aldir(m) =&1839 surf_lsm_h%aldir(ind_type,m) = & 1833 1840 albedo_pars(0,surf_lsm_h%albedo_type(ind_type,m)) 1834 surf_lsm_h%asdir(m) =&1841 surf_lsm_h%asdir(ind_type,m) = & 1835 1842 albedo_pars(1,surf_lsm_h%albedo_type(ind_type,m)) 1836 surf_lsm_h%albedo(:,m) =&1843 surf_lsm_h%albedo(ind_type,m) = & 1837 1844 albedo_pars(2,surf_lsm_h%albedo_type(ind_type,m)) 1838 ENDIF 1845 ENDIF 1846 ENDDO 1839 1847 1840 1848 ENDDO … … 1842 1850 DO m = 1, surf_usm_h%ns 1843 1851 ! 1844 !-- Initialize spectral albedos for urban-type surfaces. Please note, 1845 !-- for urban surfaces a tile approach is applied, so that the 1846 !-- resulting albedo should be calculated via the weighted average of 1847 !-- respective surface fractions. However, for the moment the albedo 1848 !-- is set to the wall-surface value. 1849 IF ( surf_usm_h%albedo_type(0,m) /= 0 ) THEN 1850 surf_usm_h%aldif(m) = & 1851 albedo_pars(0,surf_usm_h%albedo_type(0,m)) 1852 surf_usm_h%asdif(m) = & 1853 albedo_pars(1,surf_usm_h%albedo_type(0,m)) 1854 surf_usm_h%aldir(m) = & 1855 albedo_pars(0,surf_usm_h%albedo_type(0,m)) 1856 surf_usm_h%asdir(m) = & 1857 albedo_pars(1,surf_usm_h%albedo_type(0,m)) 1858 surf_usm_h%albedo(:,m) = & 1859 albedo_pars(2,surf_usm_h%albedo_type(0,m)) 1860 ENDIF 1852 !-- Spectral albedos for wall/green/window surfaces 1853 DO ind_type = 0, 2 1854 IF ( surf_usm_h%albedo_type(ind_type,m) /= 0 ) THEN 1855 surf_usm_h%aldif(ind_type,m) = & 1856 albedo_pars(0,surf_usm_h%albedo_type(ind_type,m)) 1857 surf_usm_h%asdif(ind_type,m) = & 1858 albedo_pars(1,surf_usm_h%albedo_type(ind_type,m)) 1859 surf_usm_h%aldir(ind_type,m) = & 1860 albedo_pars(0,surf_usm_h%albedo_type(ind_type,m)) 1861 surf_usm_h%asdir(ind_type,m) = & 1862 albedo_pars(1,surf_usm_h%albedo_type(ind_type,m)) 1863 surf_usm_h%albedo(ind_type,m) = & 1864 albedo_pars(2,surf_usm_h%albedo_type(ind_type,m)) 1865 ENDIF 1866 ENDDO 1867 1861 1868 ENDDO 1862 1869 1863 1870 DO l = 0, 3 1871 1864 1872 DO m = 1, surf_def_v(l)%ns 1865 1873 IF ( surf_def_v(l)%albedo_type(0,m) /= 0 ) THEN 1866 surf_def_v(l)%aldif( m) =&1874 surf_def_v(l)%aldif(0,m) = & 1867 1875 albedo_pars(0,surf_def_v(l)%albedo_type(0,m)) 1868 surf_def_v(l)%asdif( m) =&1876 surf_def_v(l)%asdif(0,m) = & 1869 1877 albedo_pars(1,surf_def_v(l)%albedo_type(0,m)) 1870 surf_def_v(l)%aldir( m) =&1878 surf_def_v(l)%aldir(0,m) = & 1871 1879 albedo_pars(0,surf_def_v(l)%albedo_type(0,m)) 1872 surf_def_v(l)%asdir( m) =&1880 surf_def_v(l)%asdir(0,m) = & 1873 1881 albedo_pars(1,surf_def_v(l)%albedo_type(0,m)) 1874 surf_def_v(l)%albedo( :,m) = &1882 surf_def_v(l)%albedo(0,m) = & 1875 1883 albedo_pars(2,surf_def_v(l)%albedo_type(0,m)) 1876 1884 ENDIF 1877 1885 ENDDO 1886 1878 1887 DO m = 1, surf_lsm_v(l)%ns 1879 IF ( surf_lsm_v(l)%vegetation_surface(m) ) ind_type = 0 1880 IF ( surf_lsm_v(l)%pavement_surface(m) ) ind_type = 1 1881 IF ( surf_lsm_v(l)%water_surface(m) ) ind_type = 2 1882 1883 IF ( surf_lsm_v(l)%albedo_type(0,m) /= 0 ) THEN 1884 surf_lsm_v(l)%aldif(m) = & 1888 ! 1889 !-- Spectral albedos for vegetation/pavement/water surfaces 1890 DO ind_type = 0, 2 1891 IF ( surf_lsm_v(l)%albedo_type(ind_type,m) /= 0 ) THEN 1892 surf_lsm_v(l)%aldif(ind_type,m) = & 1885 1893 albedo_pars(0,surf_lsm_v(l)%albedo_type(ind_type,m)) 1886 surf_lsm_v(l)%asdif(m) =&1894 surf_lsm_v(l)%asdif(ind_type,m) = & 1887 1895 albedo_pars(1,surf_lsm_v(l)%albedo_type(ind_type,m)) 1888 surf_lsm_v(l)%aldir(m) =&1896 surf_lsm_v(l)%aldir(ind_type,m) = & 1889 1897 albedo_pars(0,surf_lsm_v(l)%albedo_type(ind_type,m)) 1890 surf_lsm_v(l)%asdir(m) =&1898 surf_lsm_v(l)%asdir(ind_type,m) = & 1891 1899 albedo_pars(1,surf_lsm_v(l)%albedo_type(ind_type,m)) 1892 surf_lsm_v(l)%albedo(:,m) =&1900 surf_lsm_v(l)%albedo(ind_type,m) = & 1893 1901 albedo_pars(2,surf_lsm_v(l)%albedo_type(ind_type,m)) 1894 ENDIF1895 ENDDO1896 1897 DO m = 1, surf_usm_v(l)%ns 1898 ! 1899 ! -- Initialize spectral albedos for urban-type surfaces. Please note,1900 !-- for urban surfaces a tile approach is applied, so that the1901 !-- resulting albedo should be calculated via the weighted average of 1902 !-- respective surface fractions. However, for the moment the albedo 1903 !-- is set to the wall-surface value. 1904 IF ( surf_usm_v(l)%albedo_type(0,m) /= 0 ) THEN1905 surf_usm_v(l)%aldif(m) =&1906 albedo_pars(0,surf_usm_v(l)%albedo_type(0,m))1907 surf_usm_v(l)%asdif(m) =&1908 albedo_pars(1,surf_usm_v(l)%albedo_type(0,m))1909 surf_usm_v(l)%aldir(m) =&1910 albedo_pars(0,surf_usm_v(l)%albedo_type(0,m))1911 surf_usm_v(l)%asdir(m) =&1912 albedo_pars(1,surf_usm_v(l)%albedo_type(0,m))1913 surf_usm_v(l)%albedo(:,m) = &1914 albedo_pars(2,surf_usm_v(l)%albedo_type(0,m))1915 ENDIF 1916 ENDDO1902 ENDIF 1903 ENDDO 1904 ENDDO 1905 1906 DO m = 1, surf_usm_v(l)%ns 1907 ! 1908 !-- Spectral albedos for wall/green/window surfaces 1909 DO ind_type = 0, 2 1910 IF ( surf_usm_v(l)%albedo_type(ind_type,m) /= 0 ) THEN 1911 surf_usm_v(l)%aldif(ind_type,m) = & 1912 albedo_pars(0,surf_usm_v(l)%albedo_type(ind_type,m)) 1913 surf_usm_v(l)%asdif(ind_type,m) = & 1914 albedo_pars(1,surf_usm_v(l)%albedo_type(ind_type,m)) 1915 surf_usm_v(l)%aldir(ind_type,m) = & 1916 albedo_pars(0,surf_usm_v(l)%albedo_type(ind_type,m)) 1917 surf_usm_v(l)%asdir(ind_type,m) = & 1918 albedo_pars(1,surf_usm_v(l)%albedo_type(ind_type,m)) 1919 surf_usm_v(l)%albedo(ind_type,m) = & 1920 albedo_pars(2,surf_usm_v(l)%albedo_type(ind_type,m)) 1921 ENDIF 1922 ENDDO 1923 1924 ENDDO 1917 1925 ENDDO 1918 1926 ! … … 1930 1938 surf_def_h(0)%albedo(0,m) = albedo_pars_f%pars_xy(1,j,i) 1931 1939 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 1932 surf_def_h(0)%aldir( m) = albedo_pars_f%pars_xy(1,j,i)1940 surf_def_h(0)%aldir(0,m) = albedo_pars_f%pars_xy(1,j,i) 1933 1941 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 1934 surf_def_h(0)%aldif( m) = albedo_pars_f%pars_xy(2,j,i)1942 surf_def_h(0)%aldif(0,m) = albedo_pars_f%pars_xy(2,j,i) 1935 1943 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill ) & 1936 surf_def_h(0)%asdir( m) = albedo_pars_f%pars_xy(3,j,i)1944 surf_def_h(0)%asdir(0,m) = albedo_pars_f%pars_xy(3,j,i) 1937 1945 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill ) & 1938 surf_def_h(0)%asdif( m) = albedo_pars_f%pars_xy(4,j,i)1946 surf_def_h(0)%asdif(0,m) = albedo_pars_f%pars_xy(4,j,i) 1939 1947 ENDIF 1940 1948 ENDDO … … 1943 1951 i = surf_lsm_h%i(m) 1944 1952 j = surf_lsm_h%j(m) 1945 1946 IF ( surf_lsm_h%vegetation_surface(m) ) ind_type = 0 1947 IF ( surf_lsm_h%pavement_surface(m) ) ind_type = 1 1948 IF ( surf_lsm_h%water_surface(m) ) ind_type = 2 1949 1950 IF ( surf_lsm_h%albedo_type(ind_type,m) == 0 ) THEN 1951 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 1952 surf_lsm_h%albedo(ind_type,m) = albedo_pars_f%pars_xy(1,j,i) 1953 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 1954 surf_lsm_h%aldir(m) = albedo_pars_f%pars_xy(1,j,i) 1955 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 1956 surf_lsm_h%aldif(m) = albedo_pars_f%pars_xy(2,j,i) 1957 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill ) & 1958 surf_lsm_h%asdir(m) = albedo_pars_f%pars_xy(3,j,i) 1959 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill ) & 1960 surf_lsm_h%asdif(m) = albedo_pars_f%pars_xy(4,j,i) 1961 ENDIF 1953 ! 1954 !-- Spectral albedos for vegetation/pavement/water surfaces 1955 DO ind_type = 0, 2 1956 IF ( surf_lsm_h%albedo_type(ind_type,m) == 0 ) THEN 1957 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )& 1958 surf_lsm_h%albedo(ind_type,m) = & 1959 albedo_pars_f%pars_xy(1,j,i) 1960 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )& 1961 surf_lsm_h%aldir(ind_type,m) = & 1962 albedo_pars_f%pars_xy(1,j,i) 1963 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )& 1964 surf_lsm_h%aldif(ind_type,m) = & 1965 albedo_pars_f%pars_xy(2,j,i) 1966 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )& 1967 surf_lsm_h%asdir(ind_type,m) = & 1968 albedo_pars_f%pars_xy(3,j,i) 1969 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )& 1970 surf_lsm_h%asdif(ind_type,m) = & 1971 albedo_pars_f%pars_xy(4,j,i) 1972 ENDIF 1973 ENDDO 1962 1974 ENDDO 1963 1975 … … 1966 1978 j = surf_usm_h%j(m) 1967 1979 ! 1968 !-- At the moment, consider only wall surfaces (index 0) 1969 IF ( surf_usm_h%albedo_type(0,m) == 0 ) THEN 1970 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 1971 surf_usm_h%albedo(:,m) = albedo_pars_f%pars_xy(1,j,i) 1972 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 1973 surf_usm_h%aldir(m) = albedo_pars_f%pars_xy(1,j,i) 1974 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 1975 surf_usm_h%aldif(m) = albedo_pars_f%pars_xy(2,j,i) 1976 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill ) & 1977 surf_usm_h%asdir(m) = albedo_pars_f%pars_xy(3,j,i) 1978 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill ) & 1979 surf_usm_h%asdif(m) = albedo_pars_f%pars_xy(4,j,i) 1980 ENDIF 1980 !-- Spectral albedos for wall/green/window surfaces 1981 DO ind_type = 0, 2 1982 IF ( surf_usm_h%albedo_type(ind_type,m) == 0 ) THEN 1983 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )& 1984 surf_usm_h%albedo(ind_type,m) = & 1985 albedo_pars_f%pars_xy(1,j,i) 1986 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )& 1987 surf_usm_h%aldir(ind_type,m) = & 1988 albedo_pars_f%pars_xy(1,j,i) 1989 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )& 1990 surf_usm_h%aldif(ind_type,m) = & 1991 albedo_pars_f%pars_xy(2,j,i) 1992 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )& 1993 surf_usm_h%asdir(ind_type,m) = & 1994 albedo_pars_f%pars_xy(3,j,i) 1995 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )& 1996 surf_usm_h%asdif(ind_type,m) = & 1997 albedo_pars_f%pars_xy(4,j,i) 1998 ENDIF 1999 ENDDO 2000 1981 2001 ENDDO 1982 2002 ! … … 1987 2007 1988 2008 DO m = 1, surf_def_v(l)%ns 2009 1989 2010 i = surf_def_v(l)%i(m) 1990 2011 j = surf_def_v(l)%j(m) 2012 1991 2013 IF ( surf_def_v(l)%albedo_type(0,m) == 0 ) THEN 1992 2014 … … 1997 2019 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 1998 2020 albedo_pars_f%fill ) & 1999 surf_def_v(l)%aldir( m) =&2021 surf_def_v(l)%aldir(0,m) = & 2000 2022 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2001 2023 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2002 2024 albedo_pars_f%fill ) & 2003 surf_def_v(l)%aldif( m) =&2025 surf_def_v(l)%aldif(0,m) = & 2004 2026 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2005 2027 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= & 2006 2028 albedo_pars_f%fill ) & 2007 surf_def_v(l)%asdir( m) =&2029 surf_def_v(l)%asdir(0,m) = & 2008 2030 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2009 2031 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= & 2010 2032 albedo_pars_f%fill ) & 2011 surf_def_v(l)%asdif( m) =&2033 surf_def_v(l)%asdif(0,m) = & 2012 2034 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2013 2035 ENDIF … … 2016 2038 ioff = surf_lsm_v(l)%ioff 2017 2039 joff = surf_lsm_v(l)%joff 2040 2018 2041 DO m = 1, surf_lsm_v(l)%ns 2019 2042 i = surf_lsm_v(l)%i(m) 2020 2043 j = surf_lsm_v(l)%j(m) 2021 2022 IF ( surf_lsm_v(l)%vegetation_surface(m) ) ind_type = 0 2023 IF ( surf_lsm_v(l)%pavement_surface(m) ) ind_type = 1 2024 IF ( surf_lsm_v(l)%water_surface(m) ) ind_type = 2 2025 2026 IF ( surf_lsm_v(l)%albedo_type(ind_type,m) == 0 ) THEN 2027 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2028 albedo_pars_f%fill ) & 2029 surf_lsm_v(l)%albedo(:,m) = & 2044 ! 2045 !-- Spectral albedos for vegetation/pavement/water surfaces 2046 DO ind_type = 0, 2 2047 IF ( surf_lsm_v(l)%albedo_type(ind_type,m) == 0 ) THEN 2048 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2049 albedo_pars_f%fill ) & 2050 surf_lsm_v(l)%albedo(ind_type,m) = & 2030 2051 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2031 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /=&2032 albedo_pars_f%fill )&2033 surf_lsm_v(l)%aldir(m) =&2052 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2053 albedo_pars_f%fill ) & 2054 surf_lsm_v(l)%aldir(ind_type,m) = & 2034 2055 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2035 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /=&2036 albedo_pars_f%fill )&2037 surf_lsm_v(l)%aldif(m) =&2056 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2057 albedo_pars_f%fill ) & 2058 surf_lsm_v(l)%aldif(ind_type,m) = & 2038 2059 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2039 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /=&2040 albedo_pars_f%fill )&2041 surf_lsm_v(l)%asdir(m) =&2060 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= & 2061 albedo_pars_f%fill ) & 2062 surf_lsm_v(l)%asdir(ind_type,m) = & 2042 2063 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2043 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /=&2044 albedo_pars_f%fill )&2045 surf_lsm_v(l)%asdif(m) =&2064 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= & 2065 albedo_pars_f%fill ) & 2066 surf_lsm_v(l)%asdif(ind_type,m) = & 2046 2067 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2047 ENDIF 2068 ENDIF 2069 ENDDO 2048 2070 ENDDO 2049 2071 2050 2072 ioff = surf_usm_v(l)%ioff 2051 2073 joff = surf_usm_v(l)%joff 2074 2052 2075 DO m = 1, surf_usm_v(l)%ns 2053 2076 i = surf_usm_v(l)%i(m) 2054 2077 j = surf_usm_v(l)%j(m) 2055 2056 !-- At the moment, consider only wall surfaces (index 0) 2057 IF ( surf_usm_v(l)%albedo_type(0,m) == 0 ) THEN 2058 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2059 albedo_pars_f%fill ) & 2060 surf_usm_v(l)%albedo(:,m) = & 2078 ! 2079 !-- Spectral albedos for wall/green/window surfaces 2080 DO ind_type = 0, 2 2081 IF ( surf_usm_v(l)%albedo_type(ind_type,m) == 0 ) THEN 2082 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2083 albedo_pars_f%fill ) & 2084 surf_usm_v(l)%albedo(ind_type,m) = & 2061 2085 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2062 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /=&2063 albedo_pars_f%fill )&2064 surf_usm_v(l)%aldir(m) =&2086 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2087 albedo_pars_f%fill ) & 2088 surf_usm_v(l)%aldir(ind_type,m) = & 2065 2089 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2066 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /=&2067 albedo_pars_f%fill )&2068 surf_usm_v(l)%aldif(m) =&2090 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2091 albedo_pars_f%fill ) & 2092 surf_usm_v(l)%aldif(ind_type,m) = & 2069 2093 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2070 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /=&2071 albedo_pars_f%fill )&2072 surf_usm_v(l)%asdir(m) =&2094 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= & 2095 albedo_pars_f%fill ) & 2096 surf_usm_v(l)%asdir(ind_type,m) = & 2073 2097 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2074 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /=&2075 albedo_pars_f%fill )&2076 surf_usm_v(l)%asdif(m) =&2098 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= & 2099 albedo_pars_f%fill ) & 2100 surf_usm_v(l)%asdif(ind_type,m) = & 2077 2101 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2078 ENDIF 2102 ENDIF 2103 ENDDO 2104 2079 2105 ENDDO 2080 2106 ENDDO … … 3397 3423 DO m = surf_def_h(0)%start_index(j,i), & 3398 3424 surf_def_h(0)%end_index(j,i) 3399 rrtm_asdir(1) = surf_def_h(0)%rrtm_asdir( m)3400 rrtm_asdif(1) = surf_def_h(0)%rrtm_asdif( m)3401 rrtm_aldir(1) = surf_def_h(0)%rrtm_aldir( m)3402 rrtm_aldif(1) = surf_def_h(0)%rrtm_aldif( m)3425 rrtm_asdir(1) = surf_def_h(0)%rrtm_asdir(0,m) 3426 rrtm_asdif(1) = surf_def_h(0)%rrtm_asdif(0,m) 3427 rrtm_aldir(1) = surf_def_h(0)%rrtm_aldir(0,m) 3428 rrtm_aldif(1) = surf_def_h(0)%rrtm_aldif(0,m) 3403 3429 ENDDO 3404 3430 DO m = surf_lsm_h%start_index(j,i), & 3405 3431 surf_lsm_h%end_index(j,i) 3406 rrtm_asdir(1) = surf_lsm_h%rrtm_asdir(m) 3407 rrtm_asdif(1) = surf_lsm_h%rrtm_asdif(m) 3408 rrtm_aldir(1) = surf_lsm_h%rrtm_aldir(m) 3409 rrtm_aldif(1) = surf_lsm_h%rrtm_aldif(m) 3432 rrtm_asdir(1) = SUM( surf_lsm_h%frac(:,m) * & 3433 surf_lsm_h%rrtm_asdir(:,m) ) 3434 rrtm_asdif(1) = SUM( surf_lsm_h%frac(:,m) * & 3435 surf_lsm_h%rrtm_asdif(:,m) ) 3436 rrtm_aldir(1) = SUM( surf_lsm_h%frac(:,m) * & 3437 surf_lsm_h%rrtm_aldir(:,m) ) 3438 rrtm_aldif(1) = SUM( surf_lsm_h%frac(:,m) * & 3439 surf_lsm_h%rrtm_aldif(:,m) ) 3410 3440 ENDDO 3411 3441 DO m = surf_usm_h%start_index(j,i), & 3412 3442 surf_usm_h%end_index(j,i) 3413 rrtm_asdir(1) = surf_usm_h%rrtm_asdir(m) 3414 rrtm_asdif(1) = surf_usm_h%rrtm_asdif(m) 3415 rrtm_aldir(1) = surf_usm_h%rrtm_aldir(m) 3416 rrtm_aldif(1) = surf_usm_h%rrtm_aldif(m) 3443 rrtm_asdir(1) = SUM( surf_usm_h%frac(:,m) * & 3444 surf_usm_h%rrtm_asdir(:,m) ) 3445 rrtm_asdif(1) = SUM( surf_usm_h%frac(:,m) * & 3446 surf_usm_h%rrtm_asdif(:,m) ) 3447 rrtm_aldir(1) = SUM( surf_usm_h%frac(:,m) * & 3448 surf_usm_h%rrtm_aldir(:,m) ) 3449 rrtm_aldif(1) = SUM( surf_usm_h%frac(:,m) * & 3450 surf_usm_h%rrtm_aldif(:,m) ) 3417 3451 ENDDO 3418 3452 ! … … 3681 3715 IMPLICIT NONE 3682 3716 3683 INTEGER(iwp) :: m !< running index surface elements 3717 INTEGER(iwp) :: ind_type !< running index surface tiles 3718 INTEGER(iwp) :: m !< running index surface elements 3684 3719 3685 3720 TYPE(surf_type) :: surf !< treated surfaces 3686 3721 3687 IF ( sun_up .AND. .NOT. average_radiation ) THEN3722 IF ( sun_up .AND. .NOT. average_radiation ) THEN 3688 3723 3689 3724 DO m = 1, surf%ns 3690 3725 ! 3691 !-- Ocean 3692 IF ( surf%albedo_type(0,m) == 1 ) THEN 3693 surf%rrtm_aldir(m) = 0.026_wp / & 3694 ( zenith(0)**1.7_wp + 0.065_wp ) & 3695 + 0.15_wp * ( zenith(0) - 0.1_wp ) & 3696 * ( zenith(0) - 0.5_wp ) & 3697 * ( zenith(0) - 1.0_wp ) 3698 surf%rrtm_asdir(m) = surf%rrtm_aldir(m) 3699 ! 3700 !-- Snow 3701 ELSEIF ( surf%albedo_type(0,m) == 16 ) THEN 3702 IF ( zenith(0) < 0.5_wp ) THEN 3703 surf%rrtm_aldir(m) = 0.5_wp * (1.0_wp - surf%aldif(m)) & 3704 * ( 3.0_wp / (1.0_wp + 4.0_wp & 3705 * zenith(0))) - 1.0_wp 3706 surf%rrtm_asdir(m) = 0.5_wp * (1.0_wp - surf%asdif(m)) & 3707 * ( 3.0_wp / (1.0_wp + 4.0_wp & 3708 * zenith(0))) - 1.0_wp 3709 3710 surf%rrtm_aldir(m) = MIN(0.98_wp, surf%rrtm_aldir(m)) 3711 surf%rrtm_asdir(m) = MIN(0.98_wp, surf%rrtm_asdir(m)) 3726 !-- Loop over surface elements 3727 DO ind_type = 0, SIZE( surf%albedo_type, 1 ) - 1 3728 3729 ! 3730 !-- Ocean 3731 IF ( surf%albedo_type(ind_type,m) == 1 ) THEN 3732 surf%rrtm_aldir(ind_type,m) = 0.026_wp / & 3733 ( zenith(0)**1.7_wp + 0.065_wp )& 3734 + 0.15_wp * ( zenith(0) - 0.1_wp ) & 3735 * ( zenith(0) - 0.5_wp ) & 3736 * ( zenith(0) - 1.0_wp ) 3737 surf%rrtm_asdir(ind_type,m) = surf%rrtm_aldir(ind_type,m) 3738 ! 3739 !-- Snow 3740 ELSEIF ( surf%albedo_type(ind_type,m) == 16 ) THEN 3741 IF ( zenith(0) < 0.5_wp ) THEN 3742 surf%rrtm_aldir(ind_type,m) = & 3743 0.5_wp * ( 1.0_wp - surf%aldif(ind_type,m) ) & 3744 * ( 3.0_wp / ( 1.0_wp + 4.0_wp & 3745 * zenith(0) ) ) - 1.0_wp 3746 surf%rrtm_asdir(ind_type,m) = & 3747 0.5_wp * ( 1.0_wp - surf%asdif(ind_type,m) ) & 3748 * ( 3.0_wp / ( 1.0_wp + 4.0_wp & 3749 * zenith(0) ) ) - 1.0_wp 3750 3751 surf%rrtm_aldir(ind_type,m) = & 3752 MIN(0.98_wp, surf%rrtm_aldir(ind_type,m)) 3753 surf%rrtm_asdir(ind_type,m) = & 3754 MIN(0.98_wp, surf%rrtm_asdir(ind_type,m)) 3755 ELSE 3756 surf%rrtm_aldir(ind_type,m) = surf%aldif(ind_type,m) 3757 surf%rrtm_asdir(ind_type,m) = surf%asdif(ind_type,m) 3758 ENDIF 3759 ! 3760 !-- Sea ice 3761 ELSEIF ( surf%albedo_type(ind_type,m) == 15 ) THEN 3762 surf%rrtm_aldir(ind_type,m) = surf%aldif(ind_type,m) 3763 surf%rrtm_asdir(ind_type,m) = surf%asdif(ind_type,m) 3764 3765 ! 3766 !-- Asphalt 3767 ELSEIF ( surf%albedo_type(ind_type,m) == 17 ) THEN 3768 surf%rrtm_aldir(ind_type,m) = surf%aldif(ind_type,m) 3769 surf%rrtm_asdir(ind_type,m) = surf%asdif(ind_type,m) 3770 3771 3772 ! 3773 !-- Bare soil 3774 ELSEIF ( surf%albedo_type(ind_type,m) == 18 ) THEN 3775 surf%rrtm_aldir(ind_type,m) = surf%aldif(ind_type,m) 3776 surf%rrtm_asdir(ind_type,m) = surf%asdif(ind_type,m) 3777 3778 ! 3779 !-- Land surfaces 3712 3780 ELSE 3713 surf%rrtm_aldir(m) = surf%aldif(m) 3714 surf%rrtm_asdir(m) = surf%asdif(m) 3781 SELECT CASE ( surf%albedo_type(ind_type,m) ) 3782 3783 ! 3784 !-- Surface types with strong zenith dependence 3785 CASE ( 1, 2, 3, 4, 11, 12, 13 ) 3786 surf%rrtm_aldir(ind_type,m) = & 3787 surf%aldif(ind_type,m) * 1.4_wp / & 3788 ( 1.0_wp + 0.8_wp * zenith(0) ) 3789 surf%rrtm_asdir(ind_type,m) = & 3790 surf%asdif(ind_type,m) * 1.4_wp / & 3791 ( 1.0_wp + 0.8_wp * zenith(0) ) 3792 ! 3793 !-- Surface types with weak zenith dependence 3794 CASE ( 5, 6, 7, 8, 9, 10, 14 ) 3795 surf%rrtm_aldir(ind_type,m) = & 3796 surf%aldif(ind_type,m) * 1.1_wp / & 3797 ( 1.0_wp + 0.2_wp * zenith(0) ) 3798 surf%rrtm_asdir(ind_type,m) = & 3799 surf%asdif(ind_type,m) * 1.1_wp / & 3800 ( 1.0_wp + 0.2_wp * zenith(0) ) 3801 3802 CASE DEFAULT 3803 3804 END SELECT 3715 3805 ENDIF 3716 3806 ! 3717 !-- Sea ice 3718 ELSEIF ( surf%albedo_type(0,m) == 15 ) THEN 3719 surf%rrtm_aldir(m) = surf%aldif(m) 3720 surf%rrtm_asdir(m) = surf%asdif(m) 3721 3722 ! 3723 !-- Asphalt 3724 ELSEIF ( surf%albedo_type(0,m) == 17 ) THEN 3725 surf%rrtm_aldir(m) = surf%aldif(m) 3726 surf%rrtm_asdir(m) = surf%asdif(m) 3727 3728 3729 ! 3730 !-- Bare soil 3731 ELSEIF ( surf%albedo_type(0,m) == 18 ) THEN 3732 surf%rrtm_aldir(m) = surf%aldif(m) 3733 surf%rrtm_asdir(m) = surf%asdif(m) 3734 3735 ! 3736 !-- Land surfaces 3737 ELSE 3738 SELECT CASE ( surf%albedo_type(0,m) ) 3739 3740 ! 3741 !-- Surface types with strong zenith dependence 3742 CASE ( 1, 2, 3, 4, 11, 12, 13 ) 3743 surf%rrtm_aldir(m) = surf%aldif(m) * 1.4_wp / & 3744 (1.0_wp + 0.8_wp * zenith(0)) 3745 surf%rrtm_asdir(m) = surf%asdif(m) * 1.4_wp / & 3746 (1.0_wp + 0.8_wp * zenith(0)) 3747 ! 3748 !-- Surface types with weak zenith dependence 3749 CASE ( 5, 6, 7, 8, 9, 10, 14 ) 3750 surf%rrtm_aldir(m) = surf%aldif(m) * 1.1_wp / & 3751 (1.0_wp + 0.2_wp * zenith(0)) 3752 surf%rrtm_asdir(m) = surf%asdif(m) * 1.1_wp / & 3753 (1.0_wp + 0.2_wp * zenith(0)) 3754 3755 CASE DEFAULT 3756 3757 END SELECT 3758 ENDIF 3759 ! 3760 !-- Diffusive albedo is taken from Table 2 3761 surf%rrtm_aldif(m) = surf%aldif(m) 3762 surf%rrtm_asdif(m) = surf%asdif(m) 3807 !-- Diffusive albedo is taken from Table 2 3808 surf%rrtm_aldif(ind_type,m) = surf%aldif(ind_type,m) 3809 surf%rrtm_asdif(ind_type,m) = surf%asdif(ind_type,m) 3810 ENDDO 3763 3811 ENDDO 3764 3812 ! -
palm/trunk/SOURCE/surface_mod.f90
r2735 r2753 231 231 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: frac !< relative surface fraction (LSM: vegetation, water, pavement; USM: wall, green, window) 232 232 233 REAL(wp), DIMENSION(: ), ALLOCATABLE :: aldif!< albedo for longwave diffusive radiation, solar angle of 60°234 REAL(wp), DIMENSION(: ), ALLOCATABLE :: aldir!< albedo for longwave direct radiation, solar angle of 60°235 REAL(wp), DIMENSION(: ), ALLOCATABLE :: asdif!< albedo for shortwave diffusive radiation, solar angle of 60°236 REAL(wp), DIMENSION(: ), ALLOCATABLE :: asdir!< albedo for shortwave direct radiation, solar angle of 60°237 REAL(wp), DIMENSION(: ), ALLOCATABLE :: rrtm_aldif!< albedo for longwave diffusive radiation, solar angle of 60°238 REAL(wp), DIMENSION(: ), ALLOCATABLE :: rrtm_aldir!< albedo for longwave direct radiation, solar angle of 60°239 REAL(wp), DIMENSION(: ), ALLOCATABLE :: rrtm_asdif!< albedo for shortwave diffusive radiation, solar angle of 60°240 REAL(wp), DIMENSION(: ), ALLOCATABLE :: rrtm_asdir!< albedo for shortwave direct radiation, solar angle of 60°233 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: aldif !< albedo for longwave diffusive radiation, solar angle of 60° 234 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: aldir !< albedo for longwave direct radiation, solar angle of 60° 235 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: asdif !< albedo for shortwave diffusive radiation, solar angle of 60° 236 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: asdir !< albedo for shortwave direct radiation, solar angle of 60° 237 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_aldif !< albedo for longwave diffusive radiation, solar angle of 60° 238 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_aldir !< albedo for longwave direct radiation, solar angle of 60° 239 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_asdif !< albedo for shortwave diffusive radiation, solar angle of 60° 240 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_asdir !< albedo for shortwave direct radiation, solar angle of 60° 241 241 242 242 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_surface !< skin-surface temperature
Note: See TracChangeset
for help on using the changeset viewer.
