Changeset 2328 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Aug 3, 2017 12:34:22 PM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r2318 r2328 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Emissivity can now be set individually for each pixel. 28 ! Albedo type can be inferred from land surface model. 29 ! Added default albedo type for bare soil 30 ! 31 ! 2318 2017-07-20 17:27:44Z suehring 27 32 ! Get topography top index via Function call 28 33 ! … … 211 216 ! 212 217 !-- Predefined Land surface classes (albedo_type) after Briegleb (1992) 213 CHARACTER(37), DIMENSION(0:1 7), PARAMETER :: albedo_type_name = (/ &218 CHARACTER(37), DIMENSION(0:18), PARAMETER :: albedo_type_name = (/ & 214 219 'user defined ', & ! 0 215 220 'ocean ', & ! 1 … … 229 234 'sea ice ', & ! 15 230 235 'snow ', & ! 16 231 'pavement/roads ' & ! 17 236 'pavement/roads ', & ! 17 237 'bare soil ' & ! 18 232 238 /) 233 239 234 INTEGER(iwp) :: albedo_type = 5, & !< Albedo surface type (default: short grassland)235 day, & !< current day of the year236 day_init = 172, & !< day of the year at model start (21/06)237 dots_rad = 0 !< starting index for timeseries output240 INTEGER(iwp) :: albedo_type = 9999999, & !< Albedo surface type 241 day, & !< current day of the year 242 day_init = 172, & !< day of the year at model start (21/06) 243 dots_rad = 0 !< starting index for timeseries output 238 244 239 245 LOGICAL :: unscheduled_radiation_calls = .TRUE., & !< flag parameter indicating whether additional calls of the radiation code are allowed … … 261 267 decl_3, & !< declination coef. 3 262 268 dt_radiation = 0.0_wp, & !< radiation model timestep 263 emissivity = 0.98_wp,& !< NAMELIST surface emissivity269 emissivity = 9999999.9_wp, & !< NAMELIST surface emissivity 264 270 lambda = 0.0_wp, & !< longitude in degrees 265 271 lon = 0.0_wp, & !< longitude in radians … … 278 284 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 279 285 alpha, & !< surface broadband albedo (used for clear-sky scheme) 286 emis, & !< surface broadband emissitivity 280 287 rad_lw_out_change_0, & !< change in LW out due to change in surface temperature 281 288 rad_net, & !< net radiation at the surface … … 285 292 !-- Land surface albedos for solar zenith angle of 60° after Briegleb (1992) 286 293 !-- (shortwave, longwave, broadband): sw, lw, bb, 287 REAL(wp), DIMENSION(0:2,1:1 7), PARAMETER :: albedo_pars = RESHAPE( (/&294 REAL(wp), DIMENSION(0:2,1:18), PARAMETER :: albedo_pars = RESHAPE( (/& 288 295 0.06_wp, 0.06_wp, 0.06_wp, & ! 1 289 296 0.09_wp, 0.28_wp, 0.19_wp, & ! 2 … … 302 309 0.90_wp, 0.65_wp, 0.77_wp, & ! 15 303 310 0.95_wp, 0.70_wp, 0.82_wp, & ! 16 304 0.08_wp, 0.08_wp, 0.08_wp & ! 17 305 /), (/ 3, 17 /) ) 311 0.08_wp, 0.08_wp, 0.08_wp, & ! 17 312 0.17_wp, 0.17_wp, 0.17_wp & ! 18 313 /), (/ 3, 18 /) ) 306 314 307 315 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: & … … 510 518 ! 511 519 !-- Public variables and constants / NEEDS SORTING 512 PUBLIC decl_1, decl_2, decl_3, dots_rad, dt_radiation, force_radiation_call,&520 PUBLIC albedo, albedo_type, decl_1, decl_2, decl_3, dots_rad, dt_radiation, emissivity, force_radiation_call,& 513 521 lat, lon, rad_net, rad_net_av, radiation, radiation_scheme, rad_lw_in, & 514 522 rad_lw_in_av, rad_lw_out, rad_lw_out_av, rad_lw_out_change_0, & … … 888 896 889 897 ! 898 !-- Allocate array for storing emissivity 899 IF ( .NOT. ALLOCATED ( emis ) ) THEN 900 ALLOCATE ( emis(nysg:nyng,nxlg:nxrg) ) 901 emis = emissivity 902 ENDIF 903 904 ! 890 905 !-- Allocate array for storing the surface net radiation 891 906 IF ( .NOT. ALLOCATED ( rad_net ) ) THEN … … 956 971 ! 957 972 !-- Overwrite albedo if manually set in parameter file 958 IF ( albedo_type /= 0 .AND. albedo == 9999999.9_wp ) THEN973 IF ( albedo_type /= 0 .AND. albedo_type /= 9999999 .AND. albedo == 9999999.9_wp ) THEN 959 974 albedo = albedo_pars(2,albedo_type) 960 975 ENDIF 961 976 ! 977 !-- Write albedo to 2d array alpha to allow surface heterogeneities 962 978 alpha = albedo 963 979 … … 1194 1210 rad_sw_in(0,j,i) = solar_constant * sky_trans * zenith(0) 1195 1211 rad_sw_out(0,j,i) = alpha(j,i) * rad_sw_in(0,j,i) 1196 rad_lw_out(0,j,i) = emis sivity* sigma_sb * (pt(k,j,i) * exn)**41212 rad_lw_out(0,j,i) = emis(j,i) * sigma_sb * (pt(k,j,i) * exn)**4 1197 1213 1198 1214 IF ( cloud_physics ) THEN … … 1207 1223 1208 1224 1209 rad_lw_out_change_0(j,i) = 3.0_wp * sigma_sb * emis sivity&1225 rad_lw_out_change_0(j,i) = 3.0_wp * sigma_sb * emis(j,i) & 1210 1226 * (pt(k,j,i) * exn) ** 3 1211 1227 … … 1254 1270 ENDIF 1255 1271 1256 rad_lw_out(0,j,i) = emis sivity* sigma_sb * (pt(k,j,i) * exn)**41272 rad_lw_out(0,j,i) = emis(j,i) * sigma_sb * (pt(k,j,i) * exn)**4 1257 1273 1258 1274 rad_sw_in(0,j,i) = ( rad_net(j,i) - rad_lw_in(0,j,i) & … … 1533 1549 rrtm_tsfc = pt(nzb,j,i) * (surface_pressure / 1000.0_wp )**0.286_wp 1534 1550 1551 ! 1552 !-- Set surface emissivity 1553 rrtm_emis = emis(j,i) 1554 1535 1555 IF ( lw_radiation ) THEN 1536 1556 CALL rrtmg_lw( 1, nzt_rad , rrtm_icld , rrtm_idrv ,& … … 1723 1743 rrtm_aldir(0,:,:) = aldif 1724 1744 rrtm_asdir(0,:,:) = asdif 1745 1746 ! 1747 !-- Bare soil 1748 ELSEIF ( albedo_type == 18 ) THEN 1749 rrtm_aldir(0,:,:) = aldif 1750 rrtm_asdir(0,:,:) = asdif 1751 1725 1752 ! 1726 1753 !-- Land surfaces
Note: See TracChangeset
for help on using the changeset viewer.