Changeset 4342 for palm/trunk/SOURCE
- Timestamp:
- Dec 16, 2019 1:49:14 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
plant_canopy_model_mod.f90 (modified) (48 diffs)
-
salsa_mod.f90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r4341 r4342 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Use statements moved to module level, ocean dependency removed, redundant 30 ! variables removed 31 ! 32 ! 4341 2019-12-16 10:43:49Z motisi 29 33 ! - Unification of variable names: pc_-variables now pcm_-variables 30 34 ! (pc_latent_rate, pc_heating_rate, pc_transpiration_rate) … … 134 138 USE basic_constants_and_equations_mod, & 135 139 ONLY: c_p, degc_to_k, l_v, lv_d_cp, r_d, rd_d_rv 140 141 USE bulk_cloud_model_mod, & 142 ONLY: bulk_cloud_model, microphysics_seifert 136 143 137 144 USE control_parameters, & 138 ONLY: debug_output, humidity 145 ONLY: average_count_3d, coupling_char, debug_output, dt_3d, dz, & 146 humidity, message_string, ocean_mode, passive_scalar, & 147 plant_canopy, urban_surface 148 149 USE grid_variables, & 150 ONLY: dx, dy 139 151 140 152 USE indices, & … … 143 155 144 156 USE kinds 157 158 USE netcdf_data_input_mod, & 159 ONLY: input_pids_static, leaf_area_density_f 145 160 146 161 USE pegrid 162 163 USE surface_mod, & 164 ONLY: surf_def_h, surf_lsm_h, surf_usm_h 147 165 148 166 149 167 IMPLICIT NONE 150 151 168 152 169 CHARACTER (LEN=30) :: canopy_mode = 'homogeneous' !< canopy coverage … … 165 182 REAL(wp) :: beta_lad = 9999999.9_wp !< coefficient for lad calculation 166 183 REAL(wp) :: canopy_drag_coeff = 0.0_wp !< canopy drag coefficient (parameter) 167 REAL(wp) :: cdc = 0.0_wp !< canopy drag coeff. (abbreviation used in equations)168 184 REAL(wp) :: cthf = 0.0_wp !< canopy top heat flux 169 185 REAL(wp) :: dt_plant_canopy = 0.0_wp !< timestep account. for canopy drag … … 173 189 REAL(wp) :: leaf_scalar_exch_coeff = 0.0_wp !< canopy scalar exchange coeff. 174 190 REAL(wp) :: leaf_surface_conc = 0.0_wp !< leaf surface concentration 175 REAL(wp) :: lsc = 0.0_wp !< leaf surface concentration176 REAL(wp) :: lsec = 0.0_wp !< leaf scalar exchange coeff.177 191 178 192 REAL(wp) :: lad_vertical_gradient(10) = 0.0_wp !< lad gradient … … 197 211 SAVE 198 212 199 200 213 PRIVATE 201 214 202 215 ! 203 216 !-- Public functions … … 209 222 ! 210 223 !-- Public variables and constants 211 PUBLIC c dc, pcm_heating_rate, pcm_transpiration_rate, pcm_latent_rate,&212 canopy_mode, cthf, dt_plant_canopy, lad, lad_s, pch_index,&213 p lant_canopy_transpiration224 PUBLIC canopy_drag_coeff, pcm_heating_rate, pcm_transpiration_rate, & 225 pcm_latent_rate, canopy_mode, cthf, dt_plant_canopy, lad, lad_s, & 226 pch_index, plant_canopy_transpiration 214 227 215 228 INTERFACE pcm_calc_transpiration_rate … … 260 273 261 274 CONTAINS 262 263 264 275 276 265 277 !------------------------------------------------------------------------------! 266 278 ! Description: … … 281 293 SUBROUTINE pcm_calc_transpiration_rate(i, j, k, kk, pcbsw, pcblw, pcbtr, pcblh) 282 294 283 USE control_parameters, & 284 ONLY: dz 285 286 USE grid_variables, & 287 ONLY: dx, dy 288 289 IMPLICIT NONE 295 ! 290 296 !-- input parameters 291 297 INTEGER(iwp), INTENT(IN) :: i, j, k, kk !< indices of the pc gridbox … … 383 389 SUBROUTINE pcm_check_data_output( var, unit ) 384 390 385 USE control_parameters, &386 ONLY: message_string, urban_surface387 388 IMPLICIT NONE389 390 391 CHARACTER (LEN=*) :: unit !< 391 392 CHARACTER (LEN=*) :: var !< … … 427 428 !------------------------------------------------------------------------------! 428 429 SUBROUTINE pcm_check_parameters 429 430 USE control_parameters, & 431 ONLY: message_string 432 433 USE bulk_cloud_model_mod, & 434 ONLY: bulk_cloud_model, microphysics_seifert 435 436 USE netcdf_data_input_mod, & 437 ONLY: input_pids_static 438 439 440 IMPLICIT NONE 441 430 431 IF ( ocean_mode ) THEN 432 message_string = 'plant_canopy = .TRUE. is not allowed in the '// & 433 'ocean' 434 CALL message( 'pcm_check_parameters', 'PA0696', 1, 2, 0, 6, 0 ) 435 ENDIF 436 442 437 IF ( canopy_drag_coeff == 0.0_wp ) THEN 443 438 message_string = 'plant_canopy = .TRUE. requires a non-zero drag '// & … … 486 481 ENDIF 487 482 488 489 483 END SUBROUTINE pcm_check_parameters 490 484 … … 497 491 !------------------------------------------------------------------------------! 498 492 SUBROUTINE pcm_3d_data_averaging( mode, variable ) 499 500 501 USE control_parameters502 503 USE indices504 505 USE kinds506 507 IMPLICIT NONE508 493 509 494 CHARACTER (LEN=*) :: mode !< … … 659 644 SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf, fill_value, & 660 645 nzb_do, nzt_do ) 661 662 USE indices663 664 USE kinds665 666 667 IMPLICIT NONE668 646 669 647 CHARACTER (LEN=*) :: variable !< treated variable … … 768 746 END SELECT 769 747 770 771 748 END SUBROUTINE pcm_data_output_3d 772 749 … … 779 756 !------------------------------------------------------------------------------! 780 757 SUBROUTINE pcm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z ) 781 782 IMPLICIT NONE783 758 784 759 CHARACTER (LEN=*), INTENT(IN) :: var !< … … 791 766 792 767 ! 793 !-- Check for the grid 768 !-- Check for the grid. zpc is zu(nzb:nzb+pch_index) 794 769 SELECT CASE ( TRIM( var ) ) 795 770 … … 815 790 !------------------------------------------------------------------------------! 816 791 SUBROUTINE pcm_header ( io ) 817 818 USE control_parameters, &819 ONLY: passive_scalar820 821 822 IMPLICIT NONE823 792 824 793 CHARACTER (LEN=10) :: coor_chr !< … … 931 900 !------------------------------------------------------------------------------! 932 901 SUBROUTINE pcm_init 933 934 935 USE control_parameters, &936 ONLY: message_string, ocean_mode937 938 USE netcdf_data_input_mod, &939 ONLY: leaf_area_density_f940 941 USE pegrid942 943 USE surface_mod, &944 ONLY: surf_def_h, surf_lsm_h, surf_usm_h945 946 IMPLICIT NONE947 902 948 903 INTEGER(iwp) :: i !< running index … … 985 940 gradient = 0.0_wp 986 941 987 IF ( .NOT. ocean_mode ) THEN 988 989 lad(0) = lad_surface 990 lad_vertical_gradient_level_ind(1) = 0 991 992 DO k = 1, pch_index 993 IF ( i < 11 ) THEN 994 IF ( lad_vertical_gradient_level(i) < zu(k) .AND. & 995 lad_vertical_gradient_level(i) >= 0.0_wp ) THEN 996 gradient = lad_vertical_gradient(i) 997 lad_vertical_gradient_level_ind(i) = k - 1 998 i = i + 1 999 ENDIF 942 lad(0) = lad_surface 943 lad_vertical_gradient_level_ind(1) = 0 944 945 DO k = 1, pch_index 946 IF ( i < 11 ) THEN 947 IF ( lad_vertical_gradient_level(i) < zu(k) .AND. & 948 lad_vertical_gradient_level(i) >= 0.0_wp ) THEN 949 gradient = lad_vertical_gradient(i) 950 lad_vertical_gradient_level_ind(i) = k - 1 951 i = i + 1 1000 952 ENDIF 1001 IF ( gradient /= 0.0_wp ) THEN 1002 IF ( k /= 1 ) THEN 1003 lad(k) = lad(k-1) + dzu(k) * gradient 1004 ELSE 1005 lad(k) = lad_surface + dzu(k) * gradient 1006 ENDIF 953 ENDIF 954 IF ( gradient /= 0.0_wp ) THEN 955 IF ( k /= 1 ) THEN 956 lad(k) = lad(k-1) + dzu(k) * gradient 1007 957 ELSE 1008 lad(k) = lad (k-1)958 lad(k) = lad_surface + dzu(k) * gradient 1009 959 ENDIF 1010 ENDDO 1011 1012 ENDIF 960 ELSE 961 lad(k) = lad(k-1) 962 ENDIF 963 ENDDO 1013 964 1014 965 ! … … 1059 1010 !-- Allocate 3D-array for the leaf area density (lad_s). 1060 1011 ALLOCATE( lad_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1061 !1062 !-- Initialize canopy parameters cdc (canopy drag coefficient),1063 !-- lsec (leaf scalar exchange coefficient), lsc (leaf surface concentration)1064 !-- with the prescribed values1065 cdc = canopy_drag_coeff1066 lsec = leaf_scalar_exch_coeff1067 lsc = leaf_surface_conc1068 1012 1069 1013 ! … … 1133 1077 ! 1134 1078 ! ASCII file 1135 !-- Initialize canopy parameters c dc (canopy drag coefficient),1136 !-- l sec (leaf scalar exchange coefficient), lsc (leaf surface concentration)1079 !-- Initialize canopy parameters canopy_drag_coeff, 1080 !-- leaf_scalar_exch_coeff, leaf_surface_conc 1137 1081 !-- from file which contains complete 3D data (separate vertical profiles for 1138 1082 !-- each location). … … 1266 1210 i = surf_def_h(0)%i(m) 1267 1211 j = surf_def_h(0)%j(m) 1268 k = surf_def_h(0)%k(m)1269 1212 IF ( cum_lai_hf(0,j,i) /= 0.0_wp ) & 1270 1213 surf_def_h(0)%shf(m) = cthf * exp( -ext_coef * cum_lai_hf(0,j,i) ) … … 1275 1218 i = surf_lsm_h%i(m) 1276 1219 j = surf_lsm_h%j(m) 1277 k = surf_lsm_h%k(m)1278 1220 IF ( cum_lai_hf(0,j,i) /= 0.0_wp ) & 1279 1221 surf_lsm_h%shf(m) = cthf * exp( -ext_coef * cum_lai_hf(0,j,i) ) … … 1284 1226 i = surf_usm_h%i(m) 1285 1227 j = surf_usm_h%j(m) 1286 k = surf_usm_h%k(m)1287 1228 IF ( cum_lai_hf(0,j,i) /= 0.0_wp ) & 1288 1229 surf_usm_h%shf(m) = cthf * exp( -ext_coef * cum_lai_hf(0,j,i) ) … … 1313 1254 IF ( debug_output ) CALL debug_message( 'pcm_init', 'end' ) 1314 1255 1315 1316 1256 END SUBROUTINE pcm_init 1317 1257 … … 1323 1263 !------------------------------------------------------------------------------! 1324 1264 SUBROUTINE pcm_parin 1325 1326 USE control_parameters, &1327 ONLY: message_string, plant_canopy1328 1329 IMPLICIT NONE1330 1265 1331 1266 CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file … … 1406 1341 14 CONTINUE 1407 1342 1408 1409 1343 END SUBROUTINE pcm_parin 1410 1411 1344 1412 1345 … … 1434 1367 !------------------------------------------------------------------------------! 1435 1368 SUBROUTINE pcm_read_plant_canopy_3d 1436 1437 USE control_parameters, &1438 ONLY: coupling_char, message_string1439 1440 USE indices, &1441 ONLY: nbgp1442 1443 IMPLICIT NONE1444 1369 1445 1370 INTEGER(iwp) :: dtype !< type of input data (1=lad) … … 1507 1432 1508 1433 1509 1510 1434 !------------------------------------------------------------------------------! 1511 1435 ! Description: … … 1534 1458 SUBROUTINE pcm_tendency( component ) 1535 1459 1536 1537 USE control_parameters, &1538 ONLY: dt_3d, message_string1539 1540 USE kinds1541 1542 IMPLICIT NONE1543 1544 1460 INTEGER(iwp) :: component !< prognostic variable (u,v,w,pt,q,e) 1545 1461 INTEGER(iwp) :: i !< running index … … 1614 1530 ! 1615 1531 !-- Calculate preliminary value (pre_tend) of the tendency 1616 pre_tend = - c dc *&1532 pre_tend = - canopy_drag_coeff * & 1617 1533 lad_local * & 1618 1534 SQRT( u(k,j,i)**2 + & … … 1694 1610 ! 1695 1611 !-- Calculate preliminary value (pre_tend) of the tendency 1696 pre_tend = - c dc *&1612 pre_tend = - canopy_drag_coeff * & 1697 1613 lad_local * & 1698 1614 SQRT( ( 0.25_wp * ( u(k,j-1,i) + & … … 1744 1660 ! 1745 1661 !-- Calculate preliminary value (pre_tend) of the tendency 1746 pre_tend = - c dc *&1662 pre_tend = - canopy_drag_coeff * & 1747 1663 (0.5_wp * & 1748 1664 ( lad_s(kk+1,j,i) + lad_s(kk,j,i) )) * & … … 1820 1736 ! to include also the dependecy to the radiation 1821 1737 ! in the plant canopy box 1822 pcm_transpiration_rate(kk,j,i) = - l sec&1823 * lad_s(kk,j,i) * &1824 SQRT( ( 0.5_wp * ( u(k,j,i) + &1825 u(k,j,i+1) ) &1826 )**2 + &1827 ( 0.5_wp * ( v(k,j,i) + &1828 v(k,j+1,i) ) &1829 )**2 + &1830 ( 0.5_wp * ( w(k-1,j,i) + &1831 w(k,j,i) ) &1832 )**2 &1833 ) * &1834 ( q(k,j,i) - l sc )1738 pcm_transpiration_rate(kk,j,i) = - leaf_scalar_exch_coeff & 1739 * lad_s(kk,j,i) * & 1740 SQRT( ( 0.5_wp * ( u(k,j,i) + & 1741 u(k,j,i+1) ) & 1742 )**2 + & 1743 ( 0.5_wp * ( v(k,j,i) + & 1744 v(k,j+1,i) ) & 1745 )**2 + & 1746 ( 0.5_wp * ( w(k-1,j,i) + & 1747 w(k,j,i) ) & 1748 )**2 & 1749 ) * & 1750 ( q(k,j,i) - leaf_surface_conc ) 1835 1751 ENDIF 1836 1752 … … 1851 1767 kk = k - topo_top_ind(j,i,0) !- lad arrays are defined flat 1852 1768 tend(k,j,i) = tend(k,j,i) - & 1853 2.0_wp * c dc *&1769 2.0_wp * canopy_drag_coeff * & 1854 1770 lad_s(kk,j,i) * & 1855 1771 SQRT( ( 0.5_wp * ( u(k,j,i) + & … … 1878 1794 kk = k - topo_top_ind(j,i,0) !- lad arrays are defined flat 1879 1795 tend(k,j,i) = tend(k,j,i) - & 1880 l sec *&1796 leaf_scalar_exch_coeff * & 1881 1797 lad_s(kk,j,i) * & 1882 1798 SQRT( ( 0.5_wp * ( u(k,j,i) + & … … 1890 1806 )**2 & 1891 1807 ) * & 1892 ( s(k,j,i) - l sc )1808 ( s(k,j,i) - leaf_surface_conc ) 1893 1809 ENDDO 1894 1810 ENDDO … … 1933 1849 SUBROUTINE pcm_tendency_ij( i, j, component ) 1934 1850 1935 1936 USE control_parameters, &1937 ONLY: dt_3d, message_string1938 1939 USE kinds1940 1941 IMPLICIT NONE1942 1943 1851 INTEGER(iwp) :: component !< prognostic variable (u,v,w,pt,q,e) 1944 1852 INTEGER(iwp) :: i !< running index … … 2011 1919 ! 2012 1920 !-- Calculate preliminary value (pre_tend) of the tendency 2013 pre_tend = - c dc *&1921 pre_tend = - canopy_drag_coeff * & 2014 1922 lad_local * & 2015 1923 SQRT( u(k,j,i)**2 + & … … 2089 1997 ! 2090 1998 !-- Calculate preliminary value (pre_tend) of the tendency 2091 pre_tend = - c dc *&1999 pre_tend = - canopy_drag_coeff * & 2092 2000 lad_local * & 2093 2001 SQRT( ( 0.25_wp * ( u(k,j-1,i) + & … … 2135 2043 ! 2136 2044 !-- Calculate preliminary value (pre_tend) of the tendency 2137 pre_tend = - c dc *&2045 pre_tend = - canopy_drag_coeff * & 2138 2046 (0.5_wp * & 2139 2047 ( lad_s(kk+1,j,i) + lad_s(kk,j,i) )) * & … … 2197 2105 ! to include also the dependecy to the radiation 2198 2106 ! in the plant canopy box 2199 pcm_transpiration_rate(kk,j,i) = - l sec&2107 pcm_transpiration_rate(kk,j,i) = - leaf_scalar_exch_coeff & 2200 2108 * lad_s(kk,j,i) * & 2201 2109 SQRT( ( 0.5_wp * ( u(k,j,i) + & … … 2209 2117 )**2 & 2210 2118 ) * & 2211 ( q(k,j,i) - l sc )2119 ( q(k,j,i) - leaf_surface_conc ) 2212 2120 ENDIF 2213 2121 … … 2225 2133 kk = k - topo_top_ind(j,i,0) 2226 2134 tend(k,j,i) = tend(k,j,i) - & 2227 2.0_wp * c dc *&2135 2.0_wp * canopy_drag_coeff * & 2228 2136 lad_s(kk,j,i) * & 2229 2137 SQRT( ( 0.5_wp * ( u(k,j,i) + & … … 2249 2157 kk = k - topo_top_ind(j,i,0) 2250 2158 tend(k,j,i) = tend(k,j,i) - & 2251 l sec *&2159 leaf_scalar_exch_coeff * & 2252 2160 lad_s(kk,j,i) * & 2253 2161 SQRT( ( 0.5_wp * ( u(k,j,i) + & … … 2261 2169 )**2 & 2262 2170 ) * & 2263 ( s(k,j,i) - l sc )2171 ( s(k,j,i) - leaf_surface_conc ) 2264 2172 ENDDO 2265 2173 … … 2274 2182 2275 2183 2276 2277 2184 END MODULE plant_canopy_model_mod -
palm/trunk/SOURCE/salsa_mod.f90
r4329 r4342 26 26 ! ----------------- 27 27 ! $Id$ 28 ! cdc replaced by canopy_drag_coeff 29 ! 30 ! 4329 2019-12-10 15:46:36Z motisi 28 31 ! Renamed wall_flags_0 to wall_flags_static_0 29 32 ! … … 3831 3834 SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc ) 3832 3835 3833 USE plant_canopy_model_mod, 3834 ONLY: c dc3836 USE plant_canopy_model_mod, & 3837 ONLY: canopy_drag_coeff 3835 3838 3836 3839 IMPLICIT NONE … … 3930 3933 ! 3931 3934 !-- Friction velocity for deposition on vegetation. Calculated following Prandtl (1925): 3932 ustar = SQRT( c dc) * mag_u3935 ustar = SQRT( canopy_drag_coeff ) * mag_u 3933 3936 SELECT CASE ( depo_pcm_par_num ) 3934 3937
Note: See TracChangeset
for help on using the changeset viewer.
