Changeset 3597 for palm/trunk/SOURCE/urban_surface_mod.f90
- Timestamp:
- Dec 4, 2018 8:40:18 AM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/urban_surface_mod.f90
r3524 r3597 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Fixed calculation method of near surface air potential temperature at 10 cm 31 ! and moved to surface_layer_fluxes. Removed unnecessary _eb strings. 32 ! 33 ! 3524 2018-11-14 13:36:44Z raasch 30 34 ! bugfix concerning allocation of t_surf_wall_v 31 35 ! … … 240 244 ! - Move first call of usm_radiatin from usm_init to init_3d_model 241 245 ! - fixed problem with near surface temperature 242 ! - added near surface temperature t_surf_10cm_h(m), t_surf_10cm_v(l)%t(m)246 ! - added near surface temperature pt_10cm_h(m), pt_10cm_v(l)%t(m) 243 247 ! - does not work with temp profile including stability, ol 244 ! t_surf_10cm = pt1 now248 ! pt_10cm = pt1 now 245 249 ! - merged with 2357 bugfix, error message for nopointer version 246 250 ! - added indoor model coupling with wall heat flux … … 986 990 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_window_av !< Average of t_window 987 991 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_eb_av !< average of qsws_eb 988 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_veg_ eb_av !< average of qsws_veg_eb989 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_liq_ eb_av !< average of qsws_liq_eb992 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_veg_av !< average of qsws_veg 993 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_liq_av !< average of qsws_liq 990 994 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: swc_av !< Average of swc 991 995 … … 1041 1045 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_h !< green surface temperature (K) at horizontal walls 1042 1046 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_h_p !< progn. green surface temperature (K) at horizontal walls 1043 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_h !< near surface temperature (10cm) (K) at horizontal walls1044 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_h_p !< progn. near surface temperature (10cm) (K) at horizontal walls1045 1047 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_wall_v 1046 1048 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_wall_v_p … … 1049 1051 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_green_v 1050 1052 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_green_v_p 1051 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_10cm_v1052 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_10cm_v_p1053 1053 #else 1054 1054 REAL(wp), DIMENSION(:), POINTER :: t_surf_wall_h … … 1058 1058 REAL(wp), DIMENSION(:), POINTER :: t_surf_green_h 1059 1059 REAL(wp), DIMENSION(:), POINTER :: t_surf_green_h_p 1060 REAL(wp), DIMENSION(:), POINTER :: t_surf_10cm_h1061 REAL(wp), DIMENSION(:), POINTER :: t_surf_10cm_h_p1062 1060 1063 1061 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_wall_h_1 … … 1067 1065 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_h_1 1068 1066 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_h_2 1069 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_h_11070 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_h_21071 1067 1072 1068 TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_wall_v … … 1076 1072 TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_green_v 1077 1073 TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_green_v_p 1078 TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_10cm_v1079 TYPE(t_surf_vertical), DIMENSION(:), POINTER :: t_surf_10cm_v_p1080 1074 1081 1075 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_wall_v_1 … … 1085 1079 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_green_v_1 1086 1080 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_green_v_2 1087 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_10cm_v_11088 TYPE(t_surf_vertical), DIMENSION(0:3), TARGET :: t_surf_10cm_v_21089 1081 1090 1082 #endif … … 1092 1084 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_window_av !< average of window surface temperature (K) 1093 1085 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_green_av !< average of green wall surface temperature (K) 1094 REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: t_surf_10cm_av !< average of whole wall surface temperature (K)1095 1086 1096 1087 !-- Temporal tendencies for time stepping … … 1218 1209 MODULE PROCEDURE usm_parin 1219 1210 END INTERFACE usm_parin 1220 1221 INTERFACE usm_temperature_near_surface1222 MODULE PROCEDURE usm_temperature_near_surface1223 END INTERFACE usm_temperature_near_surface1224 1211 1225 1212 INTERFACE usm_rrd_local … … 1262 1249 !-- Public parameters, constants and initial values 1263 1250 PUBLIC usm_anthropogenic_heat, usm_material_model, usm_wall_mod, & 1264 usm_green_heat_model, usm_temperature_near_surface,building_pars, &1265 nzt_wall, t_ surf_10cm_h, t_surf_10cm_v, t_wall_h, t_wall_v, &1251 usm_green_heat_model, building_pars, & 1252 nzt_wall, t_wall_h, t_wall_v, & 1266 1253 t_window_h, t_window_v, building_type 1267 1254 … … 1363 1350 ALLOCATE ( surf_usm_h%green_type_roof(1:surf_usm_h%ns) ) 1364 1351 ALLOCATE ( surf_usm_h%r_s(1:surf_usm_h%ns) ) 1352 1365 1353 ! 1366 1354 !-- For vertical surfaces. … … 1377 1365 ALLOCATE ( surf_usm_v(l)%r_a(1:surf_usm_v(l)%ns) ) 1378 1366 ALLOCATE ( surf_usm_v(l)%r_a_green(1:surf_usm_v(l)%ns) ) 1379 ALLOCATE ( surf_usm_v(l)%r_a_window(1:surf_usm_v(l)%ns) ) 1380 1381 ALLOCATE ( surf_usm_v(l)%r_s(1:surf_usm_v(l)%ns) ) 1367 ALLOCATE ( surf_usm_v(l)%r_a_window(1:surf_usm_v(l)%ns) ) 1368 ALLOCATE ( surf_usm_v(l)%r_s(1:surf_usm_v(l)%ns) ) 1382 1369 ENDDO 1383 1370 … … 1421 1408 ALLOCATE ( surf_usm_h%g_d(1:surf_usm_h%ns) ) 1422 1409 ALLOCATE ( surf_usm_h%c_liq(1:surf_usm_h%ns) ) 1423 ALLOCATE ( surf_usm_h%qsws_liq _eb(1:surf_usm_h%ns) )1424 ALLOCATE ( surf_usm_h%qsws_veg _eb(1:surf_usm_h%ns) )1410 ALLOCATE ( surf_usm_h%qsws_liq(1:surf_usm_h%ns) ) 1411 ALLOCATE ( surf_usm_h%qsws_veg(1:surf_usm_h%ns) ) 1425 1412 ALLOCATE ( surf_usm_h%r_canopy(1:surf_usm_h%ns) ) 1426 1413 ALLOCATE ( surf_usm_h%r_canopy_min(1:surf_usm_h%ns) ) 1427 ALLOCATE ( surf_usm_h%qsws_eb(1:surf_usm_h%ns) ) 1414 ALLOCATE ( surf_usm_h%qsws_eb(1:surf_usm_h%ns) ) 1415 ALLOCATE ( surf_usm_h%pt_10cm(1:surf_usm_h%ns) ) 1416 ALLOCATE ( surf_usm_h%pt_2m(1:surf_usm_h%ns) ) 1428 1417 1429 1418 ! … … 1432 1421 ALLOCATE ( surf_usm_v(l)%g_d(1:surf_usm_v(l)%ns) ) 1433 1422 ALLOCATE ( surf_usm_v(l)%c_liq(1:surf_usm_v(l)%ns) ) 1434 ALLOCATE ( surf_usm_v(l)%qsws_liq _eb(1:surf_usm_v(l)%ns) )1435 ALLOCATE ( surf_usm_v(l)%qsws_veg _eb(1:surf_usm_v(l)%ns) )1423 ALLOCATE ( surf_usm_v(l)%qsws_liq(1:surf_usm_v(l)%ns) ) 1424 ALLOCATE ( surf_usm_v(l)%qsws_veg(1:surf_usm_v(l)%ns) ) 1436 1425 ALLOCATE ( surf_usm_v(l)%qsws_eb(1:surf_usm_v(l)%ns) ) 1437 1426 ALLOCATE ( surf_usm_v(l)%r_canopy(1:surf_usm_v(l)%ns) ) 1438 1427 ALLOCATE ( surf_usm_v(l)%r_canopy_min(1:surf_usm_v(l)%ns) ) 1428 ALLOCATE ( surf_usm_v(l)%pt_10cm(1:surf_usm_v(l)%ns) ) 1439 1429 ENDDO 1440 1430 … … 1504 1494 IF ( .NOT. ALLOCATED( t_green_h_p ) ) & 1505 1495 ALLOCATE ( t_green_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 1506 IF ( .NOT. ALLOCATED( t_surf_10cm_h ) ) &1507 ALLOCATE ( t_surf_10cm_h(1:surf_usm_h%ns) )1508 IF ( .NOT. ALLOCATED( t_surf_10cm_h_p ) ) &1509 ALLOCATE ( t_surf_10cm_h_p(1:surf_usm_h%ns) )1510 1496 IF ( .NOT. ALLOCATED( swc_h ) ) & 1511 1497 ALLOCATE ( swc_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) … … 1560 1546 IF ( .NOT. ALLOCATED( t_green_h_2 ) ) & 1561 1547 ALLOCATE ( t_green_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 1562 IF ( .NOT. ALLOCATED( t_surf_10cm_h_1 ) ) &1563 ALLOCATE ( t_surf_10cm_h_1(1:surf_usm_h%ns) )1564 IF ( .NOT. ALLOCATED( t_surf_10cm_h_2 ) ) &1565 ALLOCATE ( t_surf_10cm_h_2(1:surf_usm_h%ns) )1566 1548 IF ( .NOT. ALLOCATED( swc_h_1 ) ) & 1567 1549 ALLOCATE ( swc_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) … … 1592 1574 t_surf_window_h => t_surf_window_h_1; t_surf_window_h_p => t_surf_window_h_2 1593 1575 t_surf_green_h => t_surf_green_h_1; t_surf_green_h_p => t_surf_green_h_2 1594 t_surf_10cm_h => t_surf_10cm_h_1; t_surf_10cm_h_p => t_surf_10cm_h_21595 1576 m_liq_usm_h => m_liq_usm_h_1; m_liq_usm_h_p => m_liq_usm_h_2 1596 1577 swc_h => swc_h_1; swc_h_p => swc_h_2 … … 1630 1611 IF ( .NOT. ALLOCATED( t_surf_green_v_p(l)%t ) ) & 1631 1612 ALLOCATE ( t_surf_green_v_p(l)%t(1:surf_usm_v(l)%ns) ) 1632 IF ( .NOT. ALLOCATED( t_surf_10cm_v(l)%t ) ) &1633 ALLOCATE ( t_surf_10cm_v(l)%t(1:surf_usm_v(l)%ns) )1634 IF ( .NOT. ALLOCATED( t_surf_10cm_v_p(l)%t ) ) &1635 ALLOCATE ( t_surf_10cm_v_p(l)%t(1:surf_usm_v(l)%ns) )1636 1613 IF ( .NOT. ALLOCATED( m_liq_usm_v(l)%var_usm_1d ) ) & 1637 1614 ALLOCATE ( m_liq_usm_v(l)%var_usm_1d(1:surf_usm_v(l)%ns) ) … … 1670 1647 IF ( .NOT. ALLOCATED( t_green_v_2(l)%t ) ) & 1671 1648 ALLOCATE ( t_green_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 1672 IF ( .NOT. ALLOCATED( t_surf_10cm_v_1(l)%t ) ) &1673 ALLOCATE ( t_surf_10cm_v_1(l)%t(1:surf_usm_v(l)%ns) )1674 IF ( .NOT. ALLOCATED( t_surf_10cm_v_2(l)%t ) ) &1675 ALLOCATE ( t_surf_10cm_v_2(l)%t(1:surf_usm_v(l)%ns) )1676 1649 IF ( .NOT. ALLOCATED( m_liq_usm_v_1(l)%var_usm_1d ) ) & 1677 1650 ALLOCATE ( m_liq_usm_v_1(l)%var_usm_1d(1:surf_usm_v(l)%ns) ) … … 1691 1664 t_surf_window_v => t_surf_window_v_1; t_surf_window_v_p => t_surf_window_v_2 1692 1665 t_surf_green_v => t_surf_green_v_1; t_surf_green_v_p => t_surf_green_v_2 1693 t_surf_10cm_v => t_surf_10cm_v_1; t_surf_10cm_v_p => t_surf_10cm_v_21694 1666 m_liq_usm_v => m_liq_usm_v_1; m_liq_usm_v_p => m_liq_usm_v_2 1695 1667 swc_v => swc_v_1; swc_v_p => swc_v_2 … … 2032 2004 !-- array of latent heat flux from vegetation surfaces 2033 2005 !-- land surfaces 2034 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%qsws_veg_ eb_av) ) THEN2035 ALLOCATE( surf_usm_h%qsws_veg_ eb_av(1:surf_usm_h%ns) )2036 surf_usm_h%qsws_veg_ eb_av = 0.0_wp2006 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%qsws_veg_av) ) THEN 2007 ALLOCATE( surf_usm_h%qsws_veg_av(1:surf_usm_h%ns) ) 2008 surf_usm_h%qsws_veg_av = 0.0_wp 2037 2009 ELSE 2038 IF ( .NOT. ALLOCATED(surf_usm_v(l)%qsws_veg_ eb_av) ) THEN2039 ALLOCATE( surf_usm_v(l)%qsws_veg_ eb_av(1:surf_usm_v(l)%ns) )2040 surf_usm_v(l)%qsws_veg_ eb_av = 0.0_wp2010 IF ( .NOT. ALLOCATED(surf_usm_v(l)%qsws_veg_av) ) THEN 2011 ALLOCATE( surf_usm_v(l)%qsws_veg_av(1:surf_usm_v(l)%ns) ) 2012 surf_usm_v(l)%qsws_veg_av = 0.0_wp 2041 2013 ENDIF 2042 2014 ENDIF … … 2045 2017 !-- array of latent heat flux from surfaces with liquid 2046 2018 !-- land surfaces 2047 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%qsws_liq_ eb_av) ) THEN2048 ALLOCATE( surf_usm_h%qsws_liq_ eb_av(1:surf_usm_h%ns) )2049 surf_usm_h%qsws_liq_ eb_av = 0.0_wp2019 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%qsws_liq_av) ) THEN 2020 ALLOCATE( surf_usm_h%qsws_liq_av(1:surf_usm_h%ns) ) 2021 surf_usm_h%qsws_liq_av = 0.0_wp 2050 2022 ELSE 2051 IF ( .NOT. ALLOCATED(surf_usm_v(l)%qsws_liq_ eb_av) ) THEN2052 ALLOCATE( surf_usm_v(l)%qsws_liq_ eb_av(1:surf_usm_v(l)%ns) )2053 surf_usm_v(l)%qsws_liq_ eb_av = 0.0_wp2023 IF ( .NOT. ALLOCATED(surf_usm_v(l)%qsws_liq_av) ) THEN 2024 ALLOCATE( surf_usm_v(l)%qsws_liq_av(1:surf_usm_v(l)%ns) ) 2025 surf_usm_v(l)%qsws_liq_av = 0.0_wp 2054 2026 ENDIF 2055 2027 ENDIF … … 2171 2143 ENDIF 2172 2144 2173 CASE ( 'usm_t _surf_10cm' )2174 !-- near surface temperature for whole surfaces2145 CASE ( 'usm_theta_10cm' ) 2146 !-- near surface (10cm) temperature for whole surfaces 2175 2147 IF ( l == -1 ) THEN 2176 IF ( .NOT. ALLOCATED(surf_usm_h% t_surf_10cm_av) ) THEN2177 ALLOCATE( surf_usm_h% t_surf_10cm_av(1:surf_usm_h%ns) )2178 surf_usm_h% t_surf_10cm_av = 0.0_wp2148 IF ( .NOT. ALLOCATED(surf_usm_h%pt_10cm_av) ) THEN 2149 ALLOCATE( surf_usm_h%pt_10cm_av(1:surf_usm_h%ns) ) 2150 surf_usm_h%pt_10cm_av = 0.0_wp 2179 2151 ENDIF 2180 2152 ELSE 2181 IF ( .NOT. ALLOCATED(surf_usm_v(l)% t_surf_10cm_av) ) THEN2182 ALLOCATE( surf_usm_v(l)% t_surf_10cm_av(1:surf_usm_v(l)%ns) )2183 surf_usm_v(l)% t_surf_10cm_av = 0.0_wp2153 IF ( .NOT. ALLOCATED(surf_usm_v(l)%pt_10cm_av) ) THEN 2154 ALLOCATE( surf_usm_v(l)%pt_10cm_av(1:surf_usm_v(l)%ns) ) 2155 surf_usm_v(l)%pt_10cm_av = 0.0_wp 2184 2156 ENDIF 2185 2157 ENDIF 2186 2158 2187 2159 CASE ( 'usm_t_wall' ) 2188 2160 !-- wall temperature for iwl layer of walls and land … … 2423 2395 IF ( l == -1 ) THEN 2424 2396 DO m = 1, surf_usm_h%ns 2425 surf_usm_h%qsws_veg_ eb_av(m) = &2426 surf_usm_h%qsws_veg_ eb_av(m) + &2427 surf_usm_h%qsws_veg _eb(m)2397 surf_usm_h%qsws_veg_av(m) = & 2398 surf_usm_h%qsws_veg_av(m) + & 2399 surf_usm_h%qsws_veg(m) 2428 2400 ENDDO 2429 2401 ELSE 2430 2402 DO m = 1, surf_usm_v(l)%ns 2431 surf_usm_v(l)%qsws_veg_ eb_av(m) = &2432 surf_usm_v(l)%qsws_veg_ eb_av(m) + &2433 surf_usm_v(l)%qsws_veg _eb(m)2403 surf_usm_v(l)%qsws_veg_av(m) = & 2404 surf_usm_v(l)%qsws_veg_av(m) + & 2405 surf_usm_v(l)%qsws_veg(m) 2434 2406 ENDDO 2435 2407 ENDIF … … 2439 2411 IF ( l == -1 ) THEN 2440 2412 DO m = 1, surf_usm_h%ns 2441 surf_usm_h%qsws_liq_ eb_av(m) = &2442 surf_usm_h%qsws_liq_ eb_av(m) + &2443 surf_usm_h%qsws_liq _eb(m)2413 surf_usm_h%qsws_liq_av(m) = & 2414 surf_usm_h%qsws_liq_av(m) + & 2415 surf_usm_h%qsws_liq(m) 2444 2416 ENDDO 2445 2417 ELSE 2446 2418 DO m = 1, surf_usm_v(l)%ns 2447 surf_usm_v(l)%qsws_liq_ eb_av(m) = &2448 surf_usm_v(l)%qsws_liq_ eb_av(m) + &2449 surf_usm_v(l)%qsws_liq _eb(m)2419 surf_usm_v(l)%qsws_liq_av(m) = & 2420 surf_usm_v(l)%qsws_liq_av(m) + & 2421 surf_usm_v(l)%qsws_liq(m) 2450 2422 ENDDO 2451 2423 ENDIF … … 2579 2551 ENDIF 2580 2552 2581 CASE ( 'usm_t _surf_10cm' )2553 CASE ( 'usm_theta_10cm' ) 2582 2554 !-- near surface temperature for whole surfaces 2583 2555 IF ( l == -1 ) THEN 2584 2556 DO m = 1, surf_usm_h%ns 2585 surf_usm_h% t_surf_10cm_av(m) = &2586 surf_usm_h% t_surf_10cm_av(m) + &2587 t_surf_10cm_h(m)2557 surf_usm_h%pt_10cm_av(m) = & 2558 surf_usm_h%pt_10cm_av(m) + & 2559 surf_usm_h%pt_10cm(m) 2588 2560 ENDDO 2589 2561 ELSE 2590 2562 DO m = 1, surf_usm_v(l)%ns 2591 surf_usm_v(l)% t_surf_10cm_av(m) = &2592 surf_usm_v(l)% t_surf_10cm_av(m) + &2593 t_surf_10cm_v(l)%t(m)2563 surf_usm_v(l)%pt_10cm_av(m) = & 2564 surf_usm_v(l)%pt_10cm_av(m) + & 2565 surf_usm_v(l)%pt_10cm(m) 2594 2566 ENDDO 2595 2567 ENDIF 2596 2597 2568 2598 2569 CASE ( 'usm_t_wall' ) … … 2840 2811 IF ( l == -1 ) THEN 2841 2812 DO m = 1, surf_usm_h%ns 2842 surf_usm_h%qsws_veg_ eb_av(m) = &2843 surf_usm_h%qsws_veg_ eb_av(m) / &2813 surf_usm_h%qsws_veg_av(m) = & 2814 surf_usm_h%qsws_veg_av(m) / & 2844 2815 REAL( average_count_3d, kind=wp ) 2845 2816 ENDDO 2846 2817 ELSE 2847 2818 DO m = 1, surf_usm_v(l)%ns 2848 surf_usm_v(l)%qsws_veg_ eb_av(m) = &2849 surf_usm_v(l)%qsws_veg_ eb_av(m) / &2819 surf_usm_v(l)%qsws_veg_av(m) = & 2820 surf_usm_v(l)%qsws_veg_av(m) / & 2850 2821 REAL( average_count_3d, kind=wp ) 2851 2822 ENDDO … … 2856 2827 IF ( l == -1 ) THEN 2857 2828 DO m = 1, surf_usm_h%ns 2858 surf_usm_h%qsws_liq_ eb_av(m) = &2859 surf_usm_h%qsws_liq_ eb_av(m) / &2829 surf_usm_h%qsws_liq_av(m) = & 2830 surf_usm_h%qsws_liq_av(m) / & 2860 2831 REAL( average_count_3d, kind=wp ) 2861 2832 ENDDO 2862 2833 ELSE 2863 2834 DO m = 1, surf_usm_v(l)%ns 2864 surf_usm_v(l)%qsws_liq_ eb_av(m) = &2865 surf_usm_v(l)%qsws_liq_ eb_av(m) / &2835 surf_usm_v(l)%qsws_liq_av(m) = & 2836 surf_usm_v(l)%qsws_liq_av(m) / & 2866 2837 REAL( average_count_3d, kind=wp ) 2867 2838 ENDDO … … 2996 2967 ENDIF 2997 2968 2998 CASE ( 'usm_t _surf_10cm' )2969 CASE ( 'usm_theta_10cm' ) 2999 2970 !-- near surface temperature for whole surfaces 3000 2971 IF ( l == -1 ) THEN 3001 2972 DO m = 1, surf_usm_h%ns 3002 surf_usm_h% t_surf_10cm_av(m) = &3003 surf_usm_h% t_surf_10cm_av(m) / &2973 surf_usm_h%pt_10cm_av(m) = & 2974 surf_usm_h%pt_10cm_av(m) / & 3004 2975 REAL( average_count_3d, kind=wp ) 3005 2976 ENDDO 3006 2977 ELSE 3007 2978 DO m = 1, surf_usm_v(l)%ns 3008 surf_usm_v(l)% t_surf_10cm_av(m) = &3009 surf_usm_v(l)% t_surf_10cm_av(m) / &2979 surf_usm_v(l)%pt_10cm_av(m) = & 2980 surf_usm_v(l)%pt_10cm_av(m) / & 3010 2981 REAL( average_count_3d, kind=wp ) 3011 2982 ENDDO 3012 2983 ENDIF 2984 3013 2985 3014 2986 CASE ( 'usm_t_wall' ) … … 3173 3145 'usm_t_surf_green ', & 3174 3146 'usm_t_green ', & 3175 'usm_t _surf_10cm', &3147 'usm_theta_10cm ', & 3176 3148 'usm_skyvf ', & 3177 3149 'usm_skyvft '/) … … 3260 3232 var(1:16) == 'usm_t_surf_green' .OR. & 3261 3233 var(1:11) == 'usm_t_green' .OR. var(1:7) == 'usm_swc' .OR. & 3262 var(1:1 5) == 'usm_t_surf_10cm' ) THEN3234 var(1:14) == 'usm_theta_10cm' ) THEN 3263 3235 unit = 'K' 3264 3236 ELSE IF ( var == 'usm_rad_pc_inlw' .OR. var == 'usm_rad_pc_insw' .OR. & … … 3935 3907 j = surf_usm_h%j(m) 3936 3908 k = surf_usm_h%k(m) 3937 temp_pf(k,j,i) = surf_usm_h%qsws_veg _eb(m)3909 temp_pf(k,j,i) = surf_usm_h%qsws_veg(m) 3938 3910 ENDDO 3939 3911 ELSE … … 3943 3915 j = surf_usm_v(l)%j(m) 3944 3916 k = surf_usm_v(l)%k(m) 3945 temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg _eb(m)3917 temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg(m) 3946 3918 ENDDO 3947 3919 ENDIF … … 3952 3924 j = surf_usm_h%j(m) 3953 3925 k = surf_usm_h%k(m) 3954 temp_pf(k,j,i) = surf_usm_h%qsws_veg_ eb_av(m)3926 temp_pf(k,j,i) = surf_usm_h%qsws_veg_av(m) 3955 3927 ENDDO 3956 3928 ELSE … … 3960 3932 j = surf_usm_v(l)%j(m) 3961 3933 k = surf_usm_v(l)%k(m) 3962 temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg_ eb_av(m)3934 temp_pf(k,j,i) = surf_usm_v(l)%qsws_veg_av(m) 3963 3935 ENDDO 3964 3936 ENDIF … … 3973 3945 j = surf_usm_h%j(m) 3974 3946 k = surf_usm_h%k(m) 3975 temp_pf(k,j,i) = surf_usm_h%qsws_liq _eb(m)3947 temp_pf(k,j,i) = surf_usm_h%qsws_liq(m) 3976 3948 ENDDO 3977 3949 ELSE … … 3981 3953 j = surf_usm_v(l)%j(m) 3982 3954 k = surf_usm_v(l)%k(m) 3983 temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq _eb(m)3955 temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq(m) 3984 3956 ENDDO 3985 3957 ENDIF … … 3990 3962 j = surf_usm_h%j(m) 3991 3963 k = surf_usm_h%k(m) 3992 temp_pf(k,j,i) = surf_usm_h%qsws_liq_ eb_av(m)3964 temp_pf(k,j,i) = surf_usm_h%qsws_liq_av(m) 3993 3965 ENDDO 3994 3966 ELSE … … 3998 3970 j = surf_usm_v(l)%j(m) 3999 3971 k = surf_usm_v(l)%k(m) 4000 temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq_ eb_av(m)3972 temp_pf(k,j,i) = surf_usm_v(l)%qsws_liq_av(m) 4001 3973 ENDDO 4002 3974 ENDIF … … 4321 4293 ENDIF 4322 4294 4323 CASE ( 'usm_t _surf_10cm' )4295 CASE ( 'usm_theta_10cm' ) 4324 4296 !-- near surface temperature for whole surfaces 4325 4297 … … 4330 4302 j = surf_usm_h%j(m) 4331 4303 k = surf_usm_h%k(m) 4332 temp_pf(k,j,i) = t_surf_10cm_h(m)4304 temp_pf(k,j,i) = surf_usm_h%pt_10cm(m) 4333 4305 ENDDO 4334 4306 ELSE … … 4338 4310 j = surf_usm_v(l)%j(m) 4339 4311 k = surf_usm_v(l)%k(m) 4340 temp_pf(k,j,i) = t_surf_10cm_v(l)%t(m)4312 temp_pf(k,j,i) = surf_usm_v(l)%pt_10cm(m) 4341 4313 ENDDO 4342 4314 ENDIF 4343 4315 4316 4344 4317 ELSE 4345 4318 IF ( idsint == iup_u ) THEN … … 4348 4321 j = surf_usm_h%j(m) 4349 4322 k = surf_usm_h%k(m) 4350 temp_pf(k,j,i) = surf_usm_h% t_surf_10cm_av(m)4323 temp_pf(k,j,i) = surf_usm_h%pt_10cm_av(m) 4351 4324 ENDDO 4352 4325 ELSE … … 4356 4329 j = surf_usm_v(l)%j(m) 4357 4330 k = surf_usm_v(l)%k(m) 4358 temp_pf(k,j,i) = surf_usm_v(l)%t_surf_10cm_av(m) 4359 ENDDO 4360 4361 ENDIF 4362 4331 temp_pf(k,j,i) = surf_usm_v(l)%pt_10cm_av(m) 4332 ENDDO 4333 4334 ENDIF 4363 4335 ENDIF 4364 4365 4336 4366 4337 CASE ( 'usm_t_wall' ) 4367 4338 !-- wall temperature for iwl layer of walls and land … … 4573 4544 var(1:17) == 'usm_t_surf_window' .OR. var(1:12) == 'usm_t_window' .OR. & 4574 4545 var(1:16) == 'usm_t_surf_green' .OR. var(1:11) == 'usm_t_green' .OR. & 4575 var(1:15) == 'usm_t _surf_10cm' .OR.&4546 var(1:15) == 'usm_theta_10cm' .OR. & 4576 4547 var(1:9) == 'usm_surfz' .OR. var(1:7) == 'usm_svf' .OR. & 4577 4548 var(1:7) == 'usm_dif' .OR. var(1:11) == 'usm_surfcat' .OR. & … … 6156 6127 t_surf_green_h_p = t_surf_green_h 6157 6128 t_surf_green_v_p = t_surf_green_v 6158 t_surf_10cm_h_p = t_surf_10cm_h6159 t_surf_10cm_v_p = t_surf_10cm_v6160 6129 6161 6130 t_wall_h_p = t_wall_h … … 6180 6149 surf_usm_h%c_liq = 0.0_wp 6181 6150 6182 surf_usm_h%qsws_liq _eb= 0.0_wp6183 surf_usm_h%qsws_veg _eb= 0.0_wp6151 surf_usm_h%qsws_liq = 0.0_wp 6152 surf_usm_h%qsws_veg = 0.0_wp 6184 6153 6185 6154 ! … … 6189 6158 surf_usm_v(l)%c_liq = 0.0_wp 6190 6159 6191 surf_usm_v(l)%qsws_liq _eb= 0.0_wp6192 surf_usm_v(l)%qsws_veg _eb= 0.0_wp6160 surf_usm_v(l)%qsws_liq = 0.0_wp 6161 surf_usm_v(l)%qsws_veg = 0.0_wp 6193 6162 ENDDO 6194 6163 … … 6779 6748 ENDIF 6780 6749 6781 !-- The root extraction (= root_extr * qsws_veg _eb/ (rho_l6750 !-- The root extraction (= root_extr * qsws_veg / (rho_l 6782 6751 !-- * l_v)) ensures the mass conservation for water. The 6783 6752 !-- transpiration of plants equals the cumulative withdrawals by … … 6818 6787 swc_h(nzb_wall+1,m) - swc_h(nzb_wall,m) ) & 6819 6788 * surf_usm_h%ddz_green(nzb_wall+1,m) - surf_usm_h%gamma_w_green(nzb_wall,m) - ( & 6820 root_extr_green(nzb_wall) * surf_usm_h%qsws_veg _eb(m) &6821 ! + surf_usm_h%qsws_soil_ eb_green(m)6789 root_extr_green(nzb_wall) * surf_usm_h%qsws_veg(m) & 6790 ! + surf_usm_h%qsws_soil_green(m) 6822 6791 ) * drho_l_lv ) & 6823 6792 * surf_usm_h%ddz_green_stag(nzb_wall,m) … … 6830 6799 swc_h(kw-1,m)) * surf_usm_h%ddz_green(kw,m) & 6831 6800 + surf_usm_h%gamma_w_green(kw-1,m) - (root_extr_green(kw) & 6832 * surf_usm_h%qsws_veg _eb(m) * drho_l_lv) &6801 * surf_usm_h%qsws_veg(m) * drho_l_lv) & 6833 6802 ) * surf_usm_h%ddz_green_stag(kw,m) 6834 6803 … … 6841 6810 + surf_usm_h%gamma_w_green(nzt_wall-1,m) - ( & 6842 6811 root_extr_green(nzt_wall) & 6843 * surf_usm_h%qsws_veg _eb(m) * drho_l_lv ) &6812 * surf_usm_h%qsws_veg(m) * drho_l_lv ) & 6844 6813 ) * surf_usm_h%ddz_green_stag(nzt_wall,m) 6845 6814 … … 7053 7022 END SUBROUTINE usm_parin 7054 7023 7055 !------------------------------------------------------------------------------!7056 ! Description:7057 ! ------------7058 !> Calculates temperature near surface (10 cm) for indoor model7059 !------------------------------------------------------------------------------!7060 SUBROUTINE usm_temperature_near_surface7061 7062 IMPLICIT NONE7063 7064 INTEGER(iwp) :: i, j, k, l, m !< running indices7065 7066 !7067 !-- First, treat horizontal surface elements7068 DO m = 1, surf_usm_h%ns7069 7070 !-- Get indices of respective grid point7071 i = surf_usm_h%i(m)7072 j = surf_usm_h%j(m)7073 k = surf_usm_h%k(m)7074 7075 t_surf_10cm_h(m) = surf_usm_h%pt_surface(m) + surf_usm_h%ts(m) / kappa &7076 * ( log( 0.1_wp / surf_usm_h%z0h(m) ) &7077 - psi_h( 0.1_wp / surf_usm_h%ol(m) ) &7078 + psi_h( surf_usm_h%z0h(m) / surf_usm_h%ol(m) ) )7079 7080 ENDDO7081 !7082 !-- Now, treat vertical surface elements7083 DO l = 0, 37084 DO m = 1, surf_usm_v(l)%ns7085 7086 !-- Get indices of respective grid point7087 i = surf_usm_v(l)%i(m)7088 j = surf_usm_v(l)%j(m)7089 k = surf_usm_v(l)%k(m)7090 7091 t_surf_10cm_v(l)%t(m) =surf_usm_v(l)%pt_surface(m) + surf_usm_v(l)%ts(m) / kappa &7092 * ( log( 0.1_wp / surf_usm_v(l)%z0h(m) ) &7093 - psi_h( 0.1_wp / surf_usm_v(l)%ol(m) ) &7094 + psi_h( surf_usm_v(l)%z0h(m) / surf_usm_v(l)%ol(m) ) )7095 7096 ENDDO7097 7098 ENDDO7099 7100 7101 END SUBROUTINE usm_temperature_near_surface7102 7103 7104 7024 7105 7025 !------------------------------------------------------------------------------! … … 9442 9362 surf_usm_h%qsws(m) = surf_usm_h%qsws_eb(m) / rho_lv 9443 9363 9444 surf_usm_h%qsws_veg _eb(m) = - f_qsws_veg * ( qv1 - q_s &9364 surf_usm_h%qsws_veg(m) = - f_qsws_veg * ( qv1 - q_s & 9445 9365 + dq_s_dt * t_surf_green_h(m) - dq_s_dt & 9446 9366 * t_surf_green_h_p(m) ) 9447 9367 9448 surf_usm_h%qsws_liq _eb(m) = - f_qsws_liq * ( qv1 - q_s &9368 surf_usm_h%qsws_liq(m) = - f_qsws_liq * ( qv1 - q_s & 9449 9369 + dq_s_dt * t_surf_green_h(m) - dq_s_dt & 9450 9370 * t_surf_green_h_p(m) ) … … 9478 9398 !-- as runoff as qsws_soil is then not used in the soil model 9479 9399 IF ( m_liq_usm_h%var_usm_1d(m) /= m_liq_max ) THEN 9480 surf_usm_h%qsws_liq _eb(m) = surf_usm_h%qsws_liq_eb(m) &9400 surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) & 9481 9401 + surf_usm_h%frac(ind_pav_green,m) * prr(k+k_off,j+j_off,i+i_off)& 9482 9402 * hyrho(k+k_off) & … … 9497 9417 ! surf_usm_h%qsws_soil(m) = surf_usm_h%qsws_soil(m) + surf_usm_h%qsws_liq(m) 9498 9418 9499 surf_usm_h%qsws_liq _eb(m) = 0.0_wp9419 surf_usm_h%qsws_liq(m) = 0.0_wp 9500 9420 ENDIF 9501 9421 … … 9504 9424 !-- let the water enter the liquid water reservoir as dew on the 9505 9425 !-- plant 9506 IF ( surf_usm_h%qsws_veg _eb(m) < 0.0_wp ) THEN9507 surf_usm_h%qsws_liq _eb(m) = surf_usm_h%qsws_liq_eb(m) + surf_usm_h%qsws_veg_eb(m)9508 surf_usm_h%qsws_veg _eb(m) = 0.0_wp9426 IF ( surf_usm_h%qsws_veg(m) < 0.0_wp ) THEN 9427 surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) + surf_usm_h%qsws_veg(m) 9428 surf_usm_h%qsws_veg(m) = 0.0_wp 9509 9429 ENDIF 9510 9430 ENDIF … … 9512 9432 surf_usm_h%qsws(m) = surf_usm_h%qsws(m) / l_v 9513 9433 9514 tend = - surf_usm_h%qsws_liq _eb(m) * drho_l_lv9434 tend = - surf_usm_h%qsws_liq(m) * drho_l_lv 9515 9435 m_liq_usm_h_p%var_usm_1d(m) = m_liq_usm_h%var_usm_1d(m) + dt_3d * & 9516 9436 ( tsc(2) * tend + & … … 9895 9815 surf_usm_v(l)%qsws(m) = surf_usm_v(l)%qsws_eb(m) / rho_lv 9896 9816 9897 surf_usm_v(l)%qsws_veg _eb(m) = - f_qsws_veg * ( qv1 - q_s &9817 surf_usm_v(l)%qsws_veg(m) = - f_qsws_veg * ( qv1 - q_s & 9898 9818 + dq_s_dt * t_surf_green_v(l)%t(m) - dq_s_dt & 9899 9819 * t_surf_green_v_p(l)%t(m) ) 9900 9820 9901 ! surf_usm_h%qsws_liq _eb(m) = - f_qsws_liq * ( qv1 - q_s &9821 ! surf_usm_h%qsws_liq(m) = - f_qsws_liq * ( qv1 - q_s & 9902 9822 ! + dq_s_dt * t_surf_green_h(m) - dq_s_dt & 9903 9823 ! * t_surf_green_h_p(m) ) … … 9928 9848 !-- let the water enter the liquid water reservoir as dew on the 9929 9849 !-- plant 9930 IF ( surf_usm_v(l)%qsws_veg _eb(m) < 0.0_wp ) THEN9931 ! surf_usm_h%qsws_liq _eb(m) = surf_usm_h%qsws_liq_eb(m) + surf_usm_h%qsws_veg_eb(m)9932 surf_usm_v(l)%qsws_veg _eb(m) = 0.0_wp9850 IF ( surf_usm_v(l)%qsws_veg(m) < 0.0_wp ) THEN 9851 ! surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) + surf_usm_h%qsws_veg(m) 9852 surf_usm_v(l)%qsws_veg(m) = 0.0_wp 9933 9853 ENDIF 9934 9854 ENDIF … … 10256 10176 CALL wrd_write_string( 't_green_v(' // dum // ')' ) 10257 10177 WRITE ( 14 ) t_green_v(l)%t 10258 10178 ! 10259 10179 ENDDO 10260 10180 … … 10262 10182 END SUBROUTINE usm_wrd_local 10263 10183 10264 ! 10265 !-- Integrated stability function for heat and moisture 10266 FUNCTION psi_h( zeta ) 10267 10268 USE kinds 10269 10270 IMPLICIT NONE 10271 10272 REAL(wp) :: psi_h !< Integrated similarity function result 10273 REAL(wp) :: zeta !< Stability parameter z/L 10274 REAL(wp) :: x !< dummy variable 10275 10276 REAL(wp), PARAMETER :: a = 1.0_wp !< constant 10277 REAL(wp), PARAMETER :: b = 0.66666666666_wp !< constant 10278 REAL(wp), PARAMETER :: c = 5.0_wp !< constant 10279 REAL(wp), PARAMETER :: d = 0.35_wp !< constant 10280 REAL(wp), PARAMETER :: c_d_d = c / d !< constant 10281 REAL(wp), PARAMETER :: bc_d_d = b * c / d !< constant 10282 10283 10284 IF ( zeta < 0.0_wp ) THEN 10285 x = SQRT( 1.0_wp - 16.0_wp * zeta ) 10286 psi_h = 2.0_wp * LOG( (1.0_wp + x ) / 2.0_wp ) 10287 ELSE 10288 psi_h = - b * ( zeta - c_d_d ) * EXP( -d * zeta ) - (1.0_wp & 10289 + 0.66666666666_wp * a * zeta )**1.5_wp - bc_d_d & 10290 + 1.0_wp 10291 ! 10292 !-- Old version for stable conditions (only valid for z/L < 0.5) 10293 !-- psi_h = - 5.0_wp * zeta 10294 ENDIF 10295 10296 END FUNCTION psi_h 10297 10184 10298 10185 END MODULE urban_surface_mod
Note: See TracChangeset
for help on using the changeset viewer.