Changeset 4671 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Sep 9, 2020 8:27:58 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (52 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r4668 r4671 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Radiative transfer model RTM version 4.1 31 ! - Implementation of downward facing USM and LSM surfaces 32 ! - Removal of deprecated CSV inputs 33 ! - Bugfixes 34 ! Authors: J. Resler, P. Krc (Institute of Computer Science, Prague) 35 ! 36 ! 4668 2020-09-09 13:00:16Z pavelkrc 30 37 ! Improve debug messages during timestepping 31 38 ! … … 758 765 759 766 !-- indices needed for RTM netcdf output subroutines 760 INTEGER(iwp), PARAMETER :: nd = 5 761 CHARACTER(LEN=6), DIMENSION(0:nd-1), PARAMETER :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /) 762 INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER :: dirint = (/ iup, isouth, inorth, iwest, ieast /) 767 INTEGER(iwp), PARAMETER :: nd = 6 !< number of directions 768 CHARACTER(LEN=6), DIMENSION(0:nd-1), PARAMETER :: dirname = (/ '_up ', '_down ', '_south', '_north', '_west ', '_east ' /) 769 INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER :: dirint = (/ iup, idown, isouth, inorth, iwest, ieast /) !< direction integers 770 INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER :: diridx = (/ 0, 1, 1, 0, 3, 2 /) !< mapping to surf_h and surf_v 771 INTEGER(iwp), DIMENSION(0:1), PARAMETER :: dirint_h = (/ iup, idown /) !< mapping to surf_h directions 772 INTEGER(iwp), DIMENSION(0:3), PARAMETER :: dirint_v = (/ inorth, isouth, ieast, iwest /) !< mapping to surf_v directions 763 773 764 774 !-- indices and sizes of urban and land surface models … … 798 808 REAL(wp), PARAMETER :: ext_coef = 0.6_wp !< extinction coefficient (a.k.a. alpha) 799 809 INTEGER(iwp), PARAMETER :: rad_version_len = 10 !< length of identification string of rad version 800 CHARACTER(rad_version_len), PARAMETER :: rad_version = 'RAD v. 4. 0' !< identification of version of binary svf and restart files810 CHARACTER(rad_version_len), PARAMETER :: rad_version = 'RAD v. 4.1' !< identification of version of binary svf and restart files 801 811 INTEGER(iwp) :: raytrace_discrete_elevs = 40 !< number of discretization steps for elevation (nadir to zenith) 802 812 INTEGER(iwp) :: raytrace_discrete_azims = 80 !< number of discretization steps for azimuth (out of 360 degrees) … … 1107 1117 cos_zenith, calc_zenith, sun_direction, sun_dir_lat, sun_dir_lon, & 1108 1118 idir, jdir, kdir, id, iz, iy, ix, & 1109 iup, inorth, isouth, ieast, iwest, & 1119 iup, idown, inorth, isouth, ieast, iwest, & 1120 nd, dirname, diridx, dirint, & 1110 1121 nsurf_type, nz_urban_b, nz_urban_t, nz_urban, pch, nsurf, & 1111 1122 idsvf, ndsvf, idcsf, ndcsf, kdcsf, pct, & … … 1183 1194 INTEGER(iwp) :: ilast_word 1184 1195 INTEGER(iwp) :: ilen 1196 INTEGER(iwp) :: id 1185 1197 1186 1198 var = TRIM(variable) … … 1188 1200 !-- Identify directional variables 1189 1201 ilast_word = SCAN(var, '_', back=.TRUE.) 1202 directional = .FALSE. 1190 1203 IF ( ilast_word > 0 ) THEN 1191 SELECT CASE ( var(ilast_word:) )1192 CASE ( '_roof', '_south', '_north', '_west', '_east' )1204 DO id = 0, nd-1 1205 IF ( TRIM(var(ilast_word:)) == TRIM(dirname(id)) ) THEN 1193 1206 directional = .TRUE. 1194 write(9, *) 'vardir', var1195 flush(9)1196 1207 var = var(1:ilast_word-1) 1197 CASE DEFAULT 1198 directional = .FALSE. 1199 write(9, *) 'varnd', var 1200 flush(9) 1201 END SELECT 1202 ELSE 1203 directional = .FALSE. 1204 END IF 1208 EXIT 1209 ENDIF 1210 ENDDO 1211 ENDIF 1205 1212 1206 1213 IF ( directional ) THEN … … 1213 1220 unit = '1' 1214 1221 ELSE 1215 SELECT CASE ( var)1222 SELECT CASE ( TRIM(var) ) 1216 1223 CASE ( 'rtm_rad_net', 'rtm_rad_insw', 'rtm_rad_inlw', & 1217 1224 'rtm_rad_inswdir', 'rtm_rad_inswdif', 'rtm_rad_inswref', & … … 1689 1696 ! 1690 1697 !-- Allocate array for storing the surface net radiation 1691 IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_net ) .AND. & 1692 surf_lsm_h%ns > 0 ) THEN 1693 ALLOCATE( surf_lsm_h%rad_net(1:surf_lsm_h%ns) ) 1694 surf_lsm_h%rad_net = 0.0_wp 1695 ENDIF 1696 IF ( .NOT. ALLOCATED ( surf_usm_h%rad_net ) .AND. & 1697 surf_usm_h%ns > 0 ) THEN 1698 ALLOCATE( surf_usm_h%rad_net(1:surf_usm_h%ns) ) 1699 surf_usm_h%rad_net = 0.0_wp 1700 ENDIF 1698 DO l = 0, 1 1699 IF ( .NOT. ALLOCATED ( surf_lsm_h(l)%rad_net ) .AND. & 1700 surf_lsm_h(l)%ns > 0 ) THEN 1701 ALLOCATE( surf_lsm_h(l)%rad_net(1:surf_lsm_h(l)%ns) ) 1702 surf_lsm_h(l)%rad_net = 0.0_wp 1703 ENDIF 1704 IF ( .NOT. ALLOCATED ( surf_usm_h(l)%rad_net ) .AND. & 1705 surf_usm_h(l)%ns > 0 ) THEN 1706 ALLOCATE( surf_usm_h(l)%rad_net(1:surf_usm_h(l)%ns) ) 1707 surf_usm_h(l)%rad_net = 0.0_wp 1708 ENDIF 1709 ENDDO 1701 1710 DO l = 0, 3 1702 1711 IF ( .NOT. ALLOCATED ( surf_lsm_v(l)%rad_net ) .AND. & … … 1715 1724 ! 1716 1725 !-- Allocate array for storing the surface longwave (out) radiation change 1717 IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_lw_out_change_0 ) .AND. & 1718 surf_lsm_h%ns > 0 ) THEN 1719 ALLOCATE( surf_lsm_h%rad_lw_out_change_0(1:surf_lsm_h%ns) ) 1720 surf_lsm_h%rad_lw_out_change_0 = 0.0_wp 1721 ENDIF 1722 IF ( .NOT. ALLOCATED ( surf_usm_h%rad_lw_out_change_0 ) .AND. & 1723 surf_usm_h%ns > 0 ) THEN 1724 ALLOCATE( surf_usm_h%rad_lw_out_change_0(1:surf_usm_h%ns) ) 1725 surf_usm_h%rad_lw_out_change_0 = 0.0_wp 1726 ENDIF 1726 DO l = 0, 1 1727 IF ( .NOT. ALLOCATED ( surf_lsm_h(l)%rad_lw_out_change_0 ) .AND. & 1728 surf_lsm_h(l)%ns > 0 ) THEN 1729 ALLOCATE( surf_lsm_h(l)%rad_lw_out_change_0(1:surf_lsm_h(l)%ns) ) 1730 surf_lsm_h(l)%rad_lw_out_change_0 = 0.0_wp 1731 ENDIF 1732 IF ( .NOT. ALLOCATED ( surf_usm_h(l)%rad_lw_out_change_0 ) .AND. & 1733 surf_usm_h(l)%ns > 0 ) THEN 1734 ALLOCATE( surf_usm_h(l)%rad_lw_out_change_0(1:surf_usm_h(l)%ns) ) 1735 surf_usm_h(l)%rad_lw_out_change_0 = 0.0_wp 1736 ENDIF 1737 ENDDO 1727 1738 DO l = 0, 3 1728 1739 IF ( .NOT. ALLOCATED ( surf_lsm_v(l)%rad_lw_out_change_0 ) .AND. & … … 1740 1751 ! 1741 1752 !-- Allocate surface arrays for incoming/outgoing short/longwave radiation 1742 IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_sw_in ) .AND. & 1743 surf_lsm_h%ns > 0 ) THEN 1744 ALLOCATE( surf_lsm_h%rad_sw_in(1:surf_lsm_h%ns) ) 1745 ALLOCATE( surf_lsm_h%rad_sw_out(1:surf_lsm_h%ns) ) 1746 ALLOCATE( surf_lsm_h%rad_sw_dir(1:surf_lsm_h%ns) ) 1747 ALLOCATE( surf_lsm_h%rad_sw_dif(1:surf_lsm_h%ns) ) 1748 ALLOCATE( surf_lsm_h%rad_sw_ref(1:surf_lsm_h%ns) ) 1749 ALLOCATE( surf_lsm_h%rad_sw_res(1:surf_lsm_h%ns) ) 1750 ALLOCATE( surf_lsm_h%rad_lw_in(1:surf_lsm_h%ns) ) 1751 ALLOCATE( surf_lsm_h%rad_lw_out(1:surf_lsm_h%ns) ) 1752 ALLOCATE( surf_lsm_h%rad_lw_dif(1:surf_lsm_h%ns) ) 1753 ALLOCATE( surf_lsm_h%rad_lw_ref(1:surf_lsm_h%ns) ) 1754 ALLOCATE( surf_lsm_h%rad_lw_res(1:surf_lsm_h%ns) ) 1755 surf_lsm_h%rad_sw_in = 0.0_wp 1756 surf_lsm_h%rad_sw_out = 0.0_wp 1757 surf_lsm_h%rad_sw_dir = 0.0_wp 1758 surf_lsm_h%rad_sw_dif = 0.0_wp 1759 surf_lsm_h%rad_sw_ref = 0.0_wp 1760 surf_lsm_h%rad_sw_res = 0.0_wp 1761 surf_lsm_h%rad_lw_in = 0.0_wp 1762 surf_lsm_h%rad_lw_out = 0.0_wp 1763 surf_lsm_h%rad_lw_dif = 0.0_wp 1764 surf_lsm_h%rad_lw_ref = 0.0_wp 1765 surf_lsm_h%rad_lw_res = 0.0_wp 1766 ENDIF 1767 IF ( .NOT. ALLOCATED ( surf_usm_h%rad_sw_in ) .AND. & 1768 surf_usm_h%ns > 0 ) THEN 1769 ALLOCATE( surf_usm_h%rad_sw_in(1:surf_usm_h%ns) ) 1770 ALLOCATE( surf_usm_h%rad_sw_out(1:surf_usm_h%ns) ) 1771 ALLOCATE( surf_usm_h%rad_sw_dir(1:surf_usm_h%ns) ) 1772 ALLOCATE( surf_usm_h%rad_sw_dif(1:surf_usm_h%ns) ) 1773 ALLOCATE( surf_usm_h%rad_sw_ref(1:surf_usm_h%ns) ) 1774 ALLOCATE( surf_usm_h%rad_sw_res(1:surf_usm_h%ns) ) 1775 ALLOCATE( surf_usm_h%rad_lw_in(1:surf_usm_h%ns) ) 1776 ALLOCATE( surf_usm_h%rad_lw_out(1:surf_usm_h%ns) ) 1777 ALLOCATE( surf_usm_h%rad_lw_dif(1:surf_usm_h%ns) ) 1778 ALLOCATE( surf_usm_h%rad_lw_ref(1:surf_usm_h%ns) ) 1779 ALLOCATE( surf_usm_h%rad_lw_res(1:surf_usm_h%ns) ) 1780 surf_usm_h%rad_sw_in = 0.0_wp 1781 surf_usm_h%rad_sw_out = 0.0_wp 1782 surf_usm_h%rad_sw_dir = 0.0_wp 1783 surf_usm_h%rad_sw_dif = 0.0_wp 1784 surf_usm_h%rad_sw_ref = 0.0_wp 1785 surf_usm_h%rad_sw_res = 0.0_wp 1786 surf_usm_h%rad_lw_in = 0.0_wp 1787 surf_usm_h%rad_lw_out = 0.0_wp 1788 surf_usm_h%rad_lw_dif = 0.0_wp 1789 surf_usm_h%rad_lw_ref = 0.0_wp 1790 surf_usm_h%rad_lw_res = 0.0_wp 1791 ENDIF 1753 DO l = 0, 1 1754 IF ( .NOT. ALLOCATED ( surf_lsm_h(l)%rad_sw_in ) .AND. & 1755 surf_lsm_h(l)%ns > 0 ) THEN 1756 ALLOCATE( surf_lsm_h(l)%rad_sw_in(1:surf_lsm_h(l)%ns) ) 1757 ALLOCATE( surf_lsm_h(l)%rad_sw_out(1:surf_lsm_h(l)%ns) ) 1758 ALLOCATE( surf_lsm_h(l)%rad_sw_dir(1:surf_lsm_h(l)%ns) ) 1759 ALLOCATE( surf_lsm_h(l)%rad_sw_dif(1:surf_lsm_h(l)%ns) ) 1760 ALLOCATE( surf_lsm_h(l)%rad_sw_ref(1:surf_lsm_h(l)%ns) ) 1761 ALLOCATE( surf_lsm_h(l)%rad_sw_res(1:surf_lsm_h(l)%ns) ) 1762 ALLOCATE( surf_lsm_h(l)%rad_lw_in(1:surf_lsm_h(l)%ns) ) 1763 ALLOCATE( surf_lsm_h(l)%rad_lw_out(1:surf_lsm_h(l)%ns) ) 1764 ALLOCATE( surf_lsm_h(l)%rad_lw_dif(1:surf_lsm_h(l)%ns) ) 1765 ALLOCATE( surf_lsm_h(l)%rad_lw_ref(1:surf_lsm_h(l)%ns) ) 1766 ALLOCATE( surf_lsm_h(l)%rad_lw_res(1:surf_lsm_h(l)%ns) ) 1767 surf_lsm_h(l)%rad_sw_in = 0.0_wp 1768 surf_lsm_h(l)%rad_sw_out = 0.0_wp 1769 surf_lsm_h(l)%rad_sw_dir = 0.0_wp 1770 surf_lsm_h(l)%rad_sw_dif = 0.0_wp 1771 surf_lsm_h(l)%rad_sw_ref = 0.0_wp 1772 surf_lsm_h(l)%rad_sw_res = 0.0_wp 1773 surf_lsm_h(l)%rad_lw_in = 0.0_wp 1774 surf_lsm_h(l)%rad_lw_out = 0.0_wp 1775 surf_lsm_h(l)%rad_lw_dif = 0.0_wp 1776 surf_lsm_h(l)%rad_lw_ref = 0.0_wp 1777 surf_lsm_h(l)%rad_lw_res = 0.0_wp 1778 ENDIF 1779 IF ( .NOT. ALLOCATED ( surf_usm_h(l)%rad_sw_in ) .AND. & 1780 surf_usm_h(l)%ns > 0 ) THEN 1781 ALLOCATE( surf_usm_h(l)%rad_sw_in(1:surf_usm_h(l)%ns) ) 1782 ALLOCATE( surf_usm_h(l)%rad_sw_out(1:surf_usm_h(l)%ns) ) 1783 ALLOCATE( surf_usm_h(l)%rad_sw_dir(1:surf_usm_h(l)%ns) ) 1784 ALLOCATE( surf_usm_h(l)%rad_sw_dif(1:surf_usm_h(l)%ns) ) 1785 ALLOCATE( surf_usm_h(l)%rad_sw_ref(1:surf_usm_h(l)%ns) ) 1786 ALLOCATE( surf_usm_h(l)%rad_sw_res(1:surf_usm_h(l)%ns) ) 1787 ALLOCATE( surf_usm_h(l)%rad_lw_in(1:surf_usm_h(l)%ns) ) 1788 ALLOCATE( surf_usm_h(l)%rad_lw_out(1:surf_usm_h(l)%ns) ) 1789 ALLOCATE( surf_usm_h(l)%rad_lw_dif(1:surf_usm_h(l)%ns) ) 1790 ALLOCATE( surf_usm_h(l)%rad_lw_ref(1:surf_usm_h(l)%ns) ) 1791 ALLOCATE( surf_usm_h(l)%rad_lw_res(1:surf_usm_h(l)%ns) ) 1792 surf_usm_h(l)%rad_sw_in = 0.0_wp 1793 surf_usm_h(l)%rad_sw_out = 0.0_wp 1794 surf_usm_h(l)%rad_sw_dir = 0.0_wp 1795 surf_usm_h(l)%rad_sw_dif = 0.0_wp 1796 surf_usm_h(l)%rad_sw_ref = 0.0_wp 1797 surf_usm_h(l)%rad_sw_res = 0.0_wp 1798 surf_usm_h(l)%rad_lw_in = 0.0_wp 1799 surf_usm_h(l)%rad_lw_out = 0.0_wp 1800 surf_usm_h(l)%rad_lw_dif = 0.0_wp 1801 surf_usm_h(l)%rad_lw_ref = 0.0_wp 1802 surf_usm_h(l)%rad_lw_res = 0.0_wp 1803 ENDIF 1804 ENDDO 1792 1805 DO l = 0, 3 1793 1806 IF ( .NOT. ALLOCATED ( surf_lsm_v(l)%rad_sw_in ) .AND. & … … 1848 1861 !-- Fix net radiation in case of radiation_scheme = 'constant' 1849 1862 IF ( radiation_scheme == 'constant' ) THEN 1850 IF ( ALLOCATED( surf_lsm_h%rad_net ) ) & 1851 surf_lsm_h%rad_net = net_radiation 1852 IF ( ALLOCATED( surf_usm_h%rad_net ) ) & 1853 surf_usm_h%rad_net = net_radiation 1863 DO l = 0, 1 1864 IF ( ALLOCATED( surf_lsm_h(l)%rad_net ) ) & 1865 surf_lsm_h(l)%rad_net = net_radiation 1866 IF ( ALLOCATED( surf_usm_h(l)%rad_net ) ) & 1867 surf_usm_h(l)%rad_net = net_radiation 1868 ENDDO 1854 1869 ! 1855 1870 !-- Todo: weight with inclination angle … … 1912 1927 !-- Allocate arrays for broadband albedo, and level 1 initialization 1913 1928 !-- via namelist paramter, unless not already allocated. 1914 IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) ) THEN 1915 ALLOCATE( surf_lsm_h%albedo(1:surf_lsm_h%ns,0:2) ) 1916 surf_lsm_h%albedo = albedo 1917 ENDIF 1918 IF ( .NOT. ALLOCATED(surf_usm_h%albedo) ) THEN 1919 ALLOCATE( surf_usm_h%albedo(1:surf_usm_h%ns,0:2) ) 1920 surf_usm_h%albedo = albedo 1921 ENDIF 1922 1929 DO l = 0, 1 1930 IF ( .NOT. ALLOCATED(surf_lsm_h(l)%albedo) ) THEN 1931 ALLOCATE( surf_lsm_h(l)%albedo(1:surf_lsm_h(l)%ns,0:2) ) 1932 surf_lsm_h(l)%albedo = albedo 1933 ENDIF 1934 IF ( .NOT. ALLOCATED(surf_usm_h(l)%albedo) ) THEN 1935 ALLOCATE( surf_usm_h(l)%albedo(1:surf_usm_h(l)%ns,0:2) ) 1936 surf_usm_h(l)%albedo = albedo 1937 ENDIF 1938 ENDDO 1923 1939 DO l = 0, 3 1924 1940 IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) ) THEN … … 1936 1952 !-- input data is read from ASCII file, albedo_type will be zero, so that 1937 1953 !-- albedo won't be overwritten. 1938 DO m = 1, surf_lsm_h%ns 1939 IF ( surf_lsm_h%albedo_type(m,ind_veg_wall) /= 0 ) & 1940 surf_lsm_h%albedo(m,ind_veg_wall) = & 1941 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_veg_wall)) 1942 IF ( surf_lsm_h%albedo_type(m,ind_pav_green) /= 0 ) & 1943 surf_lsm_h%albedo(m,ind_pav_green) = & 1944 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_pav_green)) 1945 IF ( surf_lsm_h%albedo_type(m,ind_wat_win) /= 0 ) & 1946 surf_lsm_h%albedo(m,ind_wat_win) = & 1947 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_wat_win)) 1954 DO l = 0, 1 1955 DO m = 1, surf_lsm_h(l)%ns 1956 IF ( surf_lsm_h(l)%albedo_type(m,ind_veg_wall) /= 0 ) & 1957 surf_lsm_h(l)%albedo(m,ind_veg_wall) = & 1958 albedo_pars(0,surf_lsm_h(l)%albedo_type(m,ind_veg_wall)) 1959 IF ( surf_lsm_h(l)%albedo_type(m,ind_pav_green) /= 0 ) & 1960 surf_lsm_h(l)%albedo(m,ind_pav_green) = & 1961 albedo_pars(0,surf_lsm_h(l)%albedo_type(m,ind_pav_green)) 1962 IF ( surf_lsm_h(l)%albedo_type(m,ind_wat_win) /= 0 ) & 1963 surf_lsm_h(l)%albedo(m,ind_wat_win) = & 1964 albedo_pars(0,surf_lsm_h(l)%albedo_type(m,ind_wat_win)) 1965 ENDDO 1966 DO m = 1, surf_usm_h(l)%ns 1967 IF ( surf_usm_h(l)%albedo_type(m,ind_veg_wall) /= 0 ) & 1968 surf_usm_h(l)%albedo(m,ind_veg_wall) = & 1969 albedo_pars(0,surf_usm_h(l)%albedo_type(m,ind_veg_wall)) 1970 IF ( surf_usm_h(l)%albedo_type(m,ind_pav_green) /= 0 ) & 1971 surf_usm_h(l)%albedo(m,ind_pav_green) = & 1972 albedo_pars(0,surf_usm_h(l)%albedo_type(m,ind_pav_green)) 1973 IF ( surf_usm_h(l)%albedo_type(m,ind_wat_win) /= 0 ) & 1974 surf_usm_h(l)%albedo(m,ind_wat_win) = & 1975 albedo_pars(0,surf_usm_h(l)%albedo_type(m,ind_wat_win)) 1976 ENDDO 1948 1977 ENDDO 1949 DO m = 1, surf_usm_h%ns1950 IF ( surf_usm_h%albedo_type(m,ind_veg_wall) /= 0 ) &1951 surf_usm_h%albedo(m,ind_veg_wall) = &1952 albedo_pars(0,surf_usm_h%albedo_type(m,ind_veg_wall))1953 IF ( surf_usm_h%albedo_type(m,ind_pav_green) /= 0 ) &1954 surf_usm_h%albedo(m,ind_pav_green) = &1955 albedo_pars(0,surf_usm_h%albedo_type(m,ind_pav_green))1956 IF ( surf_usm_h%albedo_type(m,ind_wat_win) /= 0 ) &1957 surf_usm_h%albedo(m,ind_wat_win) = &1958 albedo_pars(0,surf_usm_h%albedo_type(m,ind_wat_win))1959 ENDDO1960 1961 1978 DO l = 0, 3 1962 1979 DO m = 1, surf_lsm_v(l)%ns … … 1991 2008 ! 1992 2009 !-- Horizontal surfaces 1993 DO m = 1, surf_lsm_h%ns 1994 i = surf_lsm_h%i(m) 1995 j = surf_lsm_h%j(m) 1996 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1997 surf_lsm_h%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 1998 surf_lsm_h%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 1999 surf_lsm_h%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 2000 ENDIF 2001 ENDDO 2002 DO m = 1, surf_usm_h%ns 2003 i = surf_usm_h%i(m) 2004 j = surf_usm_h%j(m) 2005 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 2006 surf_usm_h%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 2007 surf_usm_h%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 2008 surf_usm_h%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 2009 ENDIF 2010 DO l = 0, 1 2011 DO m = 1, surf_lsm_h(l)%ns 2012 i = surf_lsm_h(l)%i(m) 2013 j = surf_lsm_h(l)%j(m) 2014 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 2015 surf_lsm_h(l)%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 2016 surf_lsm_h(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 2017 surf_lsm_h(l)%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 2018 ENDIF 2019 ENDDO 2020 DO m = 1, surf_usm_h(l)%ns 2021 i = surf_usm_h(l)%i(m) 2022 j = surf_usm_h(l)%j(m) 2023 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 2024 surf_usm_h(l)%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 2025 surf_usm_h(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 2026 surf_usm_h(l)%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 2027 ENDIF 2028 ENDDO 2010 2029 ENDDO 2011 2030 ! … … 2044 2063 !-- to zero in order to take effect. 2045 2064 IF ( building_surface_pars_f%from_file ) THEN 2046 DO m = 1, surf_usm_h%ns 2047 i = surf_usm_h%i(m) 2048 j = surf_usm_h%j(m) 2049 k = surf_usm_h%k(m) 2050 ! 2051 !-- Iterate over surfaces in column, check height and orientation 2052 DO is = building_surface_pars_f%index_ji(1,j,i), & 2053 building_surface_pars_f%index_ji(2,j,i) 2054 IF ( building_surface_pars_f%coords(4,is) == -surf_usm_h%koff .AND. & 2055 building_surface_pars_f%coords(1,is) == k ) THEN 2056 2057 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2058 building_surface_pars_f%fill ) THEN 2059 surf_usm_h%albedo(m,ind_veg_wall) = & 2060 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2061 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2065 DO l = 0, 1 2066 DO m = 1, surf_usm_h(l)%ns 2067 i = surf_usm_h(l)%i(m) 2068 j = surf_usm_h(l)%j(m) 2069 k = surf_usm_h(l)%k(m) 2070 ! 2071 !-- Iterate over surfaces in column, check height and orientation 2072 DO is = building_surface_pars_f%index_ji(1,j,i), & 2073 building_surface_pars_f%index_ji(2,j,i) 2074 IF ( building_surface_pars_f%coords(4,is) == -surf_usm_h(l)%koff .AND. & 2075 building_surface_pars_f%coords(1,is) == k ) THEN 2076 2077 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2078 building_surface_pars_f%fill ) THEN 2079 surf_usm_h(l)%albedo(m,ind_veg_wall) = & 2080 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2081 surf_usm_h(l)%albedo_type(m,ind_veg_wall) = 0 2082 ENDIF 2083 2084 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2085 building_surface_pars_f%fill ) THEN 2086 surf_usm_h(l)%albedo(m,ind_wat_win) = & 2087 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2088 surf_usm_h(l)%albedo_type(m,ind_wat_win) = 0 2089 ENDIF 2090 2091 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2092 building_surface_pars_f%fill ) THEN 2093 surf_usm_h(l)%albedo(m,ind_pav_green) = & 2094 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2095 surf_usm_h(l)%albedo_type(m,ind_pav_green) = 0 2096 ENDIF 2097 2098 EXIT ! surface was found and processed 2062 2099 ENDIF 2063 2064 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2065 building_surface_pars_f%fill ) THEN 2066 surf_usm_h%albedo(m,ind_wat_win) = & 2067 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2068 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2069 ENDIF 2070 2071 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2072 building_surface_pars_f%fill ) THEN 2073 surf_usm_h%albedo(m,ind_pav_green) = & 2074 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2075 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2076 ENDIF 2077 2078 EXIT ! surface was found and processed 2079 ENDIF 2100 ENDDO 2080 2101 ENDDO 2081 2102 ENDDO … … 2129 2150 !-- for wall/green/window (USM) or vegetation/pavement/water surfaces 2130 2151 !-- (LSM). 2131 ALLOCATE ( surf_lsm_h%aldif(1:surf_lsm_h%ns,0:2) ) 2132 ALLOCATE ( surf_lsm_h%aldir(1:surf_lsm_h%ns,0:2) ) 2133 ALLOCATE ( surf_lsm_h%asdif(1:surf_lsm_h%ns,0:2) ) 2134 ALLOCATE ( surf_lsm_h%asdir(1:surf_lsm_h%ns,0:2) ) 2135 ALLOCATE ( surf_lsm_h%rrtm_aldif(1:surf_lsm_h%ns,0:2) ) 2136 ALLOCATE ( surf_lsm_h%rrtm_aldir(1:surf_lsm_h%ns,0:2) ) 2137 ALLOCATE ( surf_lsm_h%rrtm_asdif(1:surf_lsm_h%ns,0:2) ) 2138 ALLOCATE ( surf_lsm_h%rrtm_asdir(1:surf_lsm_h%ns,0:2) ) 2139 2140 ALLOCATE ( surf_usm_h%aldif(1:surf_usm_h%ns,0:2) ) 2141 ALLOCATE ( surf_usm_h%aldir(1:surf_usm_h%ns,0:2) ) 2142 ALLOCATE ( surf_usm_h%asdif(1:surf_usm_h%ns,0:2) ) 2143 ALLOCATE ( surf_usm_h%asdir(1:surf_usm_h%ns,0:2) ) 2144 ALLOCATE ( surf_usm_h%rrtm_aldif(1:surf_usm_h%ns,0:2) ) 2145 ALLOCATE ( surf_usm_h%rrtm_aldir(1:surf_usm_h%ns,0:2) ) 2146 ALLOCATE ( surf_usm_h%rrtm_asdif(1:surf_usm_h%ns,0:2) ) 2147 ALLOCATE ( surf_usm_h%rrtm_asdir(1:surf_usm_h%ns,0:2) ) 2148 2149 ! 2150 !-- Allocate broadband albedo (temporary for the current radiation 2151 !-- implementations) 2152 IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) ) & 2153 ALLOCATE( surf_lsm_h%albedo(1:surf_lsm_h%ns,0:2) ) 2154 IF ( .NOT. ALLOCATED(surf_usm_h%albedo) ) & 2155 ALLOCATE( surf_usm_h%albedo(1:surf_usm_h%ns,0:2) ) 2156 2152 DO l = 0, 1 2153 ALLOCATE ( surf_lsm_h(l)%aldif(1:surf_lsm_h(l)%ns,0:2) ) 2154 ALLOCATE ( surf_lsm_h(l)%aldir(1:surf_lsm_h(l)%ns,0:2) ) 2155 ALLOCATE ( surf_lsm_h(l)%asdif(1:surf_lsm_h(l)%ns,0:2) ) 2156 ALLOCATE ( surf_lsm_h(l)%asdir(1:surf_lsm_h(l)%ns,0:2) ) 2157 ALLOCATE ( surf_lsm_h(l)%rrtm_aldif(1:surf_lsm_h(l)%ns,0:2) ) 2158 ALLOCATE ( surf_lsm_h(l)%rrtm_aldir(1:surf_lsm_h(l)%ns,0:2) ) 2159 ALLOCATE ( surf_lsm_h(l)%rrtm_asdif(1:surf_lsm_h(l)%ns,0:2) ) 2160 ALLOCATE ( surf_lsm_h(l)%rrtm_asdir(1:surf_lsm_h(l)%ns,0:2) ) 2161 2162 ALLOCATE ( surf_usm_h(l)%aldif(1:surf_usm_h(l)%ns,0:2) ) 2163 ALLOCATE ( surf_usm_h(l)%aldir(1:surf_usm_h(l)%ns,0:2) ) 2164 ALLOCATE ( surf_usm_h(l)%asdif(1:surf_usm_h(l)%ns,0:2) ) 2165 ALLOCATE ( surf_usm_h(l)%asdir(1:surf_usm_h(l)%ns,0:2) ) 2166 ALLOCATE ( surf_usm_h(l)%rrtm_aldif(1:surf_usm_h(l)%ns,0:2) ) 2167 ALLOCATE ( surf_usm_h(l)%rrtm_aldir(1:surf_usm_h(l)%ns,0:2) ) 2168 ALLOCATE ( surf_usm_h(l)%rrtm_asdif(1:surf_usm_h(l)%ns,0:2) ) 2169 ALLOCATE ( surf_usm_h(l)%rrtm_asdir(1:surf_usm_h(l)%ns,0:2) ) 2170 2171 ! 2172 !-- Allocate broadband albedo (temporary for the current radiation 2173 !-- implementations) 2174 IF ( .NOT. ALLOCATED(surf_lsm_h(l)%albedo) ) & 2175 ALLOCATE( surf_lsm_h(l)%albedo(1:surf_lsm_h(l)%ns,0:2) ) 2176 IF ( .NOT. ALLOCATED(surf_usm_h(l)%albedo) ) & 2177 ALLOCATE( surf_usm_h(l)%albedo(1:surf_usm_h(l)%ns,0:2) ) 2178 ENDDO 2157 2179 ! 2158 2180 !-- Allocate albedos for short/longwave radiation, vertical surfaces … … 2191 2213 !-- paramters. Please note, this case all surface tiles are initialized 2192 2214 !-- the same. 2193 IF ( surf_lsm_h%ns > 0 ) THEN 2194 surf_lsm_h%aldif = albedo_lw_dif 2195 surf_lsm_h%aldir = albedo_lw_dir 2196 surf_lsm_h%asdif = albedo_sw_dif 2197 surf_lsm_h%asdir = albedo_sw_dir 2198 surf_lsm_h%albedo = albedo_sw_dif 2199 ENDIF 2200 IF ( surf_usm_h%ns > 0 ) THEN 2201 IF ( surf_usm_h%albedo_from_ascii ) THEN 2202 surf_usm_h%aldif = surf_usm_h%albedo 2203 surf_usm_h%aldir = surf_usm_h%albedo 2204 surf_usm_h%asdif = surf_usm_h%albedo 2205 surf_usm_h%asdir = surf_usm_h%albedo 2206 ELSE 2207 surf_usm_h%aldif = albedo_lw_dif 2208 surf_usm_h%aldir = albedo_lw_dir 2209 surf_usm_h%asdif = albedo_sw_dif 2210 surf_usm_h%asdir = albedo_sw_dir 2211 surf_usm_h%albedo = albedo_sw_dif 2215 DO l = 0, 1 2216 IF ( surf_lsm_h(l)%ns > 0 ) THEN 2217 surf_lsm_h(l)%aldif = albedo_lw_dif 2218 surf_lsm_h(l)%aldir = albedo_lw_dir 2219 surf_lsm_h(l)%asdif = albedo_sw_dif 2220 surf_lsm_h(l)%asdir = albedo_sw_dir 2221 surf_lsm_h(l)%albedo = albedo_sw_dif 2212 2222 ENDIF 2213 ENDIF 2214 2223 IF ( surf_usm_h(l)%ns > 0 ) THEN 2224 IF ( surf_usm_h(l)%albedo_from_ascii ) THEN 2225 surf_usm_h(l)%aldif = surf_usm_h(l)%albedo 2226 surf_usm_h(l)%aldir = surf_usm_h(l)%albedo 2227 surf_usm_h(l)%asdif = surf_usm_h(l)%albedo 2228 surf_usm_h(l)%asdir = surf_usm_h(l)%albedo 2229 ELSE 2230 surf_usm_h(l)%aldif = albedo_lw_dif 2231 surf_usm_h(l)%aldir = albedo_lw_dir 2232 surf_usm_h(l)%asdif = albedo_sw_dif 2233 surf_usm_h(l)%asdir = albedo_sw_dir 2234 surf_usm_h(l)%albedo = albedo_sw_dif 2235 ENDIF 2236 ENDIF 2237 ENDDO 2215 2238 DO l = 0, 3 2216 2239 … … 2243 2266 !-- is applied so that the resulting albedo is calculated via the weighted 2244 2267 !-- average of respective surface fractions. 2245 DO m = 1, surf_lsm_h%ns 2246 ! 2247 !-- Spectral albedos for vegetation/pavement/water surfaces 2248 DO ind_type = 0, 2 2249 IF ( surf_lsm_h%albedo_type(m,ind_type) /= 0 ) THEN 2250 surf_lsm_h%aldif(m,ind_type) = & 2251 albedo_pars(1,surf_lsm_h%albedo_type(m,ind_type)) 2252 surf_lsm_h%asdif(m,ind_type) = & 2253 albedo_pars(2,surf_lsm_h%albedo_type(m,ind_type)) 2254 surf_lsm_h%aldir(m,ind_type) = & 2255 albedo_pars(1,surf_lsm_h%albedo_type(m,ind_type)) 2256 surf_lsm_h%asdir(m,ind_type) = & 2257 albedo_pars(2,surf_lsm_h%albedo_type(m,ind_type)) 2258 surf_lsm_h%albedo(m,ind_type) = & 2259 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_type)) 2260 ENDIF 2261 ENDDO 2262 2263 ENDDO 2264 ! 2265 !-- For urban surface only if albedo has not been already initialized 2266 !-- in the urban-surface model via the ASCII file. 2267 IF ( .NOT. surf_usm_h%albedo_from_ascii ) THEN 2268 DO m = 1, surf_usm_h%ns 2269 ! 2270 !-- Spectral albedos for wall/green/window surfaces 2268 DO l = 0, 1 2269 DO m = 1, surf_lsm_h(l)%ns 2270 ! 2271 !-- Spectral albedos for vegetation/pavement/water surfaces 2271 2272 DO ind_type = 0, 2 2272 IF ( surf_ usm_h%albedo_type(m,ind_type) /= 0 ) THEN2273 surf_ usm_h%aldif(m,ind_type) =&2274 albedo_pars(1,surf_usm_h%albedo_type(m,ind_type))2275 surf_ usm_h%asdif(m,ind_type) =&2276 albedo_pars(2,surf_usm_h%albedo_type(m,ind_type))2277 surf_ usm_h%aldir(m,ind_type) =&2278 albedo_pars(1,surf_usm_h%albedo_type(m,ind_type))2279 surf_ usm_h%asdir(m,ind_type) =&2280 albedo_pars(2,surf_usm_h%albedo_type(m,ind_type))2281 surf_ usm_h%albedo(m,ind_type) =&2282 albedo_pars(0,surf_usm_h%albedo_type(m,ind_type))2273 IF ( surf_lsm_h(l)%albedo_type(m,ind_type) /= 0 ) THEN 2274 surf_lsm_h(l)%aldif(m,ind_type) = & 2275 albedo_pars(1,surf_lsm_h(l)%albedo_type(m,ind_type)) 2276 surf_lsm_h(l)%asdif(m,ind_type) = & 2277 albedo_pars(2,surf_lsm_h(l)%albedo_type(m,ind_type)) 2278 surf_lsm_h(l)%aldir(m,ind_type) = & 2279 albedo_pars(1,surf_lsm_h(l)%albedo_type(m,ind_type)) 2280 surf_lsm_h(l)%asdir(m,ind_type) = & 2281 albedo_pars(2,surf_lsm_h(l)%albedo_type(m,ind_type)) 2282 surf_lsm_h(l)%albedo(m,ind_type) = & 2283 albedo_pars(0,surf_lsm_h(l)%albedo_type(m,ind_type)) 2283 2284 ENDIF 2284 2285 ENDDO 2285 2286 2286 2287 ENDDO 2287 ENDIF 2288 ! 2289 !-- For urban surface only if albedo has not been already initialized 2290 !-- in the urban-surface model via the ASCII file. 2291 IF ( .NOT. surf_usm_h(l)%albedo_from_ascii ) THEN 2292 DO m = 1, surf_usm_h(l)%ns 2293 ! 2294 !-- Spectral albedos for wall/green/window surfaces 2295 DO ind_type = 0, 2 2296 IF ( surf_usm_h(l)%albedo_type(m,ind_type) /= 0 ) THEN 2297 surf_usm_h(l)%aldif(m,ind_type) = & 2298 albedo_pars(1,surf_usm_h(l)%albedo_type(m,ind_type)) 2299 surf_usm_h(l)%asdif(m,ind_type) = & 2300 albedo_pars(2,surf_usm_h(l)%albedo_type(m,ind_type)) 2301 surf_usm_h(l)%aldir(m,ind_type) = & 2302 albedo_pars(1,surf_usm_h(l)%albedo_type(m,ind_type)) 2303 surf_usm_h(l)%asdir(m,ind_type) = & 2304 albedo_pars(2,surf_usm_h(l)%albedo_type(m,ind_type)) 2305 surf_usm_h(l)%albedo(m,ind_type) = & 2306 albedo_pars(0,surf_usm_h(l)%albedo_type(m,ind_type)) 2307 ENDIF 2308 ENDDO 2309 ENDDO 2310 ENDIF 2311 ENDDO 2288 2312 2289 2313 DO l = 0, 3 2290 2291 2314 DO m = 1, surf_lsm_v(l)%ns 2292 2315 ! … … 2338 2361 ! 2339 2362 !-- Horizontal 2340 DO m = 1, surf_lsm_h%ns 2341 i = surf_lsm_h%i(m) 2342 j = surf_lsm_h%j(m) 2343 ! 2344 !-- Spectral albedos for vegetation/pavement/water surfaces 2345 DO ind_type = 0, 2 2346 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) & 2347 surf_lsm_h%albedo(m,ind_type) = & 2348 albedo_pars_f%pars_xy(0,j,i) 2349 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 2350 surf_lsm_h%aldir(m,ind_type) = & 2351 albedo_pars_f%pars_xy(1,j,i) 2352 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 2353 surf_lsm_h%aldif(m,ind_type) = & 2354 albedo_pars_f%pars_xy(1,j,i) 2355 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 2356 surf_lsm_h%asdir(m,ind_type) = & 2357 albedo_pars_f%pars_xy(2,j,i) 2358 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 2359 surf_lsm_h%asdif(m,ind_type) = & 2360 albedo_pars_f%pars_xy(2,j,i) 2363 DO l = 0, 1 2364 DO m = 1, surf_lsm_h(l)%ns 2365 i = surf_lsm_h(l)%i(m) 2366 j = surf_lsm_h(l)%j(m) 2367 ! 2368 !-- Spectral albedos for vegetation/pavement/water surfaces 2369 DO ind_type = 0, 2 2370 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) & 2371 surf_lsm_h(l)%albedo(m,ind_type) = & 2372 albedo_pars_f%pars_xy(0,j,i) 2373 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 2374 surf_lsm_h(l)%aldir(m,ind_type) = & 2375 albedo_pars_f%pars_xy(1,j,i) 2376 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 2377 surf_lsm_h(l)%aldif(m,ind_type) = & 2378 albedo_pars_f%pars_xy(1,j,i) 2379 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 2380 surf_lsm_h(l)%asdir(m,ind_type) = & 2381 albedo_pars_f%pars_xy(2,j,i) 2382 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 2383 surf_lsm_h(l)%asdif(m,ind_type) = & 2384 albedo_pars_f%pars_xy(2,j,i) 2385 ENDDO 2361 2386 ENDDO 2387 ! 2388 !-- For urban surface only if albedo has not been already initialized 2389 !-- in the urban-surface model via the ASCII file. 2390 IF ( .NOT. surf_usm_h(l)%albedo_from_ascii ) THEN 2391 DO m = 1, surf_usm_h(l)%ns 2392 i = surf_usm_h(l)%i(m) 2393 j = surf_usm_h(l)%j(m) 2394 ! 2395 !-- Broadband albedos for wall/green/window surfaces 2396 DO ind_type = 0, 2 2397 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )& 2398 surf_usm_h(l)%albedo(m,ind_type) = & 2399 albedo_pars_f%pars_xy(0,j,i) 2400 ENDDO 2401 ! 2402 !-- Spectral albedos especially for building wall surfaces 2403 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) THEN 2404 surf_usm_h(l)%aldir(m,ind_veg_wall) = & 2405 albedo_pars_f%pars_xy(1,j,i) 2406 surf_usm_h(l)%aldif(m,ind_veg_wall) = & 2407 albedo_pars_f%pars_xy(1,j,i) 2408 ENDIF 2409 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) THEN 2410 surf_usm_h(l)%asdir(m,ind_veg_wall) = & 2411 albedo_pars_f%pars_xy(2,j,i) 2412 surf_usm_h(l)%asdif(m,ind_veg_wall) = & 2413 albedo_pars_f%pars_xy(2,j,i) 2414 ENDIF 2415 ! 2416 !-- Spectral albedos especially for building green surfaces 2417 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill ) THEN 2418 surf_usm_h(l)%aldir(m,ind_pav_green) = & 2419 albedo_pars_f%pars_xy(3,j,i) 2420 surf_usm_h(l)%aldif(m,ind_pav_green) = & 2421 albedo_pars_f%pars_xy(3,j,i) 2422 ENDIF 2423 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill ) THEN 2424 surf_usm_h(l)%asdir(m,ind_pav_green) = & 2425 albedo_pars_f%pars_xy(4,j,i) 2426 surf_usm_h(l)%asdif(m,ind_pav_green) = & 2427 albedo_pars_f%pars_xy(4,j,i) 2428 ENDIF 2429 ! 2430 !-- Spectral albedos especially for building window surfaces 2431 IF ( albedo_pars_f%pars_xy(5,j,i) /= albedo_pars_f%fill ) THEN 2432 surf_usm_h(l)%aldir(m,ind_wat_win) = & 2433 albedo_pars_f%pars_xy(5,j,i) 2434 surf_usm_h(l)%aldif(m,ind_wat_win) = & 2435 albedo_pars_f%pars_xy(5,j,i) 2436 ENDIF 2437 IF ( albedo_pars_f%pars_xy(6,j,i) /= albedo_pars_f%fill ) THEN 2438 surf_usm_h(l)%asdir(m,ind_wat_win) = & 2439 albedo_pars_f%pars_xy(6,j,i) 2440 surf_usm_h(l)%asdif(m,ind_wat_win) = & 2441 albedo_pars_f%pars_xy(6,j,i) 2442 ENDIF 2443 2444 ENDDO 2445 ENDIF 2362 2446 ENDDO 2363 !2364 !-- For urban surface only if albedo has not been already initialized2365 !-- in the urban-surface model via the ASCII file.2366 IF ( .NOT. surf_usm_h%albedo_from_ascii ) THEN2367 DO m = 1, surf_usm_h%ns2368 i = surf_usm_h%i(m)2369 j = surf_usm_h%j(m)2370 !2371 !-- Broadband albedos for wall/green/window surfaces2372 DO ind_type = 0, 22373 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )&2374 surf_usm_h%albedo(m,ind_type) = &2375 albedo_pars_f%pars_xy(0,j,i)2376 ENDDO2377 !2378 !-- Spectral albedos especially for building wall surfaces2379 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) THEN2380 surf_usm_h%aldir(m,ind_veg_wall) = &2381 albedo_pars_f%pars_xy(1,j,i)2382 surf_usm_h%aldif(m,ind_veg_wall) = &2383 albedo_pars_f%pars_xy(1,j,i)2384 ENDIF2385 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) THEN2386 surf_usm_h%asdir(m,ind_veg_wall) = &2387 albedo_pars_f%pars_xy(2,j,i)2388 surf_usm_h%asdif(m,ind_veg_wall) = &2389 albedo_pars_f%pars_xy(2,j,i)2390 ENDIF2391 !2392 !-- Spectral albedos especially for building green surfaces2393 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill ) THEN2394 surf_usm_h%aldir(m,ind_pav_green) = &2395 albedo_pars_f%pars_xy(3,j,i)2396 surf_usm_h%aldif(m,ind_pav_green) = &2397 albedo_pars_f%pars_xy(3,j,i)2398 ENDIF2399 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill ) THEN2400 surf_usm_h%asdir(m,ind_pav_green) = &2401 albedo_pars_f%pars_xy(4,j,i)2402 surf_usm_h%asdif(m,ind_pav_green) = &2403 albedo_pars_f%pars_xy(4,j,i)2404 ENDIF2405 !2406 !-- Spectral albedos especially for building window surfaces2407 IF ( albedo_pars_f%pars_xy(5,j,i) /= albedo_pars_f%fill ) THEN2408 surf_usm_h%aldir(m,ind_wat_win) = &2409 albedo_pars_f%pars_xy(5,j,i)2410 surf_usm_h%aldif(m,ind_wat_win) = &2411 albedo_pars_f%pars_xy(5,j,i)2412 ENDIF2413 IF ( albedo_pars_f%pars_xy(6,j,i) /= albedo_pars_f%fill ) THEN2414 surf_usm_h%asdir(m,ind_wat_win) = &2415 albedo_pars_f%pars_xy(6,j,i)2416 surf_usm_h%asdif(m,ind_wat_win) = &2417 albedo_pars_f%pars_xy(6,j,i)2418 ENDIF2419 2420 ENDDO2421 ENDIF2422 2447 ! 2423 2448 !-- Vertical … … 2530 2555 !-- to zero in order to take effect. 2531 2556 IF ( building_surface_pars_f%from_file ) THEN 2532 DO m = 1, surf_usm_h%ns 2533 i = surf_usm_h%i(m) 2534 j = surf_usm_h%j(m) 2535 k = surf_usm_h%k(m) 2536 ! 2537 !-- Iterate over surfaces in column, check height and orientation 2538 DO is = building_surface_pars_f%index_ji(1,j,i), & 2539 building_surface_pars_f%index_ji(2,j,i) 2540 IF ( building_surface_pars_f%coords(4,is) == -surf_usm_h%koff .AND. & 2541 building_surface_pars_f%coords(1,is) == k ) THEN 2542 2543 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2544 building_surface_pars_f%fill ) THEN 2545 surf_usm_h%albedo(m,ind_veg_wall) = & 2546 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2547 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2557 DO l = 0, 1 2558 DO m = 1, surf_usm_h(l)%ns 2559 i = surf_usm_h(l)%i(m) 2560 j = surf_usm_h(l)%j(m) 2561 k = surf_usm_h(l)%k(m) 2562 ! 2563 !-- Iterate over surfaces in column, check height and orientation 2564 DO is = building_surface_pars_f%index_ji(1,j,i), & 2565 building_surface_pars_f%index_ji(2,j,i) 2566 IF ( building_surface_pars_f%coords(4,is) == -surf_usm_h(l)%koff .AND. & 2567 building_surface_pars_f%coords(1,is) == k ) THEN 2568 2569 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2570 building_surface_pars_f%fill ) THEN 2571 surf_usm_h(l)%albedo(m,ind_veg_wall) = & 2572 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2573 surf_usm_h(l)%albedo_type(m,ind_veg_wall) = 0 2574 ENDIF 2575 2576 IF ( building_surface_pars_f%pars(ind_s_alb_l_wall,is) /= & 2577 building_surface_pars_f%fill ) THEN 2578 surf_usm_h(l)%aldir(m,ind_veg_wall) = & 2579 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2580 surf_usm_h(l)%aldif(m,ind_veg_wall) = & 2581 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2582 surf_usm_h(l)%albedo_type(m,ind_veg_wall) = 0 2583 ENDIF 2584 2585 IF ( building_surface_pars_f%pars(ind_s_alb_s_wall,is) /= & 2586 building_surface_pars_f%fill ) THEN 2587 surf_usm_h(l)%asdir(m,ind_veg_wall) = & 2588 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2589 surf_usm_h(l)%asdif(m,ind_veg_wall) = & 2590 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2591 surf_usm_h(l)%albedo_type(m,ind_veg_wall) = 0 2592 ENDIF 2593 2594 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2595 building_surface_pars_f%fill ) THEN 2596 surf_usm_h(l)%albedo(m,ind_wat_win) = & 2597 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2598 surf_usm_h(l)%albedo_type(m,ind_wat_win) = 0 2599 ENDIF 2600 2601 IF ( building_surface_pars_f%pars(ind_s_alb_l_win,is) /= & 2602 building_surface_pars_f%fill ) THEN 2603 surf_usm_h(l)%aldir(m,ind_wat_win) = & 2604 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2605 surf_usm_h(l)%aldif(m,ind_wat_win) = & 2606 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2607 surf_usm_h(l)%albedo_type(m,ind_wat_win) = 0 2608 ENDIF 2609 2610 IF ( building_surface_pars_f%pars(ind_s_alb_s_win,is) /= & 2611 building_surface_pars_f%fill ) THEN 2612 surf_usm_h(l)%asdir(m,ind_wat_win) = & 2613 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2614 surf_usm_h(l)%asdif(m,ind_wat_win) = & 2615 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2616 surf_usm_h(l)%albedo_type(m,ind_wat_win) = 0 2617 ENDIF 2618 2619 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2620 building_surface_pars_f%fill ) THEN 2621 surf_usm_h(l)%albedo(m,ind_pav_green) = & 2622 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2623 surf_usm_h(l)%albedo_type(m,ind_pav_green) = 0 2624 ENDIF 2625 2626 IF ( building_surface_pars_f%pars(ind_s_alb_l_green,is) /= & 2627 building_surface_pars_f%fill ) THEN 2628 surf_usm_h(l)%aldir(m,ind_pav_green) = & 2629 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2630 surf_usm_h(l)%aldif(m,ind_pav_green) = & 2631 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2632 surf_usm_h(l)%albedo_type(m,ind_pav_green) = 0 2633 ENDIF 2634 2635 IF ( building_surface_pars_f%pars(ind_s_alb_s_green,is) /= & 2636 building_surface_pars_f%fill ) THEN 2637 surf_usm_h(l)%asdir(m,ind_pav_green) = & 2638 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2639 surf_usm_h(l)%asdif(m,ind_pav_green) = & 2640 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2641 surf_usm_h(l)%albedo_type(m,ind_pav_green) = 0 2642 ENDIF 2643 2644 EXIT ! surface was found and processed 2548 2645 ENDIF 2549 2550 IF ( building_surface_pars_f%pars(ind_s_alb_l_wall,is) /= & 2551 building_surface_pars_f%fill ) THEN 2552 surf_usm_h%aldir(m,ind_veg_wall) = & 2553 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2554 surf_usm_h%aldif(m,ind_veg_wall) = & 2555 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2556 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2557 ENDIF 2558 2559 IF ( building_surface_pars_f%pars(ind_s_alb_s_wall,is) /= & 2560 building_surface_pars_f%fill ) THEN 2561 surf_usm_h%asdir(m,ind_veg_wall) = & 2562 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2563 surf_usm_h%asdif(m,ind_veg_wall) = & 2564 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2565 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2566 ENDIF 2567 2568 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2569 building_surface_pars_f%fill ) THEN 2570 surf_usm_h%albedo(m,ind_wat_win) = & 2571 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2572 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2573 ENDIF 2574 2575 IF ( building_surface_pars_f%pars(ind_s_alb_l_win,is) /= & 2576 building_surface_pars_f%fill ) THEN 2577 surf_usm_h%aldir(m,ind_wat_win) = & 2578 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2579 surf_usm_h%aldif(m,ind_wat_win) = & 2580 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2581 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2582 ENDIF 2583 2584 IF ( building_surface_pars_f%pars(ind_s_alb_s_win,is) /= & 2585 building_surface_pars_f%fill ) THEN 2586 surf_usm_h%asdir(m,ind_wat_win) = & 2587 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2588 surf_usm_h%asdif(m,ind_wat_win) = & 2589 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2590 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2591 ENDIF 2592 2593 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2594 building_surface_pars_f%fill ) THEN 2595 surf_usm_h%albedo(m,ind_pav_green) = & 2596 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2597 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2598 ENDIF 2599 2600 IF ( building_surface_pars_f%pars(ind_s_alb_l_green,is) /= & 2601 building_surface_pars_f%fill ) THEN 2602 surf_usm_h%aldir(m,ind_pav_green) = & 2603 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2604 surf_usm_h%aldif(m,ind_pav_green) = & 2605 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2606 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2607 ENDIF 2608 2609 IF ( building_surface_pars_f%pars(ind_s_alb_s_green,is) /= & 2610 building_surface_pars_f%fill ) THEN 2611 surf_usm_h%asdir(m,ind_pav_green) = & 2612 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2613 surf_usm_h%asdif(m,ind_pav_green) = & 2614 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2615 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2616 ENDIF 2617 2618 EXIT ! surface was found and processed 2619 ENDIF 2646 ENDDO 2620 2647 ENDDO 2621 2648 ENDDO 2622 2623 2649 DO l = 0, 3 2624 2650 DO m = 1, surf_usm_v(l)%ns … … 2729 2755 ! 2730 2756 !-- Horizontally aligned natural and urban surfaces 2731 CALL calc_albedo( surf_lsm_h ) 2732 CALL calc_albedo( surf_usm_h ) 2757 DO l = 0, 1 2758 CALL calc_albedo( surf_lsm_h(l) ) 2759 CALL calc_albedo( surf_usm_h(l) ) 2760 ENDDO 2733 2761 ! 2734 2762 !-- Vertically aligned natural and urban surfaces … … 2742 2770 !-- Initialize sun-inclination independent spectral albedos 2743 2771 !-- Horizontal surfaces 2744 IF ( surf_lsm_h%ns > 0 ) THEN 2745 surf_lsm_h%rrtm_aldir = surf_lsm_h%aldir 2746 surf_lsm_h%rrtm_asdir = surf_lsm_h%asdir 2747 surf_lsm_h%rrtm_aldif = surf_lsm_h%aldif 2748 surf_lsm_h%rrtm_asdif = surf_lsm_h%asdif 2749 ENDIF 2750 IF ( surf_usm_h%ns > 0 ) THEN 2751 surf_usm_h%rrtm_aldir = surf_usm_h%aldir 2752 surf_usm_h%rrtm_asdir = surf_usm_h%asdir 2753 surf_usm_h%rrtm_aldif = surf_usm_h%aldif 2754 surf_usm_h%rrtm_asdif = surf_usm_h%asdif 2755 ENDIF 2772 DO l = 0, 1 2773 IF ( surf_lsm_h(l)%ns > 0 ) THEN 2774 surf_lsm_h(l)%rrtm_aldir = surf_lsm_h(l)%aldir 2775 surf_lsm_h(l)%rrtm_asdir = surf_lsm_h(l)%asdir 2776 surf_lsm_h(l)%rrtm_aldif = surf_lsm_h(l)%aldif 2777 surf_lsm_h(l)%rrtm_asdif = surf_lsm_h(l)%asdif 2778 ENDIF 2779 IF ( surf_usm_h(l)%ns > 0 ) THEN 2780 surf_usm_h(l)%rrtm_aldir = surf_usm_h(l)%aldir 2781 surf_usm_h(l)%rrtm_asdir = surf_usm_h(l)%asdir 2782 surf_usm_h(l)%rrtm_aldif = surf_usm_h(l)%aldif 2783 surf_usm_h(l)%rrtm_asdif = surf_usm_h(l)%asdif 2784 ENDIF 2785 ENDDO 2756 2786 ! 2757 2787 !-- Vertical surfaces … … 3287 3317 !-- First, horizontal surfaces 3288 3318 horizontal = .TRUE. 3289 surf => surf_lsm_h 3290 CALL radiation_external_surf 3291 surf => surf_usm_h 3292 CALL radiation_external_surf 3319 DO l = 0, 1 3320 surf => surf_lsm_h(l) 3321 CALL radiation_external_surf 3322 surf => surf_usm_h(l) 3323 CALL radiation_external_surf 3324 ENDDO 3293 3325 horizontal = .FALSE. 3294 3326 ! … … 3567 3599 !-- First, horizontal surfaces 3568 3600 horizontal = .TRUE. 3569 surf => surf_lsm_h 3570 CALL radiation_clearsky_surf 3571 surf => surf_usm_h 3572 CALL radiation_clearsky_surf 3601 DO l = 0, 1 3602 surf => surf_lsm_h(l) 3603 CALL radiation_clearsky_surf 3604 surf => surf_usm_h(l) 3605 CALL radiation_clearsky_surf 3606 ENDDO 3573 3607 horizontal = .FALSE. 3574 3608 ! … … 3752 3786 !-- First, horizontal surfaces 3753 3787 horizontal = .TRUE. 3754 surf => surf_lsm_h 3755 CALL radiation_constant_surf 3756 surf => surf_usm_h 3757 CALL radiation_constant_surf 3788 DO l = 0, 1 3789 surf => surf_lsm_h(l) 3790 CALL radiation_constant_surf 3791 surf => surf_usm_h(l) 3792 CALL radiation_constant_surf 3793 ENDDO 3758 3794 horizontal = .FALSE. 3759 3795 ! … … 4125 4161 ! 4126 4162 !-- Horizontally aligned default, natural and urban surfaces 4127 CALL calc_albedo( surf_lsm_h ) 4128 CALL calc_albedo( surf_usm_h ) 4163 DO l = 0, 1 4164 CALL calc_albedo( surf_lsm_h(l) ) 4165 CALL calc_albedo( surf_usm_h(l) ) 4166 ENDDO 4129 4167 ! 4130 4168 !-- Vertically aligned default, natural and urban surfaces … … 4472 4510 ! 4473 4511 !-- Prepare profiles of temperature and H2O volume mixing ratio 4474 DO m = surf_lsm_h %start_index(j,i), surf_lsm_h%end_index(j,i)4475 rrtm_tlev(0,nzb+1) = surf_lsm_h %pt_surface(m) * exner(nzb)4512 DO m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 4513 rrtm_tlev(0,nzb+1) = surf_lsm_h(0)%pt_surface(m) * exner(nzb) 4476 4514 ENDDO 4477 DO m = surf_usm_h %start_index(j,i), surf_usm_h%end_index(j,i)4478 rrtm_tlev(0,nzb+1) = surf_usm_h %pt_surface(m) * exner(nzb)4515 DO m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 4516 rrtm_tlev(0,nzb+1) = surf_usm_h(0)%pt_surface(m) * exner(nzb) 4479 4517 ENDDO 4480 4518 … … 4608 4646 !-- surface element on RRTMG-shaped array. 4609 4647 !-- Please note, as RRTMG is a single column model, surface attributes 4610 !-- are only obtained from horizontally aligned surfaces (for4611 !-- simplicity). Taking surface attributes from horizontal and4648 !-- are only obtained from upward facing horizontally aligned surfaces 4649 !-- (for simplicity). Taking surface attributes from horizontal and 4612 4650 !-- vertical walls would lead to multiple solutions. 4613 4651 !-- Moreover, for natural- and urban-type surfaces, several surface … … 4615 4653 !-- To obtain bulk parameters, apply a weighted average for these 4616 4654 !-- surfaces. 4617 DO m = surf_lsm_h %start_index(j,i), surf_lsm_h%end_index(j,i)4618 rrtm_emis = surf_lsm_h %frac(m,ind_veg_wall) * &4619 surf_lsm_h %emissivity(m,ind_veg_wall) + &4620 surf_lsm_h %frac(m,ind_pav_green) * &4621 surf_lsm_h %emissivity(m,ind_pav_green) + &4622 surf_lsm_h %frac(m,ind_wat_win) * &4623 surf_lsm_h %emissivity(m,ind_wat_win)4624 rrtm_tsfc = surf_lsm_h %pt_surface(m) * exner(nzb)4655 DO m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 4656 rrtm_emis = surf_lsm_h(0)%frac(m,ind_veg_wall) * & 4657 surf_lsm_h(0)%emissivity(m,ind_veg_wall) + & 4658 surf_lsm_h(0)%frac(m,ind_pav_green) * & 4659 surf_lsm_h(0)%emissivity(m,ind_pav_green) + & 4660 surf_lsm_h(0)%frac(m,ind_wat_win) * & 4661 surf_lsm_h(0)%emissivity(m,ind_wat_win) 4662 rrtm_tsfc = surf_lsm_h(0)%pt_surface(m) * exner(nzb) 4625 4663 ENDDO 4626 DO m = surf_usm_h %start_index(j,i), surf_usm_h%end_index(j,i)4627 rrtm_emis = surf_usm_h %frac(m,ind_veg_wall) * &4628 surf_usm_h %emissivity(m,ind_veg_wall) + &4629 surf_usm_h %frac(m,ind_pav_green) * &4630 surf_usm_h %emissivity(m,ind_pav_green) + &4631 surf_usm_h %frac(m,ind_wat_win) * &4632 surf_usm_h %emissivity(m,ind_wat_win)4633 rrtm_tsfc = surf_usm_h %pt_surface(m) * exner(nzb)4664 DO m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 4665 rrtm_emis = surf_usm_h(0)%frac(m,ind_veg_wall) * & 4666 surf_usm_h(0)%emissivity(m,ind_veg_wall) + & 4667 surf_usm_h(0)%frac(m,ind_pav_green) * & 4668 surf_usm_h(0)%emissivity(m,ind_pav_green) + & 4669 surf_usm_h(0)%frac(m,ind_wat_win) * & 4670 surf_usm_h(0)%emissivity(m,ind_wat_win) 4671 rrtm_tsfc = surf_usm_h(0)%pt_surface(m) * exner(nzb) 4634 4672 ENDDO 4635 4673 ! … … 4713 4751 !-- onto respective surface elements 4714 4752 !-- Horizontal surfaces 4715 DO m = surf_lsm_h%start_index(j,i), & 4716 surf_lsm_h%end_index(j,i) 4717 surf_lsm_h%rad_lw_in(m) = rrtm_lwdflx(0,k_topo) 4718 surf_lsm_h%rad_lw_out(m) = rrtm_lwuflx(0,k_topo) 4719 surf_lsm_h%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo) 4720 ENDDO 4721 DO m = surf_usm_h%start_index(j,i), & 4722 surf_usm_h%end_index(j,i) 4723 surf_usm_h%rad_lw_in(m) = rrtm_lwdflx(0,k_topo) 4724 surf_usm_h%rad_lw_out(m) = rrtm_lwuflx(0,k_topo) 4725 surf_usm_h%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo) 4753 DO l = 0, 1 4754 DO m = surf_lsm_h(l)%start_index(j,i), & 4755 surf_lsm_h(l)%end_index(j,i) 4756 surf_lsm_h(l)%rad_lw_in(m) = rrtm_lwdflx(0,k_topo) 4757 surf_lsm_h(l)%rad_lw_out(m) = rrtm_lwuflx(0,k_topo) 4758 surf_lsm_h(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo) 4759 ENDDO 4760 DO m = surf_usm_h(l)%start_index(j,i), & 4761 surf_usm_h(l)%end_index(j,i) 4762 surf_usm_h(l)%rad_lw_in(m) = rrtm_lwdflx(0,k_topo) 4763 surf_usm_h(l)%rad_lw_out(m) = rrtm_lwuflx(0,k_topo) 4764 surf_usm_h(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo) 4765 ENDDO 4726 4766 ENDDO 4727 4767 ! … … 4751 4791 !-- Get albedo for direct/diffusive long/shortwave radiation at 4752 4792 !-- current (y,x)-location from surface variables. 4753 !-- Only obtain it from horizontal surfaces, as RRTMG is a single 4754 !-- column model 4755 !-- (Please note, only one loop will entered, controlled by 4756 !-- start-end index.) 4757 DO m = surf_lsm_h%start_index(j,i), & 4758 surf_lsm_h%end_index(j,i) 4759 rrtm_asdir(1) = SUM( surf_lsm_h%frac(m,:) * & 4760 surf_lsm_h%rrtm_asdir(m,:) ) 4761 rrtm_asdif(1) = SUM( surf_lsm_h%frac(m,:) * & 4762 surf_lsm_h%rrtm_asdif(m,:) ) 4763 rrtm_aldir(1) = SUM( surf_lsm_h%frac(m,:) * & 4764 surf_lsm_h%rrtm_aldir(m,:) ) 4765 rrtm_aldif(1) = SUM( surf_lsm_h%frac(m,:) * & 4766 surf_lsm_h%rrtm_aldif(m,:) ) 4793 !-- Only obtain it from upward facing horizontal surfaces, 4794 !-- as RRTMG is a single column model. (Please note, only 4795 !-- one loop will entered, controlled by start-end index.) 4796 DO m = surf_lsm_h(0)%start_index(j,i), & 4797 surf_lsm_h(0)%end_index(j,i) 4798 rrtm_asdir(1) = SUM( surf_lsm_h(0)%frac(m,:) * & 4799 surf_lsm_h(0)%rrtm_asdir(m,:) ) 4800 rrtm_asdif(1) = SUM( surf_lsm_h(0)%frac(m,:) * & 4801 surf_lsm_h(0)%rrtm_asdif(m,:) ) 4802 rrtm_aldir(1) = SUM( surf_lsm_h(0)%frac(m,:) * & 4803 surf_lsm_h(0)%rrtm_aldir(m,:) ) 4804 rrtm_aldif(1) = SUM( surf_lsm_h(0)%frac(m,:) * & 4805 surf_lsm_h(0)%rrtm_aldif(m,:) ) 4767 4806 ENDDO 4768 DO m = surf_usm_h %start_index(j,i), &4769 surf_usm_h %end_index(j,i)4770 rrtm_asdir(1) = SUM( surf_usm_h %frac(m,:) * &4771 surf_usm_h %rrtm_asdir(m,:) )4772 rrtm_asdif(1) = SUM( surf_usm_h %frac(m,:) * &4773 surf_usm_h %rrtm_asdif(m,:) )4774 rrtm_aldir(1) = SUM( surf_usm_h %frac(m,:) * &4775 surf_usm_h %rrtm_aldir(m,:) )4776 rrtm_aldif(1) = SUM( surf_usm_h %frac(m,:) * &4777 surf_usm_h %rrtm_aldif(m,:) )4807 DO m = surf_usm_h(0)%start_index(j,i), & 4808 surf_usm_h(0)%end_index(j,i) 4809 rrtm_asdir(1) = SUM( surf_usm_h(0)%frac(m,:) * & 4810 surf_usm_h(0)%rrtm_asdir(m,:) ) 4811 rrtm_asdif(1) = SUM( surf_usm_h(0)%frac(m,:) * & 4812 surf_usm_h(0)%rrtm_asdif(m,:) ) 4813 rrtm_aldir(1) = SUM( surf_usm_h(0)%frac(m,:) * & 4814 surf_usm_h(0)%rrtm_aldir(m,:) ) 4815 rrtm_aldif(1) = SUM( surf_usm_h(0)%frac(m,:) * & 4816 surf_usm_h(0)%rrtm_aldif(m,:) ) 4778 4817 ENDDO 4779 4818 ! … … 4876 4915 !-- Save surface radiative fluxes onto respective surface elements 4877 4916 !-- Horizontal surfaces 4878 DO m = surf_lsm_h%start_index(j,i), & 4879 surf_lsm_h%end_index(j,i) 4880 surf_lsm_h%rad_sw_in(m) = rrtm_swdflx(0,k_topo) 4881 surf_lsm_h%rad_sw_out(m) = rrtm_swuflx(0,k_topo) 4882 ENDDO 4883 DO m = surf_usm_h%start_index(j,i), & 4884 surf_usm_h%end_index(j,i) 4885 surf_usm_h%rad_sw_in(m) = rrtm_swdflx(0,k_topo) 4886 surf_usm_h%rad_sw_out(m) = rrtm_swuflx(0,k_topo) 4917 DO l = 0, 1 4918 DO m = surf_lsm_h(l)%start_index(j,i), & 4919 surf_lsm_h(l)%end_index(j,i) 4920 surf_lsm_h(l)%rad_sw_in(m) = rrtm_swdflx(0,k_topo) 4921 surf_lsm_h(l)%rad_sw_out(m) = rrtm_swuflx(0,k_topo) 4922 ENDDO 4923 DO m = surf_usm_h(l)%start_index(j,i), & 4924 surf_usm_h(l)%end_index(j,i) 4925 surf_usm_h(l)%rad_sw_in(m) = rrtm_swdflx(0,k_topo) 4926 surf_usm_h(l)%rad_sw_out(m) = rrtm_swuflx(0,k_topo) 4927 ENDDO 4887 4928 ENDDO 4888 4929 ! … … 4908 4949 rad_sw_in = 0.0_wp 4909 4950 rad_sw_out = 0.0_wp 4910 !-- !!!!!!!! ATTEN SION !!!!!!!!!!!!!!!4951 !-- !!!!!!!! ATTENTION !!!!!!!!!!!!!!! 4911 4952 !-- Surface radiative fluxes should be also set to zero here 4912 4953 !-- Save surface radiative fluxes onto respective surface elements 4913 4954 !-- Horizontal surfaces 4914 DO m = surf_lsm_h%start_index(j,i), & 4915 surf_lsm_h%end_index(j,i) 4916 surf_lsm_h%rad_sw_in(m) = 0.0_wp 4917 surf_lsm_h%rad_sw_out(m) = 0.0_wp 4918 ENDDO 4919 DO m = surf_usm_h%start_index(j,i), & 4920 surf_usm_h%end_index(j,i) 4921 surf_usm_h%rad_sw_in(m) = 0.0_wp 4922 surf_usm_h%rad_sw_out(m) = 0.0_wp 4955 DO l = 0, 1 4956 DO m = surf_lsm_h(l)%start_index(j,i), & 4957 surf_lsm_h(l)%end_index(j,i) 4958 surf_lsm_h(l)%rad_sw_in(m) = 0.0_wp 4959 surf_lsm_h(l)%rad_sw_out(m) = 0.0_wp 4960 ENDDO 4961 DO m = surf_usm_h(l)%start_index(j,i), & 4962 surf_usm_h(l)%end_index(j,i) 4963 surf_usm_h(l)%rad_sw_in(m) = 0.0_wp 4964 surf_usm_h(l)%rad_sw_out(m) = 0.0_wp 4965 ENDDO 4923 4966 ENDDO 4924 4967 ! … … 4949 4992 IF ( .NOT. radiation_interactions ) THEN 4950 4993 !-- First, for horizontal surfaces 4951 DO m = 1, surf_lsm_h%ns 4952 surf_lsm_h%rad_net(m) = surf_lsm_h%rad_sw_in(m) & 4953 - surf_lsm_h%rad_sw_out(m) & 4954 + surf_lsm_h%rad_lw_in(m) & 4955 - surf_lsm_h%rad_lw_out(m) 4956 ENDDO 4957 DO m = 1, surf_usm_h%ns 4958 surf_usm_h%rad_net(m) = surf_usm_h%rad_sw_in(m) & 4959 - surf_usm_h%rad_sw_out(m) & 4960 + surf_usm_h%rad_lw_in(m) & 4961 - surf_usm_h%rad_lw_out(m) 4994 DO l = 0, 1 4995 DO m = 1, surf_lsm_h(l)%ns 4996 surf_lsm_h(l)%rad_net(m) = surf_lsm_h(l)%rad_sw_in(m) & 4997 - surf_lsm_h(l)%rad_sw_out(m) & 4998 + surf_lsm_h(l)%rad_lw_in(m) & 4999 - surf_lsm_h(l)%rad_lw_out(m) 5000 ENDDO 5001 DO m = 1, surf_usm_h(l)%ns 5002 surf_usm_h(l)%rad_net(m) = surf_usm_h(l)%rad_sw_in(m) & 5003 - surf_usm_h(l)%rad_sw_out(m) & 5004 + surf_usm_h(l)%rad_lw_in(m) & 5005 - surf_usm_h(l)%rad_lw_out(m) 5006 ENDDO 4962 5007 ENDDO 4963 5008 ! … … 5986 6031 ! 5987 6032 !-- Horizontal walls 5988 !-- urban 5989 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 5990 surfoutll(mm) = SUM ( surf_usm_h%frac(m,:) * & 5991 surf_usm_h%emissivity(m,:) ) & 5992 * sigma_sb & 5993 * surf_usm_h%pt_surface(m)**4 5994 albedo_surf(mm) = SUM ( surf_usm_h%frac(m,:) * & 5995 surf_usm_h%albedo(m,:) ) 5996 emiss_surf(mm) = SUM ( surf_usm_h%frac(m,:) * & 5997 surf_usm_h%emissivity(m,:) ) 5998 mm = mm + 1 5999 ENDDO 6000 ! 6001 !-- land 6002 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 6003 surfoutll(mm) = SUM ( surf_lsm_h%frac(m,:) * & 6004 surf_lsm_h%emissivity(m,:) ) & 6005 * sigma_sb & 6006 * surf_lsm_h%pt_surface(m)**4 6007 albedo_surf(mm) = SUM ( surf_lsm_h%frac(m,:) * & 6008 surf_lsm_h%albedo(m,:) ) 6009 emiss_surf(mm) = SUM ( surf_lsm_h%frac(m,:) * & 6010 surf_lsm_h%emissivity(m,:) ) 6011 mm = mm + 1 6012 ENDDO 6013 ! 6014 !-- Downward facing default surfaces 6015 !-- TODO: Downward-facing surfaces are only available as default surfaces which lack 6016 !-- temperature and heat balance, therefore they have to be simulated as neutral to 6017 !-- radiation, that means having sw/lw reflectivity=1, so they neither absorb nor emit 6018 !-- radiation and they have zero net heat flux. 6019 DO m = surf_def_h(1)%start_index(j,i), surf_def_h(1)%end_index(j,i) 6020 surfoutll(mm) = 0.0_wp 6021 albedo_surf(mm) = 1.0_wp 6022 emiss_surf(mm) = 0.0_wp 6023 mm = mm + 1 6033 DO l = 0, 1 6034 !-- urban 6035 DO m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i) 6036 surfoutll(mm) = SUM ( surf_usm_h(l)%frac(m,:) * & 6037 surf_usm_h(l)%emissivity(m,:) ) & 6038 * sigma_sb & 6039 * surf_usm_h(l)%pt_surface(m)**4 6040 albedo_surf(mm) = SUM ( surf_usm_h(l)%frac(m,:) * & 6041 surf_usm_h(l)%albedo(m,:) ) 6042 emiss_surf(mm) = SUM ( surf_usm_h(l)%frac(m,:) * & 6043 surf_usm_h(l)%emissivity(m,:) ) 6044 mm = mm + 1 6045 ENDDO 6046 ! 6047 !-- land 6048 DO m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i) 6049 surfoutll(mm) = SUM ( surf_lsm_h(l)%frac(m,:) * & 6050 surf_lsm_h(l)%emissivity(m,:) ) & 6051 * sigma_sb & 6052 * surf_lsm_h(l)%pt_surface(m)**4 6053 albedo_surf(mm) = SUM ( surf_lsm_h(l)%frac(m,:) * & 6054 surf_lsm_h(l)%albedo(m,:) ) 6055 emiss_surf(mm) = SUM ( surf_lsm_h(l)%frac(m,:) * & 6056 surf_lsm_h(l)%emissivity(m,:) ) 6057 mm = mm + 1 6058 ENDDO 6024 6059 ENDDO 6025 6060 ! … … 6428 6463 ! 6429 6464 !-- Horizontal walls 6430 !-- urban 6431 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 6432 surf_usm_h%rad_sw_in(m) = surfinsw(mm) 6433 surf_usm_h%rad_sw_out(m) = surfoutsw(mm) 6434 surf_usm_h%rad_sw_dir(m) = surfinswdir(mm) 6435 surf_usm_h%rad_sw_dif(m) = surfinswdif(mm) 6436 surf_usm_h%rad_sw_ref(m) = surfinsw(mm) - surfinswdir(mm) - & 6437 surfinswdif(mm) 6438 surf_usm_h%rad_sw_res(m) = surfins(mm) 6439 surf_usm_h%rad_lw_in(m) = surfinlw(mm) 6440 surf_usm_h%rad_lw_out(m) = surfoutlw(mm) 6441 surf_usm_h%rad_net(m) = surfinsw(mm) - surfoutsw(mm) + & 6442 surfinlw(mm) - surfoutlw(mm) 6443 surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net(m) 6444 surf_usm_h%rad_lw_dif(m) = surfinlwdif(mm) 6445 surf_usm_h%rad_lw_ref(m) = surfinlw(mm) - surfinlwdif(mm) 6446 surf_usm_h%rad_lw_res(m) = surfinl(mm) 6447 mm = mm + 1 6448 ENDDO 6449 ! 6450 !-- land 6451 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 6452 surf_lsm_h%rad_sw_in(m) = surfinsw(mm) 6453 surf_lsm_h%rad_sw_out(m) = surfoutsw(mm) 6454 surf_lsm_h%rad_sw_dir(m) = surfinswdir(mm) 6455 surf_lsm_h%rad_sw_dif(m) = surfinswdif(mm) 6456 surf_lsm_h%rad_sw_ref(m) = surfinsw(mm) - surfinswdir(mm) - & 6465 DO l = 0, 1 6466 !-- urban 6467 DO m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i) 6468 surf_usm_h(l)%rad_sw_in(m) = surfinsw(mm) 6469 surf_usm_h(l)%rad_sw_out(m) = surfoutsw(mm) 6470 surf_usm_h(l)%rad_sw_dir(m) = surfinswdir(mm) 6471 surf_usm_h(l)%rad_sw_dif(m) = surfinswdif(mm) 6472 surf_usm_h(l)%rad_sw_ref(m) = surfinsw(mm) - surfinswdir(mm) - & 6457 6473 surfinswdif(mm) 6458 surf_lsm_h%rad_sw_res(m) = surfins(mm) 6459 surf_lsm_h%rad_lw_in(m) = surfinlw(mm) 6460 surf_lsm_h%rad_lw_out(m) = surfoutlw(mm) 6461 surf_lsm_h%rad_net(m) = surfinsw(mm) - surfoutsw(mm) + & 6462 surfinlw(mm) - surfoutlw(mm) 6463 surf_lsm_h%rad_lw_dif(m) = surfinlwdif(mm) 6464 surf_lsm_h%rad_lw_ref(m) = surfinlw(mm) - surfinlwdif(mm) 6465 surf_lsm_h%rad_lw_res(m) = surfinl(mm) 6466 mm = mm + 1 6467 ENDDO 6468 ! 6469 !-- Downward facing default surfaces 6470 !-- TODO: Downward-facing surfaces are only available as default surfaces which lack 6471 !-- temperature and heat balance, therefore they have to be simulated as neutral to 6472 !-- radiation, that means having sw/lw reflectivity=1, so they neither absorb nor emit 6473 !-- radiation and they have zero net heat flux. 6474 DO m = surf_def_h(1)%start_index(j,i), surf_def_h(1)%end_index(j,i) 6475 mm = mm + 1 6474 surf_usm_h(l)%rad_sw_res(m) = surfins(mm) 6475 surf_usm_h(l)%rad_lw_in(m) = surfinlw(mm) 6476 surf_usm_h(l)%rad_lw_out(m) = surfoutlw(mm) 6477 surf_usm_h(l)%rad_net(m) = surfinsw(mm) - surfoutsw(mm) + & 6478 surfinlw(mm) - surfoutlw(mm) 6479 surf_usm_h(l)%rad_net_l(m) = surf_usm_h(l)%rad_net(m) 6480 surf_usm_h(l)%rad_lw_dif(m) = surfinlwdif(mm) 6481 surf_usm_h(l)%rad_lw_ref(m) = surfinlw(mm) - surfinlwdif(mm) 6482 surf_usm_h(l)%rad_lw_res(m) = surfinl(mm) 6483 mm = mm + 1 6484 ENDDO 6485 ! 6486 !-- land 6487 DO m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i) 6488 surf_lsm_h(l)%rad_sw_in(m) = surfinsw(mm) 6489 surf_lsm_h(l)%rad_sw_out(m) = surfoutsw(mm) 6490 surf_lsm_h(l)%rad_sw_dir(m) = surfinswdir(mm) 6491 surf_lsm_h(l)%rad_sw_dif(m) = surfinswdif(mm) 6492 surf_lsm_h(l)%rad_sw_ref(m) = surfinsw(mm) - surfinswdir(mm) - & 6493 surfinswdif(mm) 6494 surf_lsm_h(l)%rad_sw_res(m) = surfins(mm) 6495 surf_lsm_h(l)%rad_lw_in(m) = surfinlw(mm) 6496 surf_lsm_h(l)%rad_lw_out(m) = surfoutlw(mm) 6497 surf_lsm_h(l)%rad_net(m) = surfinsw(mm) - surfoutsw(mm) + & 6498 surfinlw(mm) - surfoutlw(mm) 6499 surf_lsm_h(l)%rad_lw_dif(m) = surfinlwdif(mm) 6500 surf_lsm_h(l)%rad_lw_ref(m) = surfinlw(mm) - surfinlwdif(mm) 6501 surf_lsm_h(l)%rad_lw_res(m) = surfinl(mm) 6502 mm = mm + 1 6503 ENDDO 6476 6504 ENDDO 6477 6505 ! … … 6538 6566 ENDDO 6539 6567 6540 DO m = 1, surf_usm_h%ns 6541 surf_usm_h%surfhf(m) = surf_usm_h%rad_sw_in(m) + & 6542 surf_usm_h%rad_lw_in(m) - & 6543 surf_usm_h%rad_sw_out(m) - & 6544 surf_usm_h%rad_lw_out(m) 6568 DO l = 0, 1 6569 DO m = 1, surf_usm_h(l)%ns 6570 surf_usm_h(l)%surfhf(m) = surf_usm_h(l)%rad_sw_in(m) + & 6571 surf_usm_h(l)%rad_lw_in(m) - & 6572 surf_usm_h(l)%rad_sw_out(m) - & 6573 surf_usm_h(l)%rad_lw_out(m) 6574 ENDDO 6575 DO m = 1, surf_lsm_h(l)%ns 6576 surf_lsm_h(l)%surfhf(m) = surf_lsm_h(l)%rad_sw_in(m) + & 6577 surf_lsm_h(l)%rad_lw_in(m) - & 6578 surf_lsm_h(l)%rad_sw_out(m) - & 6579 surf_lsm_h(l)%rad_lw_out(m) 6580 ENDDO 6545 6581 ENDDO 6546 DO m = 1, surf_lsm_h%ns6547 surf_lsm_h%surfhf(m) = surf_lsm_h%rad_sw_in(m) + &6548 surf_lsm_h%rad_lw_in(m) - &6549 surf_lsm_h%rad_sw_out(m) - &6550 surf_lsm_h%rad_lw_out(m)6551 ENDDO6552 6553 6582 DO l = 0, 3 6554 6583 !-- urban … … 7020 7049 !-- Number of horizontal surfaces including land- and roof surfaces in both USM and LSM. Note that 7021 7050 !-- All horizontal surface elements are already counted in surface_mod. 7022 nsurfl = surf_usm_h%ns + surf_lsm_h%ns + surf_def_h(1)%ns 7051 DO l = 0, 1 7052 nsurfl = nsurfl + surf_usm_h(l)%ns + surf_lsm_h(l)%ns 7053 ENDDO 7023 7054 ! 7024 7055 !-- Number of vertical surfaces in both USM and LSM. Note that all vertical surface elements are 7025 7056 !-- already counted in surface_mod. 7026 DO i= 0,37027 nsurfl = nsurfl + surf_usm_v( i)%ns + surf_lsm_v(i)%ns7057 DO l = 0,3 7058 nsurfl = nsurfl + surf_usm_v(l)%ns + surf_lsm_v(l)%ns 7028 7059 ENDDO 7029 7060 … … 7144 7175 ! 7145 7176 !-- Horizontal surfaces 7146 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 7147 k = surf_usm_h%k(m) 7148 isurf = isurf + 1 7149 surfl(:,isurf) = (/iup,k,j,i/) 7177 DO l = 0, 1 7178 DO m = surf_usm_h(l)%start_index(j,i), surf_usm_h(l)%end_index(j,i) 7179 k = surf_usm_h(l)%k(m) 7180 isurf = isurf + 1 7181 surfl(:,isurf) = (/dirint_h(l),k,j,i/) 7182 ENDDO 7183 DO m = surf_lsm_h(l)%start_index(j,i), surf_lsm_h(l)%end_index(j,i) 7184 k = surf_lsm_h(l)%k(m) 7185 isurf = isurf + 1 7186 surfl(:,isurf) = (/dirint_h(l),k,j,i/) 7187 ENDDO 7150 7188 ENDDO 7151 7152 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 7153 k = surf_lsm_h%k(m) 7154 isurf = isurf + 1 7155 surfl(:,isurf) = (/iup,k,j,i/) 7189 ! 7190 !-- Vertical surfaces 7191 DO l = 0, 3 7192 DO m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i) 7193 k = surf_usm_v(l)%k(m) 7194 isurf = isurf + 1 7195 surfl(:,isurf) = (/dirint_v(l),k,j,i/) 7196 ENDDO 7197 DO m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i) 7198 k = surf_lsm_v(l)%k(m) 7199 isurf = isurf + 1 7200 surfl(:,isurf) = (/dirint_v(l),k,j,i/) 7201 ENDDO 7156 7202 ENDDO 7157 7203 7158 DO m = surf_def_h(1)%start_index(j,i), surf_def_h(1)%end_index(j,i)7159 k = surf_def_h(1)%k(m)7160 isurf = isurf + 17161 surfl(:,isurf) = (/idown,k,j,i/)7162 ENDDO7163 !7164 !-- Vertical surfaces7165 l = 07166 DO m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)7167 k = surf_usm_v(l)%k(m)7168 isurf = isurf + 17169 surfl(:,isurf) = (/inorth,k,j,i/)7170 ENDDO7171 DO m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)7172 k = surf_lsm_v(l)%k(m)7173 isurf = isurf + 17174 surfl(:,isurf) = (/inorth,k,j,i/)7175 ENDDO7176 7177 l = 17178 DO m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)7179 k = surf_usm_v(l)%k(m)7180 isurf = isurf + 17181 surfl(:,isurf) = (/isouth,k,j,i/)7182 ENDDO7183 DO m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)7184 k = surf_lsm_v(l)%k(m)7185 isurf = isurf + 17186 surfl(:,isurf) = (/isouth,k,j,i/)7187 ENDDO7188 7189 l = 27190 DO m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)7191 k = surf_usm_v(l)%k(m)7192 isurf = isurf + 17193 surfl(:,isurf) = (/ieast,k,j,i/)7194 ENDDO7195 DO m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)7196 k = surf_lsm_v(l)%k(m)7197 isurf = isurf + 17198 surfl(:,isurf) = (/ieast,k,j,i/)7199 ENDDO7200 7201 l = 37202 DO m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)7203 k = surf_usm_v(l)%k(m)7204 isurf = isurf + 17205 surfl(:,isurf) = (/iwest,k,j,i/)7206 ENDDO7207 DO m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)7208 k = surf_lsm_v(l)%k(m)7209 isurf = isurf + 17210 surfl(:,isurf) = (/iwest,k,j,i/)7211 ENDDO7212 7204 ENDDO 7213 7205 ENDDO 7214 7206 ! 7215 !-- Add local MRT boxes for specified number of levels 7207 !-- Add local MRT boxes for the specified number of levels 7208 !-- !!!! NEEDS TO RETHINK AGAIN - with full 3D structure, only the one 7209 !-- !!!! of the upward faced horizontal surfaces should be taken (the lowest one = ground?) 7210 !-- !!!! mrt_nlevels number of air grid boxes might not be available 7211 !-- !!!! in case of overhanging structures! 7216 7212 nmrtbl = 0 7217 7213 IF ( mrt_nlevels > 0 ) THEN 7218 7214 DO i = nxl, nxr 7219 7215 DO j = nys, nyn 7220 DO m = surf_usm_h %start_index(j,i), surf_usm_h%end_index(j,i)7216 DO m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 7221 7217 ! 7222 7218 !-- Skip roof if requested 7223 IF ( mrt_skip_roof .AND. surf_usm_h %isroof_surf(m) ) CYCLE7219 IF ( mrt_skip_roof .AND. surf_usm_h(0)%isroof_surf(m) ) CYCLE 7224 7220 ! 7225 7221 !-- Cycle over specified no of levels … … 7228 7224 ! 7229 7225 !-- Dtto for LSM 7230 DO m = surf_lsm_h %start_index(j,i), surf_lsm_h%end_index(j,i)7226 DO m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 7231 7227 nmrtbl = nmrtbl + mrt_nlevels 7232 7228 ENDDO … … 7240 7236 DO i = nxl, nxr 7241 7237 DO j = nys, nyn 7242 DO m = surf_usm_h %start_index(j,i), surf_usm_h%end_index(j,i)7238 DO m = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 7243 7239 ! 7244 7240 !-- Skip roof if requested 7245 IF ( mrt_skip_roof .AND. surf_usm_h %isroof_surf(m) ) CYCLE7241 IF ( mrt_skip_roof .AND. surf_usm_h(0)%isroof_surf(m) ) CYCLE 7246 7242 ! 7247 7243 !-- Cycle over specified no of levels 7248 l = surf_usm_h %k(m)7244 l = surf_usm_h(0)%k(m) 7249 7245 DO k = l, l + mrt_nlevels - 1 7250 7246 imrt = imrt + 1 … … 7254 7250 ! 7255 7251 !-- Dtto for LSM 7256 DO m = surf_lsm_h %start_index(j,i), surf_lsm_h%end_index(j,i)7257 l = surf_lsm_h %k(m)7252 DO m = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 7253 l = surf_lsm_h(0)%k(m) 7258 7254 DO k = l, l + mrt_nlevels - 1 7259 7255 imrt = imrt + 1 … … 10298 10294 SELECT CASE ( TRIM( var ) ) 10299 10295 !-- block of large scale (e.g. RRTMG) radiation output variables 10296 !-- only upward faced horizontal surfaces are considered here 10300 10297 CASE ( 'rad_net*' ) 10301 10298 IF ( ALLOCATED( rad_net_av ) ) THEN 10302 10299 DO i = nxl, nxr 10303 10300 DO j = nys, nyn 10304 match_lsm = surf_lsm_h %start_index(j,i) <= &10305 surf_lsm_h %end_index(j,i)10306 match_usm = surf_usm_h %start_index(j,i) <= &10307 surf_usm_h %end_index(j,i)10301 match_lsm = surf_lsm_h(0)%start_index(j,i) <= & 10302 surf_lsm_h(0)%end_index(j,i) 10303 match_usm = surf_usm_h(0)%start_index(j,i) <= & 10304 surf_usm_h(0)%end_index(j,i) 10308 10305 10309 10306 IF ( match_lsm .AND. .NOT. match_usm ) THEN 10310 m = surf_lsm_h %end_index(j,i)10307 m = surf_lsm_h(0)%end_index(j,i) 10311 10308 rad_net_av(j,i) = rad_net_av(j,i) + & 10312 surf_lsm_h %rad_net(m)10309 surf_lsm_h(0)%rad_net(m) 10313 10310 ELSEIF ( match_usm ) THEN 10314 m = surf_usm_h %end_index(j,i)10311 m = surf_usm_h(0)%end_index(j,i) 10315 10312 rad_net_av(j,i) = rad_net_av(j,i) + & 10316 surf_usm_h %rad_net(m)10313 surf_usm_h(0)%rad_net(m) 10317 10314 ENDIF 10318 10315 ENDDO … … 10324 10321 DO i = nxl, nxr 10325 10322 DO j = nys, nyn 10326 match_lsm = surf_lsm_h %start_index(j,i) <= &10327 surf_lsm_h %end_index(j,i)10328 match_usm = surf_usm_h %start_index(j,i) <= &10329 surf_usm_h %end_index(j,i)10323 match_lsm = surf_lsm_h(0)%start_index(j,i) <= & 10324 surf_lsm_h(0)%end_index(j,i) 10325 match_usm = surf_usm_h(0)%start_index(j,i) <= & 10326 surf_usm_h(0)%end_index(j,i) 10330 10327 10331 10328 IF ( match_lsm .AND. .NOT. match_usm ) THEN 10332 m = surf_lsm_h %end_index(j,i)10329 m = surf_lsm_h(0)%end_index(j,i) 10333 10330 rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) + & 10334 surf_lsm_h %rad_lw_in(m)10331 surf_lsm_h(0)%rad_lw_in(m) 10335 10332 ELSEIF ( match_usm ) THEN 10336 m = surf_usm_h %end_index(j,i)10333 m = surf_usm_h(0)%end_index(j,i) 10337 10334 rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) + & 10338 surf_usm_h %rad_lw_in(m)10335 surf_usm_h(0)%rad_lw_in(m) 10339 10336 ENDIF 10340 10337 ENDDO … … 10346 10343 DO i = nxl, nxr 10347 10344 DO j = nys, nyn 10348 match_lsm = surf_lsm_h %start_index(j,i) <= &10349 surf_lsm_h %end_index(j,i)10350 match_usm = surf_usm_h %start_index(j,i) <= &10351 surf_usm_h %end_index(j,i)10345 match_lsm = surf_lsm_h(0)%start_index(j,i) <= & 10346 surf_lsm_h(0)%end_index(j,i) 10347 match_usm = surf_usm_h(0)%start_index(j,i) <= & 10348 surf_usm_h(0)%end_index(j,i) 10352 10349 10353 10350 IF ( match_lsm .AND. .NOT. match_usm ) THEN 10354 m = surf_lsm_h %end_index(j,i)10351 m = surf_lsm_h(0)%end_index(j,i) 10355 10352 rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) + & 10356 surf_lsm_h %rad_lw_out(m)10353 surf_lsm_h(0)%rad_lw_out(m) 10357 10354 ELSEIF ( match_usm ) THEN 10358 m = surf_usm_h %end_index(j,i)10355 m = surf_usm_h(0)%end_index(j,i) 10359 10356 rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) + & 10360 surf_usm_h %rad_lw_out(m)10357 surf_usm_h(0)%rad_lw_out(m) 10361 10358 ENDIF 10362 10359 ENDDO … … 10368 10365 DO i = nxl, nxr 10369 10366 DO j = nys, nyn 10370 match_lsm = surf_lsm_h %start_index(j,i) <= &10371 surf_lsm_h %end_index(j,i)10372 match_usm = surf_usm_h %start_index(j,i) <= &10373 surf_usm_h %end_index(j,i)10367 match_lsm = surf_lsm_h(0)%start_index(j,i) <= & 10368 surf_lsm_h(0)%end_index(j,i) 10369 match_usm = surf_usm_h(0)%start_index(j,i) <= & 10370 surf_usm_h(0)%end_index(j,i) 10374 10371 10375 10372 IF ( match_lsm .AND. .NOT. match_usm ) THEN 10376 m = surf_lsm_h %end_index(j,i)10373 m = surf_lsm_h(0)%end_index(j,i) 10377 10374 rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) + & 10378 surf_lsm_h %rad_sw_in(m)10375 surf_lsm_h(0)%rad_sw_in(m) 10379 10376 ELSEIF ( match_usm ) THEN 10380 m = surf_usm_h %end_index(j,i)10377 m = surf_usm_h(0)%end_index(j,i) 10381 10378 rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) + & 10382 surf_usm_h %rad_sw_in(m)10379 surf_usm_h(0)%rad_sw_in(m) 10383 10380 ENDIF 10384 10381 ENDDO … … 10390 10387 DO i = nxl, nxr 10391 10388 DO j = nys, nyn 10392 match_lsm = surf_lsm_h %start_index(j,i) <= &10393 surf_lsm_h %end_index(j,i)10394 match_usm = surf_usm_h %start_index(j,i) <= &10395 surf_usm_h %end_index(j,i)10389 match_lsm = surf_lsm_h(0)%start_index(j,i) <= & 10390 surf_lsm_h(0)%end_index(j,i) 10391 match_usm = surf_usm_h(0)%start_index(j,i) <= & 10392 surf_usm_h(0)%end_index(j,i) 10396 10393 10397 10394 IF ( match_lsm .AND. .NOT. match_usm ) THEN 10398 m = surf_lsm_h %end_index(j,i)10395 m = surf_lsm_h(0)%end_index(j,i) 10399 10396 rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) + & 10400 surf_lsm_h %rad_sw_out(m)10397 surf_lsm_h(0)%rad_sw_out(m) 10401 10398 ELSEIF ( match_usm ) THEN 10402 m = surf_usm_h %end_index(j,i)10399 m = surf_usm_h(0)%end_index(j,i) 10403 10400 rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) + & 10404 surf_usm_h %rad_sw_out(m)10401 surf_usm_h(0)%rad_sw_out(m) 10405 10402 ENDIF 10406 10403 ENDDO … … 11072 11069 ! 11073 11070 !-- Obtain rad_net from its respective surface type 11071 !-- Only upward faced horizontal outputs are considered here 11074 11072 !-- Natural-type surfaces 11075 DO m = surf_lsm_h %start_index(j,i), &11076 surf_lsm_h %end_index(j,i)11077 local_pf(i,j,nzb+1) = surf_lsm_h %rad_net(m)11073 DO m = surf_lsm_h(0)%start_index(j,i), & 11074 surf_lsm_h(0)%end_index(j,i) 11075 local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_net(m) 11078 11076 ENDDO 11079 11077 ! 11080 11078 !-- Urban-type surfaces 11081 DO m = surf_usm_h %start_index(j,i), &11082 surf_usm_h %end_index(j,i)11083 local_pf(i,j,nzb+1) = surf_usm_h %rad_net(m)11079 DO m = surf_usm_h(0)%start_index(j,i), & 11080 surf_usm_h(0)%end_index(j,i) 11081 local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_net(m) 11084 11082 ENDDO 11085 11083 ENDDO … … 11106 11104 !-- Obtain rad_net from its respective surface type 11107 11105 !-- Natural-type surfaces 11108 DO m = surf_lsm_h %start_index(j,i), &11109 surf_lsm_h %end_index(j,i)11110 local_pf(i,j,nzb+1) = surf_lsm_h %rad_lw_in(m)11106 DO m = surf_lsm_h(0)%start_index(j,i), & 11107 surf_lsm_h(0)%end_index(j,i) 11108 local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_lw_in(m) 11111 11109 ENDDO 11112 11110 ! 11113 11111 !-- Urban-type surfaces 11114 DO m = surf_usm_h %start_index(j,i), &11115 surf_usm_h %end_index(j,i)11116 local_pf(i,j,nzb+1) = surf_usm_h %rad_lw_in(m)11112 DO m = surf_usm_h(0)%start_index(j,i), & 11113 surf_usm_h(0)%end_index(j,i) 11114 local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_lw_in(m) 11117 11115 ENDDO 11118 11116 ENDDO … … 11139 11137 !-- Obtain rad_net from its respective surface type 11140 11138 !-- Natural-type surfaces 11141 DO m = surf_lsm_h %start_index(j,i), &11142 surf_lsm_h %end_index(j,i)11143 local_pf(i,j,nzb+1) = surf_lsm_h %rad_lw_out(m)11139 DO m = surf_lsm_h(0)%start_index(j,i), & 11140 surf_lsm_h(0)%end_index(j,i) 11141 local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_lw_out(m) 11144 11142 ENDDO 11145 11143 ! 11146 11144 !-- Urban-type surfaces 11147 DO m = surf_usm_h %start_index(j,i), &11148 surf_usm_h %end_index(j,i)11149 local_pf(i,j,nzb+1) = surf_usm_h %rad_lw_out(m)11145 DO m = surf_usm_h(0)%start_index(j,i), & 11146 surf_usm_h(0)%end_index(j,i) 11147 local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_lw_out(m) 11150 11148 ENDDO 11151 11149 ENDDO … … 11172 11170 !-- Obtain rad_net from its respective surface type 11173 11171 !-- Natural-type surfaces 11174 DO m = surf_lsm_h %start_index(j,i), &11175 surf_lsm_h %end_index(j,i)11176 local_pf(i,j,nzb+1) = surf_lsm_h %rad_sw_in(m)11172 DO m = surf_lsm_h(0)%start_index(j,i), & 11173 surf_lsm_h(0)%end_index(j,i) 11174 local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_sw_in(m) 11177 11175 ENDDO 11178 11176 ! 11179 11177 !-- Urban-type surfaces 11180 DO m = surf_usm_h %start_index(j,i), &11181 surf_usm_h %end_index(j,i)11182 local_pf(i,j,nzb+1) = surf_usm_h %rad_sw_in(m)11178 DO m = surf_usm_h(0)%start_index(j,i), & 11179 surf_usm_h(0)%end_index(j,i) 11180 local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_sw_in(m) 11183 11181 ENDDO 11184 11182 ENDDO … … 11205 11203 !-- Obtain rad_net from its respective surface type 11206 11204 !-- Natural-type surfaces 11207 DO m = surf_lsm_h %start_index(j,i), &11208 surf_lsm_h %end_index(j,i)11209 local_pf(i,j,nzb+1) = surf_lsm_h %rad_sw_out(m)11205 DO m = surf_lsm_h(0)%start_index(j,i), & 11206 surf_lsm_h(0)%end_index(j,i) 11207 local_pf(i,j,nzb+1) = surf_lsm_h(0)%rad_sw_out(m) 11210 11208 ENDDO 11211 11209 ! 11212 11210 !-- Urban-type surfaces 11213 DO m = surf_usm_h %start_index(j,i), &11214 surf_usm_h %end_index(j,i)11215 local_pf(i,j,nzb+1) = surf_usm_h %rad_sw_out(m)11211 DO m = surf_usm_h(0)%start_index(j,i), & 11212 surf_usm_h(0)%end_index(j,i) 11213 local_pf(i,j,nzb+1) = surf_usm_h(0)%rad_sw_out(m) 11216 11214 ENDDO 11217 11215 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
