Changeset 4441 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Mar 4, 2020 7:20:35 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (55 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r4429 r4441 23 23 ! Current revisions: 24 24 ! ------------------ 25 ! 25 ! - Change order of dimension in surface arrays %frac, %emissivity and %albedo 26 ! to allow for better vectorization in the radiation interactions. 27 ! - Minor formatting issues 26 28 ! 27 29 ! Former revisions: … … 1831 1833 !-- via namelist paramter, unless not already allocated. 1832 1834 IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) ) THEN 1833 ALLOCATE( surf_lsm_h%albedo( 0:2,1:surf_lsm_h%ns) )1835 ALLOCATE( surf_lsm_h%albedo(1:surf_lsm_h%ns,0:2) ) 1834 1836 surf_lsm_h%albedo = albedo 1835 1837 ENDIF 1836 1838 IF ( .NOT. ALLOCATED(surf_usm_h%albedo) ) THEN 1837 ALLOCATE( surf_usm_h%albedo( 0:2,1:surf_usm_h%ns) )1839 ALLOCATE( surf_usm_h%albedo(1:surf_usm_h%ns,0:2) ) 1838 1840 surf_usm_h%albedo = albedo 1839 1841 ENDIF … … 1841 1843 DO l = 0, 3 1842 1844 IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) ) THEN 1843 ALLOCATE( surf_lsm_v(l)%albedo( 0:2,1:surf_lsm_v(l)%ns) )1845 ALLOCATE( surf_lsm_v(l)%albedo(1:surf_lsm_v(l)%ns,0:2) ) 1844 1846 surf_lsm_v(l)%albedo = albedo 1845 1847 ENDIF 1846 1848 IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) ) THEN 1847 ALLOCATE( surf_usm_v(l)%albedo( 0:2,1:surf_usm_v(l)%ns) )1849 ALLOCATE( surf_usm_v(l)%albedo(1:surf_usm_v(l)%ns,0:2) ) 1848 1850 surf_usm_v(l)%albedo = albedo 1849 1851 ENDIF … … 1855 1857 !-- albedo won't be overwritten. 1856 1858 DO m = 1, surf_lsm_h%ns 1857 IF ( surf_lsm_h%albedo_type( ind_veg_wall,m) /= 0 ) &1858 surf_lsm_h%albedo( ind_veg_wall,m) = &1859 albedo_pars(0,surf_lsm_h%albedo_type( ind_veg_wall,m))1860 IF ( surf_lsm_h%albedo_type( ind_pav_green,m) /= 0 ) &1861 surf_lsm_h%albedo( ind_pav_green,m) = &1862 albedo_pars(0,surf_lsm_h%albedo_type( ind_pav_green,m))1863 IF ( surf_lsm_h%albedo_type( ind_wat_win,m) /= 0 ) &1864 surf_lsm_h%albedo( ind_wat_win,m) = &1865 albedo_pars(0,surf_lsm_h%albedo_type( ind_wat_win,m))1859 IF ( surf_lsm_h%albedo_type(m,ind_veg_wall) /= 0 ) & 1860 surf_lsm_h%albedo(m,ind_veg_wall) = & 1861 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_veg_wall)) 1862 IF ( surf_lsm_h%albedo_type(m,ind_pav_green) /= 0 ) & 1863 surf_lsm_h%albedo(m,ind_pav_green) = & 1864 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_pav_green)) 1865 IF ( surf_lsm_h%albedo_type(m,ind_wat_win) /= 0 ) & 1866 surf_lsm_h%albedo(m,ind_wat_win) = & 1867 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_wat_win)) 1866 1868 ENDDO 1867 1869 DO m = 1, surf_usm_h%ns 1868 IF ( surf_usm_h%albedo_type( ind_veg_wall,m) /= 0 ) &1869 surf_usm_h%albedo( ind_veg_wall,m) = &1870 albedo_pars(0,surf_usm_h%albedo_type( ind_veg_wall,m))1871 IF ( surf_usm_h%albedo_type( ind_pav_green,m) /= 0 ) &1872 surf_usm_h%albedo( ind_pav_green,m) = &1873 albedo_pars(0,surf_usm_h%albedo_type( ind_pav_green,m))1874 IF ( surf_usm_h%albedo_type( ind_wat_win,m) /= 0 ) &1875 surf_usm_h%albedo( ind_wat_win,m) = &1876 albedo_pars(0,surf_usm_h%albedo_type( ind_wat_win,m))1870 IF ( surf_usm_h%albedo_type(m,ind_veg_wall) /= 0 ) & 1871 surf_usm_h%albedo(m,ind_veg_wall) = & 1872 albedo_pars(0,surf_usm_h%albedo_type(m,ind_veg_wall)) 1873 IF ( surf_usm_h%albedo_type(m,ind_pav_green) /= 0 ) & 1874 surf_usm_h%albedo(m,ind_pav_green) = & 1875 albedo_pars(0,surf_usm_h%albedo_type(m,ind_pav_green)) 1876 IF ( surf_usm_h%albedo_type(m,ind_wat_win) /= 0 ) & 1877 surf_usm_h%albedo(m,ind_wat_win) = & 1878 albedo_pars(0,surf_usm_h%albedo_type(m,ind_wat_win)) 1877 1879 ENDDO 1878 1880 1879 1881 DO l = 0, 3 1880 1882 DO m = 1, surf_lsm_v(l)%ns 1881 IF ( surf_lsm_v(l)%albedo_type( ind_veg_wall,m) /= 0 ) &1882 surf_lsm_v(l)%albedo( ind_veg_wall,m) = &1883 albedo_pars(0,surf_lsm_v(l)%albedo_type( ind_veg_wall,m))1884 IF ( surf_lsm_v(l)%albedo_type( ind_pav_green,m) /= 0 ) &1885 surf_lsm_v(l)%albedo( ind_pav_green,m) = &1886 albedo_pars(0,surf_lsm_v(l)%albedo_type( ind_pav_green,m))1887 IF ( surf_lsm_v(l)%albedo_type( ind_wat_win,m) /= 0 ) &1888 surf_lsm_v(l)%albedo( ind_wat_win,m) = &1889 albedo_pars(0,surf_lsm_v(l)%albedo_type( ind_wat_win,m))1883 IF ( surf_lsm_v(l)%albedo_type(m,ind_veg_wall) /= 0 ) & 1884 surf_lsm_v(l)%albedo(m,ind_veg_wall) = & 1885 albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_veg_wall)) 1886 IF ( surf_lsm_v(l)%albedo_type(m,ind_pav_green) /= 0 ) & 1887 surf_lsm_v(l)%albedo(m,ind_pav_green) = & 1888 albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_pav_green)) 1889 IF ( surf_lsm_v(l)%albedo_type(m,ind_wat_win) /= 0 ) & 1890 surf_lsm_v(l)%albedo(m,ind_wat_win) = & 1891 albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_wat_win)) 1890 1892 ENDDO 1891 1893 DO m = 1, surf_usm_v(l)%ns 1892 IF ( surf_usm_v(l)%albedo_type( ind_veg_wall,m) /= 0 ) &1893 surf_usm_v(l)%albedo( ind_veg_wall,m) = &1894 albedo_pars(0,surf_usm_v(l)%albedo_type( ind_veg_wall,m))1895 IF ( surf_usm_v(l)%albedo_type( ind_pav_green,m) /= 0 ) &1896 surf_usm_v(l)%albedo( ind_pav_green,m) = &1897 albedo_pars(0,surf_usm_v(l)%albedo_type( ind_pav_green,m))1898 IF ( surf_usm_v(l)%albedo_type( ind_wat_win,m) /= 0 ) &1899 surf_usm_v(l)%albedo( ind_wat_win,m) = &1900 albedo_pars(0,surf_usm_v(l)%albedo_type( ind_wat_win,m))1894 IF ( surf_usm_v(l)%albedo_type(m,ind_veg_wall) /= 0 ) & 1895 surf_usm_v(l)%albedo(m,ind_veg_wall) = & 1896 albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_veg_wall)) 1897 IF ( surf_usm_v(l)%albedo_type(m,ind_pav_green) /= 0 ) & 1898 surf_usm_v(l)%albedo(m,ind_pav_green) = & 1899 albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_pav_green)) 1900 IF ( surf_usm_v(l)%albedo_type(m,ind_wat_win) /= 0 ) & 1901 surf_usm_v(l)%albedo(m,ind_wat_win) = & 1902 albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_wat_win)) 1901 1903 ENDDO 1902 1904 ENDDO … … 1913 1915 j = surf_lsm_h%j(m) 1914 1916 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1915 surf_lsm_h%albedo( ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)1916 surf_lsm_h%albedo( ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)1917 surf_lsm_h%albedo( ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)1917 surf_lsm_h%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 1918 surf_lsm_h%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 1919 surf_lsm_h%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 1918 1920 ENDIF 1919 1921 ENDDO … … 1922 1924 j = surf_usm_h%j(m) 1923 1925 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1924 surf_usm_h%albedo( ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)1925 surf_usm_h%albedo( ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)1926 surf_usm_h%albedo( ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)1926 surf_usm_h%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 1927 surf_usm_h%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 1928 surf_usm_h%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 1927 1929 ENDIF 1928 1930 ENDDO … … 1937 1939 j = surf_lsm_v(l)%j(m) + joff 1938 1940 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1939 surf_lsm_v(l)%albedo( ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)1940 surf_lsm_v(l)%albedo( ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)1941 surf_lsm_v(l)%albedo( ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)1941 surf_lsm_v(l)%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 1942 surf_lsm_v(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 1943 surf_lsm_v(l)%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 1942 1944 ENDIF 1943 1945 ENDDO … … 1949 1951 j = surf_usm_v(l)%j(m) + joff 1950 1952 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1951 surf_usm_v(l)%albedo( ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)1952 surf_usm_v(l)%albedo( ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)1953 surf_usm_v(l)%albedo( ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)1953 surf_usm_v(l)%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 1954 surf_usm_v(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 1955 surf_usm_v(l)%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 1954 1956 ENDIF 1955 1957 ENDDO … … 1975 1977 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 1976 1978 building_surface_pars_f%fill ) THEN 1977 surf_usm_h%albedo( ind_veg_wall,m) = &1979 surf_usm_h%albedo(m,ind_veg_wall) = & 1978 1980 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 1979 surf_usm_h%albedo_type( ind_veg_wall,m) = 01981 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 1980 1982 ENDIF 1981 1983 1982 1984 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 1983 1985 building_surface_pars_f%fill ) THEN 1984 surf_usm_h%albedo( ind_wat_win,m) = &1986 surf_usm_h%albedo(m,ind_wat_win) = & 1985 1987 building_surface_pars_f%pars(ind_s_alb_b_win,is) 1986 surf_usm_h%albedo_type( ind_wat_win,m) = 01988 surf_usm_h%albedo_type(m,ind_wat_win) = 0 1987 1989 ENDIF 1988 1990 1989 1991 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 1990 1992 building_surface_pars_f%fill ) THEN 1991 surf_usm_h%albedo( ind_pav_green,m) = &1993 surf_usm_h%albedo(m,ind_pav_green) = & 1992 1994 building_surface_pars_f%pars(ind_s_alb_b_green,is) 1993 surf_usm_h%albedo_type( ind_pav_green,m) = 01995 surf_usm_h%albedo_type(m,ind_pav_green) = 0 1994 1996 ENDIF 1995 1997 … … 2014 2016 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2015 2017 building_surface_pars_f%fill ) THEN 2016 surf_usm_v(l)%albedo( ind_veg_wall,m) = &2018 surf_usm_v(l)%albedo(m,ind_veg_wall) = & 2017 2019 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2018 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = 02020 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0 2019 2021 ENDIF 2020 2022 2021 2023 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2022 2024 building_surface_pars_f%fill ) THEN 2023 surf_usm_v(l)%albedo( ind_wat_win,m) = &2025 surf_usm_v(l)%albedo(m,ind_wat_win) = & 2024 2026 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2025 surf_usm_v(l)%albedo_type( ind_wat_win,m) = 02027 surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0 2026 2028 ENDIF 2027 2029 2028 2030 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2029 2031 building_surface_pars_f%fill ) THEN 2030 surf_usm_v(l)%albedo( ind_pav_green,m) = &2032 surf_usm_v(l)%albedo(m,ind_pav_green) = & 2031 2033 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2032 surf_usm_v(l)%albedo_type( ind_pav_green,m) = 02034 surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0 2033 2035 ENDIF 2034 2036 … … 2047 2049 !-- for wall/green/window (USM) or vegetation/pavement/water surfaces 2048 2050 !-- (LSM). 2049 ALLOCATE ( surf_lsm_h%aldif( 0:2,1:surf_lsm_h%ns) )2050 ALLOCATE ( surf_lsm_h%aldir( 0:2,1:surf_lsm_h%ns) )2051 ALLOCATE ( surf_lsm_h%asdif( 0:2,1:surf_lsm_h%ns) )2052 ALLOCATE ( surf_lsm_h%asdir( 0:2,1:surf_lsm_h%ns) )2053 ALLOCATE ( surf_lsm_h%rrtm_aldif( 0:2,1:surf_lsm_h%ns) )2054 ALLOCATE ( surf_lsm_h%rrtm_aldir( 0:2,1:surf_lsm_h%ns) )2055 ALLOCATE ( surf_lsm_h%rrtm_asdif( 0:2,1:surf_lsm_h%ns) )2056 ALLOCATE ( surf_lsm_h%rrtm_asdir( 0:2,1:surf_lsm_h%ns) )2057 2058 ALLOCATE ( surf_usm_h%aldif( 0:2,1:surf_usm_h%ns) )2059 ALLOCATE ( surf_usm_h%aldir( 0:2,1:surf_usm_h%ns) )2060 ALLOCATE ( surf_usm_h%asdif( 0:2,1:surf_usm_h%ns) )2061 ALLOCATE ( surf_usm_h%asdir( 0:2,1:surf_usm_h%ns) )2062 ALLOCATE ( surf_usm_h%rrtm_aldif( 0:2,1:surf_usm_h%ns) )2063 ALLOCATE ( surf_usm_h%rrtm_aldir( 0:2,1:surf_usm_h%ns) )2064 ALLOCATE ( surf_usm_h%rrtm_asdif( 0:2,1:surf_usm_h%ns) )2065 ALLOCATE ( surf_usm_h%rrtm_asdir( 0:2,1:surf_usm_h%ns) )2051 ALLOCATE ( surf_lsm_h%aldif(1:surf_lsm_h%ns,0:2) ) 2052 ALLOCATE ( surf_lsm_h%aldir(1:surf_lsm_h%ns,0:2) ) 2053 ALLOCATE ( surf_lsm_h%asdif(1:surf_lsm_h%ns,0:2) ) 2054 ALLOCATE ( surf_lsm_h%asdir(1:surf_lsm_h%ns,0:2) ) 2055 ALLOCATE ( surf_lsm_h%rrtm_aldif(1:surf_lsm_h%ns,0:2) ) 2056 ALLOCATE ( surf_lsm_h%rrtm_aldir(1:surf_lsm_h%ns,0:2) ) 2057 ALLOCATE ( surf_lsm_h%rrtm_asdif(1:surf_lsm_h%ns,0:2) ) 2058 ALLOCATE ( surf_lsm_h%rrtm_asdir(1:surf_lsm_h%ns,0:2) ) 2059 2060 ALLOCATE ( surf_usm_h%aldif(1:surf_usm_h%ns,0:2) ) 2061 ALLOCATE ( surf_usm_h%aldir(1:surf_usm_h%ns,0:2) ) 2062 ALLOCATE ( surf_usm_h%asdif(1:surf_usm_h%ns,0:2) ) 2063 ALLOCATE ( surf_usm_h%asdir(1:surf_usm_h%ns,0:2) ) 2064 ALLOCATE ( surf_usm_h%rrtm_aldif(1:surf_usm_h%ns,0:2) ) 2065 ALLOCATE ( surf_usm_h%rrtm_aldir(1:surf_usm_h%ns,0:2) ) 2066 ALLOCATE ( surf_usm_h%rrtm_asdif(1:surf_usm_h%ns,0:2) ) 2067 ALLOCATE ( surf_usm_h%rrtm_asdir(1:surf_usm_h%ns,0:2) ) 2066 2068 2067 2069 ! … … 2069 2071 !-- implementations) 2070 2072 IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) ) & 2071 ALLOCATE( surf_lsm_h%albedo( 0:2,1:surf_lsm_h%ns) )2073 ALLOCATE( surf_lsm_h%albedo(1:surf_lsm_h%ns,0:2) ) 2072 2074 IF ( .NOT. ALLOCATED(surf_usm_h%albedo) ) & 2073 ALLOCATE( surf_usm_h%albedo( 0:2,1:surf_usm_h%ns) )2075 ALLOCATE( surf_usm_h%albedo(1:surf_usm_h%ns,0:2) ) 2074 2076 2075 2077 ! … … 2077 2079 DO l = 0, 3 2078 2080 2079 ALLOCATE ( surf_lsm_v(l)%aldif( 0:2,1:surf_lsm_v(l)%ns) )2080 ALLOCATE ( surf_lsm_v(l)%aldir( 0:2,1:surf_lsm_v(l)%ns) )2081 ALLOCATE ( surf_lsm_v(l)%asdif( 0:2,1:surf_lsm_v(l)%ns) )2082 ALLOCATE ( surf_lsm_v(l)%asdir( 0:2,1:surf_lsm_v(l)%ns) )2083 2084 ALLOCATE ( surf_lsm_v(l)%rrtm_aldif( 0:2,1:surf_lsm_v(l)%ns) )2085 ALLOCATE ( surf_lsm_v(l)%rrtm_aldir( 0:2,1:surf_lsm_v(l)%ns) )2086 ALLOCATE ( surf_lsm_v(l)%rrtm_asdif( 0:2,1:surf_lsm_v(l)%ns) )2087 ALLOCATE ( surf_lsm_v(l)%rrtm_asdir( 0:2,1:surf_lsm_v(l)%ns) )2088 2089 ALLOCATE ( surf_usm_v(l)%aldif( 0:2,1:surf_usm_v(l)%ns) )2090 ALLOCATE ( surf_usm_v(l)%aldir( 0:2,1:surf_usm_v(l)%ns) )2091 ALLOCATE ( surf_usm_v(l)%asdif( 0:2,1:surf_usm_v(l)%ns) )2092 ALLOCATE ( surf_usm_v(l)%asdir( 0:2,1:surf_usm_v(l)%ns) )2093 2094 ALLOCATE ( surf_usm_v(l)%rrtm_aldif( 0:2,1:surf_usm_v(l)%ns) )2095 ALLOCATE ( surf_usm_v(l)%rrtm_aldir( 0:2,1:surf_usm_v(l)%ns) )2096 ALLOCATE ( surf_usm_v(l)%rrtm_asdif( 0:2,1:surf_usm_v(l)%ns) )2097 ALLOCATE ( surf_usm_v(l)%rrtm_asdir( 0:2,1:surf_usm_v(l)%ns) )2081 ALLOCATE ( surf_lsm_v(l)%aldif(1:surf_lsm_v(l)%ns,0:2) ) 2082 ALLOCATE ( surf_lsm_v(l)%aldir(1:surf_lsm_v(l)%ns,0:2) ) 2083 ALLOCATE ( surf_lsm_v(l)%asdif(1:surf_lsm_v(l)%ns,0:2) ) 2084 ALLOCATE ( surf_lsm_v(l)%asdir(1:surf_lsm_v(l)%ns,0:2) ) 2085 2086 ALLOCATE ( surf_lsm_v(l)%rrtm_aldif(1:surf_lsm_v(l)%ns,0:2) ) 2087 ALLOCATE ( surf_lsm_v(l)%rrtm_aldir(1:surf_lsm_v(l)%ns,0:2) ) 2088 ALLOCATE ( surf_lsm_v(l)%rrtm_asdif(1:surf_lsm_v(l)%ns,0:2) ) 2089 ALLOCATE ( surf_lsm_v(l)%rrtm_asdir(1:surf_lsm_v(l)%ns,0:2) ) 2090 2091 ALLOCATE ( surf_usm_v(l)%aldif(1:surf_usm_v(l)%ns,0:2) ) 2092 ALLOCATE ( surf_usm_v(l)%aldir(1:surf_usm_v(l)%ns,0:2) ) 2093 ALLOCATE ( surf_usm_v(l)%asdif(1:surf_usm_v(l)%ns,0:2) ) 2094 ALLOCATE ( surf_usm_v(l)%asdir(1:surf_usm_v(l)%ns,0:2) ) 2095 2096 ALLOCATE ( surf_usm_v(l)%rrtm_aldif(1:surf_usm_v(l)%ns,0:2) ) 2097 ALLOCATE ( surf_usm_v(l)%rrtm_aldir(1:surf_usm_v(l)%ns,0:2) ) 2098 ALLOCATE ( surf_usm_v(l)%rrtm_asdif(1:surf_usm_v(l)%ns,0:2) ) 2099 ALLOCATE ( surf_usm_v(l)%rrtm_asdir(1:surf_usm_v(l)%ns,0:2) ) 2098 2100 ! 2099 2101 !-- Allocate broadband albedo (temporary for the current radiation 2100 2102 !-- implementations) 2101 2103 IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) ) & 2102 ALLOCATE( surf_lsm_v(l)%albedo( 0:2,1:surf_lsm_v(l)%ns) )2104 ALLOCATE( surf_lsm_v(l)%albedo(1:surf_lsm_v(l)%ns,0:2) ) 2103 2105 IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) ) & 2104 ALLOCATE( surf_usm_v(l)%albedo( 0:2,1:surf_usm_v(l)%ns) )2106 ALLOCATE( surf_usm_v(l)%albedo(1:surf_usm_v(l)%ns,0:2) ) 2105 2107 2106 2108 ENDDO … … 2165 2167 !-- Spectral albedos for vegetation/pavement/water surfaces 2166 2168 DO ind_type = 0, 2 2167 IF ( surf_lsm_h%albedo_type( ind_type,m) /= 0 ) THEN2168 surf_lsm_h%aldif( ind_type,m) = &2169 albedo_pars(1,surf_lsm_h%albedo_type( ind_type,m))2170 surf_lsm_h%asdif( ind_type,m) = &2171 albedo_pars(2,surf_lsm_h%albedo_type( ind_type,m))2172 surf_lsm_h%aldir( ind_type,m) = &2173 albedo_pars(1,surf_lsm_h%albedo_type( ind_type,m))2174 surf_lsm_h%asdir( ind_type,m) = &2175 albedo_pars(2,surf_lsm_h%albedo_type( ind_type,m))2176 surf_lsm_h%albedo( ind_type,m) = &2177 albedo_pars(0,surf_lsm_h%albedo_type( ind_type,m))2169 IF ( surf_lsm_h%albedo_type(m,ind_type) /= 0 ) THEN 2170 surf_lsm_h%aldif(m,ind_type) = & 2171 albedo_pars(1,surf_lsm_h%albedo_type(m,ind_type)) 2172 surf_lsm_h%asdif(m,ind_type) = & 2173 albedo_pars(2,surf_lsm_h%albedo_type(m,ind_type)) 2174 surf_lsm_h%aldir(m,ind_type) = & 2175 albedo_pars(1,surf_lsm_h%albedo_type(m,ind_type)) 2176 surf_lsm_h%asdir(m,ind_type) = & 2177 albedo_pars(2,surf_lsm_h%albedo_type(m,ind_type)) 2178 surf_lsm_h%albedo(m,ind_type) = & 2179 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_type)) 2178 2180 ENDIF 2179 2181 ENDDO … … 2188 2190 !-- Spectral albedos for wall/green/window surfaces 2189 2191 DO ind_type = 0, 2 2190 IF ( surf_usm_h%albedo_type( ind_type,m) /= 0 ) THEN2191 surf_usm_h%aldif( ind_type,m) = &2192 albedo_pars(1,surf_usm_h%albedo_type( ind_type,m))2193 surf_usm_h%asdif( ind_type,m) = &2194 albedo_pars(2,surf_usm_h%albedo_type( ind_type,m))2195 surf_usm_h%aldir( ind_type,m) = &2196 albedo_pars(1,surf_usm_h%albedo_type( ind_type,m))2197 surf_usm_h%asdir( ind_type,m) = &2198 albedo_pars(2,surf_usm_h%albedo_type( ind_type,m))2199 surf_usm_h%albedo( ind_type,m) = &2200 albedo_pars(0,surf_usm_h%albedo_type( ind_type,m))2192 IF ( surf_usm_h%albedo_type(m,ind_type) /= 0 ) THEN 2193 surf_usm_h%aldif(m,ind_type) = & 2194 albedo_pars(1,surf_usm_h%albedo_type(m,ind_type)) 2195 surf_usm_h%asdif(m,ind_type) = & 2196 albedo_pars(2,surf_usm_h%albedo_type(m,ind_type)) 2197 surf_usm_h%aldir(m,ind_type) = & 2198 albedo_pars(1,surf_usm_h%albedo_type(m,ind_type)) 2199 surf_usm_h%asdir(m,ind_type) = & 2200 albedo_pars(2,surf_usm_h%albedo_type(m,ind_type)) 2201 surf_usm_h%albedo(m,ind_type) = & 2202 albedo_pars(0,surf_usm_h%albedo_type(m,ind_type)) 2201 2203 ENDIF 2202 2204 ENDDO … … 2211 2213 !-- Spectral albedos for vegetation/pavement/water surfaces 2212 2214 DO ind_type = 0, 2 2213 IF ( surf_lsm_v(l)%albedo_type( ind_type,m) /= 0 ) THEN2214 surf_lsm_v(l)%aldif( ind_type,m) = &2215 albedo_pars(1,surf_lsm_v(l)%albedo_type( ind_type,m))2216 surf_lsm_v(l)%asdif( ind_type,m) = &2217 albedo_pars(2,surf_lsm_v(l)%albedo_type( ind_type,m))2218 surf_lsm_v(l)%aldir( ind_type,m) = &2219 albedo_pars(1,surf_lsm_v(l)%albedo_type( ind_type,m))2220 surf_lsm_v(l)%asdir( ind_type,m) = &2221 albedo_pars(2,surf_lsm_v(l)%albedo_type( ind_type,m))2222 surf_lsm_v(l)%albedo( ind_type,m) = &2223 albedo_pars(0,surf_lsm_v(l)%albedo_type( ind_type,m))2215 IF ( surf_lsm_v(l)%albedo_type(m,ind_type) /= 0 ) THEN 2216 surf_lsm_v(l)%aldif(m,ind_type) = & 2217 albedo_pars(1,surf_lsm_v(l)%albedo_type(m,ind_type)) 2218 surf_lsm_v(l)%asdif(m,ind_type) = & 2219 albedo_pars(2,surf_lsm_v(l)%albedo_type(m,ind_type)) 2220 surf_lsm_v(l)%aldir(m,ind_type) = & 2221 albedo_pars(1,surf_lsm_v(l)%albedo_type(m,ind_type)) 2222 surf_lsm_v(l)%asdir(m,ind_type) = & 2223 albedo_pars(2,surf_lsm_v(l)%albedo_type(m,ind_type)) 2224 surf_lsm_v(l)%albedo(m,ind_type) = & 2225 albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_type)) 2224 2226 ENDIF 2225 2227 ENDDO … … 2233 2235 !-- Spectral albedos for wall/green/window surfaces 2234 2236 DO ind_type = 0, 2 2235 IF ( surf_usm_v(l)%albedo_type( ind_type,m) /= 0 ) THEN2236 surf_usm_v(l)%aldif( ind_type,m) = &2237 albedo_pars(1,surf_usm_v(l)%albedo_type( ind_type,m))2238 surf_usm_v(l)%asdif( ind_type,m) = &2239 albedo_pars(2,surf_usm_v(l)%albedo_type( ind_type,m))2240 surf_usm_v(l)%aldir( ind_type,m) = &2241 albedo_pars(1,surf_usm_v(l)%albedo_type( ind_type,m))2242 surf_usm_v(l)%asdir( ind_type,m) = &2243 albedo_pars(2,surf_usm_v(l)%albedo_type( ind_type,m))2244 surf_usm_v(l)%albedo( ind_type,m) = &2245 albedo_pars(0,surf_usm_v(l)%albedo_type( ind_type,m))2237 IF ( surf_usm_v(l)%albedo_type(m,ind_type) /= 0 ) THEN 2238 surf_usm_v(l)%aldif(m,ind_type) = & 2239 albedo_pars(1,surf_usm_v(l)%albedo_type(m,ind_type)) 2240 surf_usm_v(l)%asdif(m,ind_type) = & 2241 albedo_pars(2,surf_usm_v(l)%albedo_type(m,ind_type)) 2242 surf_usm_v(l)%aldir(m,ind_type) = & 2243 albedo_pars(1,surf_usm_v(l)%albedo_type(m,ind_type)) 2244 surf_usm_v(l)%asdir(m,ind_type) = & 2245 albedo_pars(2,surf_usm_v(l)%albedo_type(m,ind_type)) 2246 surf_usm_v(l)%albedo(m,ind_type) = & 2247 albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_type)) 2246 2248 ENDIF 2247 2249 ENDDO … … 2263 2265 DO ind_type = 0, 2 2264 2266 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) & 2265 surf_lsm_h%albedo( ind_type,m) = &2267 surf_lsm_h%albedo(m,ind_type) = & 2266 2268 albedo_pars_f%pars_xy(0,j,i) 2267 2269 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 2268 surf_lsm_h%aldir( ind_type,m) = &2270 surf_lsm_h%aldir(m,ind_type) = & 2269 2271 albedo_pars_f%pars_xy(1,j,i) 2270 2272 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 2271 surf_lsm_h%aldif( ind_type,m) = &2273 surf_lsm_h%aldif(m,ind_type) = & 2272 2274 albedo_pars_f%pars_xy(1,j,i) 2273 2275 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 2274 surf_lsm_h%asdir( ind_type,m) = &2276 surf_lsm_h%asdir(m,ind_type) = & 2275 2277 albedo_pars_f%pars_xy(2,j,i) 2276 2278 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 2277 surf_lsm_h%asdif( ind_type,m) = &2279 surf_lsm_h%asdif(m,ind_type) = & 2278 2280 albedo_pars_f%pars_xy(2,j,i) 2279 2281 ENDDO … … 2290 2292 DO ind_type = 0, 2 2291 2293 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )& 2292 surf_usm_h%albedo( ind_type,m) = &2294 surf_usm_h%albedo(m,ind_type) = & 2293 2295 albedo_pars_f%pars_xy(0,j,i) 2294 2296 ENDDO … … 2296 2298 !-- Spectral albedos especially for building wall surfaces 2297 2299 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) THEN 2298 surf_usm_h%aldir( ind_veg_wall,m) = &2300 surf_usm_h%aldir(m,ind_veg_wall) = & 2299 2301 albedo_pars_f%pars_xy(1,j,i) 2300 surf_usm_h%aldif( ind_veg_wall,m) = &2302 surf_usm_h%aldif(m,ind_veg_wall) = & 2301 2303 albedo_pars_f%pars_xy(1,j,i) 2302 2304 ENDIF 2303 2305 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) THEN 2304 surf_usm_h%asdir( ind_veg_wall,m) = &2306 surf_usm_h%asdir(m,ind_veg_wall) = & 2305 2307 albedo_pars_f%pars_xy(2,j,i) 2306 surf_usm_h%asdif( ind_veg_wall,m) = &2308 surf_usm_h%asdif(m,ind_veg_wall) = & 2307 2309 albedo_pars_f%pars_xy(2,j,i) 2308 2310 ENDIF … … 2310 2312 !-- Spectral albedos especially for building green surfaces 2311 2313 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill ) THEN 2312 surf_usm_h%aldir( ind_pav_green,m) = &2314 surf_usm_h%aldir(m,ind_pav_green) = & 2313 2315 albedo_pars_f%pars_xy(3,j,i) 2314 surf_usm_h%aldif( ind_pav_green,m) = &2316 surf_usm_h%aldif(m,ind_pav_green) = & 2315 2317 albedo_pars_f%pars_xy(3,j,i) 2316 2318 ENDIF 2317 2319 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill ) THEN 2318 surf_usm_h%asdir( ind_pav_green,m) = &2320 surf_usm_h%asdir(m,ind_pav_green) = & 2319 2321 albedo_pars_f%pars_xy(4,j,i) 2320 surf_usm_h%asdif( ind_pav_green,m) = &2322 surf_usm_h%asdif(m,ind_pav_green) = & 2321 2323 albedo_pars_f%pars_xy(4,j,i) 2322 2324 ENDIF … … 2324 2326 !-- Spectral albedos especially for building window surfaces 2325 2327 IF ( albedo_pars_f%pars_xy(5,j,i) /= albedo_pars_f%fill ) THEN 2326 surf_usm_h%aldir( ind_wat_win,m) = &2328 surf_usm_h%aldir(m,ind_wat_win) = & 2327 2329 albedo_pars_f%pars_xy(5,j,i) 2328 surf_usm_h%aldif( ind_wat_win,m) = &2330 surf_usm_h%aldif(m,ind_wat_win) = & 2329 2331 albedo_pars_f%pars_xy(5,j,i) 2330 2332 ENDIF 2331 2333 IF ( albedo_pars_f%pars_xy(6,j,i) /= albedo_pars_f%fill ) THEN 2332 surf_usm_h%asdir( ind_wat_win,m) = &2334 surf_usm_h%asdir(m,ind_wat_win) = & 2333 2335 albedo_pars_f%pars_xy(6,j,i) 2334 surf_usm_h%asdif( ind_wat_win,m) = &2336 surf_usm_h%asdif(m,ind_wat_win) = & 2335 2337 albedo_pars_f%pars_xy(6,j,i) 2336 2338 ENDIF … … 2352 2354 IF ( albedo_pars_f%pars_xy(0,j+joff,i+ioff) /= & 2353 2355 albedo_pars_f%fill ) & 2354 surf_lsm_v(l)%albedo( ind_type,m) = &2356 surf_lsm_v(l)%albedo(m,ind_type) = & 2355 2357 albedo_pars_f%pars_xy(0,j+joff,i+ioff) 2356 2358 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2357 2359 albedo_pars_f%fill ) & 2358 surf_lsm_v(l)%aldir( ind_type,m) = &2360 surf_lsm_v(l)%aldir(m,ind_type) = & 2359 2361 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2360 2362 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2361 2363 albedo_pars_f%fill ) & 2362 surf_lsm_v(l)%aldif( ind_type,m) = &2364 surf_lsm_v(l)%aldif(m,ind_type) = & 2363 2365 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2364 2366 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2365 2367 albedo_pars_f%fill ) & 2366 surf_lsm_v(l)%asdir( ind_type,m) = &2368 surf_lsm_v(l)%asdir(m,ind_type) = & 2367 2369 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2368 2370 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2369 2371 albedo_pars_f%fill ) & 2370 surf_lsm_v(l)%asdif( ind_type,m) = &2372 surf_lsm_v(l)%asdif(m,ind_type) = & 2371 2373 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2372 2374 ENDDO … … 2387 2389 IF ( albedo_pars_f%pars_xy(0,j+joff,i+ioff) /= & 2388 2390 albedo_pars_f%fill ) & 2389 surf_usm_v(l)%albedo( ind_type,m) = &2391 surf_usm_v(l)%albedo(m,ind_type) = & 2390 2392 albedo_pars_f%pars_xy(0,j+joff,i+ioff) 2391 2393 ENDDO … … 2394 2396 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2395 2397 albedo_pars_f%fill ) THEN 2396 surf_usm_v(l)%aldir( ind_veg_wall,m) = &2398 surf_usm_v(l)%aldir(m,ind_veg_wall) = & 2397 2399 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2398 surf_usm_v(l)%aldif( ind_veg_wall,m) = &2400 surf_usm_v(l)%aldif(m,ind_veg_wall) = & 2399 2401 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2400 2402 ENDIF 2401 2403 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2402 2404 albedo_pars_f%fill ) THEN 2403 surf_usm_v(l)%asdir( ind_veg_wall,m) = &2405 surf_usm_v(l)%asdir(m,ind_veg_wall) = & 2404 2406 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2405 surf_usm_v(l)%asdif( ind_veg_wall,m) = &2407 surf_usm_v(l)%asdif(m,ind_veg_wall) = & 2406 2408 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2407 2409 ENDIF … … 2410 2412 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= & 2411 2413 albedo_pars_f%fill ) THEN 2412 surf_usm_v(l)%aldir( ind_pav_green,m) = &2414 surf_usm_v(l)%aldir(m,ind_pav_green) = & 2413 2415 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2414 surf_usm_v(l)%aldif( ind_pav_green,m) = &2416 surf_usm_v(l)%aldif(m,ind_pav_green) = & 2415 2417 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2416 2418 ENDIF 2417 2419 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= & 2418 2420 albedo_pars_f%fill ) THEN 2419 surf_usm_v(l)%asdir( ind_pav_green,m) = &2421 surf_usm_v(l)%asdir(m,ind_pav_green) = & 2420 2422 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2421 surf_usm_v(l)%asdif( ind_pav_green,m) = &2423 surf_usm_v(l)%asdif(m,ind_pav_green) = & 2422 2424 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2423 2425 ENDIF … … 2426 2428 IF ( albedo_pars_f%pars_xy(5,j+joff,i+ioff) /= & 2427 2429 albedo_pars_f%fill ) THEN 2428 surf_usm_v(l)%aldir( ind_wat_win,m) = &2430 surf_usm_v(l)%aldir(m,ind_wat_win) = & 2429 2431 albedo_pars_f%pars_xy(5,j+joff,i+ioff) 2430 surf_usm_v(l)%aldif( ind_wat_win,m) = &2432 surf_usm_v(l)%aldif(m,ind_wat_win) = & 2431 2433 albedo_pars_f%pars_xy(5,j+joff,i+ioff) 2432 2434 ENDIF 2433 2435 IF ( albedo_pars_f%pars_xy(6,j+joff,i+ioff) /= & 2434 2436 albedo_pars_f%fill ) THEN 2435 surf_usm_v(l)%asdir( ind_wat_win,m) = &2437 surf_usm_v(l)%asdir(m,ind_wat_win) = & 2436 2438 albedo_pars_f%pars_xy(6,j+joff,i+ioff) 2437 surf_usm_v(l)%asdif( ind_wat_win,m) = &2439 surf_usm_v(l)%asdif(m,ind_wat_win) = & 2438 2440 albedo_pars_f%pars_xy(6,j+joff,i+ioff) 2439 2441 ENDIF … … 2461 2463 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2462 2464 building_surface_pars_f%fill ) THEN 2463 surf_usm_h%albedo( ind_veg_wall,m) = &2465 surf_usm_h%albedo(m,ind_veg_wall) = & 2464 2466 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2465 surf_usm_h%albedo_type( ind_veg_wall,m) = 02467 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2466 2468 ENDIF 2467 2469 2468 2470 IF ( building_surface_pars_f%pars(ind_s_alb_l_wall,is) /= & 2469 2471 building_surface_pars_f%fill ) THEN 2470 surf_usm_h%aldir( ind_veg_wall,m) = &2472 surf_usm_h%aldir(m,ind_veg_wall) = & 2471 2473 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2472 surf_usm_h%aldif( ind_veg_wall,m) = &2474 surf_usm_h%aldif(m,ind_veg_wall) = & 2473 2475 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2474 surf_usm_h%albedo_type( ind_veg_wall,m) = 02476 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2475 2477 ENDIF 2476 2478 2477 2479 IF ( building_surface_pars_f%pars(ind_s_alb_s_wall,is) /= & 2478 2480 building_surface_pars_f%fill ) THEN 2479 surf_usm_h%asdir( ind_veg_wall,m) = &2481 surf_usm_h%asdir(m,ind_veg_wall) = & 2480 2482 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2481 surf_usm_h%asdif( ind_veg_wall,m) = &2483 surf_usm_h%asdif(m,ind_veg_wall) = & 2482 2484 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2483 surf_usm_h%albedo_type( ind_veg_wall,m) = 02485 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2484 2486 ENDIF 2485 2487 2486 2488 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2487 2489 building_surface_pars_f%fill ) THEN 2488 surf_usm_h%albedo( ind_wat_win,m) = &2490 surf_usm_h%albedo(m,ind_wat_win) = & 2489 2491 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2490 surf_usm_h%albedo_type( ind_wat_win,m) = 02492 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2491 2493 ENDIF 2492 2494 2493 2495 IF ( building_surface_pars_f%pars(ind_s_alb_l_win,is) /= & 2494 2496 building_surface_pars_f%fill ) THEN 2495 surf_usm_h%aldir( ind_wat_win,m) = &2497 surf_usm_h%aldir(m,ind_wat_win) = & 2496 2498 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2497 surf_usm_h%aldif( ind_wat_win,m) = &2499 surf_usm_h%aldif(m,ind_wat_win) = & 2498 2500 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2499 surf_usm_h%albedo_type( ind_wat_win,m) = 02501 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2500 2502 ENDIF 2501 2503 2502 2504 IF ( building_surface_pars_f%pars(ind_s_alb_s_win,is) /= & 2503 2505 building_surface_pars_f%fill ) THEN 2504 surf_usm_h%asdir( ind_wat_win,m) = &2506 surf_usm_h%asdir(m,ind_wat_win) = & 2505 2507 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2506 surf_usm_h%asdif( ind_wat_win,m) = &2508 surf_usm_h%asdif(m,ind_wat_win) = & 2507 2509 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2508 surf_usm_h%albedo_type( ind_wat_win,m) = 02510 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2509 2511 ENDIF 2510 2512 2511 2513 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2512 2514 building_surface_pars_f%fill ) THEN 2513 surf_usm_h%albedo( ind_pav_green,m) = &2515 surf_usm_h%albedo(m,ind_pav_green) = & 2514 2516 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2515 surf_usm_h%albedo_type( ind_pav_green,m) = 02517 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2516 2518 ENDIF 2517 2519 2518 2520 IF ( building_surface_pars_f%pars(ind_s_alb_l_green,is) /= & 2519 2521 building_surface_pars_f%fill ) THEN 2520 surf_usm_h%aldir( ind_pav_green,m) = &2522 surf_usm_h%aldir(m,ind_pav_green) = & 2521 2523 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2522 surf_usm_h%aldif( ind_pav_green,m) = &2524 surf_usm_h%aldif(m,ind_pav_green) = & 2523 2525 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2524 surf_usm_h%albedo_type( ind_pav_green,m) = 02526 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2525 2527 ENDIF 2526 2528 2527 2529 IF ( building_surface_pars_f%pars(ind_s_alb_s_green,is) /= & 2528 2530 building_surface_pars_f%fill ) THEN 2529 surf_usm_h%asdir( ind_pav_green,m) = &2531 surf_usm_h%asdir(m,ind_pav_green) = & 2530 2532 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2531 surf_usm_h%asdif( ind_pav_green,m) = &2533 surf_usm_h%asdif(m,ind_pav_green) = & 2532 2534 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2533 surf_usm_h%albedo_type( ind_pav_green,m) = 02535 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2534 2536 ENDIF 2535 2537 … … 2554 2556 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2555 2557 building_surface_pars_f%fill ) THEN 2556 surf_usm_v(l)%albedo( ind_veg_wall,m) = &2558 surf_usm_v(l)%albedo(m,ind_veg_wall) = & 2557 2559 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2558 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = 02560 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0 2559 2561 ENDIF 2560 2562 2561 2563 IF ( building_surface_pars_f%pars(ind_s_alb_l_wall,is) /= & 2562 2564 building_surface_pars_f%fill ) THEN 2563 surf_usm_v(l)%aldir( ind_veg_wall,m) = &2565 surf_usm_v(l)%aldir(m,ind_veg_wall) = & 2564 2566 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2565 surf_usm_v(l)%aldif( ind_veg_wall,m) = &2567 surf_usm_v(l)%aldif(m,ind_veg_wall) = & 2566 2568 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2567 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = 02569 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0 2568 2570 ENDIF 2569 2571 2570 2572 IF ( building_surface_pars_f%pars(ind_s_alb_s_wall,is) /= & 2571 2573 building_surface_pars_f%fill ) THEN 2572 surf_usm_v(l)%asdir( ind_veg_wall,m) = &2574 surf_usm_v(l)%asdir(m,ind_veg_wall) = & 2573 2575 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2574 surf_usm_v(l)%asdif( ind_veg_wall,m) = &2576 surf_usm_v(l)%asdif(m,ind_veg_wall) = & 2575 2577 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2576 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = 02578 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0 2577 2579 ENDIF 2578 2580 2579 2581 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2580 2582 building_surface_pars_f%fill ) THEN 2581 surf_usm_v(l)%albedo( ind_wat_win,m) = &2583 surf_usm_v(l)%albedo(m,ind_wat_win) = & 2582 2584 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2583 surf_usm_v(l)%albedo_type( ind_wat_win,m) = 02585 surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0 2584 2586 ENDIF 2585 2587 2586 2588 IF ( building_surface_pars_f%pars(ind_s_alb_l_win,is) /= & 2587 2589 building_surface_pars_f%fill ) THEN 2588 surf_usm_v(l)%aldir( ind_wat_win,m) = &2590 surf_usm_v(l)%aldir(m,ind_wat_win) = & 2589 2591 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2590 surf_usm_v(l)%aldif( ind_wat_win,m) = &2592 surf_usm_v(l)%aldif(m,ind_wat_win) = & 2591 2593 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2592 surf_usm_v(l)%albedo_type( ind_wat_win,m) = 02594 surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0 2593 2595 ENDIF 2594 2596 2595 2597 IF ( building_surface_pars_f%pars(ind_s_alb_s_win,is) /= & 2596 2598 building_surface_pars_f%fill ) THEN 2597 surf_usm_v(l)%asdir( ind_wat_win,m) = &2599 surf_usm_v(l)%asdir(m,ind_wat_win) = & 2598 2600 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2599 surf_usm_v(l)%asdif( ind_wat_win,m) = &2601 surf_usm_v(l)%asdif(m,ind_wat_win) = & 2600 2602 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2601 surf_usm_v(l)%albedo_type( ind_wat_win,m) = 02603 surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0 2602 2604 ENDIF 2603 2605 2604 2606 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2605 2607 building_surface_pars_f%fill ) THEN 2606 surf_usm_v(l)%albedo( ind_pav_green,m) = &2608 surf_usm_v(l)%albedo(m,ind_pav_green) = & 2607 2609 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2608 surf_usm_v(l)%albedo_type( ind_pav_green,m) = 02610 surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0 2609 2611 ENDIF 2610 2612 2611 2613 IF ( building_surface_pars_f%pars(ind_s_alb_l_green,is) /= & 2612 2614 building_surface_pars_f%fill ) THEN 2613 surf_usm_v(l)%aldir( ind_pav_green,m) = &2615 surf_usm_v(l)%aldir(m,ind_pav_green) = & 2614 2616 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2615 surf_usm_v(l)%aldif( ind_pav_green,m) = &2617 surf_usm_v(l)%aldif(m,ind_pav_green) = & 2616 2618 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2617 surf_usm_v(l)%albedo_type( ind_pav_green,m) = 02619 surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0 2618 2620 ENDIF 2619 2621 2620 2622 IF ( building_surface_pars_f%pars(ind_s_alb_s_green,is) /= & 2621 2623 building_surface_pars_f%fill ) THEN 2622 surf_usm_v(l)%asdir( ind_pav_green,m) = &2624 surf_usm_v(l)%asdir(m,ind_pav_green) = & 2623 2625 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2624 surf_usm_v(l)%asdif( ind_pav_green,m) = &2626 surf_usm_v(l)%asdif(m,ind_pav_green) = & 2625 2627 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2626 surf_usm_v(l)%albedo_type( ind_pav_green,m) = 02628 surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0 2627 2629 ENDIF 2628 2630 … … 3272 3274 DO m = 1, surf%ns 3273 3275 k = surf%k(m) 3274 surf%rad_sw_out(m) = ( surf%frac( ind_veg_wall,m) * &3275 surf%albedo( ind_veg_wall,m) &3276 + surf%frac( ind_pav_green,m) * &3277 surf%albedo( ind_pav_green,m) &3278 + surf%frac( ind_wat_win,m) * &3279 surf%albedo( ind_wat_win,m) ) &3276 surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3277 surf%albedo(m,ind_veg_wall) & 3278 + surf%frac(m,ind_pav_green) * & 3279 surf%albedo(m,ind_pav_green) & 3280 + surf%frac(m,ind_wat_win) * & 3281 surf%albedo(m,ind_wat_win) ) & 3280 3282 * surf%rad_sw_in(m) 3281 3283 3282 surf%rad_lw_out(m) = ( surf%frac( ind_veg_wall,m) * &3283 surf%emissivity( ind_veg_wall,m) &3284 + surf%frac( ind_pav_green,m) * &3285 surf%emissivity( ind_pav_green,m) &3286 + surf%frac( ind_wat_win,m) * &3287 surf%emissivity( ind_wat_win,m) &3284 surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3285 surf%emissivity(m,ind_veg_wall) & 3286 + surf%frac(m,ind_pav_green) * & 3287 surf%emissivity(m,ind_pav_green) & 3288 + surf%frac(m,ind_wat_win) * & 3289 surf%emissivity(m,ind_wat_win) & 3288 3290 ) & 3289 3291 * sigma_sb & … … 3291 3293 3292 3294 surf%rad_lw_out_change_0(m) = & 3293 ( surf%frac( ind_veg_wall,m) * &3294 surf%emissivity( ind_veg_wall,m) &3295 + surf%frac( ind_pav_green,m) * &3296 surf%emissivity(i nd_pav_green,m) &3297 + surf%frac( ind_wat_win,m) * &3298 surf%emissivity( ind_wat_win,m) &3295 ( surf%frac(m,ind_veg_wall) * & 3296 surf%emissivity(m,ind_veg_wall) & 3297 + surf%frac(m,ind_pav_green) * & 3298 surf%emissivity(im,ind_pav_green) & 3299 + surf%frac(m,ind_wat_win) * & 3300 surf%emissivity(m,ind_wat_win) & 3299 3301 ) * 4.0_wp * sigma_sb & 3300 3302 * ( surf%pt_surface(m) * exner(k) )**3 … … 3340 3342 ! 3341 3343 !-- Weighted average according to surface fraction. 3342 surf%rad_sw_out(m) = ( surf%frac( ind_veg_wall,m) * &3343 surf%albedo( ind_veg_wall,m) &3344 + surf%frac( ind_pav_green,m) * &3345 surf%albedo( ind_pav_green,m) &3346 + surf%frac( ind_wat_win,m) * &3347 surf%albedo( ind_wat_win,m) ) &3344 surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3345 surf%albedo(m,ind_veg_wall) & 3346 + surf%frac(m,ind_pav_green) * & 3347 surf%albedo(m,ind_pav_green) & 3348 + surf%frac(m,ind_wat_win) * & 3349 surf%albedo(m,ind_wat_win) ) & 3348 3350 * surf%rad_sw_in(m) 3349 3351 3350 surf%rad_lw_out(m) = ( surf%frac( ind_veg_wall,m) * &3351 surf%emissivity( ind_veg_wall,m) &3352 + surf%frac( ind_pav_green,m) * &3353 surf%emissivity( ind_pav_green,m) &3354 + surf%frac( ind_wat_win,m) * &3355 surf%emissivity( ind_wat_win,m) &3352 surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3353 surf%emissivity(m,ind_veg_wall) & 3354 + surf%frac(m,ind_pav_green) * & 3355 surf%emissivity(m,ind_pav_green) & 3356 + surf%frac(m,ind_wat_win) * & 3357 surf%emissivity(m,ind_wat_win) & 3356 3358 ) & 3357 3359 * sigma_sb & … … 3359 3361 3360 3362 surf%rad_lw_out_change_0(m) = & 3361 ( surf%frac( ind_veg_wall,m) * &3362 surf%emissivity( ind_veg_wall,m) &3363 + surf%frac( ind_pav_green,m) * &3364 surf%emissivity( ind_pav_green,m) &3365 + surf%frac( ind_wat_win,m) * &3366 surf%emissivity( ind_wat_win,m) &3363 ( surf%frac(m,ind_veg_wall) * & 3364 surf%emissivity(m,ind_veg_wall) & 3365 + surf%frac(m,ind_pav_green) * & 3366 surf%emissivity(m,ind_pav_green) & 3367 + surf%frac(m,ind_wat_win) * & 3368 surf%emissivity(m,ind_wat_win) & 3367 3369 ) * 4.0_wp * sigma_sb & 3368 3370 * ( surf%pt_surface(m) * exner(k) )**3 … … 3550 3552 !-- calculated fluxes below are not actually used as they are 3551 3553 !-- overwritten in radiation_interaction. 3552 surf%rad_sw_out(m) = ( surf%frac( ind_veg_wall,m) * &3553 surf%albedo( ind_veg_wall,m) &3554 + surf%frac( ind_pav_green,m) * &3555 surf%albedo( ind_pav_green,m) &3556 + surf%frac( ind_wat_win,m) * &3557 surf%albedo( ind_wat_win,m) ) &3554 surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3555 surf%albedo(m,ind_veg_wall) & 3556 + surf%frac(m,ind_pav_green) * & 3557 surf%albedo(m,ind_pav_green) & 3558 + surf%frac(m,ind_wat_win) * & 3559 surf%albedo(m,ind_wat_win) ) & 3558 3560 * surf%rad_sw_in(m) 3559 3561 3560 surf%rad_lw_out(m) = ( surf%frac( ind_veg_wall,m) * &3561 surf%emissivity( ind_veg_wall,m) &3562 + surf%frac( ind_pav_green,m) * &3563 surf%emissivity( ind_pav_green,m) &3564 + surf%frac( ind_wat_win,m) * &3565 surf%emissivity( ind_wat_win,m) &3562 surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3563 surf%emissivity(m,ind_veg_wall) & 3564 + surf%frac(m,ind_pav_green) * & 3565 surf%emissivity(m,ind_pav_green) & 3566 + surf%frac(m,ind_wat_win) * & 3567 surf%emissivity(m,ind_wat_win) & 3566 3568 ) & 3567 3569 * sigma_sb & … … 3569 3571 3570 3572 surf%rad_lw_out_change_0(m) = & 3571 ( surf%frac( ind_veg_wall,m) * &3572 surf%emissivity( ind_veg_wall,m) &3573 + surf%frac( ind_pav_green,m) * &3574 surf%emissivity( ind_pav_green,m) &3575 + surf%frac( ind_wat_win,m) * &3576 surf%emissivity( ind_wat_win,m) &3573 ( surf%frac(m,ind_veg_wall) * & 3574 surf%emissivity(m,ind_veg_wall) & 3575 + surf%frac(m,ind_pav_green) * & 3576 surf%emissivity(m,ind_pav_green) & 3577 + surf%frac(m,ind_wat_win) * & 3578 surf%emissivity(m,ind_wat_win) & 3577 3579 ) * 4.0_wp * sigma_sb & 3578 3580 * ( surf%pt_surface(m) * exner(nzb) )** 3 … … 3749 3751 ! 3750 3752 !-- Weighted average according to surface fraction. 3751 surf%rad_lw_out(m) = ( surf%frac( ind_veg_wall,m) * &3752 surf%emissivity( ind_veg_wall,m) &3753 + surf%frac( ind_pav_green,m) * &3754 surf%emissivity( ind_pav_green,m) &3755 + surf%frac( ind_wat_win,m) * &3756 surf%emissivity( ind_wat_win,m) &3753 surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3754 surf%emissivity(m,ind_veg_wall) & 3755 + surf%frac(m,ind_pav_green) * & 3756 surf%emissivity(m,ind_pav_green) & 3757 + surf%frac(m,ind_wat_win) * & 3758 surf%emissivity(m,ind_wat_win) & 3757 3759 ) & 3758 3760 * sigma_sb & … … 3762 3764 + surf%rad_lw_out(m) ) & 3763 3765 / ( 1.0_wp - & 3764 ( surf%frac( ind_veg_wall,m) * &3765 surf%albedo( ind_veg_wall,m) &3766 + surf%frac( ind_pav_green,m) * &3767 surf%albedo( ind_pav_green,m) &3768 + surf%frac( ind_wat_win,m) * &3769 surf%albedo( ind_wat_win,m) ) &3766 ( surf%frac(m,ind_veg_wall) * & 3767 surf%albedo(m,ind_veg_wall) & 3768 + surf%frac(m,ind_pav_green) * & 3769 surf%albedo(m,ind_pav_green) & 3770 + surf%frac(m,ind_wat_win) * & 3771 surf%albedo(m,ind_wat_win) ) & 3770 3772 ) 3771 3773 3772 surf%rad_sw_out(m) = ( surf%frac( ind_veg_wall,m) * &3773 surf%albedo( ind_veg_wall,m) &3774 + surf%frac( ind_pav_green,m) * &3775 surf%albedo( ind_pav_green,m) &3776 + surf%frac( ind_wat_win,m) * &3777 surf%albedo( ind_wat_win,m) ) &3774 surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3775 surf%albedo(m,ind_veg_wall) & 3776 + surf%frac(m,ind_pav_green) * & 3777 surf%albedo(m,ind_pav_green) & 3778 + surf%frac(m,ind_wat_win) * & 3779 surf%albedo(m,ind_wat_win) ) & 3778 3780 * surf%rad_sw_in(m) 3779 3781 … … 4531 4533 !-- surfaces. 4532 4534 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 4533 rrtm_emis = surf_lsm_h%frac( ind_veg_wall,m) * &4534 surf_lsm_h%emissivity( ind_veg_wall,m) + &4535 surf_lsm_h%frac( ind_pav_green,m) * &4536 surf_lsm_h%emissivity( ind_pav_green,m) + &4537 surf_lsm_h%frac( ind_wat_win,m) * &4538 surf_lsm_h%emissivity( ind_wat_win,m)4535 rrtm_emis = surf_lsm_h%frac(m,ind_veg_wall) * & 4536 surf_lsm_h%emissivity(m,ind_veg_wall) + & 4537 surf_lsm_h%frac(m,ind_pav_green) * & 4538 surf_lsm_h%emissivity(m,ind_pav_green) + & 4539 surf_lsm_h%frac(m,ind_wat_win) * & 4540 surf_lsm_h%emissivity(m,ind_wat_win) 4539 4541 rrtm_tsfc = surf_lsm_h%pt_surface(m) * exner(nzb) 4540 4542 ENDDO 4541 4543 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 4542 rrtm_emis = surf_usm_h%frac( ind_veg_wall,m) * &4543 surf_usm_h%emissivity( ind_veg_wall,m) + &4544 surf_usm_h%frac( ind_pav_green,m) * &4545 surf_usm_h%emissivity( ind_pav_green,m) + &4546 surf_usm_h%frac( ind_wat_win,m) * &4547 surf_usm_h%emissivity( ind_wat_win,m)4544 rrtm_emis = surf_usm_h%frac(m,ind_veg_wall) * & 4545 surf_usm_h%emissivity(m,ind_veg_wall) + & 4546 surf_usm_h%frac(m,ind_pav_green) * & 4547 surf_usm_h%emissivity(m,ind_pav_green) + & 4548 surf_usm_h%frac(m,ind_wat_win) * & 4549 surf_usm_h%emissivity(m,ind_wat_win) 4548 4550 rrtm_tsfc = surf_usm_h%pt_surface(m) * exner(nzb) 4549 4551 ENDDO … … 4672 4674 DO m = surf_lsm_h%start_index(j,i), & 4673 4675 surf_lsm_h%end_index(j,i) 4674 rrtm_asdir(1) = SUM( surf_lsm_h%frac( :,m) * &4676 rrtm_asdir(1) = SUM( surf_lsm_h%frac(m,:) * & 4675 4677 surf_lsm_h%rrtm_asdir(:,m) ) 4676 rrtm_asdif(1) = SUM( surf_lsm_h%frac( :,m) * &4678 rrtm_asdif(1) = SUM( surf_lsm_h%frac(m,:) * & 4677 4679 surf_lsm_h%rrtm_asdif(:,m) ) 4678 rrtm_aldir(1) = SUM( surf_lsm_h%frac( :,m) * &4680 rrtm_aldir(1) = SUM( surf_lsm_h%frac(m,:) * & 4679 4681 surf_lsm_h%rrtm_aldir(:,m) ) 4680 rrtm_aldif(1) = SUM( surf_lsm_h%frac( :,m) * &4682 rrtm_aldif(1) = SUM( surf_lsm_h%frac(m,:) * & 4681 4683 surf_lsm_h%rrtm_aldif(:,m) ) 4682 4684 ENDDO 4683 4685 DO m = surf_usm_h%start_index(j,i), & 4684 4686 surf_usm_h%end_index(j,i) 4685 rrtm_asdir(1) = SUM( surf_usm_h%frac( :,m) * &4687 rrtm_asdir(1) = SUM( surf_usm_h%frac(m,:) * & 4686 4688 surf_usm_h%rrtm_asdir(:,m) ) 4687 rrtm_asdif(1) = SUM( surf_usm_h%frac( :,m) * &4689 rrtm_asdif(1) = SUM( surf_usm_h%frac(m,:) * & 4688 4690 surf_usm_h%rrtm_asdif(:,m) ) 4689 rrtm_aldir(1) = SUM( surf_usm_h%frac( :,m) * &4691 rrtm_aldir(1) = SUM( surf_usm_h%frac(m,:) * & 4690 4692 surf_usm_h%rrtm_aldir(:,m) ) 4691 rrtm_aldif(1) = SUM( surf_usm_h%frac( :,m) * &4693 rrtm_aldif(1) = SUM( surf_usm_h%frac(m,:) * & 4692 4694 surf_usm_h%rrtm_aldif(:,m) ) 4693 4695 ENDDO … … 4989 4991 ! 4990 4992 !-- Ocean 4991 IF ( surf%albedo_type( ind_type,m) == 1 ) THEN4992 surf%rrtm_aldir( ind_type,m) = 0.026_wp / &4993 IF ( surf%albedo_type(m,ind_type) == 1 ) THEN 4994 surf%rrtm_aldir(m,ind_type) = 0.026_wp / & 4993 4995 ( cos_zenith**1.7_wp + 0.065_wp )& 4994 4996 + 0.15_wp * ( cos_zenith - 0.1_wp ) & 4995 4997 * ( cos_zenith - 0.5_wp ) & 4996 4998 * ( cos_zenith - 1.0_wp ) 4997 surf%rrtm_asdir( ind_type,m) = surf%rrtm_aldir(ind_type,m)4999 surf%rrtm_asdir(m,ind_type) = surf%rrtm_aldir(m,ind_type) 4998 5000 ! 4999 5001 !-- Snow 5000 ELSEIF ( surf%albedo_type( ind_type,m) == 16 ) THEN5002 ELSEIF ( surf%albedo_type(m,ind_type) == 16 ) THEN 5001 5003 IF ( cos_zenith < 0.5_wp ) THEN 5002 surf%rrtm_aldir( ind_type,m) = &5003 0.5_wp * ( 1.0_wp - surf%aldif(i nd_type,m) ) &5004 surf%rrtm_aldir(m,ind_type) = & 5005 0.5_wp * ( 1.0_wp - surf%aldif(im,ind_type) ) & 5004 5006 * ( ( 3.0_wp / ( 1.0_wp + 4.0_wp & 5005 5007 * cos_zenith ) ) - 1.0_wp ) 5006 surf%rrtm_asdir( ind_type,m) = &5007 0.5_wp * ( 1.0_wp - surf%asdif( ind_type,m) ) &5008 surf%rrtm_asdir(m,ind_type) = & 5009 0.5_wp * ( 1.0_wp - surf%asdif(m,ind_type) ) & 5008 5010 * ( ( 3.0_wp / ( 1.0_wp + 4.0_wp & 5009 5011 * cos_zenith ) ) - 1.0_wp ) 5010 5012 5011 surf%rrtm_aldir( ind_type,m) = &5012 MIN(0.98_wp, surf%rrtm_aldir( ind_type,m))5013 surf%rrtm_asdir( ind_type,m) = &5014 MIN(0.98_wp, surf%rrtm_asdir( ind_type,m))5013 surf%rrtm_aldir(m,ind_type) = & 5014 MIN(0.98_wp, surf%rrtm_aldir(m,ind_type)) 5015 surf%rrtm_asdir(m,ind_type) = & 5016 MIN(0.98_wp, surf%rrtm_asdir(m,ind_type)) 5015 5017 ELSE 5016 surf%rrtm_aldir( ind_type,m) = surf%aldif(ind_type,m)5017 surf%rrtm_asdir( ind_type,m) = surf%asdif(ind_type,m)5018 surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) 5019 surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) 5018 5020 ENDIF 5019 5021 ! 5020 5022 !-- Sea ice 5021 ELSEIF ( surf%albedo_type( ind_type,m) == 15 ) THEN5022 surf%rrtm_aldir( ind_type,m) = surf%aldif(ind_type,m)5023 surf%rrtm_asdir( ind_type,m) = surf%asdif(ind_type,m)5023 ELSEIF ( surf%albedo_type(m,ind_type) == 15 ) THEN 5024 surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) 5025 surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) 5024 5026 5025 5027 ! 5026 5028 !-- Asphalt 5027 ELSEIF ( surf%albedo_type( ind_type,m) == 17 ) THEN5028 surf%rrtm_aldir( ind_type,m) = surf%aldif(ind_type,m)5029 surf%rrtm_asdir( ind_type,m) = surf%asdif(ind_type,m)5029 ELSEIF ( surf%albedo_type(m,ind_type) == 17 ) THEN 5030 surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) 5031 surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) 5030 5032 5031 5033 5032 5034 ! 5033 5035 !-- Bare soil 5034 ELSEIF ( surf%albedo_type( ind_type,m) == 18 ) THEN5035 surf%rrtm_aldir( ind_type,m) = surf%aldif(ind_type,m)5036 surf%rrtm_asdir( ind_type,m) = surf%asdif(ind_type,m)5036 ELSEIF ( surf%albedo_type(m,ind_type) == 18 ) THEN 5037 surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) 5038 surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) 5037 5039 5038 5040 ! 5039 5041 !-- Land surfaces 5040 5042 ELSE 5041 SELECT CASE ( surf%albedo_type( ind_type,m) )5043 SELECT CASE ( surf%albedo_type(m,ind_type) ) 5042 5044 5043 5045 ! 5044 5046 !-- Surface types with strong zenith dependence 5045 5047 CASE ( 1, 2, 3, 4, 11, 12, 13 ) 5046 surf%rrtm_aldir( ind_type,m) = &5047 surf%aldif( ind_type,m) * 1.4_wp / &5048 surf%rrtm_aldir(m,ind_type) = & 5049 surf%aldif(m,ind_type) * 1.4_wp / & 5048 5050 ( 1.0_wp + 0.8_wp * cos_zenith ) 5049 surf%rrtm_asdir( ind_type,m) = &5050 surf%asdif( ind_type,m) * 1.4_wp / &5051 surf%rrtm_asdir(m,ind_type) = & 5052 surf%asdif(m,ind_type) * 1.4_wp / & 5051 5053 ( 1.0_wp + 0.8_wp * cos_zenith ) 5052 5054 ! 5053 5055 !-- Surface types with weak zenith dependence 5054 5056 CASE ( 5, 6, 7, 8, 9, 10, 14 ) 5055 surf%rrtm_aldir( ind_type,m) = &5056 surf%aldif( ind_type,m) * 1.1_wp / &5057 surf%rrtm_aldir(m,ind_type) = & 5058 surf%aldif(m,ind_type) * 1.1_wp / & 5057 5059 ( 1.0_wp + 0.2_wp * cos_zenith ) 5058 surf%rrtm_asdir( ind_type,m) = &5059 surf%asdif( ind_type,m) * 1.1_wp / &5060 surf%rrtm_asdir(m,ind_type) = & 5061 surf%asdif(m,ind_type) * 1.1_wp / & 5060 5062 ( 1.0_wp + 0.2_wp * cos_zenith ) 5061 5063 … … 5066 5068 ! 5067 5069 !-- Diffusive albedo is taken from Table 2 5068 surf%rrtm_aldif( ind_type,m) = surf%aldif(ind_type,m)5069 surf%rrtm_asdif( ind_type,m) = surf%asdif(ind_type,m)5070 surf%rrtm_aldif(m,ind_type) = surf%aldif(m,ind_type) 5071 surf%rrtm_asdif(m,ind_type) = surf%asdif(m,ind_type) 5070 5072 ENDDO 5071 5073 ENDDO … … 5883 5885 DO i = nxl, nxr 5884 5886 DO j = nys, nyn 5885 !-- urban 5887 ! 5888 !-- urban 5886 5889 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 5887 surfoutll(mm) = SUM ( surf_usm_h%frac( :,m) * &5888 surf_usm_h%emissivity( :,m) ) &5890 surfoutll(mm) = SUM ( surf_usm_h%frac(m,:) * & 5891 surf_usm_h%emissivity(m,:) ) & 5889 5892 * sigma_sb & 5890 5893 * surf_usm_h%pt_surface(m)**4 5891 albedo_surf(mm) = SUM ( surf_usm_h%frac( :,m) * &5892 surf_usm_h%albedo( :,m) )5893 emiss_surf(mm) = SUM ( surf_usm_h%frac( :,m) * &5894 surf_usm_h%emissivity( :,m) )5894 albedo_surf(mm) = SUM ( surf_usm_h%frac(m,:) * & 5895 surf_usm_h%albedo(m,:) ) 5896 emiss_surf(mm) = SUM ( surf_usm_h%frac(m,:) * & 5897 surf_usm_h%emissivity(m,:) ) 5895 5898 mm = mm + 1 5896 5899 ENDDO 5897 !-- land 5900 ! 5901 !-- land 5898 5902 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 5899 surfoutll(mm) = SUM ( surf_lsm_h%frac( :,m) * &5900 surf_lsm_h%emissivity( :,m) ) &5903 surfoutll(mm) = SUM ( surf_lsm_h%frac(m,:) * & 5904 surf_lsm_h%emissivity(m,:) ) & 5901 5905 * sigma_sb & 5902 5906 * surf_lsm_h%pt_surface(m)**4 5903 albedo_surf(mm) = SUM ( surf_lsm_h%frac( :,m) * &5904 surf_lsm_h%albedo( :,m) )5905 emiss_surf(mm) = SUM ( surf_lsm_h%frac( :,m) * &5906 surf_lsm_h%emissivity( :,m) )5907 albedo_surf(mm) = SUM ( surf_lsm_h%frac(m,:) * & 5908 surf_lsm_h%albedo(m,:) ) 5909 emiss_surf(mm) = SUM ( surf_lsm_h%frac(m,:) * & 5910 surf_lsm_h%emissivity(m,:) ) 5907 5911 mm = mm + 1 5908 5912 ENDDO … … 5910 5914 ENDDO 5911 5915 ! 5912 !-- 5916 !-- Vertical walls 5913 5917 DO i = nxl, nxr 5914 5918 DO j = nys, nyn 5915 5919 DO ll = 0, 3 5916 5920 l = reorder(ll) 5917 !-- urban 5921 ! 5922 !-- urban 5918 5923 DO m = surf_usm_v(l)%start_index(j,i), & 5919 5924 surf_usm_v(l)%end_index(j,i) 5920 surfoutll(mm) = SUM ( surf_usm_v(l)%frac( :,m) * &5921 surf_usm_v(l)%emissivity( :,m) ) &5925 surfoutll(mm) = SUM ( surf_usm_v(l)%frac(m,:) * & 5926 surf_usm_v(l)%emissivity(m,:) ) & 5922 5927 * sigma_sb & 5923 5928 * surf_usm_v(l)%pt_surface(m)**4 5924 albedo_surf(mm) = SUM ( surf_usm_v(l)%frac( :,m) * &5925 surf_usm_v(l)%albedo( :,m) )5926 emiss_surf(mm) = SUM ( surf_usm_v(l)%frac( :,m) * &5927 surf_usm_v(l)%emissivity( :,m) )5929 albedo_surf(mm) = SUM ( surf_usm_v(l)%frac(m,:) * & 5930 surf_usm_v(l)%albedo(m,:) ) 5931 emiss_surf(mm) = SUM ( surf_usm_v(l)%frac(m,:) * & 5932 surf_usm_v(l)%emissivity(m,:) ) 5928 5933 mm = mm + 1 5929 5934 ENDDO 5930 !-- land 5935 ! 5936 !-- land 5931 5937 DO m = surf_lsm_v(l)%start_index(j,i), & 5932 5938 surf_lsm_v(l)%end_index(j,i) 5933 surfoutll(mm) = SUM ( surf_lsm_v(l)%frac( :,m) * &5934 surf_lsm_v(l)%emissivity( :,m) ) &5939 surfoutll(mm) = SUM ( surf_lsm_v(l)%frac(m,:) * & 5940 surf_lsm_v(l)%emissivity(m,:) ) & 5935 5941 * sigma_sb & 5936 5942 * surf_lsm_v(l)%pt_surface(m)**4 5937 albedo_surf(mm) = SUM ( surf_lsm_v(l)%frac( :,m) * &5938 surf_lsm_v(l)%albedo( :,m) )5939 emiss_surf(mm) = SUM ( surf_lsm_v(l)%frac( :,m) * &5940 surf_lsm_v(l)%emissivity( :,m) )5943 albedo_surf(mm) = SUM ( surf_lsm_v(l)%frac(m,:) * & 5944 surf_lsm_v(l)%albedo(m,:) ) 5945 emiss_surf(mm) = SUM ( surf_lsm_v(l)%frac(m,:) * & 5946 surf_lsm_v(l)%emissivity(m,:) ) 5941 5947 mm = mm + 1 5942 5948 ENDDO … … 5945 5951 ENDDO 5946 5952 5947 IF ( trace_fluxes_above >= 0. _wp ) THEN5953 IF ( trace_fluxes_above >= 0.0_wp ) THEN 5948 5954 CALL radiation_print_debug_surf( 'surfoutll before initial pass', surfoutll ) 5949 5955 CALL radiation_print_debug_horz( 'rad_lw_in_diff before initial pass', rad_lw_in_diff ) … … 6008 6014 j = FLOOR(ACOS(cos_zenith) / pi * raytrace_discrete_elevs) 6009 6015 i = MODULO(NINT(ATAN2(sun_dir_lon, sun_dir_lat) & 6010 / (2. _wp*pi) * raytrace_discrete_azims-.5_wp, iwp), &6016 / (2.0_wp*pi) * raytrace_discrete_azims-0.5_wp, iwp), & 6011 6017 raytrace_discrete_azims) 6012 6018 isd = dsidir_rev(j, i) … … 6024 6030 i = mrtbl(ix, imrt) 6025 6031 mrtinsw(imrt) = mrtinsw(imrt) + mrtdsit(imrt, isd) * rad_sw_in_dir(j,i) & 6026 / cos_zenith / 4. _wp ! normal to sphere6032 / cos_zenith / 4.0_wp ! normal to sphere 6027 6033 ENDDO 6028 6034 ENDIF … … 6039 6045 IF ( npcbl > 0 ) THEN 6040 6046 6041 pcbinswdir(:) = 0. _wp6042 pcbinswdif(:) = 0. _wp6043 pcbinlw(:) = 0. _wp6047 pcbinswdir(:) = 0.0_wp 6048 pcbinswdif(:) = 0.0_wp 6049 pcbinlw(:) = 0.0_wp 6044 6050 6045 6051 DO icsf = 1, ncsfl … … 6065 6071 IF ( cos_zenith > 0 ) THEN 6066 6072 !-- Estimate directed box absorption 6067 pc_abs_frac = 1. _wp - exp(pc_abs_eff * lad_s(k,j,i))6073 pc_abs_frac = 1.0_wp - exp(pc_abs_eff * lad_s(k,j,i)) 6068 6074 ! 6069 6075 !-- isd has already been established, see 1) … … 6091 6097 ENDIF 6092 6098 6093 IF ( trace_fluxes_above >= 0. _wp ) THEN6099 IF ( trace_fluxes_above >= 0.0_wp ) THEN 6094 6100 CALL radiation_print_debug_surf( 'surfinl after initial pass', surfinl ) 6095 6101 CALL radiation_print_debug_surf( 'surfinlwdif after initial pass', surfinlwdif ) … … 6118 6124 ENDIF 6119 6125 6120 IF ( trace_fluxes_above >= 0. _wp ) THEN6126 IF ( trace_fluxes_above >= 0.0_wp ) THEN 6121 6127 CALL radiation_print_debug_surf( 'surfinl after PC emiss', surfinl ) 6122 6128 ENDIF … … 6135 6141 nrefsteps = 0 6136 6142 surfoutsl = albedo_surf * surfins 6137 surfoutll = (1. _wp - emiss_surf) * surfinl6143 surfoutll = (1.0_wp - emiss_surf) * surfinl 6138 6144 surfoutsw = surfoutsw + surfoutsl 6139 6145 surfoutlw = surfoutlw + surfoutll … … 6148 6154 ! 6149 6155 !-- for non-transparent surfaces, longwave albedo is 1 - emissivity 6150 surfoutll = (1. _wp - emiss_surf) * surfinl6151 6152 IF ( trace_fluxes_above >= 0. _wp ) THEN6156 surfoutll = (1.0_wp - emiss_surf) * surfinl 6157 6158 IF ( trace_fluxes_above >= 0.0_wp ) THEN 6153 6159 CALL radiation_print_debug_surf( 'surfoutll before reflective pass', surfoutll, refstep ) 6154 6160 CALL radiation_print_debug_surf( 'surfoutsl before reflective pass', surfoutsl, refstep ) … … 6178 6184 ! 6179 6185 !-- Reset for the input from next reflective pass 6180 surfins = 0. _wp6181 surfinl = 0. _wp6186 surfins = 0.0_wp 6187 surfinl = 0.00_wp 6182 6188 ! 6183 6189 !-- Reflected radiation … … 6222 6228 ENDDO 6223 6229 6224 IF ( trace_fluxes_above >= 0. _wp ) THEN6230 IF ( trace_fluxes_above >= 0.0_wp ) THEN 6225 6231 CALL radiation_print_debug_surf( 'surfinl after reflected pass', surfinl, refstep ) 6226 6232 CALL radiation_print_debug_surf( 'surfins after reflected pass', surfins, refstep ) … … 6268 6274 IF ( nmrtbl > 0 ) THEN 6269 6275 IF ( mrt_include_sw ) THEN 6270 mrt(:) = ((mrtinsw(:) + mrtinlw(:)) / sigma_sb) ** .25_wp6276 mrt(:) = ((mrtinsw(:) + mrtinlw(:)) / sigma_sb) ** 0.25_wp 6271 6277 ELSE 6272 mrt(:) = (mrtinlw(:) / sigma_sb) ** .25_wp6278 mrt(:) = (mrtinlw(:) / sigma_sb) ** 0.25_wp 6273 6279 ENDIF 6274 6280 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
