- Timestamp:
- Jun 1, 2017 2:12:31 PM (7 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
land_surface_model_mod.f90 (modified) (13 diffs)
-
radiation_model_mod.f90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/land_surface_model_mod.f90
r2237 r2242 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Changed soil configuration to 8 layers. The number of soil layers is now 28 ! freely adjustable via the NAMELIST. 29 ! 30 ! 2237 2017-05-31 10:34:53Z suehring 27 31 ! Bugfix in write restart data 28 32 ! … … 225 229 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: var_2D !< 2D prognostic variable 226 230 END TYPE surf_type_lsm 231 227 232 ! 228 233 !-- LSM model constants 229 INTEGER(iwp), PARAMETER :: nzb_soil = 0, & !< bottom of the soil model (to be switched) 230 nzt_soil = 3, & !< top of the soil model (to be switched) 231 nzs = 4 !< number of soil layers (fixed for now) 232 233 REAL(wp), PARAMETER :: & 234 235 REAL(wp), PARAMETER :: & 234 236 b_ch = 6.04_wp, & ! Clapp & Hornberger exponent 235 237 lambda_h_dry = 0.19_wp, & ! heat conductivity for dry soil … … 242 244 243 245 246 REAL(wp), DIMENSION(0:7), PARAMETER :: zs_default = & ! default soil layer configuration 247 (/ 0.005_wp, 0.02_wp, 0.04_wp, & 248 0.07_wp, 0.15_wp, 0.28_wp, & 249 1.00_wp, 2.89_wp /) 250 251 244 252 ! 245 253 !-- LSM variables 246 INTEGER(iwp) :: veg_type = 2, & !< NAMELIST veg_type_2d 247 soil_type = 3 !< NAMELIST soil_type_2d 248 254 INTEGER(iwp) :: nzb_soil = 0, & !< bottom of the soil model (Earth's surface) 255 nzt_soil = 0, & !< top of the soil model 256 nzs = 0, & !< number of soil layers 257 veg_type = 2, & !< default NAMELIST veg_type_2d 258 soil_type = 3 !< default NAMELIST soil_type_2d 259 260 249 261 LOGICAL :: conserve_water_content = .TRUE., & !< open or closed bottom surface for the soil model 250 262 force_radiation_call_l = .FALSE., & !< flag to force calling of radiation routine … … 288 300 z0q_eb = 9999999.9_wp !< NAMELIST z0q (lsm_par) 289 301 290 REAL(wp), DIMENSION(nzb_soil:nzt_soil) :: & 291 ddz_soil_stag, & !< 1/dz_soil_stag 292 dz_soil_stag, & !< soil grid spacing (center-center) 293 root_extr = 0.0_wp, & !< root extraction 294 root_fraction = (/9999999.9_wp, 9999999.9_wp, & 295 9999999.9_wp, 9999999.9_wp /), & !< distribution of root surface area to the individual soil layers 296 zs = (/0.07_wp, 0.28_wp, 1.00_wp, 2.89_wp/), & !< soil layer depths (m) 297 soil_moisture = 0.0_wp !< soil moisture content (m3/m3) 298 299 REAL(wp), DIMENSION(nzb_soil:nzt_soil+1) :: & 300 soil_temperature = (/290.0_wp, 287.0_wp, 285.0_wp, 283.0_wp, & !< soil temperature (K) 301 283.0_wp /), & 302 ddz_soil, & !< 1/dz_soil 303 dz_soil !< soil grid spacing (edge-edge) 304 305 302 REAL(wp), DIMENSION(:), ALLOCATABLE :: ddz_soil, & !< 1/dz_soil 303 ddz_soil_stag, & !< 1/dz_soil_stag 304 dz_soil, & !< soil grid spacing (edge-edge) 305 dz_soil_stag, & !< soil grid spacing (center-center) 306 root_extr !< root extraction 307 308 309 310 REAL(wp), DIMENSION(0:20) :: root_fraction = 9999999.9_wp, & !< distribution of root surface area to the individual soil layers 311 soil_moisture = 0.0_wp, & !< NAMELIST soil moisture content (m3/m3) 312 soil_temperature = 300.0_wp, & !< NAMELIST soil temperature (K) +1 313 zs = 9999999.9_wp !< soil layer depths 314 306 315 #if defined( __nopointer ) 307 316 TYPE(surf_type_lsm), TARGET :: t_soil_h, & !< Soil temperature (K), horizontal surface elements … … 533 542 534 543 ! 535 !-- Root distribution (sum = 1) level 1, level 2, level 3, level 4, 536 REAL(wp), DIMENSION(0:3,1:20), PARAMETER :: root_distribution = RESHAPE( (/ & 537 0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp, & ! 1 538 0.35_wp, 0.38_wp, 0.23_wp, 0.04_wp, & ! 2 539 0.26_wp, 0.39_wp, 0.29_wp, 0.06_wp, & ! 3 540 0.26_wp, 0.38_wp, 0.29_wp, 0.07_wp, & ! 4 541 0.24_wp, 0.38_wp, 0.31_wp, 0.07_wp, & ! 5 542 0.25_wp, 0.34_wp, 0.27_wp, 0.14_wp, & ! 6 543 0.27_wp, 0.27_wp, 0.27_wp, 0.09_wp, & ! 7 544 1.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 8 545 0.47_wp, 0.45_wp, 0.08_wp, 0.00_wp, & ! 9 546 0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp, & ! 10 547 0.17_wp, 0.31_wp, 0.33_wp, 0.19_wp, & ! 11 548 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 12 549 0.25_wp, 0.34_wp, 0.27_wp, 0.11_wp, & ! 13 550 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 14 551 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 15 552 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 16 553 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 17 554 0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp, & ! 18 555 0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp, & ! 19 556 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp & ! 20 557 /), (/ 4, 20 /) ) 544 !-- Root distribution (sum = 1) level 1-8 545 !-- 546 REAL(wp), DIMENSION(0:7,1:20), PARAMETER :: root_distribution = RESHAPE( (/& 547 0.035_wp, 0.069_wp, 0.069_wp, 0.108_wp, & 548 0.195_wp, 0.214_wp, 0.284_wp, 0.026_wp, & ! 1 549 0.050_wp, 0.100_wp, 0.100_wp, 0.136_wp, & 550 0.181_wp, 0.192_wp, 0.215_wp, 0.026_wp, & ! 2 551 0.038_wp, 0.075_wp, 0.075_wp, 0.111_wp, & 552 0.185_wp, 0.203_wp, 0.273_wp, 0.040_wp, & ! 3 553 0.038_wp, 0.075_wp, 0.075_wp, 0.110_wp, & 554 0.180_wp, 0.199_wp, 0.277_wp, 0.046_wp, & ! 4 555 0.035_wp, 0.069_wp, 0.069_wp, 0.105_wp, & 556 0.180_wp, 0.201_wp, 0.295_wp, 0.046_wp, & ! 5 557 0.035_wp, 0.072_wp, 0.072_wp, 0.105_wp, & 558 0.161_wp, 0.180_wp, 0.282_wp, 0.093_wp, & ! 6 559 0.040_wp, 0.077_wp, 0.077_wp, 0.112_wp, & 560 0.176_wp, 0.192_wp, 0.266_wp, 0.060_wp, & ! 7 561 0.142_wp, 0.286_wp, 0.286_wp, 0.286_wp, & 562 0.000_wp, 0.000_wp, 0.000_wp, 0.000_wp, & ! 8 563 0.068_wp, 0.134_wp, 0.134_wp, 0.177_wp, & 564 0.214_wp, 0.203_wp, 0.070_wp, 0.000_wp, & ! 9 565 0.035_wp, 0.068_wp, 0.068_wp, 0.108_wp, & 566 0.195_wp, 0.215_wp, 0.285_wp, 0.026_wp, & ! 10 567 0.025_wp, 0.048_wp, 0.048_wp, 0.078_wp, & 568 0.147_wp, 0.175_wp, 0.353_wp, 0.126_wp, & ! 11 569 0.000_wp, 0.000_wp, 0.000_wp, 0.000_wp, & 570 0.000_wp, 0.000_wp, 0.000_wp, 0.000_wp, & ! 12 571 0.036_wp, 0.072_wp, 0.072_wp, 0.103_wp, & 572 0.163_wp, 0.180_wp, 0.273_wp, 0.074_wp, & ! 13 573 0.000_wp, 0.000_wp, 0.000_wp, 0.000_wp, & 574 0.000_wp, 0.000_wp, 0.000_wp, 0.000_wp, & ! 14 575 0.000_wp, 0.000_wp, 0.000_wp, 0.000_wp, & 576 0.000_wp, 0.000_wp, 0.000_wp, 0.000_wp, & ! 15 577 0.032_wp, 0.066_wp, 0.066_wp, 0.100_wp, & 578 0.172_wp, 0.192_wp, 0.299_wp, 0.073_wp, & ! 16 579 0.032_wp, 0.066_wp, 0.066_wp, 0.100_wp, & 580 0.172_wp, 0.192_wp, 0.299_wp, 0.073_wp, & ! 17 581 0.028_wp, 0.055_wp, 0.055_wp, 0.087_wp, & 582 0.166_wp, 0.195_wp, 0.348_wp, 0.066_wp, & ! 18 583 0.028_wp, 0.055_wp, 0.055_wp, 0.087_wp, & 584 0.166_wp, 0.195_wp, 0.348_wp, 0.066_wp, & ! 19 585 0.000_wp, 0.000_wp, 0.000_wp, 0.000_wp, & 586 0.000_wp, 0.000_wp, 0.000_wp, 0.000_wp & ! 20 587 /), (/ 8, 20 /) ) 588 558 589 559 590 ! … … 930 961 931 962 IF ( veg_type == 0 ) THEN 932 IF ( SUM( root_fraction ) /= 1.0_wp ) THEN933 message_string = 'veg_type = 0 (user_defined)'// &934 'requires setting of root_fraction(0:3)'// &935 '/= 9999999.9 and SUM(root_fraction) = 1'936 CALL message( 'check_parameters', 'PA0401', 1, 2, 0, 6, 0 )937 ENDIF938 939 963 IF ( min_canopy_resistance == 9999999.9_wp ) THEN 940 964 message_string = 'veg_type = 0 (user defined)'// & … … 1079 1103 ENDIF 1080 1104 1081 1105 1106 1107 ! 1108 !-- Determine number of soil layers to be used and check whether an appropriate 1109 !-- root fraction is prescribed 1110 nzb_soil = 0 1111 nzt_soil = 0 1112 IF ( ALL( zs == 9999999.9_wp ) ) THEN 1113 nzt_soil = 7 1114 zs(nzb_soil:nzt_soil) = zs_default 1115 ELSE 1116 DO k = 0, 19 1117 IF ( zs(k) /= 9999999.9_wp ) THEN 1118 nzt_soil = nzt_soil + 1 1119 IF ( root_fraction(k) == 9999999.9_wp ) THEN 1120 message_string = 'manual setting of zs '// & 1121 'requires adequate setting of root_fraction'//& 1122 '/= 9999999.9 ' // & 1123 'and SUM(root_fraction) = 1' 1124 CALL message( 'check_parameters', 'PA0452', 1, 2, 0, 6, 0 ) 1125 ENDIF 1126 ENDIF 1127 ENDDO 1128 ENDIF 1129 1130 IF ( veg_type == 0 ) THEN 1131 IF ( SUM( root_fraction(nzb_soil:nzt_soil) ) /= 1.0_wp ) THEN 1132 message_string = 'veg_type = 0 (user_defined)'// & 1133 'requires setting of root_fraction'// & 1134 '/= 9999999.9 and SUM(root_fraction) = 1' 1135 CALL message( 'check_parameters', 'PA0401', 1, 2, 0, 6, 0 ) 1136 ENDIF 1137 ENDIF 1138 1139 1082 1140 END SUBROUTINE lsm_check_parameters 1083 1141 … … 1225 1283 ELSE 1226 1284 pt1 = pt(k,j,i) 1227 qv1 = q(k,j,i) 1285 IF ( humidity ) THEN 1286 qv1 = q(k,j,i) 1287 ELSE 1288 qv1 = 0.0_wp 1289 ENDIF 1228 1290 ENDIF 1229 1291 ! … … 1789 1851 1790 1852 ! 1791 !-- Set init al values for prognostic quantities1853 !-- Set initial values for prognostic quantities 1792 1854 !-- Horizontal surfaces 1793 1855 tt_surface_h_m%var_1d = 0.0_wp … … 1842 1904 ENDDO 1843 1905 1906 1844 1907 ! 1845 1908 !-- Allocate 3D soil model arrays … … 2154 2217 z0h_factor = z0h_eb / ( z0_eb + 1.0E-20_wp ) 2155 2218 2156 IF ( A NY( root_fraction == 9999999.9_wp ) ) THEN2219 IF ( ALL( root_fraction == 9999999.9_wp ) ) THEN 2157 2220 DO m = 1, surf_lsm_h%ns 2158 2221 i = surf_lsm_h%i(m) 2159 2222 j = surf_lsm_h%j(m) 2160 2223 2161 DO k = nzb_soil, nzt_soil 2224 2225 DO k = nzb_soil, nzt_soil 2162 2226 surf_lsm_h%root_fr(k,m) = root_distribution(k,veg_type) 2163 root_fraction(k) = root_distribution(k,veg_type)2227 root_fraction(k) = root_distribution(k,veg_type) 2164 2228 ENDDO 2165 2229 ENDDO … … 2302 2366 2303 2367 INTEGER(iwp) :: l !< index indicating facing of surface array 2304 2368 2369 ! 2370 !-- Allocate global 1D arrays 2371 ALLOCATE ( ddz_soil(nzb_soil:nzt_soil+1) ) 2372 ALLOCATE ( ddz_soil_stag(nzb_soil:nzt_soil) ) 2373 ALLOCATE ( dz_soil(nzb_soil:nzt_soil+1) ) 2374 ALLOCATE ( dz_soil_stag(nzb_soil:nzt_soil) ) 2375 ALLOCATE ( root_extr(nzb_soil:nzt_soil) ) 2376 2377 root_extr = 0.0_wp 2378 2305 2379 ! 2306 2380 !-- Allocate surface and soil temperature / humidity. Please note, … … 2494 2568 conserve_water_content, & 2495 2569 f_shortwave_incoming, field_capacity, & 2496 aero_resist_kray, hydraulic_conductivity, 2570 aero_resist_kray, hydraulic_conductivity, & 2497 2571 lambda_surface_stable, & 2498 2572 lambda_surface_unstable, leaf_area_index, & -
palm/trunk/SOURCE/radiation_model_mod.f90
r2233 r2242 25 25 ! ----------------- 26 26 ! $Id$ 27 ! 27 ! Allow for RRTMG runs without humidity/cloud physics 28 ! 29 ! 2233 2017-05-30 18:08:54Z suehring 30 ! 28 31 ! 2232 2017-05-30 17:47:52Z suehring 29 32 ! Adjustments to new topography concept … … 1415 1418 / 1000.0_wp )**0.286_wp 1416 1419 1417 DO k = nzb+1, nzt+1 1418 rrtm_tlay(0,k) = pt(k,j,i) * ( (hyp(k) ) / 100000.0_wp & 1419 )**0.286_wp + l_d_cp * ql(k,j,i) 1420 rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * (q(k,j,i) - ql(k,j,i)) 1421 1422 ENDDO 1420 1421 IF ( cloud_physics ) THEN 1422 DO k = nzb+1, nzt+1 1423 rrtm_tlay(0,k) = pt(k,j,i) * ( (hyp(k) ) / 100000.0_wp & 1424 )**0.286_wp + l_d_cp * ql(k,j,i) 1425 rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * (q(k,j,i) - ql(k,j,i)) 1426 ENDDO 1427 ELSE 1428 DO k = nzb+1, nzt+1 1429 rrtm_tlay(0,k) = pt(k,j,i) * ( (hyp(k) ) / 100000.0_wp & 1430 )**0.286_wp 1431 rrtm_h2ovmr(0,k) = 0.0_wp 1432 ENDDO 1433 ENDIF 1423 1434 1424 1435 ! … … 1455 1466 rrtm_icld = 0 1456 1467 1457 DO k = nzb+1, nzt+1 1458 rrtm_cliqwp(0,k) = ql(k,j,i) * 1000.0_wp * & 1459 (rrtm_plev(0,k) - rrtm_plev(0,k+1)) & 1460 * 100.0_wp / g 1461 1462 IF ( rrtm_cliqwp(0,k) > 0.0_wp ) THEN 1463 rrtm_cldfr(0,k) = 1.0_wp 1464 IF ( rrtm_icld == 0 ) rrtm_icld = 1 1465 1466 ! 1467 !-- Calculate cloud droplet effective radius 1468 IF ( cloud_physics ) THEN 1469 rrtm_reliq(0,k) = 1.0E6_wp * ( 3.0_wp * ql(k,j,i) & 1470 * rho_surface & 1471 / ( 4.0_wp * pi * nc_const * rho_l ) & 1472 )**0.33333333333333_wp & 1473 * EXP( LOG( sigma_gc )**2 ) 1474 1475 ELSEIF ( cloud_droplets ) THEN 1476 number_of_particles = prt_count(k,j,i) 1477 1478 IF (number_of_particles <= 0) CYCLE 1479 particles => grid_particles(k,j,i)%particles(1:number_of_particles) 1480 s_r2 = 0.0_wp 1481 s_r3 = 0.0_wp 1482 1483 DO n = 1, number_of_particles 1484 IF ( particles(n)%particle_mask ) THEN 1485 s_r2 = s_r2 + particles(n)%radius**2 * & 1486 particles(n)%weight_factor 1487 s_r3 = s_r3 + particles(n)%radius**3 * & 1488 particles(n)%weight_factor 1489 ENDIF 1490 ENDDO 1491 1492 IF ( s_r2 > 0.0_wp ) rrtm_reliq(0,k) = s_r3 / s_r2 1493 1468 IF ( cloud_physics ) THEN 1469 DO k = nzb+1, nzt+1 1470 rrtm_cliqwp(0,k) = ql(k,j,i) * 1000.0_wp * & 1471 (rrtm_plev(0,k) - rrtm_plev(0,k+1)) & 1472 * 100.0_wp / g 1473 1474 IF ( rrtm_cliqwp(0,k) > 0.0_wp ) THEN 1475 rrtm_cldfr(0,k) = 1.0_wp 1476 IF ( rrtm_icld == 0 ) rrtm_icld = 1 1477 1478 ! 1479 !-- Calculate cloud droplet effective radius 1480 IF ( cloud_physics ) THEN 1481 rrtm_reliq(0,k) = 1.0E6_wp * ( 3.0_wp * ql(k,j,i) & 1482 * rho_surface & 1483 / ( 4.0_wp * pi * nc_const * rho_l ) & 1484 )**0.33333333333333_wp & 1485 * EXP( LOG( sigma_gc )**2 ) 1486 1487 ELSEIF ( cloud_droplets ) THEN 1488 number_of_particles = prt_count(k,j,i) 1489 1490 IF (number_of_particles <= 0) CYCLE 1491 particles => grid_particles(k,j,i)%particles(1:number_of_particles) 1492 s_r2 = 0.0_wp 1493 s_r3 = 0.0_wp 1494 1495 DO n = 1, number_of_particles 1496 IF ( particles(n)%particle_mask ) THEN 1497 s_r2 = s_r2 + particles(n)%radius**2 * & 1498 particles(n)%weight_factor 1499 s_r3 = s_r3 + particles(n)%radius**3 * & 1500 particles(n)%weight_factor 1501 ENDIF 1502 ENDDO 1503 1504 IF ( s_r2 > 0.0_wp ) rrtm_reliq(0,k) = s_r3 / s_r2 1505 1506 ENDIF 1507 1508 ! 1509 !-- Limit effective radius 1510 IF ( rrtm_reliq(0,k) > 0.0_wp ) THEN 1511 rrtm_reliq(0,k) = MAX(rrtm_reliq(0,k),2.5_wp) 1512 rrtm_reliq(0,k) = MIN(rrtm_reliq(0,k),60.0_wp) 1513 ENDIF 1494 1514 ENDIF 1495 1496 ! 1497 !-- Limit effective radius 1498 IF ( rrtm_reliq(0,k) > 0.0_wp ) THEN 1499 rrtm_reliq(0,k) = MAX(rrtm_reliq(0,k),2.5_wp) 1500 rrtm_reliq(0,k) = MIN(rrtm_reliq(0,k),60.0_wp) 1501 ENDIF 1502 ENDIF 1503 ENDDO 1515 ENDDO 1516 ENDIF 1504 1517 1505 1518 !
Note: See TracChangeset
for help on using the changeset viewer.
