Changeset 4441
- Timestamp:
- Mar 4, 2020 7:20:35 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/chemistry_model_mod.f90
r4403 r4441 22 22 ! Current revisions: 23 23 ! ----------------- 24 ! 24 ! Change order of dimension in surface array %frac to allow for better 25 ! vectorization. 25 26 ! 26 27 ! Former revisions: … … 3533 3534 ! 3534 3535 !-- Get land use for i,j and assign to DEPAC lu 3535 IF ( surf_lsm_h%frac( ind_veg_wall,m) > 0 ) THEN3536 IF ( surf_lsm_h%frac(m,ind_veg_wall) > 0 ) THEN 3536 3537 luv_palm = surf_lsm_h%vegetation_type(m) 3537 3538 IF ( luv_palm == ind_luv_user ) THEN … … 3577 3578 ENDIF 3578 3579 3579 IF ( surf_lsm_h%frac( ind_pav_green,m) > 0 ) THEN3580 IF ( surf_lsm_h%frac(m,ind_pav_green) > 0 ) THEN 3580 3581 lup_palm = surf_lsm_h%pavement_type(m) 3581 3582 IF ( lup_palm == ind_lup_user ) THEN … … 3615 3616 ENDIF 3616 3617 3617 IF ( surf_lsm_h%frac( ind_wat_win,m) > 0 ) THEN3618 IF ( surf_lsm_h%frac(m,ind_wat_win) > 0 ) THEN 3618 3619 luw_palm = surf_lsm_h%water_type(m) 3619 3620 IF ( luw_palm == ind_luw_user ) THEN … … 3675 3676 ! 3676 3677 !-- Vegetation 3677 IF ( surf_lsm_h%frac( ind_veg_wall,m) > 0 ) THEN3678 IF ( surf_lsm_h%frac(m,ind_veg_wall) > 0 ) THEN 3678 3679 3679 3680 ! … … 3812 3813 ! 3813 3814 !-- Pavement 3814 IF ( surf_lsm_h%frac( ind_pav_green,m) > 0 ) THEN3815 IF ( surf_lsm_h%frac(m,ind_pav_green) > 0 ) THEN 3815 3816 ! 3816 3817 !-- No vegetation on pavements: … … 3939 3940 ! 3940 3941 !-- Water 3941 IF ( surf_lsm_h%frac( ind_wat_win,m) > 0 ) THEN3942 IF ( surf_lsm_h%frac(m,ind_wat_win) > 0 ) THEN 3942 3943 ! 3943 3944 !-- No vegetation on water: … … 4073 4074 DO lsp = 1, nspec 4074 4075 4075 bud(lsp) = surf_lsm_h%frac( ind_veg_wall,m) * bud_luv(lsp) + &4076 surf_lsm_h%frac( ind_pav_green,m) * bud_lup(lsp) + &4077 surf_lsm_h%frac( ind_wat_win,m) * bud_luw(lsp)4076 bud(lsp) = surf_lsm_h%frac(m,ind_veg_wall) * bud_luv(lsp) + & 4077 surf_lsm_h%frac(m,ind_pav_green) * bud_lup(lsp) + & 4078 surf_lsm_h%frac(m,ind_wat_win) * bud_luw(lsp) 4078 4079 ! 4079 4080 !-- Compute new concentration: … … 4121 4122 ! 4122 4123 !-- Get land use for i,j and assign to DEPAC lu 4123 IF ( surf_usm_h%frac( ind_pav_green,m) > 0 ) THEN4124 IF ( surf_usm_h%frac(m,ind_pav_green) > 0 ) THEN 4124 4125 ! 4125 4126 !-- For green urban surfaces (e.g. green roofs … … 4168 4169 ENDIF 4169 4170 4170 IF ( surf_usm_h%frac( ind_veg_wall,m) > 0 ) THEN4171 IF ( surf_usm_h%frac(m,ind_veg_wall) > 0 ) THEN 4171 4172 ! 4172 4173 !-- For walls in USM assume concrete walls/roofs, … … 4210 4211 ENDIF 4211 4212 4212 IF ( surf_usm_h%frac( ind_wat_win,m) > 0 ) THEN4213 IF ( surf_usm_h%frac(m,ind_wat_win) > 0 ) THEN 4213 4214 ! 4214 4215 !-- For windows in USM assume metal as this is … … 4295 4296 ! 4296 4297 !-- Walls/roofs 4297 IF ( surf_usm_h%frac( ind_veg_wall,m) > 0 ) THEN4298 IF ( surf_usm_h%frac(m,ind_veg_wall) > 0 ) THEN 4298 4299 ! 4299 4300 !-- No vegetation on non-green walls: … … 4426 4427 ! 4427 4428 !-- Green usm surfaces 4428 IF ( surf_usm_h%frac( ind_pav_green,m) > 0 ) THEN4429 IF ( surf_usm_h%frac(m,ind_pav_green) > 0 ) THEN 4429 4430 4430 4431 ! … … 4564 4565 ! 4565 4566 !-- Windows 4566 IF ( surf_usm_h%frac( ind_wat_win,m) > 0 ) THEN4567 IF ( surf_usm_h%frac(m,ind_wat_win) > 0 ) THEN 4567 4568 ! 4568 4569 !-- No vegetation on windows: … … 4696 4697 4697 4698 4698 bud(lsp) = surf_usm_h%frac( ind_veg_wall,m) * bud_luu(lsp) + &4699 surf_usm_h%frac( ind_pav_green,m) * bud_lug(lsp) + &4700 surf_usm_h%frac( ind_wat_win,m) * bud_lud(lsp)4699 bud(lsp) = surf_usm_h%frac(m,ind_veg_wall) * bud_luu(lsp) + & 4700 surf_usm_h%frac(m,ind_pav_green) * bud_lug(lsp) + & 4701 surf_usm_h%frac(m,ind_wat_win) * bud_lud(lsp) 4701 4702 ! 4702 4703 !-- Compute new concentration -
palm/trunk/SOURCE/data_output_2d.f90
r4360 r4441 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Change order of dimension in surface array %frac to allow for better 23 ! vectorization. 23 24 ! 24 25 ! Former revisions: … … 426 427 i = surf_usm_h%i(m) 427 428 j = surf_usm_h%j(m) 428 local_pf(i,j,nzb+1) = surf_usm_h%frac( ind_veg_wall,m) * &429 local_pf(i,j,nzb+1) = surf_usm_h%frac(m,ind_veg_wall) * & 429 430 surf_usm_h%wghf_eb(m) + & 430 surf_usm_h%frac( ind_pav_green,m) * &431 surf_usm_h%frac(m,ind_pav_green) * & 431 432 surf_usm_h%wghf_eb_green(m) + & 432 surf_usm_h%frac( ind_wat_win,m) * &433 surf_usm_h%frac(m,ind_wat_win) * & 433 434 surf_usm_h%wghf_eb_window(m) 434 435 ENDDO … … 755 756 j = surf_usm_h%j(m) 756 757 local_pf(i,j,nzb+1) = & 757 ( surf_usm_h%frac( ind_veg_wall,m) * &758 ( surf_usm_h%frac(m,ind_veg_wall) * & 758 759 surf_usm_h%r_a(m) + & 759 surf_usm_h%frac( ind_pav_green,m) * &760 surf_usm_h%frac(m,ind_pav_green) * & 760 761 surf_usm_h%r_a_green(m) + & 761 surf_usm_h%frac( ind_wat_win,m) * &762 surf_usm_h%frac(m,ind_wat_win) * & 762 763 surf_usm_h%r_a_window(m) ) 763 764 ENDDO -
palm/trunk/SOURCE/flow_statistics.f90
r4360 r4441 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Change order of dimension in surface array %frac to allow for better 23 ! vectorization. 23 24 ! 24 25 ! Former revisions: … … 1089 1090 m = surf_def_h(0)%start_index(j,i) 1090 1091 sums_l(nzb,108,tn) = sums_l(nzb,108,tn) + & 1091 surf_def_h(0)%rrtm_aldif( 0,m) * rmask(j,i,sr)1092 surf_def_h(0)%rrtm_aldif(m,0) * rmask(j,i,sr) 1092 1093 sums_l(nzb,109,tn) = sums_l(nzb,109,tn) + & 1093 surf_def_h(0)%rrtm_aldir( 0,m) * rmask(j,i,sr)1094 surf_def_h(0)%rrtm_aldir(m,0) * rmask(j,i,sr) 1094 1095 sums_l(nzb,110,tn) = sums_l(nzb,110,tn) + & 1095 surf_def_h(0)%rrtm_asdif( 0,m) * rmask(j,i,sr)1096 surf_def_h(0)%rrtm_asdif(m,0) * rmask(j,i,sr) 1096 1097 sums_l(nzb,111,tn) = sums_l(nzb,111,tn) + & 1097 surf_def_h(0)%rrtm_asdir( 0,m) * rmask(j,i,sr)1098 surf_def_h(0)%rrtm_asdir(m,0) * rmask(j,i,sr) 1098 1099 ENDIF 1099 1100 IF ( surf_lsm_h%end_index(j,i) >= & … … 1101 1102 m = surf_lsm_h%start_index(j,i) 1102 1103 sums_l(nzb,108,tn) = sums_l(nzb,108,tn) + & 1103 SUM( surf_lsm_h%frac( :,m) * &1104 surf_lsm_h%rrtm_aldif( :,m) ) * rmask(j,i,sr)1104 SUM( surf_lsm_h%frac(m,:) * & 1105 surf_lsm_h%rrtm_aldif(m,:) ) * rmask(j,i,sr) 1105 1106 sums_l(nzb,109,tn) = sums_l(nzb,109,tn) + & 1106 SUM( surf_lsm_h%frac( :,m) * &1107 surf_lsm_h%rrtm_aldir( :,m) ) * rmask(j,i,sr)1107 SUM( surf_lsm_h%frac(m,:) * & 1108 surf_lsm_h%rrtm_aldir(m,:) ) * rmask(j,i,sr) 1108 1109 sums_l(nzb,110,tn) = sums_l(nzb,110,tn) + & 1109 SUM( surf_lsm_h%frac( :,m) * &1110 surf_lsm_h%rrtm_asdif( :,m) ) * rmask(j,i,sr)1110 SUM( surf_lsm_h%frac(m,:) * & 1111 surf_lsm_h%rrtm_asdif(m,:) ) * rmask(j,i,sr) 1111 1112 sums_l(nzb,111,tn) = sums_l(nzb,111,tn) + & 1112 SUM( surf_lsm_h%frac( :,m) * &1113 surf_lsm_h%rrtm_asdir( :,m) ) * rmask(j,i,sr)1113 SUM( surf_lsm_h%frac(m,:) * & 1114 surf_lsm_h%rrtm_asdir(m,:) ) * rmask(j,i,sr) 1114 1115 ENDIF 1115 1116 IF ( surf_usm_h%end_index(j,i) >= & … … 1117 1118 m = surf_usm_h%start_index(j,i) 1118 1119 sums_l(nzb,108,tn) = sums_l(nzb,108,tn) + & 1119 SUM( surf_usm_h%frac( :,m) * &1120 surf_usm_h%rrtm_aldif( :,m) ) * rmask(j,i,sr)1120 SUM( surf_usm_h%frac(m,:) * & 1121 surf_usm_h%rrtm_aldif(m,:) ) * rmask(j,i,sr) 1121 1122 sums_l(nzb,109,tn) = sums_l(nzb,109,tn) + & 1122 SUM( surf_usm_h%frac( :,m) * &1123 surf_usm_h%rrtm_aldir( :,m) ) * rmask(j,i,sr)1123 SUM( surf_usm_h%frac(m,:) * & 1124 surf_usm_h%rrtm_aldir(m,:) ) * rmask(j,i,sr) 1124 1125 sums_l(nzb,110,tn) = sums_l(nzb,110,tn) + & 1125 SUM( surf_usm_h%frac( :,m) * &1126 surf_usm_h%rrtm_asdif( :,m) ) * rmask(j,i,sr)1126 SUM( surf_usm_h%frac(m,:) * & 1127 surf_usm_h%rrtm_asdif(m,:) ) * rmask(j,i,sr) 1127 1128 sums_l(nzb,111,tn) = sums_l(nzb,111,tn) + & 1128 SUM( surf_usm_h%frac( :,m) * &1129 surf_usm_h%rrtm_asdir( :,m) ) * rmask(j,i,sr)1129 SUM( surf_usm_h%frac(m,:) * & 1130 surf_usm_h%rrtm_asdir(m,:) ) * rmask(j,i,sr) 1130 1131 ENDIF 1131 1132 -
palm/trunk/SOURCE/indoor_model_mod.f90
r4402 r4441 21 21 ! Current revisions: 22 22 ! ----------------- 23 ! 23 ! Change order of dimension in surface array %frac to allow for better 24 ! vectorization. 24 25 ! 25 26 ! Former revisions: … … 1225 1226 ( buildings(nb)%num_facades_per_building_h + & 1226 1227 buildings(nb)%num_facades_per_building_v ) !< [m2] area of total facade 1227 window_area_per_facade = surf_usm_h%frac( ind_wat_win,m) * facade_element_area !< [m2] window area per facade element1228 window_area_per_facade = surf_usm_h%frac(m,ind_wat_win) * facade_element_area !< [m2] window area per facade element 1228 1229 1229 1230 buildings(nb)%net_floor_area = buildings(nb)%vol_tot / ( buildings(nb)%height_storey ) … … 1275 1276 near_facade_temperature = surf_usm_h%pt_10cm(m) 1276 1277 indoor_wall_window_temperature = & 1277 surf_usm_h%frac( ind_veg_wall,m) * t_wall_h(nzt_wall,m) &1278 + surf_usm_h%frac( ind_wat_win,m) * t_window_h(nzt_wall,m)1278 surf_usm_h%frac(m,ind_veg_wall) * t_wall_h(nzt_wall,m) & 1279 + surf_usm_h%frac(m,ind_wat_win) * t_window_h(nzt_wall,m) 1279 1280 ! 1280 1281 !-- Solar thermal gains. If net_sw_in larger than sun-protection … … 1435 1436 ( buildings(nb)%num_facades_per_building_h + & 1436 1437 buildings(nb)%num_facades_per_building_v ) !< [m2] area of total facade 1437 window_area_per_facade = surf_usm_v(l)%frac( ind_wat_win,m) * facade_element_area !< [m2] window area per facade element1438 window_area_per_facade = surf_usm_v(l)%frac(m,ind_wat_win) * facade_element_area !< [m2] window area per facade element 1438 1439 1439 1440 buildings(nb)%net_floor_area = buildings(nb)%vol_tot / ( buildings(nb)%height_storey ) … … 1486 1487 near_facade_temperature = surf_usm_v(l)%pt_10cm(m) 1487 1488 indoor_wall_window_temperature = & 1488 surf_usm_v(l)%frac( ind_veg_wall,m) * t_wall_v(l)%t(nzt_wall,m) &1489 + surf_usm_v(l)%frac( ind_wat_win,m) * t_window_v(l)%t(nzt_wall,m)1489 surf_usm_v(l)%frac(m,ind_veg_wall) * t_wall_v(l)%t(nzt_wall,m) & 1490 + surf_usm_v(l)%frac(m,ind_wat_win) * t_window_v(l)%t(nzt_wall,m) 1490 1491 ! 1491 1492 !-- Solar thermal gains. If net_sw_in larger than sun-protection -
palm/trunk/SOURCE/land_surface_model_mod.f90
r4429 r4441 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Change order of dimension in surface arrays %frac, %emissivity and %albedo 23 ! to allow for better vectorization in the radiation interactions. 23 24 ! 24 25 ! Former revisions: … … 2502 2503 !-- fraction. 2503 2504 !-- Set default values at each surface element. 2504 ALLOCATE ( surf_lsm_h%albedo_type( 0:2,1:surf_lsm_h%ns) )2505 ALLOCATE ( surf_lsm_h%emissivity( 0:2,1:surf_lsm_h%ns) )2505 ALLOCATE ( surf_lsm_h%albedo_type(1:surf_lsm_h%ns,0:2) ) 2506 ALLOCATE ( surf_lsm_h%emissivity(1:surf_lsm_h%ns,0:2) ) 2506 2507 ! 2507 2508 !-- Initialize albedo type according to its default type, in order to set values 2508 2509 !-- independent on default albedo_type in radiation model. 2509 surf_lsm_h%albedo_type( ind_veg_wall,:) = &2510 surf_lsm_h%albedo_type(:,ind_veg_wall) = & 2510 2511 INT( vegetation_pars(ind_v_at,vegetation_type) ) 2511 surf_lsm_h%albedo_type( ind_wat_win,:) = &2512 surf_lsm_h%albedo_type(:,ind_wat_win) = & 2512 2513 INT( water_pars(ind_w_at,water_type) ) 2513 surf_lsm_h%albedo_type( ind_pav_green,:) = &2514 surf_lsm_h%albedo_type(:,ind_pav_green) = & 2514 2515 INT( pavement_pars(ind_p_at,pavement_type) ) 2515 2516 surf_lsm_h%emissivity = emissivity 2516 2517 DO l = 0, 3 2517 ALLOCATE ( surf_lsm_v(l)%albedo_type( 0:2,1:surf_lsm_v(l)%ns) )2518 ALLOCATE ( surf_lsm_v(l)%emissivity( 0:2,1:surf_lsm_v(l)%ns) )2518 ALLOCATE ( surf_lsm_v(l)%albedo_type(1:surf_lsm_v(l)%ns,0:2) ) 2519 ALLOCATE ( surf_lsm_v(l)%emissivity(1:surf_lsm_v(l)%ns,0:2) ) 2519 2520 ! 2520 2521 !-- Initialize albedo type according to its default type, in order to 2521 2522 !-- set values independent on default albedo_type in radiation model. 2522 surf_lsm_v(l)%albedo_type( ind_veg_wall,:) = &2523 surf_lsm_v(l)%albedo_type(:,ind_veg_wall) = & 2523 2524 INT( vegetation_pars(ind_v_at,vegetation_type) ) 2524 surf_lsm_v(l)%albedo_type( ind_wat_win,:) = &2525 surf_lsm_v(l)%albedo_type(:,ind_wat_win) = & 2525 2526 INT( water_pars(ind_w_at,water_type) ) 2526 surf_lsm_v(l)%albedo_type( ind_pav_green,:) = &2527 surf_lsm_v(l)%albedo_type(:,ind_pav_green) = & 2527 2528 INT( pavement_pars(ind_p_at,pavement_type) ) 2528 2529 surf_lsm_v(l)%emissivity = emissivity … … 2531 2532 !-- Allocate arrays for relative surface fraction. 2532 2533 !-- 0 - vegetation fraction, 2 - water fraction, 1 - pavement fraction 2533 ALLOCATE( surf_lsm_h%frac( 0:2,1:surf_lsm_h%ns) )2534 ALLOCATE( surf_lsm_h%frac(1:surf_lsm_h%ns,0:2) ) 2534 2535 surf_lsm_h%frac = 0.0_wp 2535 2536 DO l = 0, 3 2536 ALLOCATE( surf_lsm_v(l)%frac( 0:2,1:surf_lsm_v(l)%ns) )2537 ALLOCATE( surf_lsm_v(l)%frac(1:surf_lsm_v(l)%ns,0:2) ) 2537 2538 surf_lsm_v(l)%frac = 0.0_wp 2538 2539 ENDDO … … 2588 2589 2589 2590 surf_lsm_h%vegetation_surface = .TRUE. 2590 surf_lsm_h%frac( ind_veg_wall,:) = 1.0_wp2591 surf_lsm_h%frac(:,ind_veg_wall) = 1.0_wp 2591 2592 DO l = 0, 3 2592 2593 surf_lsm_v(l)%vegetation_surface = .TRUE. 2593 surf_lsm_v(l)%frac( ind_veg_wall,:) = 1.0_wp2594 surf_lsm_v(l)%frac(:,ind_veg_wall) = 1.0_wp 2594 2595 ENDDO 2595 2596 … … 2597 2598 2598 2599 surf_lsm_h%water_surface = .TRUE. 2599 surf_lsm_h%frac( ind_wat_win,:) = 1.0_wp2600 surf_lsm_h%frac(:,ind_wat_win) = 1.0_wp 2600 2601 ! 2601 2602 !-- Note, vertical water surface does not really make sense. 2602 2603 DO l = 0, 3 2603 2604 surf_lsm_v(l)%water_surface = .TRUE. 2604 surf_lsm_v(l)%frac( ind_wat_win,:) = 1.0_wp2605 surf_lsm_v(l)%frac(:,ind_wat_win) = 1.0_wp 2605 2606 ENDDO 2606 2607 … … 2608 2609 2609 2610 surf_lsm_h%pavement_surface = .TRUE. 2610 surf_lsm_h%frac( ind_pav_green,:) = 1.0_wp2611 surf_lsm_h%frac(:,ind_pav_green) = 1.0_wp 2611 2612 DO l = 0, 3 2612 2613 surf_lsm_v(l)%pavement_surface = .TRUE. 2613 surf_lsm_v(l)%frac( ind_pav_green,:) = 1.0_wp2614 surf_lsm_v(l)%frac(:,ind_pav_green) = 1.0_wp 2614 2615 ENDDO 2615 2616 … … 2745 2746 IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /= & 2746 2747 surface_fraction_f%fill ) THEN 2747 surf_lsm_h%frac( ind_veg_wall,m) = &2748 surf_lsm_h%frac(m,ind_veg_wall) = & 2748 2749 surface_fraction_f%frac(ind_veg_wall,j,i) 2749 2750 ENDIF 2750 2751 IF ( surface_fraction_f%frac(ind_pav_green,j,i) /= & 2751 2752 surface_fraction_f%fill ) THEN 2752 surf_lsm_h%frac( ind_pav_green,m) = &2753 surf_lsm_h%frac(m,ind_pav_green) = & 2753 2754 surface_fraction_f%frac(ind_pav_green,j,i) 2754 2755 ENDIF 2755 2756 IF ( surface_fraction_f%frac(ind_wat_win,j,i) /= & 2756 2757 surface_fraction_f%fill ) THEN 2757 surf_lsm_h%frac( ind_wat_win,m) = &2758 surf_lsm_h%frac(m,ind_wat_win) = & 2758 2759 surface_fraction_f%frac(ind_wat_win,j,i) 2759 2760 ENDIF … … 2761 2762 !-- Check if sum of relative fractions is zero. This case, give an 2762 2763 !-- error message. 2763 IF ( SUM ( surf_lsm_h%frac( :,m) ) == 0.0_wp ) THEN2764 IF ( SUM ( surf_lsm_h%frac(m,:) ) == 0.0_wp ) THEN 2764 2765 WRITE( message_string, * ) & 2765 2766 'surface fractions at grid point (j,i) = (', & … … 2773 2774 !-- fractions to one. Note, at the moment no tile approach is 2774 2775 !-- implemented, so that relative fractions are either 1 or zero. 2775 IF ( SUM ( surf_lsm_h%frac( :,m) ) > 1.0_wp .OR. &2776 SUM ( surf_lsm_h%frac( :,m) ) < 1.0_wp ) THEN2777 surf_lsm_h%frac( :,m) = surf_lsm_h%frac(:,m) / &2778 SUM ( surf_lsm_h%frac( :,m) )2776 IF ( SUM ( surf_lsm_h%frac(m,:) ) > 1.0_wp .OR. & 2777 SUM ( surf_lsm_h%frac(m,:) ) < 1.0_wp ) THEN 2778 surf_lsm_h%frac(m,:) = surf_lsm_h%frac(m,:) / & 2779 SUM ( surf_lsm_h%frac(m,:) ) 2779 2780 2780 2781 ENDIF … … 2791 2792 IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /= & 2792 2793 surface_fraction_f%fill ) THEN 2793 surf_lsm_v(l)%frac( ind_veg_wall,m) = &2794 surf_lsm_v(l)%frac(m,ind_veg_wall) = & 2794 2795 surface_fraction_f%frac(ind_veg_wall,j,i) 2795 2796 ENDIF 2796 2797 IF ( surface_fraction_f%frac(ind_pav_green,j,i) /= & 2797 2798 surface_fraction_f%fill ) THEN 2798 surf_lsm_v(l)%frac( ind_pav_green,m) = &2799 surf_lsm_v(l)%frac(m,ind_pav_green) = & 2799 2800 surface_fraction_f%frac(ind_pav_green,j,i) 2800 2801 ENDIF 2801 2802 IF ( surface_fraction_f%frac(ind_wat_win,j,i) /= & 2802 2803 surface_fraction_f%fill ) THEN 2803 surf_lsm_v(l)%frac( ind_wat_win,m) = &2804 surf_lsm_v(l)%frac(m,ind_wat_win) = & 2804 2805 surface_fraction_f%frac(ind_wat_win,j,i) 2805 2806 ENDIF … … 2807 2808 !-- Check if sum of relative fractions is zero. This case, give an 2808 2809 !-- error message. 2809 IF ( SUM ( surf_lsm_v(l)%frac( :,m) ) == 0.0_wp ) THEN2810 IF ( SUM ( surf_lsm_v(l)%frac(m,:) ) == 0.0_wp ) THEN 2810 2811 WRITE( message_string, * ) & 2811 2812 'surface fractions at grid point (j,i) = (', & … … 2819 2820 !-- fractions to one. Note, at the moment no tile approach is 2820 2821 !-- implemented, so that relative fractions are either 1 or zero. 2821 IF ( SUM ( surf_lsm_v(l)%frac( :,m) ) > 1.0_wp .OR. &2822 SUM ( surf_lsm_v(l)%frac( :,m) ) < 1.0_wp ) THEN2823 surf_lsm_v(l)%frac( :,m) = surf_lsm_v(l)%frac(:,m) / &2824 SUM ( surf_lsm_v(l)%frac( :,m) )2822 IF ( SUM ( surf_lsm_v(l)%frac(m,:) ) > 1.0_wp .OR. & 2823 SUM ( surf_lsm_v(l)%frac(m,:) ) < 1.0_wp ) THEN 2824 surf_lsm_v(l)%frac(m,:) = surf_lsm_v(l)%frac(m,:) / & 2825 SUM ( surf_lsm_v(l)%frac(m,:) ) 2825 2826 2826 2827 ENDIF … … 2834 2835 2835 2836 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) & 2836 surf_lsm_h%frac( ind_veg_wall,m) = 1.0_wp2837 surf_lsm_h%frac(m,ind_veg_wall) = 1.0_wp 2837 2838 IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) & 2838 surf_lsm_h%frac( ind_pav_green,m) = 1.0_wp2839 surf_lsm_h%frac(m,ind_pav_green) = 1.0_wp 2839 2840 IF ( water_type_f%var(j,i) /= water_type_f%fill ) & 2840 surf_lsm_h%frac( ind_wat_win,m) = 1.0_wp2841 surf_lsm_h%frac(m,ind_wat_win) = 1.0_wp 2841 2842 ENDDO 2842 2843 DO l = 0, 3 … … 2848 2849 2849 2850 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) & 2850 surf_lsm_v(l)%frac( ind_veg_wall,m) = 1.0_wp2851 surf_lsm_v(l)%frac(m,ind_veg_wall) = 1.0_wp 2851 2852 IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) & 2852 surf_lsm_v(l)%frac( ind_pav_green,m) = 1.0_wp2853 surf_lsm_v(l)%frac(m,ind_pav_green) = 1.0_wp 2853 2854 IF ( water_type_f%var(j,i) /= water_type_f%fill ) & 2854 surf_lsm_v(l)%frac( ind_wat_win,m) = 1.0_wp2855 surf_lsm_v(l)%frac(m,ind_wat_win) = 1.0_wp 2855 2856 ENDDO 2856 2857 ENDDO … … 3218 3219 surf_lsm_h%f_sw_in(m) = f_shortwave_incoming 3219 3220 surf_lsm_h%c_surface(m) = c_surface 3220 surf_lsm_h%albedo_type( ind_veg_wall,m) = albedo_type3221 surf_lsm_h%emissivity( ind_veg_wall,m) = emissivity3221 surf_lsm_h%albedo_type(m,ind_veg_wall) = albedo_type 3222 surf_lsm_h%emissivity(m,ind_veg_wall) = emissivity 3222 3223 3223 3224 surf_lsm_h%vegetation_type(m) = vegetation_type … … 3247 3248 surf_lsm_v(l)%f_sw_in(m) = f_shortwave_incoming 3248 3249 surf_lsm_v(l)%c_surface(m) = c_surface 3249 surf_lsm_v(l)%albedo_type( ind_veg_wall,m) = albedo_type3250 surf_lsm_v(l)%emissivity( ind_veg_wall,m) = emissivity3250 surf_lsm_v(l)%albedo_type(m,ind_veg_wall) = albedo_type 3251 surf_lsm_v(l)%emissivity(m,ind_veg_wall) = emissivity 3251 3252 3252 3253 surf_lsm_v(l)%vegetation_type(m) = vegetation_type … … 3285 3286 surf_lsm_h%f_sw_in(m) = vegetation_pars(ind_v_f_sw_in,st) 3286 3287 surf_lsm_h%c_surface(m) = vegetation_pars(ind_v_c_surf,st) 3287 surf_lsm_h%albedo_type( ind_veg_wall,m) = INT( vegetation_pars(ind_v_at,st) )3288 surf_lsm_h%emissivity( ind_veg_wall,m) = vegetation_pars(ind_v_emis,st)3288 surf_lsm_h%albedo_type(m,ind_veg_wall) = INT( vegetation_pars(ind_v_at,st) ) 3289 surf_lsm_h%emissivity(m,ind_veg_wall) = vegetation_pars(ind_v_emis,st) 3289 3290 3290 3291 surf_lsm_h%vegetation_type(m) = st … … 3314 3315 surf_lsm_v(l)%f_sw_in(m) = vegetation_pars(ind_v_f_sw_in,st) 3315 3316 surf_lsm_v(l)%c_surface(m) = vegetation_pars(ind_v_c_surf,st) 3316 surf_lsm_v(l)%albedo_type( ind_veg_wall,m) = INT( vegetation_pars(ind_v_at,st) )3317 surf_lsm_v(l)%emissivity( ind_veg_wall,m) = vegetation_pars(ind_v_emis,st)3317 surf_lsm_v(l)%albedo_type(m,ind_veg_wall) = INT( vegetation_pars(ind_v_at,st) ) 3318 surf_lsm_v(l)%emissivity(m,ind_veg_wall) = vegetation_pars(ind_v_emis,st) 3318 3319 3319 3320 surf_lsm_v(l)%vegetation_type(m) = st … … 3393 3394 IF ( vegetation_pars_f%pars_xy(ind_v_at,j,i) /= & 3394 3395 vegetation_pars_f%fill ) & 3395 surf_lsm_h%albedo_type( ind_veg_wall,m) = &3396 surf_lsm_h%albedo_type(m,ind_veg_wall) = & 3396 3397 INT( vegetation_pars_f%pars_xy(ind_v_at,j,i) ) 3397 3398 IF ( vegetation_pars_f%pars_xy(ind_v_emis,j,i) /= & 3398 3399 vegetation_pars_f%fill ) & 3399 surf_lsm_h%emissivity( ind_veg_wall,m) = &3400 surf_lsm_h%emissivity(m,ind_veg_wall) = & 3400 3401 vegetation_pars_f%pars_xy(ind_v_emis,j,i) 3401 3402 ENDIF … … 3469 3470 IF ( vegetation_pars_f%pars_xy(ind_v_at,j,i) /= & 3470 3471 vegetation_pars_f%fill ) & 3471 surf_lsm_v(l)%albedo_type( ind_veg_wall,m) = &3472 surf_lsm_v(l)%albedo_type(m,ind_veg_wall) = & 3472 3473 INT( vegetation_pars_f%pars_xy(ind_v_at,j,i) ) 3473 3474 IF ( vegetation_pars_f%pars_xy(ind_v_emis,j,i) /= & 3474 3475 vegetation_pars_f%fill ) & 3475 surf_lsm_v(l)%emissivity( ind_veg_wall,m) = &3476 surf_lsm_v(l)%emissivity(m,ind_veg_wall) = & 3476 3477 vegetation_pars_f%pars_xy(ind_v_emis,j,i) 3477 3478 ENDIF … … 3523 3524 surf_lsm_h%lambda_surface_u(m) = 1.0E10_wp 3524 3525 surf_lsm_h%c_surface(m) = 0.0_wp 3525 surf_lsm_h%albedo_type( ind_wat_win,m) = albedo_type3526 surf_lsm_h%emissivity( ind_wat_win,m) = emissivity3526 surf_lsm_h%albedo_type(m,ind_wat_win) = albedo_type 3527 surf_lsm_h%emissivity(m,ind_wat_win) = emissivity 3527 3528 3528 3529 surf_lsm_h%water_type(m) = water_type … … 3544 3545 surf_lsm_v(l)%lambda_surface_u(m) = 1.0E10_wp 3545 3546 surf_lsm_v(l)%c_surface(m) = 0.0_wp 3546 surf_lsm_v(l)%albedo_type( ind_wat_win,m) = albedo_type3547 surf_lsm_v(l)%emissivity( ind_wat_win,m) = emissivity3547 surf_lsm_v(l)%albedo_type(m,ind_wat_win) = albedo_type 3548 surf_lsm_v(l)%emissivity(m,ind_wat_win) = emissivity 3548 3549 3549 3550 surf_lsm_v(l)%water_type(m) = water_type … … 3577 3578 surf_lsm_h%lambda_surface_u(m) = water_pars(ind_w_lambda_u,st) 3578 3579 surf_lsm_h%c_surface(m) = 0.0_wp 3579 surf_lsm_h%albedo_type( ind_wat_win,m) = INT( water_pars(ind_w_at,st) )3580 surf_lsm_h%emissivity( ind_wat_win,m) = water_pars(ind_w_emis,st)3580 surf_lsm_h%albedo_type(m,ind_wat_win) = INT( water_pars(ind_w_at,st) ) 3581 surf_lsm_h%emissivity(m,ind_wat_win) = water_pars(ind_w_emis,st) 3581 3582 3582 3583 surf_lsm_h%water_type(m) = st … … 3605 3606 water_pars(ind_w_lambda_u,st) 3606 3607 surf_lsm_v(l)%c_surface(m) = 0.0_wp 3607 surf_lsm_v(l)%albedo_type( ind_wat_win,m) = &3608 surf_lsm_v(l)%albedo_type(m,ind_wat_win) = & 3608 3609 INT( water_pars(ind_w_at,st) ) 3609 surf_lsm_v(l)%emissivity( ind_wat_win,m) = &3610 surf_lsm_v(l)%emissivity(m,ind_wat_win) = & 3610 3611 water_pars(ind_w_emis,st) 3611 3612 … … 3664 3665 IF ( water_pars_f%pars_xy(ind_w_at,j,i) /= & 3665 3666 water_pars_f%fill ) & 3666 surf_lsm_h%albedo_type( ind_wat_win,m) = &3667 surf_lsm_h%albedo_type(m,ind_wat_win) = & 3667 3668 INT( water_pars_f%pars_xy(ind_w_at,j,i) ) 3668 3669 3669 3670 IF ( water_pars_f%pars_xy(ind_w_emis,j,i) /= & 3670 3671 water_pars_f%fill ) & 3671 surf_lsm_h%emissivity( ind_wat_win,m) = &3672 surf_lsm_h%emissivity(m,ind_wat_win) = & 3672 3673 water_pars_f%pars_xy(ind_w_emis,j,i) 3673 3674 ENDIF … … 3724 3725 IF ( water_pars_f%pars_xy(ind_w_at,j,i) /= & 3725 3726 water_pars_f%fill ) & 3726 surf_lsm_v(l)%albedo_type( ind_wat_win,m) = &3727 surf_lsm_v(l)%albedo_type(m,ind_wat_win) = & 3727 3728 INT( water_pars_f%pars_xy(ind_w_at,j,i) ) 3728 3729 3729 3730 IF ( water_pars_f%pars_xy(ind_w_emis,j,i) /= & 3730 3731 water_pars_f%fill ) & 3731 surf_lsm_v(l)%emissivity( ind_wat_win,m) = &3732 surf_lsm_v(l)%emissivity(m,ind_wat_win) = & 3732 3733 water_pars_f%pars_xy(ind_w_emis,j,i) 3733 3734 ENDIF … … 3810 3811 * 0.25_wp 3811 3812 3812 surf_lsm_h%albedo_type( ind_pav_green,m) = albedo_type3813 surf_lsm_h%emissivity( ind_pav_green,m) = emissivity3813 surf_lsm_h%albedo_type(m,ind_pav_green) = albedo_type 3814 surf_lsm_h%emissivity(m,ind_pav_green) = emissivity 3814 3815 3815 3816 surf_lsm_h%pavement_type(m) = pavement_type … … 3848 3849 * 0.25_wp 3849 3850 3850 surf_lsm_v(l)%albedo_type( ind_pav_green,m) = albedo_type3851 surf_lsm_v(l)%emissivity( ind_pav_green,m) = emissivity3851 surf_lsm_v(l)%albedo_type(m,ind_pav_green) = albedo_type 3852 surf_lsm_v(l)%emissivity(m,ind_pav_green) = emissivity 3852 3853 3853 3854 surf_lsm_v(l)%pavement_type(m) = pavement_type … … 3908 3909 * dz_soil(nzb_soil) & 3909 3910 * 0.25_wp 3910 surf_lsm_h%albedo_type( ind_pav_green,m) = INT( pavement_pars(ind_p_at,st) )3911 surf_lsm_h%emissivity( ind_pav_green,m) = pavement_pars(ind_p_emis,st)3911 surf_lsm_h%albedo_type(m,ind_pav_green) = INT( pavement_pars(ind_p_at,st) ) 3912 surf_lsm_h%emissivity(m,ind_pav_green) = pavement_pars(ind_p_emis,st) 3912 3913 3913 3914 surf_lsm_h%pavement_type(m) = st … … 3961 3962 * dz_soil(nzb_soil) & 3962 3963 * 0.25_wp 3963 surf_lsm_v(l)%albedo_type( ind_pav_green,m) = &3964 surf_lsm_v(l)%albedo_type(m,ind_pav_green) = & 3964 3965 INT( pavement_pars(ind_p_at,st) ) 3965 surf_lsm_v(l)%emissivity( ind_pav_green,m) = &3966 surf_lsm_v(l)%emissivity(m,ind_pav_green) = & 3966 3967 pavement_pars(ind_p_emis,st) 3967 3968 … … 4030 4031 IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= & 4031 4032 pavement_pars_f%fill ) & 4032 surf_lsm_h%albedo_type( ind_pav_green,m) = &4033 surf_lsm_h%albedo_type(m,ind_pav_green) = & 4033 4034 INT( pavement_pars_f%pars_xy(ind_p_at,j,i) ) 4034 4035 IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= & 4035 4036 pavement_pars_f%fill ) & 4036 surf_lsm_h%emissivity( ind_pav_green,m) = &4037 surf_lsm_h%emissivity(m,ind_pav_green) = & 4037 4038 pavement_pars_f%pars_xy(ind_p_emis,j,i) 4038 4039 ENDIF … … 4090 4091 IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= & 4091 4092 pavement_pars_f%fill ) & 4092 surf_lsm_v(l)%albedo_type( ind_pav_green,m) = &4093 surf_lsm_v(l)%albedo_type(m,ind_pav_green) = & 4093 4094 INT( pavement_pars_f%pars_xy(ind_p_at,j,i) ) 4094 4095 4095 4096 IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= & 4096 4097 pavement_pars_f%fill ) & 4097 surf_lsm_v(l)%emissivity( ind_pav_green,m) = &4098 surf_lsm_v(l)%emissivity(m,ind_pav_green) = & 4098 4099 pavement_pars_f%pars_xy(ind_p_emis,j,i) 4099 4100 ENDIF -
palm/trunk/SOURCE/radiation_model_mod.f90
r4429 r4441 23 23 ! Current revisions: 24 24 ! ------------------ 25 ! 25 ! - Change order of dimension in surface arrays %frac, %emissivity and %albedo 26 ! to allow for better vectorization in the radiation interactions. 27 ! - Minor formatting issues 26 28 ! 27 29 ! Former revisions: … … 1831 1833 !-- via namelist paramter, unless not already allocated. 1832 1834 IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) ) THEN 1833 ALLOCATE( surf_lsm_h%albedo( 0:2,1:surf_lsm_h%ns) )1835 ALLOCATE( surf_lsm_h%albedo(1:surf_lsm_h%ns,0:2) ) 1834 1836 surf_lsm_h%albedo = albedo 1835 1837 ENDIF 1836 1838 IF ( .NOT. ALLOCATED(surf_usm_h%albedo) ) THEN 1837 ALLOCATE( surf_usm_h%albedo( 0:2,1:surf_usm_h%ns) )1839 ALLOCATE( surf_usm_h%albedo(1:surf_usm_h%ns,0:2) ) 1838 1840 surf_usm_h%albedo = albedo 1839 1841 ENDIF … … 1841 1843 DO l = 0, 3 1842 1844 IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) ) THEN 1843 ALLOCATE( surf_lsm_v(l)%albedo( 0:2,1:surf_lsm_v(l)%ns) )1845 ALLOCATE( surf_lsm_v(l)%albedo(1:surf_lsm_v(l)%ns,0:2) ) 1844 1846 surf_lsm_v(l)%albedo = albedo 1845 1847 ENDIF 1846 1848 IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) ) THEN 1847 ALLOCATE( surf_usm_v(l)%albedo( 0:2,1:surf_usm_v(l)%ns) )1849 ALLOCATE( surf_usm_v(l)%albedo(1:surf_usm_v(l)%ns,0:2) ) 1848 1850 surf_usm_v(l)%albedo = albedo 1849 1851 ENDIF … … 1855 1857 !-- albedo won't be overwritten. 1856 1858 DO m = 1, surf_lsm_h%ns 1857 IF ( surf_lsm_h%albedo_type( ind_veg_wall,m) /= 0 ) &1858 surf_lsm_h%albedo( ind_veg_wall,m) = &1859 albedo_pars(0,surf_lsm_h%albedo_type( ind_veg_wall,m))1860 IF ( surf_lsm_h%albedo_type( ind_pav_green,m) /= 0 ) &1861 surf_lsm_h%albedo( ind_pav_green,m) = &1862 albedo_pars(0,surf_lsm_h%albedo_type( ind_pav_green,m))1863 IF ( surf_lsm_h%albedo_type( ind_wat_win,m) /= 0 ) &1864 surf_lsm_h%albedo( ind_wat_win,m) = &1865 albedo_pars(0,surf_lsm_h%albedo_type( ind_wat_win,m))1859 IF ( surf_lsm_h%albedo_type(m,ind_veg_wall) /= 0 ) & 1860 surf_lsm_h%albedo(m,ind_veg_wall) = & 1861 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_veg_wall)) 1862 IF ( surf_lsm_h%albedo_type(m,ind_pav_green) /= 0 ) & 1863 surf_lsm_h%albedo(m,ind_pav_green) = & 1864 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_pav_green)) 1865 IF ( surf_lsm_h%albedo_type(m,ind_wat_win) /= 0 ) & 1866 surf_lsm_h%albedo(m,ind_wat_win) = & 1867 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_wat_win)) 1866 1868 ENDDO 1867 1869 DO m = 1, surf_usm_h%ns 1868 IF ( surf_usm_h%albedo_type( ind_veg_wall,m) /= 0 ) &1869 surf_usm_h%albedo( ind_veg_wall,m) = &1870 albedo_pars(0,surf_usm_h%albedo_type( ind_veg_wall,m))1871 IF ( surf_usm_h%albedo_type( ind_pav_green,m) /= 0 ) &1872 surf_usm_h%albedo( ind_pav_green,m) = &1873 albedo_pars(0,surf_usm_h%albedo_type( ind_pav_green,m))1874 IF ( surf_usm_h%albedo_type( ind_wat_win,m) /= 0 ) &1875 surf_usm_h%albedo( ind_wat_win,m) = &1876 albedo_pars(0,surf_usm_h%albedo_type( ind_wat_win,m))1870 IF ( surf_usm_h%albedo_type(m,ind_veg_wall) /= 0 ) & 1871 surf_usm_h%albedo(m,ind_veg_wall) = & 1872 albedo_pars(0,surf_usm_h%albedo_type(m,ind_veg_wall)) 1873 IF ( surf_usm_h%albedo_type(m,ind_pav_green) /= 0 ) & 1874 surf_usm_h%albedo(m,ind_pav_green) = & 1875 albedo_pars(0,surf_usm_h%albedo_type(m,ind_pav_green)) 1876 IF ( surf_usm_h%albedo_type(m,ind_wat_win) /= 0 ) & 1877 surf_usm_h%albedo(m,ind_wat_win) = & 1878 albedo_pars(0,surf_usm_h%albedo_type(m,ind_wat_win)) 1877 1879 ENDDO 1878 1880 1879 1881 DO l = 0, 3 1880 1882 DO m = 1, surf_lsm_v(l)%ns 1881 IF ( surf_lsm_v(l)%albedo_type( ind_veg_wall,m) /= 0 ) &1882 surf_lsm_v(l)%albedo( ind_veg_wall,m) = &1883 albedo_pars(0,surf_lsm_v(l)%albedo_type( ind_veg_wall,m))1884 IF ( surf_lsm_v(l)%albedo_type( ind_pav_green,m) /= 0 ) &1885 surf_lsm_v(l)%albedo( ind_pav_green,m) = &1886 albedo_pars(0,surf_lsm_v(l)%albedo_type( ind_pav_green,m))1887 IF ( surf_lsm_v(l)%albedo_type( ind_wat_win,m) /= 0 ) &1888 surf_lsm_v(l)%albedo( ind_wat_win,m) = &1889 albedo_pars(0,surf_lsm_v(l)%albedo_type( ind_wat_win,m))1883 IF ( surf_lsm_v(l)%albedo_type(m,ind_veg_wall) /= 0 ) & 1884 surf_lsm_v(l)%albedo(m,ind_veg_wall) = & 1885 albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_veg_wall)) 1886 IF ( surf_lsm_v(l)%albedo_type(m,ind_pav_green) /= 0 ) & 1887 surf_lsm_v(l)%albedo(m,ind_pav_green) = & 1888 albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_pav_green)) 1889 IF ( surf_lsm_v(l)%albedo_type(m,ind_wat_win) /= 0 ) & 1890 surf_lsm_v(l)%albedo(m,ind_wat_win) = & 1891 albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_wat_win)) 1890 1892 ENDDO 1891 1893 DO m = 1, surf_usm_v(l)%ns 1892 IF ( surf_usm_v(l)%albedo_type( ind_veg_wall,m) /= 0 ) &1893 surf_usm_v(l)%albedo( ind_veg_wall,m) = &1894 albedo_pars(0,surf_usm_v(l)%albedo_type( ind_veg_wall,m))1895 IF ( surf_usm_v(l)%albedo_type( ind_pav_green,m) /= 0 ) &1896 surf_usm_v(l)%albedo( ind_pav_green,m) = &1897 albedo_pars(0,surf_usm_v(l)%albedo_type( ind_pav_green,m))1898 IF ( surf_usm_v(l)%albedo_type( ind_wat_win,m) /= 0 ) &1899 surf_usm_v(l)%albedo( ind_wat_win,m) = &1900 albedo_pars(0,surf_usm_v(l)%albedo_type( ind_wat_win,m))1894 IF ( surf_usm_v(l)%albedo_type(m,ind_veg_wall) /= 0 ) & 1895 surf_usm_v(l)%albedo(m,ind_veg_wall) = & 1896 albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_veg_wall)) 1897 IF ( surf_usm_v(l)%albedo_type(m,ind_pav_green) /= 0 ) & 1898 surf_usm_v(l)%albedo(m,ind_pav_green) = & 1899 albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_pav_green)) 1900 IF ( surf_usm_v(l)%albedo_type(m,ind_wat_win) /= 0 ) & 1901 surf_usm_v(l)%albedo(m,ind_wat_win) = & 1902 albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_wat_win)) 1901 1903 ENDDO 1902 1904 ENDDO … … 1913 1915 j = surf_lsm_h%j(m) 1914 1916 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1915 surf_lsm_h%albedo( ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)1916 surf_lsm_h%albedo( ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)1917 surf_lsm_h%albedo( ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)1917 surf_lsm_h%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 1918 surf_lsm_h%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 1919 surf_lsm_h%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 1918 1920 ENDIF 1919 1921 ENDDO … … 1922 1924 j = surf_usm_h%j(m) 1923 1925 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1924 surf_usm_h%albedo( ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)1925 surf_usm_h%albedo( ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)1926 surf_usm_h%albedo( ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)1926 surf_usm_h%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 1927 surf_usm_h%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 1928 surf_usm_h%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 1927 1929 ENDIF 1928 1930 ENDDO … … 1937 1939 j = surf_lsm_v(l)%j(m) + joff 1938 1940 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1939 surf_lsm_v(l)%albedo( ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)1940 surf_lsm_v(l)%albedo( ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)1941 surf_lsm_v(l)%albedo( ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)1941 surf_lsm_v(l)%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 1942 surf_lsm_v(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 1943 surf_lsm_v(l)%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 1942 1944 ENDIF 1943 1945 ENDDO … … 1949 1951 j = surf_usm_v(l)%j(m) + joff 1950 1952 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1951 surf_usm_v(l)%albedo( ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)1952 surf_usm_v(l)%albedo( ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)1953 surf_usm_v(l)%albedo( ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)1953 surf_usm_v(l)%albedo(m,ind_veg_wall) = albedo_pars_f%pars_xy(0,j,i) 1954 surf_usm_v(l)%albedo(m,ind_pav_green) = albedo_pars_f%pars_xy(0,j,i) 1955 surf_usm_v(l)%albedo(m,ind_wat_win) = albedo_pars_f%pars_xy(0,j,i) 1954 1956 ENDIF 1955 1957 ENDDO … … 1975 1977 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 1976 1978 building_surface_pars_f%fill ) THEN 1977 surf_usm_h%albedo( ind_veg_wall,m) = &1979 surf_usm_h%albedo(m,ind_veg_wall) = & 1978 1980 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 1979 surf_usm_h%albedo_type( ind_veg_wall,m) = 01981 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 1980 1982 ENDIF 1981 1983 1982 1984 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 1983 1985 building_surface_pars_f%fill ) THEN 1984 surf_usm_h%albedo( ind_wat_win,m) = &1986 surf_usm_h%albedo(m,ind_wat_win) = & 1985 1987 building_surface_pars_f%pars(ind_s_alb_b_win,is) 1986 surf_usm_h%albedo_type( ind_wat_win,m) = 01988 surf_usm_h%albedo_type(m,ind_wat_win) = 0 1987 1989 ENDIF 1988 1990 1989 1991 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 1990 1992 building_surface_pars_f%fill ) THEN 1991 surf_usm_h%albedo( ind_pav_green,m) = &1993 surf_usm_h%albedo(m,ind_pav_green) = & 1992 1994 building_surface_pars_f%pars(ind_s_alb_b_green,is) 1993 surf_usm_h%albedo_type( ind_pav_green,m) = 01995 surf_usm_h%albedo_type(m,ind_pav_green) = 0 1994 1996 ENDIF 1995 1997 … … 2014 2016 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2015 2017 building_surface_pars_f%fill ) THEN 2016 surf_usm_v(l)%albedo( ind_veg_wall,m) = &2018 surf_usm_v(l)%albedo(m,ind_veg_wall) = & 2017 2019 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2018 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = 02020 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0 2019 2021 ENDIF 2020 2022 2021 2023 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2022 2024 building_surface_pars_f%fill ) THEN 2023 surf_usm_v(l)%albedo( ind_wat_win,m) = &2025 surf_usm_v(l)%albedo(m,ind_wat_win) = & 2024 2026 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2025 surf_usm_v(l)%albedo_type( ind_wat_win,m) = 02027 surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0 2026 2028 ENDIF 2027 2029 2028 2030 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2029 2031 building_surface_pars_f%fill ) THEN 2030 surf_usm_v(l)%albedo( ind_pav_green,m) = &2032 surf_usm_v(l)%albedo(m,ind_pav_green) = & 2031 2033 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2032 surf_usm_v(l)%albedo_type( ind_pav_green,m) = 02034 surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0 2033 2035 ENDIF 2034 2036 … … 2047 2049 !-- for wall/green/window (USM) or vegetation/pavement/water surfaces 2048 2050 !-- (LSM). 2049 ALLOCATE ( surf_lsm_h%aldif( 0:2,1:surf_lsm_h%ns) )2050 ALLOCATE ( surf_lsm_h%aldir( 0:2,1:surf_lsm_h%ns) )2051 ALLOCATE ( surf_lsm_h%asdif( 0:2,1:surf_lsm_h%ns) )2052 ALLOCATE ( surf_lsm_h%asdir( 0:2,1:surf_lsm_h%ns) )2053 ALLOCATE ( surf_lsm_h%rrtm_aldif( 0:2,1:surf_lsm_h%ns) )2054 ALLOCATE ( surf_lsm_h%rrtm_aldir( 0:2,1:surf_lsm_h%ns) )2055 ALLOCATE ( surf_lsm_h%rrtm_asdif( 0:2,1:surf_lsm_h%ns) )2056 ALLOCATE ( surf_lsm_h%rrtm_asdir( 0:2,1:surf_lsm_h%ns) )2057 2058 ALLOCATE ( surf_usm_h%aldif( 0:2,1:surf_usm_h%ns) )2059 ALLOCATE ( surf_usm_h%aldir( 0:2,1:surf_usm_h%ns) )2060 ALLOCATE ( surf_usm_h%asdif( 0:2,1:surf_usm_h%ns) )2061 ALLOCATE ( surf_usm_h%asdir( 0:2,1:surf_usm_h%ns) )2062 ALLOCATE ( surf_usm_h%rrtm_aldif( 0:2,1:surf_usm_h%ns) )2063 ALLOCATE ( surf_usm_h%rrtm_aldir( 0:2,1:surf_usm_h%ns) )2064 ALLOCATE ( surf_usm_h%rrtm_asdif( 0:2,1:surf_usm_h%ns) )2065 ALLOCATE ( surf_usm_h%rrtm_asdir( 0:2,1:surf_usm_h%ns) )2051 ALLOCATE ( surf_lsm_h%aldif(1:surf_lsm_h%ns,0:2) ) 2052 ALLOCATE ( surf_lsm_h%aldir(1:surf_lsm_h%ns,0:2) ) 2053 ALLOCATE ( surf_lsm_h%asdif(1:surf_lsm_h%ns,0:2) ) 2054 ALLOCATE ( surf_lsm_h%asdir(1:surf_lsm_h%ns,0:2) ) 2055 ALLOCATE ( surf_lsm_h%rrtm_aldif(1:surf_lsm_h%ns,0:2) ) 2056 ALLOCATE ( surf_lsm_h%rrtm_aldir(1:surf_lsm_h%ns,0:2) ) 2057 ALLOCATE ( surf_lsm_h%rrtm_asdif(1:surf_lsm_h%ns,0:2) ) 2058 ALLOCATE ( surf_lsm_h%rrtm_asdir(1:surf_lsm_h%ns,0:2) ) 2059 2060 ALLOCATE ( surf_usm_h%aldif(1:surf_usm_h%ns,0:2) ) 2061 ALLOCATE ( surf_usm_h%aldir(1:surf_usm_h%ns,0:2) ) 2062 ALLOCATE ( surf_usm_h%asdif(1:surf_usm_h%ns,0:2) ) 2063 ALLOCATE ( surf_usm_h%asdir(1:surf_usm_h%ns,0:2) ) 2064 ALLOCATE ( surf_usm_h%rrtm_aldif(1:surf_usm_h%ns,0:2) ) 2065 ALLOCATE ( surf_usm_h%rrtm_aldir(1:surf_usm_h%ns,0:2) ) 2066 ALLOCATE ( surf_usm_h%rrtm_asdif(1:surf_usm_h%ns,0:2) ) 2067 ALLOCATE ( surf_usm_h%rrtm_asdir(1:surf_usm_h%ns,0:2) ) 2066 2068 2067 2069 ! … … 2069 2071 !-- implementations) 2070 2072 IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) ) & 2071 ALLOCATE( surf_lsm_h%albedo( 0:2,1:surf_lsm_h%ns) )2073 ALLOCATE( surf_lsm_h%albedo(1:surf_lsm_h%ns,0:2) ) 2072 2074 IF ( .NOT. ALLOCATED(surf_usm_h%albedo) ) & 2073 ALLOCATE( surf_usm_h%albedo( 0:2,1:surf_usm_h%ns) )2075 ALLOCATE( surf_usm_h%albedo(1:surf_usm_h%ns,0:2) ) 2074 2076 2075 2077 ! … … 2077 2079 DO l = 0, 3 2078 2080 2079 ALLOCATE ( surf_lsm_v(l)%aldif( 0:2,1:surf_lsm_v(l)%ns) )2080 ALLOCATE ( surf_lsm_v(l)%aldir( 0:2,1:surf_lsm_v(l)%ns) )2081 ALLOCATE ( surf_lsm_v(l)%asdif( 0:2,1:surf_lsm_v(l)%ns) )2082 ALLOCATE ( surf_lsm_v(l)%asdir( 0:2,1:surf_lsm_v(l)%ns) )2083 2084 ALLOCATE ( surf_lsm_v(l)%rrtm_aldif( 0:2,1:surf_lsm_v(l)%ns) )2085 ALLOCATE ( surf_lsm_v(l)%rrtm_aldir( 0:2,1:surf_lsm_v(l)%ns) )2086 ALLOCATE ( surf_lsm_v(l)%rrtm_asdif( 0:2,1:surf_lsm_v(l)%ns) )2087 ALLOCATE ( surf_lsm_v(l)%rrtm_asdir( 0:2,1:surf_lsm_v(l)%ns) )2088 2089 ALLOCATE ( surf_usm_v(l)%aldif( 0:2,1:surf_usm_v(l)%ns) )2090 ALLOCATE ( surf_usm_v(l)%aldir( 0:2,1:surf_usm_v(l)%ns) )2091 ALLOCATE ( surf_usm_v(l)%asdif( 0:2,1:surf_usm_v(l)%ns) )2092 ALLOCATE ( surf_usm_v(l)%asdir( 0:2,1:surf_usm_v(l)%ns) )2093 2094 ALLOCATE ( surf_usm_v(l)%rrtm_aldif( 0:2,1:surf_usm_v(l)%ns) )2095 ALLOCATE ( surf_usm_v(l)%rrtm_aldir( 0:2,1:surf_usm_v(l)%ns) )2096 ALLOCATE ( surf_usm_v(l)%rrtm_asdif( 0:2,1:surf_usm_v(l)%ns) )2097 ALLOCATE ( surf_usm_v(l)%rrtm_asdir( 0:2,1:surf_usm_v(l)%ns) )2081 ALLOCATE ( surf_lsm_v(l)%aldif(1:surf_lsm_v(l)%ns,0:2) ) 2082 ALLOCATE ( surf_lsm_v(l)%aldir(1:surf_lsm_v(l)%ns,0:2) ) 2083 ALLOCATE ( surf_lsm_v(l)%asdif(1:surf_lsm_v(l)%ns,0:2) ) 2084 ALLOCATE ( surf_lsm_v(l)%asdir(1:surf_lsm_v(l)%ns,0:2) ) 2085 2086 ALLOCATE ( surf_lsm_v(l)%rrtm_aldif(1:surf_lsm_v(l)%ns,0:2) ) 2087 ALLOCATE ( surf_lsm_v(l)%rrtm_aldir(1:surf_lsm_v(l)%ns,0:2) ) 2088 ALLOCATE ( surf_lsm_v(l)%rrtm_asdif(1:surf_lsm_v(l)%ns,0:2) ) 2089 ALLOCATE ( surf_lsm_v(l)%rrtm_asdir(1:surf_lsm_v(l)%ns,0:2) ) 2090 2091 ALLOCATE ( surf_usm_v(l)%aldif(1:surf_usm_v(l)%ns,0:2) ) 2092 ALLOCATE ( surf_usm_v(l)%aldir(1:surf_usm_v(l)%ns,0:2) ) 2093 ALLOCATE ( surf_usm_v(l)%asdif(1:surf_usm_v(l)%ns,0:2) ) 2094 ALLOCATE ( surf_usm_v(l)%asdir(1:surf_usm_v(l)%ns,0:2) ) 2095 2096 ALLOCATE ( surf_usm_v(l)%rrtm_aldif(1:surf_usm_v(l)%ns,0:2) ) 2097 ALLOCATE ( surf_usm_v(l)%rrtm_aldir(1:surf_usm_v(l)%ns,0:2) ) 2098 ALLOCATE ( surf_usm_v(l)%rrtm_asdif(1:surf_usm_v(l)%ns,0:2) ) 2099 ALLOCATE ( surf_usm_v(l)%rrtm_asdir(1:surf_usm_v(l)%ns,0:2) ) 2098 2100 ! 2099 2101 !-- Allocate broadband albedo (temporary for the current radiation 2100 2102 !-- implementations) 2101 2103 IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) ) & 2102 ALLOCATE( surf_lsm_v(l)%albedo( 0:2,1:surf_lsm_v(l)%ns) )2104 ALLOCATE( surf_lsm_v(l)%albedo(1:surf_lsm_v(l)%ns,0:2) ) 2103 2105 IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) ) & 2104 ALLOCATE( surf_usm_v(l)%albedo( 0:2,1:surf_usm_v(l)%ns) )2106 ALLOCATE( surf_usm_v(l)%albedo(1:surf_usm_v(l)%ns,0:2) ) 2105 2107 2106 2108 ENDDO … … 2165 2167 !-- Spectral albedos for vegetation/pavement/water surfaces 2166 2168 DO ind_type = 0, 2 2167 IF ( surf_lsm_h%albedo_type( ind_type,m) /= 0 ) THEN2168 surf_lsm_h%aldif( ind_type,m) = &2169 albedo_pars(1,surf_lsm_h%albedo_type( ind_type,m))2170 surf_lsm_h%asdif( ind_type,m) = &2171 albedo_pars(2,surf_lsm_h%albedo_type( ind_type,m))2172 surf_lsm_h%aldir( ind_type,m) = &2173 albedo_pars(1,surf_lsm_h%albedo_type( ind_type,m))2174 surf_lsm_h%asdir( ind_type,m) = &2175 albedo_pars(2,surf_lsm_h%albedo_type( ind_type,m))2176 surf_lsm_h%albedo( ind_type,m) = &2177 albedo_pars(0,surf_lsm_h%albedo_type( ind_type,m))2169 IF ( surf_lsm_h%albedo_type(m,ind_type) /= 0 ) THEN 2170 surf_lsm_h%aldif(m,ind_type) = & 2171 albedo_pars(1,surf_lsm_h%albedo_type(m,ind_type)) 2172 surf_lsm_h%asdif(m,ind_type) = & 2173 albedo_pars(2,surf_lsm_h%albedo_type(m,ind_type)) 2174 surf_lsm_h%aldir(m,ind_type) = & 2175 albedo_pars(1,surf_lsm_h%albedo_type(m,ind_type)) 2176 surf_lsm_h%asdir(m,ind_type) = & 2177 albedo_pars(2,surf_lsm_h%albedo_type(m,ind_type)) 2178 surf_lsm_h%albedo(m,ind_type) = & 2179 albedo_pars(0,surf_lsm_h%albedo_type(m,ind_type)) 2178 2180 ENDIF 2179 2181 ENDDO … … 2188 2190 !-- Spectral albedos for wall/green/window surfaces 2189 2191 DO ind_type = 0, 2 2190 IF ( surf_usm_h%albedo_type( ind_type,m) /= 0 ) THEN2191 surf_usm_h%aldif( ind_type,m) = &2192 albedo_pars(1,surf_usm_h%albedo_type( ind_type,m))2193 surf_usm_h%asdif( ind_type,m) = &2194 albedo_pars(2,surf_usm_h%albedo_type( ind_type,m))2195 surf_usm_h%aldir( ind_type,m) = &2196 albedo_pars(1,surf_usm_h%albedo_type( ind_type,m))2197 surf_usm_h%asdir( ind_type,m) = &2198 albedo_pars(2,surf_usm_h%albedo_type( ind_type,m))2199 surf_usm_h%albedo( ind_type,m) = &2200 albedo_pars(0,surf_usm_h%albedo_type( ind_type,m))2192 IF ( surf_usm_h%albedo_type(m,ind_type) /= 0 ) THEN 2193 surf_usm_h%aldif(m,ind_type) = & 2194 albedo_pars(1,surf_usm_h%albedo_type(m,ind_type)) 2195 surf_usm_h%asdif(m,ind_type) = & 2196 albedo_pars(2,surf_usm_h%albedo_type(m,ind_type)) 2197 surf_usm_h%aldir(m,ind_type) = & 2198 albedo_pars(1,surf_usm_h%albedo_type(m,ind_type)) 2199 surf_usm_h%asdir(m,ind_type) = & 2200 albedo_pars(2,surf_usm_h%albedo_type(m,ind_type)) 2201 surf_usm_h%albedo(m,ind_type) = & 2202 albedo_pars(0,surf_usm_h%albedo_type(m,ind_type)) 2201 2203 ENDIF 2202 2204 ENDDO … … 2211 2213 !-- Spectral albedos for vegetation/pavement/water surfaces 2212 2214 DO ind_type = 0, 2 2213 IF ( surf_lsm_v(l)%albedo_type( ind_type,m) /= 0 ) THEN2214 surf_lsm_v(l)%aldif( ind_type,m) = &2215 albedo_pars(1,surf_lsm_v(l)%albedo_type( ind_type,m))2216 surf_lsm_v(l)%asdif( ind_type,m) = &2217 albedo_pars(2,surf_lsm_v(l)%albedo_type( ind_type,m))2218 surf_lsm_v(l)%aldir( ind_type,m) = &2219 albedo_pars(1,surf_lsm_v(l)%albedo_type( ind_type,m))2220 surf_lsm_v(l)%asdir( ind_type,m) = &2221 albedo_pars(2,surf_lsm_v(l)%albedo_type( ind_type,m))2222 surf_lsm_v(l)%albedo( ind_type,m) = &2223 albedo_pars(0,surf_lsm_v(l)%albedo_type( ind_type,m))2215 IF ( surf_lsm_v(l)%albedo_type(m,ind_type) /= 0 ) THEN 2216 surf_lsm_v(l)%aldif(m,ind_type) = & 2217 albedo_pars(1,surf_lsm_v(l)%albedo_type(m,ind_type)) 2218 surf_lsm_v(l)%asdif(m,ind_type) = & 2219 albedo_pars(2,surf_lsm_v(l)%albedo_type(m,ind_type)) 2220 surf_lsm_v(l)%aldir(m,ind_type) = & 2221 albedo_pars(1,surf_lsm_v(l)%albedo_type(m,ind_type)) 2222 surf_lsm_v(l)%asdir(m,ind_type) = & 2223 albedo_pars(2,surf_lsm_v(l)%albedo_type(m,ind_type)) 2224 surf_lsm_v(l)%albedo(m,ind_type) = & 2225 albedo_pars(0,surf_lsm_v(l)%albedo_type(m,ind_type)) 2224 2226 ENDIF 2225 2227 ENDDO … … 2233 2235 !-- Spectral albedos for wall/green/window surfaces 2234 2236 DO ind_type = 0, 2 2235 IF ( surf_usm_v(l)%albedo_type( ind_type,m) /= 0 ) THEN2236 surf_usm_v(l)%aldif( ind_type,m) = &2237 albedo_pars(1,surf_usm_v(l)%albedo_type( ind_type,m))2238 surf_usm_v(l)%asdif( ind_type,m) = &2239 albedo_pars(2,surf_usm_v(l)%albedo_type( ind_type,m))2240 surf_usm_v(l)%aldir( ind_type,m) = &2241 albedo_pars(1,surf_usm_v(l)%albedo_type( ind_type,m))2242 surf_usm_v(l)%asdir( ind_type,m) = &2243 albedo_pars(2,surf_usm_v(l)%albedo_type( ind_type,m))2244 surf_usm_v(l)%albedo( ind_type,m) = &2245 albedo_pars(0,surf_usm_v(l)%albedo_type( ind_type,m))2237 IF ( surf_usm_v(l)%albedo_type(m,ind_type) /= 0 ) THEN 2238 surf_usm_v(l)%aldif(m,ind_type) = & 2239 albedo_pars(1,surf_usm_v(l)%albedo_type(m,ind_type)) 2240 surf_usm_v(l)%asdif(m,ind_type) = & 2241 albedo_pars(2,surf_usm_v(l)%albedo_type(m,ind_type)) 2242 surf_usm_v(l)%aldir(m,ind_type) = & 2243 albedo_pars(1,surf_usm_v(l)%albedo_type(m,ind_type)) 2244 surf_usm_v(l)%asdir(m,ind_type) = & 2245 albedo_pars(2,surf_usm_v(l)%albedo_type(m,ind_type)) 2246 surf_usm_v(l)%albedo(m,ind_type) = & 2247 albedo_pars(0,surf_usm_v(l)%albedo_type(m,ind_type)) 2246 2248 ENDIF 2247 2249 ENDDO … … 2263 2265 DO ind_type = 0, 2 2264 2266 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) & 2265 surf_lsm_h%albedo( ind_type,m) = &2267 surf_lsm_h%albedo(m,ind_type) = & 2266 2268 albedo_pars_f%pars_xy(0,j,i) 2267 2269 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 2268 surf_lsm_h%aldir( ind_type,m) = &2270 surf_lsm_h%aldir(m,ind_type) = & 2269 2271 albedo_pars_f%pars_xy(1,j,i) 2270 2272 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) & 2271 surf_lsm_h%aldif( ind_type,m) = &2273 surf_lsm_h%aldif(m,ind_type) = & 2272 2274 albedo_pars_f%pars_xy(1,j,i) 2273 2275 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 2274 surf_lsm_h%asdir( ind_type,m) = &2276 surf_lsm_h%asdir(m,ind_type) = & 2275 2277 albedo_pars_f%pars_xy(2,j,i) 2276 2278 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) & 2277 surf_lsm_h%asdif( ind_type,m) = &2279 surf_lsm_h%asdif(m,ind_type) = & 2278 2280 albedo_pars_f%pars_xy(2,j,i) 2279 2281 ENDDO … … 2290 2292 DO ind_type = 0, 2 2291 2293 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )& 2292 surf_usm_h%albedo( ind_type,m) = &2294 surf_usm_h%albedo(m,ind_type) = & 2293 2295 albedo_pars_f%pars_xy(0,j,i) 2294 2296 ENDDO … … 2296 2298 !-- Spectral albedos especially for building wall surfaces 2297 2299 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) THEN 2298 surf_usm_h%aldir( ind_veg_wall,m) = &2300 surf_usm_h%aldir(m,ind_veg_wall) = & 2299 2301 albedo_pars_f%pars_xy(1,j,i) 2300 surf_usm_h%aldif( ind_veg_wall,m) = &2302 surf_usm_h%aldif(m,ind_veg_wall) = & 2301 2303 albedo_pars_f%pars_xy(1,j,i) 2302 2304 ENDIF 2303 2305 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) THEN 2304 surf_usm_h%asdir( ind_veg_wall,m) = &2306 surf_usm_h%asdir(m,ind_veg_wall) = & 2305 2307 albedo_pars_f%pars_xy(2,j,i) 2306 surf_usm_h%asdif( ind_veg_wall,m) = &2308 surf_usm_h%asdif(m,ind_veg_wall) = & 2307 2309 albedo_pars_f%pars_xy(2,j,i) 2308 2310 ENDIF … … 2310 2312 !-- Spectral albedos especially for building green surfaces 2311 2313 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill ) THEN 2312 surf_usm_h%aldir( ind_pav_green,m) = &2314 surf_usm_h%aldir(m,ind_pav_green) = & 2313 2315 albedo_pars_f%pars_xy(3,j,i) 2314 surf_usm_h%aldif( ind_pav_green,m) = &2316 surf_usm_h%aldif(m,ind_pav_green) = & 2315 2317 albedo_pars_f%pars_xy(3,j,i) 2316 2318 ENDIF 2317 2319 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill ) THEN 2318 surf_usm_h%asdir( ind_pav_green,m) = &2320 surf_usm_h%asdir(m,ind_pav_green) = & 2319 2321 albedo_pars_f%pars_xy(4,j,i) 2320 surf_usm_h%asdif( ind_pav_green,m) = &2322 surf_usm_h%asdif(m,ind_pav_green) = & 2321 2323 albedo_pars_f%pars_xy(4,j,i) 2322 2324 ENDIF … … 2324 2326 !-- Spectral albedos especially for building window surfaces 2325 2327 IF ( albedo_pars_f%pars_xy(5,j,i) /= albedo_pars_f%fill ) THEN 2326 surf_usm_h%aldir( ind_wat_win,m) = &2328 surf_usm_h%aldir(m,ind_wat_win) = & 2327 2329 albedo_pars_f%pars_xy(5,j,i) 2328 surf_usm_h%aldif( ind_wat_win,m) = &2330 surf_usm_h%aldif(m,ind_wat_win) = & 2329 2331 albedo_pars_f%pars_xy(5,j,i) 2330 2332 ENDIF 2331 2333 IF ( albedo_pars_f%pars_xy(6,j,i) /= albedo_pars_f%fill ) THEN 2332 surf_usm_h%asdir( ind_wat_win,m) = &2334 surf_usm_h%asdir(m,ind_wat_win) = & 2333 2335 albedo_pars_f%pars_xy(6,j,i) 2334 surf_usm_h%asdif( ind_wat_win,m) = &2336 surf_usm_h%asdif(m,ind_wat_win) = & 2335 2337 albedo_pars_f%pars_xy(6,j,i) 2336 2338 ENDIF … … 2352 2354 IF ( albedo_pars_f%pars_xy(0,j+joff,i+ioff) /= & 2353 2355 albedo_pars_f%fill ) & 2354 surf_lsm_v(l)%albedo( ind_type,m) = &2356 surf_lsm_v(l)%albedo(m,ind_type) = & 2355 2357 albedo_pars_f%pars_xy(0,j+joff,i+ioff) 2356 2358 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2357 2359 albedo_pars_f%fill ) & 2358 surf_lsm_v(l)%aldir( ind_type,m) = &2360 surf_lsm_v(l)%aldir(m,ind_type) = & 2359 2361 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2360 2362 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2361 2363 albedo_pars_f%fill ) & 2362 surf_lsm_v(l)%aldif( ind_type,m) = &2364 surf_lsm_v(l)%aldif(m,ind_type) = & 2363 2365 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2364 2366 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2365 2367 albedo_pars_f%fill ) & 2366 surf_lsm_v(l)%asdir( ind_type,m) = &2368 surf_lsm_v(l)%asdir(m,ind_type) = & 2367 2369 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2368 2370 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2369 2371 albedo_pars_f%fill ) & 2370 surf_lsm_v(l)%asdif( ind_type,m) = &2372 surf_lsm_v(l)%asdif(m,ind_type) = & 2371 2373 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2372 2374 ENDDO … … 2387 2389 IF ( albedo_pars_f%pars_xy(0,j+joff,i+ioff) /= & 2388 2390 albedo_pars_f%fill ) & 2389 surf_usm_v(l)%albedo( ind_type,m) = &2391 surf_usm_v(l)%albedo(m,ind_type) = & 2390 2392 albedo_pars_f%pars_xy(0,j+joff,i+ioff) 2391 2393 ENDDO … … 2394 2396 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2395 2397 albedo_pars_f%fill ) THEN 2396 surf_usm_v(l)%aldir( ind_veg_wall,m) = &2398 surf_usm_v(l)%aldir(m,ind_veg_wall) = & 2397 2399 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2398 surf_usm_v(l)%aldif( ind_veg_wall,m) = &2400 surf_usm_v(l)%aldif(m,ind_veg_wall) = & 2399 2401 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2400 2402 ENDIF 2401 2403 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2402 2404 albedo_pars_f%fill ) THEN 2403 surf_usm_v(l)%asdir( ind_veg_wall,m) = &2405 surf_usm_v(l)%asdir(m,ind_veg_wall) = & 2404 2406 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2405 surf_usm_v(l)%asdif( ind_veg_wall,m) = &2407 surf_usm_v(l)%asdif(m,ind_veg_wall) = & 2406 2408 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2407 2409 ENDIF … … 2410 2412 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= & 2411 2413 albedo_pars_f%fill ) THEN 2412 surf_usm_v(l)%aldir( ind_pav_green,m) = &2414 surf_usm_v(l)%aldir(m,ind_pav_green) = & 2413 2415 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2414 surf_usm_v(l)%aldif( ind_pav_green,m) = &2416 surf_usm_v(l)%aldif(m,ind_pav_green) = & 2415 2417 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2416 2418 ENDIF 2417 2419 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= & 2418 2420 albedo_pars_f%fill ) THEN 2419 surf_usm_v(l)%asdir( ind_pav_green,m) = &2421 surf_usm_v(l)%asdir(m,ind_pav_green) = & 2420 2422 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2421 surf_usm_v(l)%asdif( ind_pav_green,m) = &2423 surf_usm_v(l)%asdif(m,ind_pav_green) = & 2422 2424 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2423 2425 ENDIF … … 2426 2428 IF ( albedo_pars_f%pars_xy(5,j+joff,i+ioff) /= & 2427 2429 albedo_pars_f%fill ) THEN 2428 surf_usm_v(l)%aldir( ind_wat_win,m) = &2430 surf_usm_v(l)%aldir(m,ind_wat_win) = & 2429 2431 albedo_pars_f%pars_xy(5,j+joff,i+ioff) 2430 surf_usm_v(l)%aldif( ind_wat_win,m) = &2432 surf_usm_v(l)%aldif(m,ind_wat_win) = & 2431 2433 albedo_pars_f%pars_xy(5,j+joff,i+ioff) 2432 2434 ENDIF 2433 2435 IF ( albedo_pars_f%pars_xy(6,j+joff,i+ioff) /= & 2434 2436 albedo_pars_f%fill ) THEN 2435 surf_usm_v(l)%asdir( ind_wat_win,m) = &2437 surf_usm_v(l)%asdir(m,ind_wat_win) = & 2436 2438 albedo_pars_f%pars_xy(6,j+joff,i+ioff) 2437 surf_usm_v(l)%asdif( ind_wat_win,m) = &2439 surf_usm_v(l)%asdif(m,ind_wat_win) = & 2438 2440 albedo_pars_f%pars_xy(6,j+joff,i+ioff) 2439 2441 ENDIF … … 2461 2463 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2462 2464 building_surface_pars_f%fill ) THEN 2463 surf_usm_h%albedo( ind_veg_wall,m) = &2465 surf_usm_h%albedo(m,ind_veg_wall) = & 2464 2466 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2465 surf_usm_h%albedo_type( ind_veg_wall,m) = 02467 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2466 2468 ENDIF 2467 2469 2468 2470 IF ( building_surface_pars_f%pars(ind_s_alb_l_wall,is) /= & 2469 2471 building_surface_pars_f%fill ) THEN 2470 surf_usm_h%aldir( ind_veg_wall,m) = &2472 surf_usm_h%aldir(m,ind_veg_wall) = & 2471 2473 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2472 surf_usm_h%aldif( ind_veg_wall,m) = &2474 surf_usm_h%aldif(m,ind_veg_wall) = & 2473 2475 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2474 surf_usm_h%albedo_type( ind_veg_wall,m) = 02476 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2475 2477 ENDIF 2476 2478 2477 2479 IF ( building_surface_pars_f%pars(ind_s_alb_s_wall,is) /= & 2478 2480 building_surface_pars_f%fill ) THEN 2479 surf_usm_h%asdir( ind_veg_wall,m) = &2481 surf_usm_h%asdir(m,ind_veg_wall) = & 2480 2482 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2481 surf_usm_h%asdif( ind_veg_wall,m) = &2483 surf_usm_h%asdif(m,ind_veg_wall) = & 2482 2484 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2483 surf_usm_h%albedo_type( ind_veg_wall,m) = 02485 surf_usm_h%albedo_type(m,ind_veg_wall) = 0 2484 2486 ENDIF 2485 2487 2486 2488 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2487 2489 building_surface_pars_f%fill ) THEN 2488 surf_usm_h%albedo( ind_wat_win,m) = &2490 surf_usm_h%albedo(m,ind_wat_win) = & 2489 2491 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2490 surf_usm_h%albedo_type( ind_wat_win,m) = 02492 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2491 2493 ENDIF 2492 2494 2493 2495 IF ( building_surface_pars_f%pars(ind_s_alb_l_win,is) /= & 2494 2496 building_surface_pars_f%fill ) THEN 2495 surf_usm_h%aldir( ind_wat_win,m) = &2497 surf_usm_h%aldir(m,ind_wat_win) = & 2496 2498 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2497 surf_usm_h%aldif( ind_wat_win,m) = &2499 surf_usm_h%aldif(m,ind_wat_win) = & 2498 2500 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2499 surf_usm_h%albedo_type( ind_wat_win,m) = 02501 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2500 2502 ENDIF 2501 2503 2502 2504 IF ( building_surface_pars_f%pars(ind_s_alb_s_win,is) /= & 2503 2505 building_surface_pars_f%fill ) THEN 2504 surf_usm_h%asdir( ind_wat_win,m) = &2506 surf_usm_h%asdir(m,ind_wat_win) = & 2505 2507 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2506 surf_usm_h%asdif( ind_wat_win,m) = &2508 surf_usm_h%asdif(m,ind_wat_win) = & 2507 2509 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2508 surf_usm_h%albedo_type( ind_wat_win,m) = 02510 surf_usm_h%albedo_type(m,ind_wat_win) = 0 2509 2511 ENDIF 2510 2512 2511 2513 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2512 2514 building_surface_pars_f%fill ) THEN 2513 surf_usm_h%albedo( ind_pav_green,m) = &2515 surf_usm_h%albedo(m,ind_pav_green) = & 2514 2516 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2515 surf_usm_h%albedo_type( ind_pav_green,m) = 02517 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2516 2518 ENDIF 2517 2519 2518 2520 IF ( building_surface_pars_f%pars(ind_s_alb_l_green,is) /= & 2519 2521 building_surface_pars_f%fill ) THEN 2520 surf_usm_h%aldir( ind_pav_green,m) = &2522 surf_usm_h%aldir(m,ind_pav_green) = & 2521 2523 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2522 surf_usm_h%aldif( ind_pav_green,m) = &2524 surf_usm_h%aldif(m,ind_pav_green) = & 2523 2525 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2524 surf_usm_h%albedo_type( ind_pav_green,m) = 02526 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2525 2527 ENDIF 2526 2528 2527 2529 IF ( building_surface_pars_f%pars(ind_s_alb_s_green,is) /= & 2528 2530 building_surface_pars_f%fill ) THEN 2529 surf_usm_h%asdir( ind_pav_green,m) = &2531 surf_usm_h%asdir(m,ind_pav_green) = & 2530 2532 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2531 surf_usm_h%asdif( ind_pav_green,m) = &2533 surf_usm_h%asdif(m,ind_pav_green) = & 2532 2534 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2533 surf_usm_h%albedo_type( ind_pav_green,m) = 02535 surf_usm_h%albedo_type(m,ind_pav_green) = 0 2534 2536 ENDIF 2535 2537 … … 2554 2556 IF ( building_surface_pars_f%pars(ind_s_alb_b_wall,is) /= & 2555 2557 building_surface_pars_f%fill ) THEN 2556 surf_usm_v(l)%albedo( ind_veg_wall,m) = &2558 surf_usm_v(l)%albedo(m,ind_veg_wall) = & 2557 2559 building_surface_pars_f%pars(ind_s_alb_b_wall,is) 2558 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = 02560 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0 2559 2561 ENDIF 2560 2562 2561 2563 IF ( building_surface_pars_f%pars(ind_s_alb_l_wall,is) /= & 2562 2564 building_surface_pars_f%fill ) THEN 2563 surf_usm_v(l)%aldir( ind_veg_wall,m) = &2565 surf_usm_v(l)%aldir(m,ind_veg_wall) = & 2564 2566 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2565 surf_usm_v(l)%aldif( ind_veg_wall,m) = &2567 surf_usm_v(l)%aldif(m,ind_veg_wall) = & 2566 2568 building_surface_pars_f%pars(ind_s_alb_l_wall,is) 2567 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = 02569 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0 2568 2570 ENDIF 2569 2571 2570 2572 IF ( building_surface_pars_f%pars(ind_s_alb_s_wall,is) /= & 2571 2573 building_surface_pars_f%fill ) THEN 2572 surf_usm_v(l)%asdir( ind_veg_wall,m) = &2574 surf_usm_v(l)%asdir(m,ind_veg_wall) = & 2573 2575 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2574 surf_usm_v(l)%asdif( ind_veg_wall,m) = &2576 surf_usm_v(l)%asdif(m,ind_veg_wall) = & 2575 2577 building_surface_pars_f%pars(ind_s_alb_s_wall,is) 2576 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = 02578 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = 0 2577 2579 ENDIF 2578 2580 2579 2581 IF ( building_surface_pars_f%pars(ind_s_alb_b_win,is) /= & 2580 2582 building_surface_pars_f%fill ) THEN 2581 surf_usm_v(l)%albedo( ind_wat_win,m) = &2583 surf_usm_v(l)%albedo(m,ind_wat_win) = & 2582 2584 building_surface_pars_f%pars(ind_s_alb_b_win,is) 2583 surf_usm_v(l)%albedo_type( ind_wat_win,m) = 02585 surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0 2584 2586 ENDIF 2585 2587 2586 2588 IF ( building_surface_pars_f%pars(ind_s_alb_l_win,is) /= & 2587 2589 building_surface_pars_f%fill ) THEN 2588 surf_usm_v(l)%aldir( ind_wat_win,m) = &2590 surf_usm_v(l)%aldir(m,ind_wat_win) = & 2589 2591 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2590 surf_usm_v(l)%aldif( ind_wat_win,m) = &2592 surf_usm_v(l)%aldif(m,ind_wat_win) = & 2591 2593 building_surface_pars_f%pars(ind_s_alb_l_win,is) 2592 surf_usm_v(l)%albedo_type( ind_wat_win,m) = 02594 surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0 2593 2595 ENDIF 2594 2596 2595 2597 IF ( building_surface_pars_f%pars(ind_s_alb_s_win,is) /= & 2596 2598 building_surface_pars_f%fill ) THEN 2597 surf_usm_v(l)%asdir( ind_wat_win,m) = &2599 surf_usm_v(l)%asdir(m,ind_wat_win) = & 2598 2600 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2599 surf_usm_v(l)%asdif( ind_wat_win,m) = &2601 surf_usm_v(l)%asdif(m,ind_wat_win) = & 2600 2602 building_surface_pars_f%pars(ind_s_alb_s_win,is) 2601 surf_usm_v(l)%albedo_type( ind_wat_win,m) = 02603 surf_usm_v(l)%albedo_type(m,ind_wat_win) = 0 2602 2604 ENDIF 2603 2605 2604 2606 IF ( building_surface_pars_f%pars(ind_s_alb_b_green,is) /= & 2605 2607 building_surface_pars_f%fill ) THEN 2606 surf_usm_v(l)%albedo( ind_pav_green,m) = &2608 surf_usm_v(l)%albedo(m,ind_pav_green) = & 2607 2609 building_surface_pars_f%pars(ind_s_alb_b_green,is) 2608 surf_usm_v(l)%albedo_type( ind_pav_green,m) = 02610 surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0 2609 2611 ENDIF 2610 2612 2611 2613 IF ( building_surface_pars_f%pars(ind_s_alb_l_green,is) /= & 2612 2614 building_surface_pars_f%fill ) THEN 2613 surf_usm_v(l)%aldir( ind_pav_green,m) = &2615 surf_usm_v(l)%aldir(m,ind_pav_green) = & 2614 2616 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2615 surf_usm_v(l)%aldif( ind_pav_green,m) = &2617 surf_usm_v(l)%aldif(m,ind_pav_green) = & 2616 2618 building_surface_pars_f%pars(ind_s_alb_l_green,is) 2617 surf_usm_v(l)%albedo_type( ind_pav_green,m) = 02619 surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0 2618 2620 ENDIF 2619 2621 2620 2622 IF ( building_surface_pars_f%pars(ind_s_alb_s_green,is) /= & 2621 2623 building_surface_pars_f%fill ) THEN 2622 surf_usm_v(l)%asdir( ind_pav_green,m) = &2624 surf_usm_v(l)%asdir(m,ind_pav_green) = & 2623 2625 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2624 surf_usm_v(l)%asdif( ind_pav_green,m) = &2626 surf_usm_v(l)%asdif(m,ind_pav_green) = & 2625 2627 building_surface_pars_f%pars(ind_s_alb_s_green,is) 2626 surf_usm_v(l)%albedo_type( ind_pav_green,m) = 02628 surf_usm_v(l)%albedo_type(m,ind_pav_green) = 0 2627 2629 ENDIF 2628 2630 … … 3272 3274 DO m = 1, surf%ns 3273 3275 k = surf%k(m) 3274 surf%rad_sw_out(m) = ( surf%frac( ind_veg_wall,m) * &3275 surf%albedo( ind_veg_wall,m) &3276 + surf%frac( ind_pav_green,m) * &3277 surf%albedo( ind_pav_green,m) &3278 + surf%frac( ind_wat_win,m) * &3279 surf%albedo( ind_wat_win,m) ) &3276 surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3277 surf%albedo(m,ind_veg_wall) & 3278 + surf%frac(m,ind_pav_green) * & 3279 surf%albedo(m,ind_pav_green) & 3280 + surf%frac(m,ind_wat_win) * & 3281 surf%albedo(m,ind_wat_win) ) & 3280 3282 * surf%rad_sw_in(m) 3281 3283 3282 surf%rad_lw_out(m) = ( surf%frac( ind_veg_wall,m) * &3283 surf%emissivity( ind_veg_wall,m) &3284 + surf%frac( ind_pav_green,m) * &3285 surf%emissivity( ind_pav_green,m) &3286 + surf%frac( ind_wat_win,m) * &3287 surf%emissivity( ind_wat_win,m) &3284 surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3285 surf%emissivity(m,ind_veg_wall) & 3286 + surf%frac(m,ind_pav_green) * & 3287 surf%emissivity(m,ind_pav_green) & 3288 + surf%frac(m,ind_wat_win) * & 3289 surf%emissivity(m,ind_wat_win) & 3288 3290 ) & 3289 3291 * sigma_sb & … … 3291 3293 3292 3294 surf%rad_lw_out_change_0(m) = & 3293 ( surf%frac( ind_veg_wall,m) * &3294 surf%emissivity( ind_veg_wall,m) &3295 + surf%frac( ind_pav_green,m) * &3296 surf%emissivity(i nd_pav_green,m) &3297 + surf%frac( ind_wat_win,m) * &3298 surf%emissivity( ind_wat_win,m) &3295 ( surf%frac(m,ind_veg_wall) * & 3296 surf%emissivity(m,ind_veg_wall) & 3297 + surf%frac(m,ind_pav_green) * & 3298 surf%emissivity(im,ind_pav_green) & 3299 + surf%frac(m,ind_wat_win) * & 3300 surf%emissivity(m,ind_wat_win) & 3299 3301 ) * 4.0_wp * sigma_sb & 3300 3302 * ( surf%pt_surface(m) * exner(k) )**3 … … 3340 3342 ! 3341 3343 !-- Weighted average according to surface fraction. 3342 surf%rad_sw_out(m) = ( surf%frac( ind_veg_wall,m) * &3343 surf%albedo( ind_veg_wall,m) &3344 + surf%frac( ind_pav_green,m) * &3345 surf%albedo( ind_pav_green,m) &3346 + surf%frac( ind_wat_win,m) * &3347 surf%albedo( ind_wat_win,m) ) &3344 surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3345 surf%albedo(m,ind_veg_wall) & 3346 + surf%frac(m,ind_pav_green) * & 3347 surf%albedo(m,ind_pav_green) & 3348 + surf%frac(m,ind_wat_win) * & 3349 surf%albedo(m,ind_wat_win) ) & 3348 3350 * surf%rad_sw_in(m) 3349 3351 3350 surf%rad_lw_out(m) = ( surf%frac( ind_veg_wall,m) * &3351 surf%emissivity( ind_veg_wall,m) &3352 + surf%frac( ind_pav_green,m) * &3353 surf%emissivity( ind_pav_green,m) &3354 + surf%frac( ind_wat_win,m) * &3355 surf%emissivity( ind_wat_win,m) &3352 surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3353 surf%emissivity(m,ind_veg_wall) & 3354 + surf%frac(m,ind_pav_green) * & 3355 surf%emissivity(m,ind_pav_green) & 3356 + surf%frac(m,ind_wat_win) * & 3357 surf%emissivity(m,ind_wat_win) & 3356 3358 ) & 3357 3359 * sigma_sb & … … 3359 3361 3360 3362 surf%rad_lw_out_change_0(m) = & 3361 ( surf%frac( ind_veg_wall,m) * &3362 surf%emissivity( ind_veg_wall,m) &3363 + surf%frac( ind_pav_green,m) * &3364 surf%emissivity( ind_pav_green,m) &3365 + surf%frac( ind_wat_win,m) * &3366 surf%emissivity( ind_wat_win,m) &3363 ( surf%frac(m,ind_veg_wall) * & 3364 surf%emissivity(m,ind_veg_wall) & 3365 + surf%frac(m,ind_pav_green) * & 3366 surf%emissivity(m,ind_pav_green) & 3367 + surf%frac(m,ind_wat_win) * & 3368 surf%emissivity(m,ind_wat_win) & 3367 3369 ) * 4.0_wp * sigma_sb & 3368 3370 * ( surf%pt_surface(m) * exner(k) )**3 … … 3550 3552 !-- calculated fluxes below are not actually used as they are 3551 3553 !-- overwritten in radiation_interaction. 3552 surf%rad_sw_out(m) = ( surf%frac( ind_veg_wall,m) * &3553 surf%albedo( ind_veg_wall,m) &3554 + surf%frac( ind_pav_green,m) * &3555 surf%albedo( ind_pav_green,m) &3556 + surf%frac( ind_wat_win,m) * &3557 surf%albedo( ind_wat_win,m) ) &3554 surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3555 surf%albedo(m,ind_veg_wall) & 3556 + surf%frac(m,ind_pav_green) * & 3557 surf%albedo(m,ind_pav_green) & 3558 + surf%frac(m,ind_wat_win) * & 3559 surf%albedo(m,ind_wat_win) ) & 3558 3560 * surf%rad_sw_in(m) 3559 3561 3560 surf%rad_lw_out(m) = ( surf%frac( ind_veg_wall,m) * &3561 surf%emissivity( ind_veg_wall,m) &3562 + surf%frac( ind_pav_green,m) * &3563 surf%emissivity( ind_pav_green,m) &3564 + surf%frac( ind_wat_win,m) * &3565 surf%emissivity( ind_wat_win,m) &3562 surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3563 surf%emissivity(m,ind_veg_wall) & 3564 + surf%frac(m,ind_pav_green) * & 3565 surf%emissivity(m,ind_pav_green) & 3566 + surf%frac(m,ind_wat_win) * & 3567 surf%emissivity(m,ind_wat_win) & 3566 3568 ) & 3567 3569 * sigma_sb & … … 3569 3571 3570 3572 surf%rad_lw_out_change_0(m) = & 3571 ( surf%frac( ind_veg_wall,m) * &3572 surf%emissivity( ind_veg_wall,m) &3573 + surf%frac( ind_pav_green,m) * &3574 surf%emissivity( ind_pav_green,m) &3575 + surf%frac( ind_wat_win,m) * &3576 surf%emissivity( ind_wat_win,m) &3573 ( surf%frac(m,ind_veg_wall) * & 3574 surf%emissivity(m,ind_veg_wall) & 3575 + surf%frac(m,ind_pav_green) * & 3576 surf%emissivity(m,ind_pav_green) & 3577 + surf%frac(m,ind_wat_win) * & 3578 surf%emissivity(m,ind_wat_win) & 3577 3579 ) * 4.0_wp * sigma_sb & 3578 3580 * ( surf%pt_surface(m) * exner(nzb) )** 3 … … 3749 3751 ! 3750 3752 !-- Weighted average according to surface fraction. 3751 surf%rad_lw_out(m) = ( surf%frac( ind_veg_wall,m) * &3752 surf%emissivity( ind_veg_wall,m) &3753 + surf%frac( ind_pav_green,m) * &3754 surf%emissivity( ind_pav_green,m) &3755 + surf%frac( ind_wat_win,m) * &3756 surf%emissivity( ind_wat_win,m) &3753 surf%rad_lw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3754 surf%emissivity(m,ind_veg_wall) & 3755 + surf%frac(m,ind_pav_green) * & 3756 surf%emissivity(m,ind_pav_green) & 3757 + surf%frac(m,ind_wat_win) * & 3758 surf%emissivity(m,ind_wat_win) & 3757 3759 ) & 3758 3760 * sigma_sb & … … 3762 3764 + surf%rad_lw_out(m) ) & 3763 3765 / ( 1.0_wp - & 3764 ( surf%frac( ind_veg_wall,m) * &3765 surf%albedo( ind_veg_wall,m) &3766 + surf%frac( ind_pav_green,m) * &3767 surf%albedo( ind_pav_green,m) &3768 + surf%frac( ind_wat_win,m) * &3769 surf%albedo( ind_wat_win,m) ) &3766 ( surf%frac(m,ind_veg_wall) * & 3767 surf%albedo(m,ind_veg_wall) & 3768 + surf%frac(m,ind_pav_green) * & 3769 surf%albedo(m,ind_pav_green) & 3770 + surf%frac(m,ind_wat_win) * & 3771 surf%albedo(m,ind_wat_win) ) & 3770 3772 ) 3771 3773 3772 surf%rad_sw_out(m) = ( surf%frac( ind_veg_wall,m) * &3773 surf%albedo( ind_veg_wall,m) &3774 + surf%frac( ind_pav_green,m) * &3775 surf%albedo( ind_pav_green,m) &3776 + surf%frac( ind_wat_win,m) * &3777 surf%albedo( ind_wat_win,m) ) &3774 surf%rad_sw_out(m) = ( surf%frac(m,ind_veg_wall) * & 3775 surf%albedo(m,ind_veg_wall) & 3776 + surf%frac(m,ind_pav_green) * & 3777 surf%albedo(m,ind_pav_green) & 3778 + surf%frac(m,ind_wat_win) * & 3779 surf%albedo(m,ind_wat_win) ) & 3778 3780 * surf%rad_sw_in(m) 3779 3781 … … 4531 4533 !-- surfaces. 4532 4534 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 4533 rrtm_emis = surf_lsm_h%frac( ind_veg_wall,m) * &4534 surf_lsm_h%emissivity( ind_veg_wall,m) + &4535 surf_lsm_h%frac( ind_pav_green,m) * &4536 surf_lsm_h%emissivity( ind_pav_green,m) + &4537 surf_lsm_h%frac( ind_wat_win,m) * &4538 surf_lsm_h%emissivity( ind_wat_win,m)4535 rrtm_emis = surf_lsm_h%frac(m,ind_veg_wall) * & 4536 surf_lsm_h%emissivity(m,ind_veg_wall) + & 4537 surf_lsm_h%frac(m,ind_pav_green) * & 4538 surf_lsm_h%emissivity(m,ind_pav_green) + & 4539 surf_lsm_h%frac(m,ind_wat_win) * & 4540 surf_lsm_h%emissivity(m,ind_wat_win) 4539 4541 rrtm_tsfc = surf_lsm_h%pt_surface(m) * exner(nzb) 4540 4542 ENDDO 4541 4543 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 4542 rrtm_emis = surf_usm_h%frac( ind_veg_wall,m) * &4543 surf_usm_h%emissivity( ind_veg_wall,m) + &4544 surf_usm_h%frac( ind_pav_green,m) * &4545 surf_usm_h%emissivity( ind_pav_green,m) + &4546 surf_usm_h%frac( ind_wat_win,m) * &4547 surf_usm_h%emissivity( ind_wat_win,m)4544 rrtm_emis = surf_usm_h%frac(m,ind_veg_wall) * & 4545 surf_usm_h%emissivity(m,ind_veg_wall) + & 4546 surf_usm_h%frac(m,ind_pav_green) * & 4547 surf_usm_h%emissivity(m,ind_pav_green) + & 4548 surf_usm_h%frac(m,ind_wat_win) * & 4549 surf_usm_h%emissivity(m,ind_wat_win) 4548 4550 rrtm_tsfc = surf_usm_h%pt_surface(m) * exner(nzb) 4549 4551 ENDDO … … 4672 4674 DO m = surf_lsm_h%start_index(j,i), & 4673 4675 surf_lsm_h%end_index(j,i) 4674 rrtm_asdir(1) = SUM( surf_lsm_h%frac( :,m) * &4676 rrtm_asdir(1) = SUM( surf_lsm_h%frac(m,:) * & 4675 4677 surf_lsm_h%rrtm_asdir(:,m) ) 4676 rrtm_asdif(1) = SUM( surf_lsm_h%frac( :,m) * &4678 rrtm_asdif(1) = SUM( surf_lsm_h%frac(m,:) * & 4677 4679 surf_lsm_h%rrtm_asdif(:,m) ) 4678 rrtm_aldir(1) = SUM( surf_lsm_h%frac( :,m) * &4680 rrtm_aldir(1) = SUM( surf_lsm_h%frac(m,:) * & 4679 4681 surf_lsm_h%rrtm_aldir(:,m) ) 4680 rrtm_aldif(1) = SUM( surf_lsm_h%frac( :,m) * &4682 rrtm_aldif(1) = SUM( surf_lsm_h%frac(m,:) * & 4681 4683 surf_lsm_h%rrtm_aldif(:,m) ) 4682 4684 ENDDO 4683 4685 DO m = surf_usm_h%start_index(j,i), & 4684 4686 surf_usm_h%end_index(j,i) 4685 rrtm_asdir(1) = SUM( surf_usm_h%frac( :,m) * &4687 rrtm_asdir(1) = SUM( surf_usm_h%frac(m,:) * & 4686 4688 surf_usm_h%rrtm_asdir(:,m) ) 4687 rrtm_asdif(1) = SUM( surf_usm_h%frac( :,m) * &4689 rrtm_asdif(1) = SUM( surf_usm_h%frac(m,:) * & 4688 4690 surf_usm_h%rrtm_asdif(:,m) ) 4689 rrtm_aldir(1) = SUM( surf_usm_h%frac( :,m) * &4691 rrtm_aldir(1) = SUM( surf_usm_h%frac(m,:) * & 4690 4692 surf_usm_h%rrtm_aldir(:,m) ) 4691 rrtm_aldif(1) = SUM( surf_usm_h%frac( :,m) * &4693 rrtm_aldif(1) = SUM( surf_usm_h%frac(m,:) * & 4692 4694 surf_usm_h%rrtm_aldif(:,m) ) 4693 4695 ENDDO … … 4989 4991 ! 4990 4992 !-- Ocean 4991 IF ( surf%albedo_type( ind_type,m) == 1 ) THEN4992 surf%rrtm_aldir( ind_type,m) = 0.026_wp / &4993 IF ( surf%albedo_type(m,ind_type) == 1 ) THEN 4994 surf%rrtm_aldir(m,ind_type) = 0.026_wp / & 4993 4995 ( cos_zenith**1.7_wp + 0.065_wp )& 4994 4996 + 0.15_wp * ( cos_zenith - 0.1_wp ) & 4995 4997 * ( cos_zenith - 0.5_wp ) & 4996 4998 * ( cos_zenith - 1.0_wp ) 4997 surf%rrtm_asdir( ind_type,m) = surf%rrtm_aldir(ind_type,m)4999 surf%rrtm_asdir(m,ind_type) = surf%rrtm_aldir(m,ind_type) 4998 5000 ! 4999 5001 !-- Snow 5000 ELSEIF ( surf%albedo_type( ind_type,m) == 16 ) THEN5002 ELSEIF ( surf%albedo_type(m,ind_type) == 16 ) THEN 5001 5003 IF ( cos_zenith < 0.5_wp ) THEN 5002 surf%rrtm_aldir( ind_type,m) = &5003 0.5_wp * ( 1.0_wp - surf%aldif(i nd_type,m) ) &5004 surf%rrtm_aldir(m,ind_type) = & 5005 0.5_wp * ( 1.0_wp - surf%aldif(im,ind_type) ) & 5004 5006 * ( ( 3.0_wp / ( 1.0_wp + 4.0_wp & 5005 5007 * cos_zenith ) ) - 1.0_wp ) 5006 surf%rrtm_asdir( ind_type,m) = &5007 0.5_wp * ( 1.0_wp - surf%asdif( ind_type,m) ) &5008 surf%rrtm_asdir(m,ind_type) = & 5009 0.5_wp * ( 1.0_wp - surf%asdif(m,ind_type) ) & 5008 5010 * ( ( 3.0_wp / ( 1.0_wp + 4.0_wp & 5009 5011 * cos_zenith ) ) - 1.0_wp ) 5010 5012 5011 surf%rrtm_aldir( ind_type,m) = &5012 MIN(0.98_wp, surf%rrtm_aldir( ind_type,m))5013 surf%rrtm_asdir( ind_type,m) = &5014 MIN(0.98_wp, surf%rrtm_asdir( ind_type,m))5013 surf%rrtm_aldir(m,ind_type) = & 5014 MIN(0.98_wp, surf%rrtm_aldir(m,ind_type)) 5015 surf%rrtm_asdir(m,ind_type) = & 5016 MIN(0.98_wp, surf%rrtm_asdir(m,ind_type)) 5015 5017 ELSE 5016 surf%rrtm_aldir( ind_type,m) = surf%aldif(ind_type,m)5017 surf%rrtm_asdir( ind_type,m) = surf%asdif(ind_type,m)5018 surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) 5019 surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) 5018 5020 ENDIF 5019 5021 ! 5020 5022 !-- Sea ice 5021 ELSEIF ( surf%albedo_type( ind_type,m) == 15 ) THEN5022 surf%rrtm_aldir( ind_type,m) = surf%aldif(ind_type,m)5023 surf%rrtm_asdir( ind_type,m) = surf%asdif(ind_type,m)5023 ELSEIF ( surf%albedo_type(m,ind_type) == 15 ) THEN 5024 surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) 5025 surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) 5024 5026 5025 5027 ! 5026 5028 !-- Asphalt 5027 ELSEIF ( surf%albedo_type( ind_type,m) == 17 ) THEN5028 surf%rrtm_aldir( ind_type,m) = surf%aldif(ind_type,m)5029 surf%rrtm_asdir( ind_type,m) = surf%asdif(ind_type,m)5029 ELSEIF ( surf%albedo_type(m,ind_type) == 17 ) THEN 5030 surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) 5031 surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) 5030 5032 5031 5033 5032 5034 ! 5033 5035 !-- Bare soil 5034 ELSEIF ( surf%albedo_type( ind_type,m) == 18 ) THEN5035 surf%rrtm_aldir( ind_type,m) = surf%aldif(ind_type,m)5036 surf%rrtm_asdir( ind_type,m) = surf%asdif(ind_type,m)5036 ELSEIF ( surf%albedo_type(m,ind_type) == 18 ) THEN 5037 surf%rrtm_aldir(m,ind_type) = surf%aldif(m,ind_type) 5038 surf%rrtm_asdir(m,ind_type) = surf%asdif(m,ind_type) 5037 5039 5038 5040 ! 5039 5041 !-- Land surfaces 5040 5042 ELSE 5041 SELECT CASE ( surf%albedo_type( ind_type,m) )5043 SELECT CASE ( surf%albedo_type(m,ind_type) ) 5042 5044 5043 5045 ! 5044 5046 !-- Surface types with strong zenith dependence 5045 5047 CASE ( 1, 2, 3, 4, 11, 12, 13 ) 5046 surf%rrtm_aldir( ind_type,m) = &5047 surf%aldif( ind_type,m) * 1.4_wp / &5048 surf%rrtm_aldir(m,ind_type) = & 5049 surf%aldif(m,ind_type) * 1.4_wp / & 5048 5050 ( 1.0_wp + 0.8_wp * cos_zenith ) 5049 surf%rrtm_asdir( ind_type,m) = &5050 surf%asdif( ind_type,m) * 1.4_wp / &5051 surf%rrtm_asdir(m,ind_type) = & 5052 surf%asdif(m,ind_type) * 1.4_wp / & 5051 5053 ( 1.0_wp + 0.8_wp * cos_zenith ) 5052 5054 ! 5053 5055 !-- Surface types with weak zenith dependence 5054 5056 CASE ( 5, 6, 7, 8, 9, 10, 14 ) 5055 surf%rrtm_aldir( ind_type,m) = &5056 surf%aldif( ind_type,m) * 1.1_wp / &5057 surf%rrtm_aldir(m,ind_type) = & 5058 surf%aldif(m,ind_type) * 1.1_wp / & 5057 5059 ( 1.0_wp + 0.2_wp * cos_zenith ) 5058 surf%rrtm_asdir( ind_type,m) = &5059 surf%asdif( ind_type,m) * 1.1_wp / &5060 surf%rrtm_asdir(m,ind_type) = & 5061 surf%asdif(m,ind_type) * 1.1_wp / & 5060 5062 ( 1.0_wp + 0.2_wp * cos_zenith ) 5061 5063 … … 5066 5068 ! 5067 5069 !-- Diffusive albedo is taken from Table 2 5068 surf%rrtm_aldif( ind_type,m) = surf%aldif(ind_type,m)5069 surf%rrtm_asdif( ind_type,m) = surf%asdif(ind_type,m)5070 surf%rrtm_aldif(m,ind_type) = surf%aldif(m,ind_type) 5071 surf%rrtm_asdif(m,ind_type) = surf%asdif(m,ind_type) 5070 5072 ENDDO 5071 5073 ENDDO … … 5883 5885 DO i = nxl, nxr 5884 5886 DO j = nys, nyn 5885 !-- urban 5887 ! 5888 !-- urban 5886 5889 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 5887 surfoutll(mm) = SUM ( surf_usm_h%frac( :,m) * &5888 surf_usm_h%emissivity( :,m) ) &5890 surfoutll(mm) = SUM ( surf_usm_h%frac(m,:) * & 5891 surf_usm_h%emissivity(m,:) ) & 5889 5892 * sigma_sb & 5890 5893 * surf_usm_h%pt_surface(m)**4 5891 albedo_surf(mm) = SUM ( surf_usm_h%frac( :,m) * &5892 surf_usm_h%albedo( :,m) )5893 emiss_surf(mm) = SUM ( surf_usm_h%frac( :,m) * &5894 surf_usm_h%emissivity( :,m) )5894 albedo_surf(mm) = SUM ( surf_usm_h%frac(m,:) * & 5895 surf_usm_h%albedo(m,:) ) 5896 emiss_surf(mm) = SUM ( surf_usm_h%frac(m,:) * & 5897 surf_usm_h%emissivity(m,:) ) 5895 5898 mm = mm + 1 5896 5899 ENDDO 5897 !-- land 5900 ! 5901 !-- land 5898 5902 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 5899 surfoutll(mm) = SUM ( surf_lsm_h%frac( :,m) * &5900 surf_lsm_h%emissivity( :,m) ) &5903 surfoutll(mm) = SUM ( surf_lsm_h%frac(m,:) * & 5904 surf_lsm_h%emissivity(m,:) ) & 5901 5905 * sigma_sb & 5902 5906 * surf_lsm_h%pt_surface(m)**4 5903 albedo_surf(mm) = SUM ( surf_lsm_h%frac( :,m) * &5904 surf_lsm_h%albedo( :,m) )5905 emiss_surf(mm) = SUM ( surf_lsm_h%frac( :,m) * &5906 surf_lsm_h%emissivity( :,m) )5907 albedo_surf(mm) = SUM ( surf_lsm_h%frac(m,:) * & 5908 surf_lsm_h%albedo(m,:) ) 5909 emiss_surf(mm) = SUM ( surf_lsm_h%frac(m,:) * & 5910 surf_lsm_h%emissivity(m,:) ) 5907 5911 mm = mm + 1 5908 5912 ENDDO … … 5910 5914 ENDDO 5911 5915 ! 5912 !-- 5916 !-- Vertical walls 5913 5917 DO i = nxl, nxr 5914 5918 DO j = nys, nyn 5915 5919 DO ll = 0, 3 5916 5920 l = reorder(ll) 5917 !-- urban 5921 ! 5922 !-- urban 5918 5923 DO m = surf_usm_v(l)%start_index(j,i), & 5919 5924 surf_usm_v(l)%end_index(j,i) 5920 surfoutll(mm) = SUM ( surf_usm_v(l)%frac( :,m) * &5921 surf_usm_v(l)%emissivity( :,m) ) &5925 surfoutll(mm) = SUM ( surf_usm_v(l)%frac(m,:) * & 5926 surf_usm_v(l)%emissivity(m,:) ) & 5922 5927 * sigma_sb & 5923 5928 * surf_usm_v(l)%pt_surface(m)**4 5924 albedo_surf(mm) = SUM ( surf_usm_v(l)%frac( :,m) * &5925 surf_usm_v(l)%albedo( :,m) )5926 emiss_surf(mm) = SUM ( surf_usm_v(l)%frac( :,m) * &5927 surf_usm_v(l)%emissivity( :,m) )5929 albedo_surf(mm) = SUM ( surf_usm_v(l)%frac(m,:) * & 5930 surf_usm_v(l)%albedo(m,:) ) 5931 emiss_surf(mm) = SUM ( surf_usm_v(l)%frac(m,:) * & 5932 surf_usm_v(l)%emissivity(m,:) ) 5928 5933 mm = mm + 1 5929 5934 ENDDO 5930 !-- land 5935 ! 5936 !-- land 5931 5937 DO m = surf_lsm_v(l)%start_index(j,i), & 5932 5938 surf_lsm_v(l)%end_index(j,i) 5933 surfoutll(mm) = SUM ( surf_lsm_v(l)%frac( :,m) * &5934 surf_lsm_v(l)%emissivity( :,m) ) &5939 surfoutll(mm) = SUM ( surf_lsm_v(l)%frac(m,:) * & 5940 surf_lsm_v(l)%emissivity(m,:) ) & 5935 5941 * sigma_sb & 5936 5942 * surf_lsm_v(l)%pt_surface(m)**4 5937 albedo_surf(mm) = SUM ( surf_lsm_v(l)%frac( :,m) * &5938 surf_lsm_v(l)%albedo( :,m) )5939 emiss_surf(mm) = SUM ( surf_lsm_v(l)%frac( :,m) * &5940 surf_lsm_v(l)%emissivity( :,m) )5943 albedo_surf(mm) = SUM ( surf_lsm_v(l)%frac(m,:) * & 5944 surf_lsm_v(l)%albedo(m,:) ) 5945 emiss_surf(mm) = SUM ( surf_lsm_v(l)%frac(m,:) * & 5946 surf_lsm_v(l)%emissivity(m,:) ) 5941 5947 mm = mm + 1 5942 5948 ENDDO … … 5945 5951 ENDDO 5946 5952 5947 IF ( trace_fluxes_above >= 0. _wp ) THEN5953 IF ( trace_fluxes_above >= 0.0_wp ) THEN 5948 5954 CALL radiation_print_debug_surf( 'surfoutll before initial pass', surfoutll ) 5949 5955 CALL radiation_print_debug_horz( 'rad_lw_in_diff before initial pass', rad_lw_in_diff ) … … 6008 6014 j = FLOOR(ACOS(cos_zenith) / pi * raytrace_discrete_elevs) 6009 6015 i = MODULO(NINT(ATAN2(sun_dir_lon, sun_dir_lat) & 6010 / (2. _wp*pi) * raytrace_discrete_azims-.5_wp, iwp), &6016 / (2.0_wp*pi) * raytrace_discrete_azims-0.5_wp, iwp), & 6011 6017 raytrace_discrete_azims) 6012 6018 isd = dsidir_rev(j, i) … … 6024 6030 i = mrtbl(ix, imrt) 6025 6031 mrtinsw(imrt) = mrtinsw(imrt) + mrtdsit(imrt, isd) * rad_sw_in_dir(j,i) & 6026 / cos_zenith / 4. _wp ! normal to sphere6032 / cos_zenith / 4.0_wp ! normal to sphere 6027 6033 ENDDO 6028 6034 ENDIF … … 6039 6045 IF ( npcbl > 0 ) THEN 6040 6046 6041 pcbinswdir(:) = 0. _wp6042 pcbinswdif(:) = 0. _wp6043 pcbinlw(:) = 0. _wp6047 pcbinswdir(:) = 0.0_wp 6048 pcbinswdif(:) = 0.0_wp 6049 pcbinlw(:) = 0.0_wp 6044 6050 6045 6051 DO icsf = 1, ncsfl … … 6065 6071 IF ( cos_zenith > 0 ) THEN 6066 6072 !-- Estimate directed box absorption 6067 pc_abs_frac = 1. _wp - exp(pc_abs_eff * lad_s(k,j,i))6073 pc_abs_frac = 1.0_wp - exp(pc_abs_eff * lad_s(k,j,i)) 6068 6074 ! 6069 6075 !-- isd has already been established, see 1) … … 6091 6097 ENDIF 6092 6098 6093 IF ( trace_fluxes_above >= 0. _wp ) THEN6099 IF ( trace_fluxes_above >= 0.0_wp ) THEN 6094 6100 CALL radiation_print_debug_surf( 'surfinl after initial pass', surfinl ) 6095 6101 CALL radiation_print_debug_surf( 'surfinlwdif after initial pass', surfinlwdif ) … … 6118 6124 ENDIF 6119 6125 6120 IF ( trace_fluxes_above >= 0. _wp ) THEN6126 IF ( trace_fluxes_above >= 0.0_wp ) THEN 6121 6127 CALL radiation_print_debug_surf( 'surfinl after PC emiss', surfinl ) 6122 6128 ENDIF … … 6135 6141 nrefsteps = 0 6136 6142 surfoutsl = albedo_surf * surfins 6137 surfoutll = (1. _wp - emiss_surf) * surfinl6143 surfoutll = (1.0_wp - emiss_surf) * surfinl 6138 6144 surfoutsw = surfoutsw + surfoutsl 6139 6145 surfoutlw = surfoutlw + surfoutll … … 6148 6154 ! 6149 6155 !-- for non-transparent surfaces, longwave albedo is 1 - emissivity 6150 surfoutll = (1. _wp - emiss_surf) * surfinl6151 6152 IF ( trace_fluxes_above >= 0. _wp ) THEN6156 surfoutll = (1.0_wp - emiss_surf) * surfinl 6157 6158 IF ( trace_fluxes_above >= 0.0_wp ) THEN 6153 6159 CALL radiation_print_debug_surf( 'surfoutll before reflective pass', surfoutll, refstep ) 6154 6160 CALL radiation_print_debug_surf( 'surfoutsl before reflective pass', surfoutsl, refstep ) … … 6178 6184 ! 6179 6185 !-- Reset for the input from next reflective pass 6180 surfins = 0. _wp6181 surfinl = 0. _wp6186 surfins = 0.0_wp 6187 surfinl = 0.00_wp 6182 6188 ! 6183 6189 !-- Reflected radiation … … 6222 6228 ENDDO 6223 6229 6224 IF ( trace_fluxes_above >= 0. _wp ) THEN6230 IF ( trace_fluxes_above >= 0.0_wp ) THEN 6225 6231 CALL radiation_print_debug_surf( 'surfinl after reflected pass', surfinl, refstep ) 6226 6232 CALL radiation_print_debug_surf( 'surfins after reflected pass', surfins, refstep ) … … 6268 6274 IF ( nmrtbl > 0 ) THEN 6269 6275 IF ( mrt_include_sw ) THEN 6270 mrt(:) = ((mrtinsw(:) + mrtinlw(:)) / sigma_sb) ** .25_wp6276 mrt(:) = ((mrtinsw(:) + mrtinlw(:)) / sigma_sb) ** 0.25_wp 6271 6277 ELSE 6272 mrt(:) = (mrtinlw(:) / sigma_sb) ** .25_wp6278 mrt(:) = (mrtinlw(:) / sigma_sb) ** 0.25_wp 6273 6279 ENDIF 6274 6280 ENDIF -
palm/trunk/SOURCE/salsa_mod.f90
r4417 r4441 21 21 ! Current revisions: 22 22 ! ----------------- 23 ! 23 ! Change order of dimension in surface array %frac to allow for better 24 ! vectorization. 24 25 ! 25 26 ! Former revisions: … … 2712 2713 ! 2713 2714 !-- Vegetation (LSM): 2714 IF ( surf%frac( ind_veg_wall,m) > 0 ) THEN2715 IF ( surf%frac(m,ind_veg_wall) > 0 ) THEN 2715 2716 veg_type_palm = surf%vegetation_type(m) 2716 2717 SELECT CASE ( veg_type_palm ) … … 2758 2759 ! 2759 2760 !-- Pavement (LSM): 2760 IF ( surf%frac( ind_pav_green,m) > 0 ) THEN2761 IF ( surf%frac(m,ind_pav_green) > 0 ) THEN 2761 2762 pav_type_palm = surf%pavement_type(m) 2762 2763 IF ( pav_type_palm == 0 ) THEN ! error … … 2769 2770 ! 2770 2771 !-- Water (LSM): 2771 IF ( surf%frac( ind_wat_win,m) > 0 ) THEN2772 IF ( surf%frac(m,ind_wat_win) > 0 ) THEN 2772 2773 wat_type_palm = surf%water_type(m) 2773 2774 IF ( wat_type_palm == 0 ) THEN ! error … … 2784 2785 ! 2785 2786 !-- Wall surfaces (USM): 2786 IF ( surf%frac( ind_veg_wall,m) > 0 ) THEN2787 IF ( surf%frac(m,ind_veg_wall) > 0 ) THEN 2787 2788 match_veg_wall(m) = 15 ! urban in Z01 2788 2789 ENDIF 2789 2790 ! 2790 2791 !-- Green walls and roofs (USM): 2791 IF ( surf%frac( ind_pav_green,m) > 0 ) THEN2792 IF ( surf%frac(m,ind_pav_green) > 0 ) THEN 2792 2793 match_pav_green(m) = 6 ! (short) grass in Z01 2793 2794 ENDIF 2794 2795 ! 2795 2796 !-- Windows (USM): 2796 IF ( surf%frac( ind_wat_win,m) > 0 ) THEN2797 IF ( surf%frac(m,ind_wat_win) > 0 ) THEN 2797 2798 match_wat_win(m) = 15 ! urban in Z01 2798 2799 ENDIF … … 4386 4387 END SELECT 4387 4388 ENDDO 4388 depo_sum = depo_sum + surf%frac( ind_pav_green,m) * depo4389 depo_sum = depo_sum + surf%frac(m,ind_pav_green) * depo 4389 4390 ENDIF 4390 4391 … … 4417 4418 END SELECT 4418 4419 ENDDO 4419 depo_sum = depo_sum + surf%frac( ind_veg_wall,m) * depo4420 depo_sum = depo_sum + surf%frac(m,ind_veg_wall) * depo 4420 4421 ENDIF 4421 4422 … … 4448 4449 END SELECT 4449 4450 ENDDO 4450 depo_sum = depo_sum + surf%frac( ind_wat_win,m) * depo4451 depo_sum = depo_sum + surf%frac(m,ind_wat_win) * depo 4451 4452 ENDIF 4452 4453 -
palm/trunk/SOURCE/sum_up_3d_data.f90
r4360 r4441 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Change order of dimension in surface array %frac to allow for better 23 ! vectorization. 23 24 ! 24 25 ! Former revisions: … … 371 372 m = surf_usm_h%end_index(j,i) 372 373 ghf_av(j,i) = ghf_av(j,i) + & 373 surf_usm_h%frac( ind_veg_wall,m) * &374 surf_usm_h%frac(m,ind_veg_wall) * & 374 375 surf_usm_h%wghf_eb(m) + & 375 surf_usm_h%frac( ind_pav_green,m) * &376 surf_usm_h%frac(m,ind_pav_green) * & 376 377 surf_usm_h%wghf_eb_green(m) + & 377 surf_usm_h%frac( ind_wat_win,m) * &378 surf_usm_h%frac(m,ind_wat_win) * & 378 379 surf_usm_h%wghf_eb_window(m) 379 380 ENDIF … … 644 645 m = surf_usm_h%end_index(j,i) 645 646 r_a_av(j,i) = r_a_av(j,i) + & 646 surf_usm_h%frac( ind_veg_wall,m) * &647 surf_usm_h%frac(m,ind_veg_wall) * & 647 648 surf_usm_h%r_a(m) + & 648 surf_usm_h%frac( ind_pav_green,m) * &649 surf_usm_h%frac(m,ind_pav_green) * & 649 650 surf_usm_h%r_a_green(m) + & 650 surf_usm_h%frac( ind_wat_win,m) * &651 surf_usm_h%frac(m,ind_wat_win) * & 651 652 surf_usm_h%r_a_window(m) 652 653 ENDIF -
palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90
r4440 r4441 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Set back turbulent length scale to 8 x grid spacing in the parametrized mode 23 ! (was accidantly changed). 23 24 ! 24 25 ! Former revisions: … … 811 812 !-- Define length scale for the imposed turbulence, which is defined as 812 813 !-- 8 times the minimum grid spacing 813 length_scale = 30.0_wp * MIN( dx, dy, MINVAL( dzw ) ) !8.0_wp * MIN( dx, dy, MINVAL( dzw ) )814 length_scale = 8.0_wp * MIN( dx, dy, MINVAL( dzw ) ) 814 815 ! 815 816 !-- Define constant to gradually decrease length scales and Reynolds stress -
palm/trunk/SOURCE/urban_surface_mod.f90
r4392 r4441 23 23 ! Current revisions: 24 24 ! ------------------ 25 ! 25 ! Change order of dimension in surface arrays %frac, %emissivity and %albedo 26 ! to allow for better vectorization in the radiation interactions. 26 27 ! 27 28 ! Former revisions: … … 800 801 !-- Allocate albedo_type and albedo. Each surface element 801 802 !-- has 3 values, 0: wall fraction, 1: green fraction, 2: window fraction. 802 ALLOCATE ( surf_usm_h%albedo_type( 0:2,1:surf_usm_h%ns) )803 ALLOCATE ( surf_usm_h%albedo( 0:2,1:surf_usm_h%ns) )803 ALLOCATE ( surf_usm_h%albedo_type(1:surf_usm_h%ns,0:2) ) 804 ALLOCATE ( surf_usm_h%albedo(1:surf_usm_h%ns,0:2) ) 804 805 surf_usm_h%albedo_type = albedo_type 805 806 DO l = 0, 3 806 ALLOCATE ( surf_usm_v(l)%albedo_type( 0:2,1:surf_usm_v(l)%ns) )807 ALLOCATE ( surf_usm_v(l)%albedo( 0:2,1:surf_usm_v(l)%ns) )807 ALLOCATE ( surf_usm_v(l)%albedo_type(1:surf_usm_v(l)%ns,0:2) ) 808 ALLOCATE ( surf_usm_v(l)%albedo(1:surf_usm_v(l)%ns,0:2) ) 808 809 surf_usm_v(l)%albedo_type = albedo_type 809 810 ENDDO … … 837 838 !-- Allocate arrays for relative surface fraction. 838 839 !-- 0 - wall fraction, 1 - green fraction, 2 - window fraction 839 ALLOCATE ( surf_usm_h%frac( 0:2,1:surf_usm_h%ns) )840 ALLOCATE ( surf_usm_h%frac(1:surf_usm_h%ns,0:2) ) 840 841 surf_usm_h%frac = 0.0_wp 841 842 DO l = 0, 3 842 ALLOCATE ( surf_usm_v(l)%frac( 0:2,1:surf_usm_v(l)%ns) )843 ALLOCATE ( surf_usm_v(l)%frac(1:surf_usm_v(l)%ns,0:2) ) 843 844 surf_usm_v(l)%frac = 0.0_wp 844 845 ENDDO … … 855 856 ALLOCATE ( surf_usm_h%transmissivity(1:surf_usm_h%ns) ) 856 857 ALLOCATE ( surf_usm_h%lai(1:surf_usm_h%ns) ) 857 ALLOCATE ( surf_usm_h%emissivity( 0:2,1:surf_usm_h%ns) )858 ALLOCATE ( surf_usm_h%emissivity(1:surf_usm_h%ns,0:2) ) 858 859 ALLOCATE ( surf_usm_h%r_a(1:surf_usm_h%ns) ) 859 860 ALLOCATE ( surf_usm_h%r_a_green(1:surf_usm_h%ns) ) … … 873 874 ALLOCATE ( surf_usm_v(l)%transmissivity(1:surf_usm_v(l)%ns) ) 874 875 ALLOCATE ( surf_usm_v(l)%lai(1:surf_usm_v(l)%ns) ) 875 ALLOCATE ( surf_usm_v(l)%emissivity( 0:2,1:surf_usm_v(l)%ns) )876 ALLOCATE ( surf_usm_v(l)%emissivity(1:surf_usm_v(l)%ns,0:2) ) 876 877 ALLOCATE ( surf_usm_v(l)%r_a(1:surf_usm_v(l)%ns) ) 877 878 ALLOCATE ( surf_usm_v(l)%r_a_green(1:surf_usm_v(l)%ns) ) … … 3616 3617 ! 3617 3618 !-- Initialize relatvie wall- (0), green- (1) and window (2) fractions 3618 surf_usm_h%frac( ind_veg_wall,m) = building_pars(ind_wall_frac_r,building_type)3619 surf_usm_h%frac( ind_pav_green,m) = building_pars(ind_green_frac_r,building_type)3620 surf_usm_h%frac( ind_wat_win,m) = building_pars(ind_win_frac_r,building_type)3619 surf_usm_h%frac(m,ind_veg_wall) = building_pars(ind_wall_frac_r,building_type) 3620 surf_usm_h%frac(m,ind_pav_green) = building_pars(ind_green_frac_r,building_type) 3621 surf_usm_h%frac(m,ind_wat_win) = building_pars(ind_win_frac_r,building_type) 3621 3622 surf_usm_h%lai(m) = building_pars(ind_lai_r,building_type) 3622 3623 … … 3650 3651 ! 3651 3652 !-- emissivity of wall-, green- and window fraction 3652 surf_usm_h%emissivity( ind_veg_wall,m) = building_pars(ind_emis_wall_r,building_type)3653 surf_usm_h%emissivity( ind_pav_green,m) = building_pars(ind_emis_green_r,building_type)3654 surf_usm_h%emissivity( ind_wat_win,m) = building_pars(ind_emis_win_r,building_type)3653 surf_usm_h%emissivity(m,ind_veg_wall) = building_pars(ind_emis_wall_r,building_type) 3654 surf_usm_h%emissivity(m,ind_pav_green) = building_pars(ind_emis_green_r,building_type) 3655 surf_usm_h%emissivity(m,ind_wat_win) = building_pars(ind_emis_win_r,building_type) 3655 3656 3656 3657 surf_usm_h%transmissivity(m) = building_pars(ind_trans_r,building_type) … … 3661 3662 ! 3662 3663 !-- albedo type for wall fraction, green fraction, window fraction 3663 surf_usm_h%albedo_type( ind_veg_wall,m) = INT( building_pars(ind_alb_wall_r,building_type) )3664 surf_usm_h%albedo_type( ind_pav_green,m) = INT( building_pars(ind_alb_green_r,building_type) )3665 surf_usm_h%albedo_type( ind_wat_win,m) = INT( building_pars(ind_alb_win_r,building_type) )3664 surf_usm_h%albedo_type(m,ind_veg_wall) = INT( building_pars(ind_alb_wall_r,building_type) ) 3665 surf_usm_h%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green_r,building_type) ) 3666 surf_usm_h%albedo_type(m,ind_wat_win) = INT( building_pars(ind_alb_win_r,building_type) ) 3666 3667 3667 3668 surf_usm_h%zw(nzb_wall,m) = building_pars(ind_thick_1_wall_r,building_type) … … 3774 3775 ! 3775 3776 !-- Initialize relatvie wall- (0), green- (1) and window (2) fractions 3776 surf_usm_v(l)%frac( ind_veg_wall,m) = building_pars(ind_wall_frac,building_type)3777 surf_usm_v(l)%frac( ind_pav_green,m) = building_pars(ind_green_frac_w,building_type)3778 surf_usm_v(l)%frac( ind_wat_win,m) = building_pars(ind_win_frac,building_type)3777 surf_usm_v(l)%frac(m,ind_veg_wall) = building_pars(ind_wall_frac,building_type) 3778 surf_usm_v(l)%frac(m,ind_pav_green) = building_pars(ind_green_frac_w,building_type) 3779 surf_usm_v(l)%frac(m,ind_wat_win) = building_pars(ind_win_frac,building_type) 3779 3780 surf_usm_v(l)%lai(m) = building_pars(ind_lai_w,building_type) 3780 3781 … … 3813 3814 ! 3814 3815 !-- emissivity of wall-, green- and window fraction 3815 surf_usm_v(l)%emissivity( ind_veg_wall,m) = building_pars(ind_emis_wall,building_type)3816 surf_usm_v(l)%emissivity( ind_pav_green,m) = building_pars(ind_emis_green,building_type)3817 surf_usm_v(l)%emissivity( ind_wat_win,m) = building_pars(ind_emis_win,building_type)3816 surf_usm_v(l)%emissivity(m,ind_veg_wall) = building_pars(ind_emis_wall,building_type) 3817 surf_usm_v(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green,building_type) 3818 surf_usm_v(l)%emissivity(m,ind_wat_win) = building_pars(ind_emis_win,building_type) 3818 3819 3819 3820 surf_usm_v(l)%transmissivity(m) = building_pars(ind_trans,building_type) … … 3823 3824 surf_usm_v(l)%z0q(m) = building_pars(ind_z0qh,building_type) 3824 3825 3825 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = INT( building_pars(ind_alb_wall,building_type) )3826 surf_usm_v(l)%albedo_type( ind_pav_green,m) = INT( building_pars(ind_alb_green,building_type) )3827 surf_usm_v(l)%albedo_type( ind_wat_win,m) = INT( building_pars(ind_alb_win,building_type) )3826 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = INT( building_pars(ind_alb_wall,building_type) ) 3827 surf_usm_v(l)%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green,building_type) ) 3828 surf_usm_v(l)%albedo_type(m,ind_wat_win) = INT( building_pars(ind_alb_win,building_type) ) 3828 3829 3829 3830 surf_usm_v(l)%zw(nzb_wall,m) = building_pars(ind_thick_1,building_type) … … 3880 3881 ! 3881 3882 !-- Initialize relatvie wall- (0), green- (1) and window (2) fractions 3882 surf_usm_h%frac( ind_veg_wall,m) = building_pars(ind_wall_frac_r,st)3883 surf_usm_h%frac( ind_pav_green,m) = building_pars(ind_green_frac_r,st)3884 surf_usm_h%frac( ind_wat_win,m) = building_pars(ind_win_frac_r,st)3883 surf_usm_h%frac(m,ind_veg_wall) = building_pars(ind_wall_frac_r,st) 3884 surf_usm_h%frac(m,ind_pav_green) = building_pars(ind_green_frac_r,st) 3885 surf_usm_h%frac(m,ind_wat_win) = building_pars(ind_win_frac_r,st) 3885 3886 surf_usm_h%lai(m) = building_pars(ind_lai_r,st) 3886 3887 … … 3916 3917 ! 3917 3918 !-- emissivity of wall-, green- and window fraction 3918 surf_usm_h%emissivity( ind_veg_wall,m) = building_pars(ind_emis_wall_r,st)3919 surf_usm_h%emissivity( ind_pav_green,m) = building_pars(ind_emis_green_r,st)3920 surf_usm_h%emissivity( ind_wat_win,m) = building_pars(ind_emis_win_r,st)3919 surf_usm_h%emissivity(m,ind_veg_wall) = building_pars(ind_emis_wall_r,st) 3920 surf_usm_h%emissivity(m,ind_pav_green) = building_pars(ind_emis_green_r,st) 3921 surf_usm_h%emissivity(m,ind_wat_win) = building_pars(ind_emis_win_r,st) 3921 3922 3922 3923 surf_usm_h%transmissivity(m) = building_pars(ind_trans_r,st) … … 3927 3928 ! 3928 3929 !-- albedo type for wall fraction, green fraction, window fraction 3929 surf_usm_h%albedo_type( ind_veg_wall,m) = INT( building_pars(ind_alb_wall_r,st) )3930 surf_usm_h%albedo_type( ind_pav_green,m) = INT( building_pars(ind_alb_green_r,st) )3931 surf_usm_h%albedo_type( ind_wat_win,m) = INT( building_pars(ind_alb_win_r,st) )3930 surf_usm_h%albedo_type(m,ind_veg_wall) = INT( building_pars(ind_alb_wall_r,st) ) 3931 surf_usm_h%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green_r,st) ) 3932 surf_usm_h%albedo_type(m,ind_wat_win) = INT( building_pars(ind_alb_win_r,st) ) 3932 3933 3933 3934 surf_usm_h%zw(nzb_wall,m) = building_pars(ind_thick_1_wall_r,st) … … 4047 4048 ! 4048 4049 !-- Initialize relatvie wall- (0), green- (1) and window (2) fractions 4049 surf_usm_v(l)%frac( ind_veg_wall,m) = building_pars(ind_wall_frac,st)4050 surf_usm_v(l)%frac( ind_pav_green,m) = building_pars(ind_green_frac_w,st)4051 surf_usm_v(l)%frac( ind_wat_win,m) = building_pars(ind_win_frac,st)4050 surf_usm_v(l)%frac(m,ind_veg_wall) = building_pars(ind_wall_frac,st) 4051 surf_usm_v(l)%frac(m,ind_pav_green) = building_pars(ind_green_frac_w,st) 4052 surf_usm_v(l)%frac(m,ind_wat_win) = building_pars(ind_win_frac,st) 4052 4053 surf_usm_v(l)%lai(m) = building_pars(ind_lai_w,st) 4053 4054 … … 4086 4087 ! 4087 4088 !-- emissivity of wall-, green- and window fraction 4088 surf_usm_v(l)%emissivity( ind_veg_wall,m) = building_pars(ind_emis_wall,st)4089 surf_usm_v(l)%emissivity( ind_pav_green,m) = building_pars(ind_emis_green,st)4090 surf_usm_v(l)%emissivity( ind_wat_win,m) = building_pars(ind_emis_win,st)4089 surf_usm_v(l)%emissivity(m,ind_veg_wall) = building_pars(ind_emis_wall,st) 4090 surf_usm_v(l)%emissivity(m,ind_pav_green) = building_pars(ind_emis_green,st) 4091 surf_usm_v(l)%emissivity(m,ind_wat_win) = building_pars(ind_emis_win,st) 4091 4092 4092 4093 surf_usm_v(l)%transmissivity(m) = building_pars(ind_trans,st) … … 4096 4097 surf_usm_v(l)%z0q(m) = building_pars(ind_z0qh,st) 4097 4098 4098 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = INT( building_pars(ind_alb_wall,st) )4099 surf_usm_v(l)%albedo_type( ind_pav_green,m) = INT( building_pars(ind_alb_green,st) )4100 surf_usm_v(l)%albedo_type( ind_wat_win,m) = INT( building_pars(ind_alb_win,st) )4099 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = INT( building_pars(ind_alb_wall,st) ) 4100 surf_usm_v(l)%albedo_type(m,ind_pav_green) = INT( building_pars(ind_alb_green,st) ) 4101 surf_usm_v(l)%albedo_type(m,ind_wat_win) = INT( building_pars(ind_alb_win,st) ) 4101 4102 4102 4103 surf_usm_v(l)%zw(nzb_wall,m) = building_pars(ind_thick_1,st) … … 4193 4194 IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /= & 4194 4195 building_pars_f%fill ) & 4195 surf_usm_h%frac( ind_veg_wall,m) = &4196 surf_usm_h%frac(m,ind_veg_wall) = & 4196 4197 building_pars_f%pars_xy(ind_wall_frac,j,i) 4197 4198 4198 4199 IF ( building_pars_f%pars_xy(ind_green_frac_r,j,i) /= & 4199 4200 building_pars_f%fill ) & 4200 surf_usm_h%frac( ind_pav_green,m) = &4201 surf_usm_h%frac(m,ind_pav_green) = & 4201 4202 building_pars_f%pars_xy(ind_green_frac_r,j,i) 4202 4203 4203 4204 IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /= & 4204 4205 building_pars_f%fill ) & 4205 surf_usm_h%frac( ind_wat_win,m) = &4206 surf_usm_h%frac(m,ind_wat_win) = & 4206 4207 building_pars_f%pars_xy(ind_win_frac,j,i) 4207 4208 … … 4325 4326 IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= & 4326 4327 building_pars_f%fill ) & 4327 surf_usm_h%emissivity( ind_veg_wall,m) = &4328 surf_usm_h%emissivity(m,ind_veg_wall) = & 4328 4329 building_pars_f%pars_xy(ind_emis_wall,j,i) 4329 4330 4330 4331 IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= & 4331 4332 building_pars_f%fill ) & 4332 surf_usm_h%emissivity( ind_pav_green,m) = &4333 surf_usm_h%emissivity(m,ind_pav_green) = & 4333 4334 building_pars_f%pars_xy(ind_emis_green,j,i) 4334 4335 4335 4336 IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= & 4336 4337 building_pars_f%fill ) & 4337 surf_usm_h%emissivity( ind_wat_win,m) = &4338 surf_usm_h%emissivity(m,ind_wat_win) = & 4338 4339 building_pars_f%pars_xy(ind_emis_win,j,i) 4339 4340 … … 4356 4357 IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /= & 4357 4358 building_pars_f%fill ) & 4358 surf_usm_h%albedo_type( ind_veg_wall,m) = &4359 surf_usm_h%albedo_type(m,ind_veg_wall) = & 4359 4360 building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) 4360 4361 4361 4362 IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /= & 4362 4363 building_pars_f%fill ) & 4363 surf_usm_h%albedo_type( ind_pav_green,m) = &4364 surf_usm_h%albedo_type(m,ind_pav_green) = & 4364 4365 building_pars_f%pars_xy(ind_alb_green_agfl,j,i) 4365 4366 IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /= & 4366 4367 building_pars_f%fill ) & 4367 surf_usm_h%albedo_type( ind_wat_win,m) = &4368 surf_usm_h%albedo_type(m,ind_wat_win) = & 4368 4369 building_pars_f%pars_xy(ind_alb_win_agfl,j,i) 4369 4370 … … 4481 4482 IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /= & 4482 4483 building_pars_f%fill ) & 4483 surf_usm_v(l)%frac( ind_veg_wall,m) = &4484 surf_usm_v(l)%frac(m,ind_veg_wall) = & 4484 4485 building_pars_f%pars_xy(ind_wall_frac,j,i) 4485 4486 4486 4487 IF ( building_pars_f%pars_xy(ind_green_frac_w,j,i) /= & 4487 4488 building_pars_f%fill ) & 4488 surf_usm_v(l)%frac( ind_pav_green,m) = &4489 surf_usm_v(l)%frac(m,ind_pav_green) = & 4489 4490 building_pars_f%pars_xy(ind_green_frac_w,j,i) 4490 4491 4491 4492 IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /= & 4492 4493 building_pars_f%fill ) & 4493 surf_usm_v(l)%frac( ind_wat_win,m) = &4494 surf_usm_v(l)%frac(m,ind_wat_win) = & 4494 4495 building_pars_f%pars_xy(ind_win_frac,j,i) 4495 4496 … … 4614 4615 IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= & 4615 4616 building_pars_f%fill ) & 4616 surf_usm_v(l)%emissivity( ind_veg_wall,m) = &4617 surf_usm_v(l)%emissivity(m,ind_veg_wall) = & 4617 4618 building_pars_f%pars_xy(ind_emis_wall,j,i) 4618 4619 4619 4620 IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= & 4620 4621 building_pars_f%fill ) & 4621 surf_usm_v(l)%emissivity( ind_pav_green,m) = &4622 surf_usm_v(l)%emissivity(m,ind_pav_green) = & 4622 4623 building_pars_f%pars_xy(ind_emis_green,j,i) 4623 4624 4624 4625 IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= & 4625 4626 building_pars_f%fill ) & 4626 surf_usm_v(l)%emissivity( ind_wat_win,m) = &4627 surf_usm_v(l)%emissivity(m,ind_wat_win) = & 4627 4628 building_pars_f%pars_xy(ind_emis_win,j,i) 4628 4629 … … 4647 4648 IF ( building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) /= & 4648 4649 building_pars_f%fill ) & 4649 surf_usm_v(l)%albedo_type( ind_veg_wall,m) = &4650 surf_usm_v(l)%albedo_type(m,ind_veg_wall) = & 4650 4651 building_pars_f%pars_xy(ind_alb_wall_agfl,j,i) 4651 4652 4652 4653 IF ( building_pars_f%pars_xy(ind_alb_green_agfl,j,i) /= & 4653 4654 building_pars_f%fill ) & 4654 surf_usm_v(l)%albedo_type( ind_pav_green,m) = &4655 surf_usm_v(l)%albedo_type(m,ind_pav_green) = & 4655 4656 building_pars_f%pars_xy(ind_alb_green_agfl,j,i) 4656 4657 IF ( building_pars_f%pars_xy(ind_alb_win_agfl,j,i) /= & 4657 4658 building_pars_f%fill ) & 4658 surf_usm_v(l)%albedo_type( ind_wat_win,m) = &4659 surf_usm_v(l)%albedo_type(m,ind_wat_win) = & 4659 4660 building_pars_f%pars_xy(ind_alb_win_agfl,j,i) 4660 4661 … … 4730 4731 IF ( building_surface_pars_f%pars(ind_s_wall_frac,is) /= & 4731 4732 building_surface_pars_f%fill ) & 4732 surf_usm_h%frac( ind_veg_wall,m) = &4733 surf_usm_h%frac(m,ind_veg_wall) = & 4733 4734 building_surface_pars_f%pars(ind_s_wall_frac,is) 4734 4735 4735 4736 IF ( building_surface_pars_f%pars(ind_s_green_frac_w,is) /= & 4736 4737 building_surface_pars_f%fill ) & 4737 surf_usm_h%frac( ind_pav_green,m) = &4738 surf_usm_h%frac(m,ind_pav_green) = & 4738 4739 building_surface_pars_f%pars(ind_s_green_frac_w,is) 4739 4740 4740 4741 IF ( building_surface_pars_f%pars(ind_s_green_frac_r,is) /= & 4741 4742 building_surface_pars_f%fill ) & 4742 surf_usm_h%frac( ind_pav_green,m) = &4743 surf_usm_h%frac(m,ind_pav_green) = & 4743 4744 building_surface_pars_f%pars(ind_s_green_frac_r,is) 4744 4745 !TODO clarify: why should _w and _r be on the same surface? … … 4746 4747 IF ( building_surface_pars_f%pars(ind_s_win_frac,is) /= & 4747 4748 building_surface_pars_f%fill ) & 4748 surf_usm_h%frac( ind_wat_win,m) = &4749 surf_usm_h%frac(m,ind_wat_win) = & 4749 4750 building_surface_pars_f%pars(ind_s_win_frac,is) 4750 4751 … … 4826 4827 IF ( building_surface_pars_f%pars(ind_s_emis_wall,is) /= & 4827 4828 building_surface_pars_f%fill ) & 4828 surf_usm_h%emissivity( ind_veg_wall,m) = &4829 surf_usm_h%emissivity(m,ind_veg_wall) = & 4829 4830 building_surface_pars_f%pars(ind_s_emis_wall,is) 4830 4831 4831 4832 IF ( building_surface_pars_f%pars(ind_s_emis_green,is) /= & 4832 4833 building_surface_pars_f%fill ) & 4833 surf_usm_h%emissivity( ind_pav_green,m) = &4834 surf_usm_h%emissivity(m,ind_pav_green) = & 4834 4835 building_surface_pars_f%pars(ind_s_emis_green,is) 4835 4836 4836 4837 IF ( building_surface_pars_f%pars(ind_s_emis_win,is) /= & 4837 4838 building_surface_pars_f%fill ) & 4838 surf_usm_h%emissivity( ind_wat_win,m) = &4839 surf_usm_h%emissivity(m,ind_wat_win) = & 4839 4840 building_surface_pars_f%pars(ind_s_emis_win,is) 4840 4841 … … 4877 4878 IF ( building_surface_pars_f%pars(ind_s_wall_frac,is) /= & 4878 4879 building_surface_pars_f%fill ) & 4879 surf_usm_v(l)%frac( ind_veg_wall,m) = &4880 surf_usm_v(l)%frac(m,ind_veg_wall) = & 4880 4881 building_surface_pars_f%pars(ind_s_wall_frac,is) 4881 4882 4882 4883 IF ( building_surface_pars_f%pars(ind_s_green_frac_w,is) /= & 4883 4884 building_surface_pars_f%fill ) & 4884 surf_usm_v(l)%frac( ind_pav_green,m) = &4885 surf_usm_v(l)%frac(m,ind_pav_green) = & 4885 4886 building_surface_pars_f%pars(ind_s_green_frac_w,is) 4886 4887 4887 4888 IF ( building_surface_pars_f%pars(ind_s_green_frac_r,is) /= & 4888 4889 building_surface_pars_f%fill ) & 4889 surf_usm_v(l)%frac( ind_pav_green,m) = &4890 surf_usm_v(l)%frac(m,ind_pav_green) = & 4890 4891 building_surface_pars_f%pars(ind_s_green_frac_r,is) 4891 4892 !TODO clarify: why should _w and _r be on the same surface? … … 4893 4894 IF ( building_surface_pars_f%pars(ind_s_win_frac,is) /= & 4894 4895 building_surface_pars_f%fill ) & 4895 surf_usm_v(l)%frac( ind_wat_win,m) = &4896 surf_usm_v(l)%frac(m,ind_wat_win) = & 4896 4897 building_surface_pars_f%pars(ind_s_win_frac,is) 4897 4898 … … 4973 4974 IF ( building_surface_pars_f%pars(ind_s_emis_wall,is) /= & 4974 4975 building_surface_pars_f%fill ) & 4975 surf_usm_v(l)%emissivity( ind_veg_wall,m) = &4976 surf_usm_v(l)%emissivity(m,ind_veg_wall) = & 4976 4977 building_surface_pars_f%pars(ind_s_emis_wall,is) 4977 4978 4978 4979 IF ( building_surface_pars_f%pars(ind_s_emis_green,is) /= & 4979 4980 building_surface_pars_f%fill ) & 4980 surf_usm_v(l)%emissivity( ind_pav_green,m) = &4981 surf_usm_v(l)%emissivity(m,ind_pav_green) = & 4981 4982 building_surface_pars_f%pars(ind_s_emis_green,is) 4982 4983 4983 4984 IF ( building_surface_pars_f%pars(ind_s_emis_win,is) /= & 4984 4985 building_surface_pars_f%fill ) & 4985 surf_usm_v(l)%emissivity( ind_wat_win,m) = &4986 surf_usm_v(l)%emissivity(m,ind_wat_win) = & 4986 4987 building_surface_pars_f%pars(ind_s_emis_win,is) 4987 4988 … … 5015 5016 relative_fractions_corrected = .FALSE. 5016 5017 DO m = 1, surf_usm_h%ns 5017 sum_frac = SUM( surf_usm_h%frac( :,m) )5018 sum_frac = SUM( surf_usm_h%frac(m,:) ) 5018 5019 IF ( sum_frac /= 1.0_wp ) THEN 5019 5020 relative_fractions_corrected = .TRUE. … … 5023 5024 !-- driver creation. 5024 5025 IF ( sum_frac /= 0.0_wp ) THEN 5025 surf_usm_h%frac( :,m) = surf_usm_h%frac(:,m) / sum_frac5026 surf_usm_h%frac(m,:) = surf_usm_h%frac(m,:) / sum_frac 5026 5027 ! 5027 5028 !-- In case all relative fractions are erroneously set to zero, 5028 5029 !-- set wall fraction to 1. 5029 5030 ELSE 5030 surf_usm_h%frac( ind_veg_wall,m) = 1.0_wp5031 surf_usm_h%frac( ind_wat_win,m) = 0.0_wp5032 surf_usm_h%frac( ind_pav_green,m) = 0.0_wp5031 surf_usm_h%frac(m,ind_veg_wall) = 1.0_wp 5032 surf_usm_h%frac(m,ind_wat_win) = 0.0_wp 5033 surf_usm_h%frac(m,ind_pav_green) = 0.0_wp 5033 5034 ENDIF 5034 5035 ENDIF … … 5051 5052 DO l = 0, 3 5052 5053 DO m = 1, surf_usm_v(l)%ns 5053 sum_frac = SUM( surf_usm_v(l)%frac( :,m) )5054 sum_frac = SUM( surf_usm_v(l)%frac(m,:) ) 5054 5055 IF ( sum_frac /= 1.0_wp ) THEN 5055 5056 relative_fractions_corrected = .TRUE. … … 5057 5058 !-- Normalize relative fractions to 1. 5058 5059 IF ( sum_frac /= 0.0_wp ) THEN 5059 surf_usm_v(l)%frac( :,m) = surf_usm_v(l)%frac(:,m) / sum_frac5060 surf_usm_v(l)%frac(m,:) = surf_usm_v(l)%frac(m,:) / sum_frac 5060 5061 ! 5061 5062 !-- In case all relative fractions are erroneously set to zero, 5062 5063 !-- set wall fraction to 1. 5063 5064 ELSE 5064 surf_usm_v(l)%frac( ind_veg_wall,m) = 1.0_wp5065 surf_usm_v(l)%frac( ind_wat_win,m) = 0.0_wp5066 surf_usm_v(l)%frac( ind_pav_green,m) = 0.0_wp5065 surf_usm_v(l)%frac(m,ind_veg_wall) = 1.0_wp 5066 surf_usm_v(l)%frac(m,ind_wat_win) = 0.0_wp 5067 surf_usm_v(l)%frac(m,ind_pav_green) = 0.0_wp 5067 5068 ENDIF 5068 5069 ENDIF … … 5367 5368 - t_wall_h(nzb_wall,m) ) * & 5368 5369 surf_usm_h%ddz_wall(nzb_wall+1,m) & 5369 + surf_usm_h%frac( ind_veg_wall,m) &5370 / (surf_usm_h%frac( ind_veg_wall,m) &5371 + surf_usm_h%frac( ind_pav_green,m) ) &5370 + surf_usm_h%frac(m,ind_veg_wall) & 5371 / (surf_usm_h%frac(m,ind_veg_wall) & 5372 + surf_usm_h%frac(m,ind_pav_green) ) & 5372 5373 * surf_usm_h%wghf_eb(m) & 5373 - surf_usm_h%frac( ind_pav_green,m) &5374 / (surf_usm_h%frac( ind_veg_wall,m) &5375 + surf_usm_h%frac( ind_pav_green,m) ) &5374 - surf_usm_h%frac(m,ind_pav_green) & 5375 / (surf_usm_h%frac(m,ind_veg_wall) & 5376 + surf_usm_h%frac(m,ind_pav_green) ) & 5376 5377 * ( surf_usm_h%lambda_h_green(nzt_wall,m)* wall_mod(nzt_wall) & 5377 5378 * surf_usm_h%ddz_green(nzt_wall,m) & … … 5550 5551 - t_wall_v(l)%t(nzb_wall,m) ) * & 5551 5552 surf_usm_v(l)%ddz_wall(nzb_wall+1,m) & 5552 + surf_usm_v(l)%frac( ind_veg_wall,m) &5553 / (surf_usm_v(l)%frac( ind_veg_wall,m) &5554 + surf_usm_v(l)%frac( ind_pav_green,m) ) &5553 + surf_usm_v(l)%frac(m,ind_veg_wall) & 5554 / (surf_usm_v(l)%frac(m,ind_veg_wall) & 5555 + surf_usm_v(l)%frac(m,ind_pav_green) ) & 5555 5556 * surf_usm_v(l)%wghf_eb(m) & 5556 - surf_usm_v(l)%frac( ind_pav_green,m) &5557 / (surf_usm_v(l)%frac( ind_veg_wall,m) &5558 + surf_usm_v(l)%frac( ind_pav_green,m) ) &5557 - surf_usm_v(l)%frac(m,ind_pav_green) & 5558 / (surf_usm_v(l)%frac(m,ind_veg_wall) & 5559 + surf_usm_v(l)%frac(m,ind_pav_green) ) & 5559 5560 * ( surf_usm_v(l)%lambda_h_green(nzt_wall,m)* wall_mod(nzt_wall) & 5560 5561 * surf_usm_v(l)%ddz_green(nzt_wall,m) & … … 5768 5769 !$OMP DO SCHEDULE (STATIC) 5769 5770 DO m = 1, surf_usm_h%ns 5770 IF (surf_usm_h%frac( ind_pav_green,m) > 0.0_wp) THEN5771 IF (surf_usm_h%frac(m,ind_pav_green) > 0.0_wp) THEN 5771 5772 ! 5772 5773 !-- Obtain indices … … 6020 6021 DO m = 1, surf_usm_v(l)%ns 6021 6022 6022 IF (surf_usm_v(l)%frac( ind_pav_green,m) > 0.0_wp) THEN6023 IF (surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp) THEN 6023 6024 ! 6024 6025 !-- no substrate layer for green walls / only groundbase green walls (ivy i.e.) -> green layers get same … … 7271 7272 ENDIF 7272 7273 7273 surf_usm_h%albedo( :,m) = -1.0_wp7274 surf_usm_h%albedo(m,:) = -1.0_wp 7274 7275 surf_usm_h%thickness_wall(m) = -1.0_wp 7275 7276 surf_usm_h%thickness_green(m) = -1.0_wp … … 7288 7289 ENDIF 7289 7290 surf_usm_h%surface_types(m) = usm_par(5,jw,iw) 7290 surf_usm_h%albedo( :,m) = usm_val(1,jw,iw)7291 surf_usm_h%albedo(m,:) = usm_val(1,jw,iw) 7291 7292 surf_usm_h%transmissivity(m) = 0.0_wp 7292 7293 ENDIF … … 7328 7329 ! 7329 7330 !-- Albedo 7330 IF ( surf_usm_h%albedo( ind_veg_wall,m) < 0.0_wp ) THEN7331 surf_usm_h%albedo( :,m) = surface_params(ialbedo,ip)7331 IF ( surf_usm_h%albedo(m,ind_veg_wall) < 0.0_wp ) THEN 7332 surf_usm_h%albedo(m,:) = surface_params(ialbedo,ip) 7332 7333 ENDIF 7333 7334 ! 7334 7335 !-- Albedo type is 0 (custom), others are replaced later 7335 surf_usm_h%albedo_type( :,m) = 07336 surf_usm_h%albedo_type(m,:) = 0 7336 7337 ! 7337 7338 !-- Transmissivity … … 7341 7342 ! 7342 7343 !-- emissivity of the wall 7343 surf_usm_h%emissivity( :,m) = surface_params(iemiss,ip)7344 surf_usm_h%emissivity(m,:) = surface_params(iemiss,ip) 7344 7345 ! 7345 7346 !-- heat conductivity λS between air and wall ( W mâ2 Kâ1 ) … … 7425 7426 surf_usm_v(l)%surface_types(m) = roof_category !< default category for wall surface in roof zone 7426 7427 END IF 7427 surf_usm_v(l)%albedo( :,m) = -1.0_wp7428 surf_usm_v(l)%albedo(m,:) = -1.0_wp 7428 7429 surf_usm_v(l)%thickness_wall(m) = -1.0_wp 7429 7430 surf_usm_v(l)%thickness_window(m) = -1.0_wp … … 7436 7437 surf_usm_v(l)%surface_types(m) = pedestrian_category !< default category for wall surface in 7437 7438 !<pedestrian zone 7438 surf_usm_v(l)%albedo( :,m) = -1.0_wp7439 surf_usm_v(l)%albedo(m,:) = -1.0_wp 7439 7440 surf_usm_v(l)%thickness_wall(m) = -1.0_wp 7440 7441 surf_usm_v(l)%thickness_window(m) = -1.0_wp … … 7443 7444 ELSE 7444 7445 surf_usm_v(l)%surface_types(m) = usm_par(ii+1,jw,iw) 7445 surf_usm_v(l)%albedo( :,m) = usm_val(ij,jw,iw)7446 surf_usm_v(l)%albedo(m,:) = usm_val(ij,jw,iw) 7446 7447 surf_usm_v(l)%thickness_wall(m) = usm_val(ij+1,jw,iw) 7447 7448 surf_usm_v(l)%thickness_window(m) = usm_val(ij+1,jw,iw) … … 7454 7455 IF ( usm_par(ii+3,jw,iw) == 0 ) THEN 7455 7456 surf_usm_v(l)%surface_types(m) = wall_category !< default category for wall surface 7456 surf_usm_v(l)%albedo( :,m) = -1.0_wp7457 surf_usm_v(l)%albedo(m,:) = -1.0_wp 7457 7458 surf_usm_v(l)%thickness_wall(m) = -1.0_wp 7458 7459 surf_usm_v(l)%thickness_window(m) = -1.0_wp … … 7461 7462 ELSE 7462 7463 surf_usm_v(l)%surface_types(m) = usm_par(ii+3,jw,iw) 7463 surf_usm_v(l)%albedo( :,m) = usm_val(ij+2,jw,iw)7464 surf_usm_v(l)%albedo(m,:) = usm_val(ij+2,jw,iw) 7464 7465 surf_usm_v(l)%thickness_wall(m) = usm_val(ij+3,jw,iw) 7465 7466 surf_usm_v(l)%thickness_window(m) = usm_val(ij+3,jw,iw) … … 7472 7473 IF ( usm_par(ii+5,jw,iw) == 0 ) THEN 7473 7474 surf_usm_v(l)%surface_types(m) = roof_category !< default category for roof surface 7474 surf_usm_v(l)%albedo( :,m) = -1.0_wp7475 surf_usm_v(l)%albedo(m,:) = -1.0_wp 7475 7476 surf_usm_v(l)%thickness_wall(m) = -1.0_wp 7476 7477 surf_usm_v(l)%thickness_window(m) = -1.0_wp … … 7479 7480 ELSE 7480 7481 surf_usm_v(l)%surface_types(m) = usm_par(ii+5,jw,iw) 7481 surf_usm_v(l)%albedo( :,m) = usm_val(ij+4,jw,iw)7482 surf_usm_v(l)%albedo(m,:) = usm_val(ij+4,jw,iw) 7482 7483 surf_usm_v(l)%thickness_wall(m) = usm_val(ij+5,jw,iw) 7483 7484 surf_usm_v(l)%thickness_window(m) = usm_val(ij+5,jw,iw) … … 7501 7502 surf_usm_v(l)%surface_types(m) = roof_category !< default category for wall surface in roof zone 7502 7503 END IF 7503 surf_usm_v(l)%albedo( :,m) = -1.0_wp7504 surf_usm_v(l)%albedo(m,:) = -1.0_wp 7504 7505 surf_usm_v(l)%thickness_wall(m) = -1.0_wp 7505 7506 surf_usm_v(l)%thickness_window(m) = -1.0_wp … … 7541 7542 ! 7542 7543 !-- Albedo 7543 IF ( surf_usm_v(l)%albedo( ind_veg_wall,m) < 0.0_wp ) THEN7544 surf_usm_v(l)%albedo( :,m) = surface_params(ialbedo,ip)7544 IF ( surf_usm_v(l)%albedo(m,ind_veg_wall) < 0.0_wp ) THEN 7545 surf_usm_v(l)%albedo(m,:) = surface_params(ialbedo,ip) 7545 7546 ENDIF 7546 7547 !-- Albedo type is 0 (custom), others are replaced later 7547 surf_usm_v(l)%albedo_type( :,m) = 07548 surf_usm_v(l)%albedo_type(m,:) = 0 7548 7549 !-- Transmissivity of the windows 7549 7550 IF ( surf_usm_v(l)%transmissivity(m) < 0.0_wp ) THEN … … 7833 7834 !-- Note, this is a temporary fix and need to be removed later. 7834 7835 IF ( during_spinup ) THEN 7835 frac_win = surf_usm_h%frac( ind_wat_win,m)7836 frac_wall = surf_usm_h%frac( ind_veg_wall,m)7837 frac_green = surf_usm_h%frac( ind_pav_green,m)7838 surf_usm_h%frac( ind_wat_win,m) = 0.0_wp7839 surf_usm_h%frac( ind_veg_wall,m) = 1.0_wp7840 surf_usm_h%frac( ind_pav_green,m) = 0.0_wp7836 frac_win = surf_usm_h%frac(m,ind_wat_win) 7837 frac_wall = surf_usm_h%frac(m,ind_veg_wall) 7838 frac_green = surf_usm_h%frac(m,ind_pav_green) 7839 surf_usm_h%frac(m,ind_wat_win) = 0.0_wp 7840 surf_usm_h%frac(m,ind_veg_wall) = 1.0_wp 7841 surf_usm_h%frac(m,ind_pav_green) = 0.0_wp 7841 7842 ENDIF 7842 7843 ! … … 7869 7870 rho_cp = c_p * hyp(k) / ( r_d * surf_usm_h%pt1(m) * exner(k) ) 7870 7871 7871 IF ( surf_usm_h%frac( ind_pav_green,m) > 0.0_wp ) THEN7872 IF ( surf_usm_h%frac(m,ind_pav_green) > 0.0_wp ) THEN 7872 7873 ! 7873 7874 !-- Calculate frequently used parameters … … 7921 7922 7922 7923 7923 IF ( surf_usm_h%frac( ind_pav_green,m) > 0.0_wp ) THEN7924 IF ( surf_usm_h%frac(m,ind_pav_green) > 0.0_wp ) THEN 7924 7925 !-- Adapted from LSM: 7925 7926 !-- Second step: calculate canopy resistance r_canopy … … 8021 8022 !-- is used 8022 8023 coef_1 = surf_usm_h%rad_net_l(m) + & 8023 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity( ind_veg_wall,m) * &8024 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(m,ind_veg_wall) * & 8024 8025 sigma_sb * t_surf_wall_h(m) ** 4 + & 8025 8026 f_shf * surf_usm_h%pt1(m) + & 8026 8027 lambda_surface * t_wall_h(nzb_wall,m) 8027 IF ( ( .NOT. during_spinup ) .AND. (surf_usm_h%frac( ind_wat_win,m) > 0.0_wp ) ) THEN8028 IF ( ( .NOT. during_spinup ) .AND. (surf_usm_h%frac(m,ind_wat_win) > 0.0_wp ) ) THEN 8028 8029 coef_window_1 = surf_usm_h%rad_net_l(m) + & 8029 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity( ind_wat_win,m) &8030 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(m,ind_wat_win) & 8030 8031 * sigma_sb * t_surf_window_h(m) ** 4 + & 8031 8032 f_shf_window * surf_usm_h%pt1(m) + & 8032 8033 lambda_surface_window * t_window_h(nzb_wall,m) 8033 8034 ENDIF 8034 IF ( ( humidity ) .AND. ( surf_usm_h%frac( ind_pav_green,m) > 0.0_wp ) ) THEN8035 IF ( ( humidity ) .AND. ( surf_usm_h%frac(m,ind_pav_green) > 0.0_wp ) ) THEN 8035 8036 coef_green_1 = surf_usm_h%rad_net_l(m) + & 8036 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity( ind_pav_green,m) * sigma_sb * &8037 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(m,ind_pav_green) * sigma_sb * & 8037 8038 t_surf_green_h(m) ** 4 + & 8038 8039 f_shf_green * surf_usm_h%pt1(m) + f_qsws * ( qv1 - q_s & … … 8041 8042 ELSE 8042 8043 coef_green_1 = surf_usm_h%rad_net_l(m) + & 8043 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity( ind_pav_green,m) *&8044 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(m,ind_pav_green) *& 8044 8045 sigma_sb * t_surf_green_h(m) ** 4 + & 8045 8046 f_shf_green * surf_usm_h%pt1(m) + & … … 8048 8049 ! 8049 8050 !-- denominator of the prognostic equation 8050 coef_2 = 4.0_wp * surf_usm_h%emissivity( ind_veg_wall,m) * &8051 coef_2 = 4.0_wp * surf_usm_h%emissivity(m,ind_veg_wall) * & 8051 8052 sigma_sb * t_surf_wall_h(m) ** 3 & 8052 8053 + lambda_surface + f_shf / exner(k) 8053 IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_h%frac( ind_wat_win,m) > 0.0_wp ) ) THEN8054 coef_window_2 = 4.0_wp * surf_usm_h%emissivity( ind_wat_win,m) * &8054 IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_h%frac(m,ind_wat_win) > 0.0_wp ) ) THEN 8055 coef_window_2 = 4.0_wp * surf_usm_h%emissivity(m,ind_wat_win) * & 8055 8056 sigma_sb * t_surf_window_h(m) ** 3 & 8056 8057 + lambda_surface_window + f_shf_window / exner(k) 8057 8058 ENDIF 8058 IF ( ( humidity ) .AND. ( surf_usm_h%frac( ind_pav_green,m) > 0.0_wp ) ) THEN8059 coef_green_2 = 4.0_wp * surf_usm_h%emissivity( ind_pav_green,m) * sigma_sb * &8059 IF ( ( humidity ) .AND. ( surf_usm_h%frac(m,ind_pav_green) > 0.0_wp ) ) THEN 8060 coef_green_2 = 4.0_wp * surf_usm_h%emissivity(m,ind_pav_green) * sigma_sb * & 8060 8061 t_surf_green_h(m) ** 3 + f_qsws * dq_s_dt & 8061 8062 + lambda_surface_green + f_shf_green / exner(k) 8062 8063 ELSE 8063 coef_green_2 = 4.0_wp * surf_usm_h%emissivity( ind_pav_green,m) * sigma_sb * &8064 coef_green_2 = 4.0_wp * surf_usm_h%emissivity(m,ind_pav_green) * sigma_sb * & 8064 8065 t_surf_green_h(m) ** 3 & 8065 8066 + lambda_surface_green + f_shf_green / exner(k) … … 8071 8072 surf_usm_h%c_surface(m) * t_surf_wall_h(m) ) / & 8072 8073 ( surf_usm_h%c_surface(m) + coef_2 * dt_3d * tsc(2) ) 8073 IF (( .NOT. during_spinup ) .AND. (surf_usm_h%frac( ind_wat_win,m) > 0.0_wp)) THEN8074 IF (( .NOT. during_spinup ) .AND. (surf_usm_h%frac(m,ind_wat_win) > 0.0_wp)) THEN 8074 8075 t_surf_window_h_p(m) = ( coef_window_1 * dt_3d * tsc(2) + & 8075 8076 surf_usm_h%c_surface_window(m) * t_surf_window_h(m) ) / & … … 8093 8094 !-- store also vpt_surface, which is, due to the lack of moisture on roofs simply 8094 8095 !-- assumed to be the surface temperature. 8095 surf_usm_h%pt_surface(m) = ( surf_usm_h%frac( ind_veg_wall,m) * t_surf_wall_h_p(m) &8096 + surf_usm_h%frac( ind_wat_win,m) * t_surf_window_h_p(m) &8097 + surf_usm_h%frac( ind_pav_green,m) * t_surf_green_h_p(m) ) &8096 surf_usm_h%pt_surface(m) = ( surf_usm_h%frac(m,ind_veg_wall) * t_surf_wall_h_p(m) & 8097 + surf_usm_h%frac(m,ind_wat_win) * t_surf_window_h_p(m) & 8098 + surf_usm_h%frac(m,ind_pav_green) * t_surf_green_h_p(m) ) & 8098 8099 / exner(k) 8099 8100 … … 8138 8139 !-- rad_net_l is never used! 8139 8140 surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net_l(m) + & 8140 surf_usm_h%frac( ind_veg_wall,m) * &8141 sigma_sb * surf_usm_h%emissivity( ind_veg_wall,m) * &8141 surf_usm_h%frac(m,ind_veg_wall) * & 8142 sigma_sb * surf_usm_h%emissivity(m,ind_veg_wall) * & 8142 8143 ( t_surf_wall_h_p(m)**4 - t_surf_wall_h(m)**4 ) & 8143 + surf_usm_h%frac( ind_wat_win,m) * &8144 sigma_sb * surf_usm_h%emissivity( ind_wat_win,m) * &8144 + surf_usm_h%frac(m,ind_wat_win) * & 8145 sigma_sb * surf_usm_h%emissivity(m,ind_wat_win) * & 8145 8146 ( t_surf_window_h_p(m)**4 - t_surf_window_h(m)**4 ) & 8146 + surf_usm_h%frac( ind_pav_green,m) * &8147 sigma_sb * surf_usm_h%emissivity( ind_pav_green,m) * &8147 + surf_usm_h%frac(m,ind_pav_green) * & 8148 sigma_sb * surf_usm_h%emissivity(m,ind_pav_green) * & 8148 8149 ( t_surf_green_h_p(m)**4 - t_surf_green_h(m)**4 ) 8149 8150 … … 8158 8159 !-- ground/wall/roof surface heat flux 8159 8160 surf_usm_h%wshf_eb(m) = - f_shf * ( surf_usm_h%pt1(m) - t_surf_wall_h_p(m) / exner(k) ) * & 8160 surf_usm_h%frac( ind_veg_wall,m) &8161 surf_usm_h%frac(m,ind_veg_wall) & 8161 8162 - f_shf_window * ( surf_usm_h%pt1(m) - t_surf_window_h_p(m) / exner(k) ) * & 8162 surf_usm_h%frac( ind_wat_win,m) &8163 surf_usm_h%frac(m,ind_wat_win) & 8163 8164 - f_shf_green * ( surf_usm_h%pt1(m) - t_surf_green_h_p(m) / exner(k) ) * & 8164 surf_usm_h%frac( ind_pav_green,m)8165 surf_usm_h%frac(m,ind_pav_green) 8165 8166 ! 8166 8167 !-- store kinematic surface heat fluxes for utilization in other processes … … 8175 8176 8176 8177 8177 IF (surf_usm_h%frac( ind_pav_green,m) > 0.0_wp) THEN8178 IF (surf_usm_h%frac(m,ind_pav_green) > 0.0_wp) THEN 8178 8179 8179 8180 … … 8221 8222 IF ( m_liq_usm_h%var_usm_1d(m) /= m_liq_max ) THEN 8222 8223 surf_usm_h%qsws_liq(m) = surf_usm_h%qsws_liq(m) & 8223 + surf_usm_h%frac( ind_pav_green,m) * prr(k+k_off,j+j_off,i+i_off)&8224 + surf_usm_h%frac(m,ind_pav_green) * prr(k+k_off,j+j_off,i+i_off)& 8224 8225 * hyrho(k+k_off) & 8225 8226 * 0.001_wp * rho_l * l_v … … 8286 8287 !-- values are restored. 8287 8288 IF ( during_spinup ) THEN 8288 surf_usm_h%frac( ind_wat_win,m) = frac_win8289 surf_usm_h%frac( ind_veg_wall,m) = frac_wall8290 surf_usm_h%frac( ind_pav_green,m) = frac_green8289 surf_usm_h%frac(m,ind_wat_win) = frac_win 8290 surf_usm_h%frac(m,ind_veg_wall) = frac_wall 8291 surf_usm_h%frac(m,ind_pav_green) = frac_green 8291 8292 ENDIF 8292 8293 … … 8302 8303 !-- Note, this is a temporary fix and need to be removed later. 8303 8304 IF ( during_spinup ) THEN 8304 frac_win = surf_usm_v(l)%frac( ind_wat_win,m)8305 frac_wall = surf_usm_v(l)%frac( ind_veg_wall,m)8306 frac_green = surf_usm_v(l)%frac( ind_pav_green,m)8307 surf_usm_v(l)%frac( ind_wat_win,m) = 0.0_wp8308 surf_usm_v(l)%frac( ind_veg_wall,m) = 1.0_wp8309 surf_usm_v(l)%frac( ind_pav_green,m) = 0.0_wp8305 frac_win = surf_usm_v(l)%frac(m,ind_wat_win) 8306 frac_wall = surf_usm_v(l)%frac(m,ind_veg_wall) 8307 frac_green = surf_usm_v(l)%frac(m,ind_pav_green) 8308 surf_usm_v(l)%frac(m,ind_wat_win) = 0.0_wp 8309 surf_usm_v(l)%frac(m,ind_veg_wall) = 1.0_wp 8310 surf_usm_v(l)%frac(m,ind_pav_green) = 0.0_wp 8310 8311 ENDIF 8311 8312 ! … … 8331 8332 ENDIF 8332 8333 ! 8333 !-- calculate rho * c_p coefficient at wall layer8334 !-- calculate rho * c_p coefficient at wall layer 8334 8335 rho_cp = c_p * hyp(k) / ( r_d * surf_usm_v(l)%pt1(m) * exner(k) ) 8335 8336 8336 IF (surf_usm_v(l)%frac( 1,m) > 0.0_wp ) THEN8337 ! 8338 !-- Calculate frequently used parameters8337 IF (surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp ) THEN 8338 ! 8339 !-- Calculate frequently used parameters 8339 8340 rho_lv = rho_cp / c_p * l_v 8340 8341 drho_l_lv = 1.0_wp / (rho_l * l_v) … … 8382 8383 8383 8384 8384 IF ( surf_usm_v(l)%frac( ind_pav_green,m) > 0.0_wp ) THEN8385 IF ( surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp ) THEN 8385 8386 ! 8386 8387 !-- Adapted from LSM: … … 8460 8461 coef_1 = surf_usm_v(l)%rad_net_l(m) + & ! coef +1 corresponds to -lwout 8461 8462 ! included in calculation of radnet_l 8462 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity( ind_veg_wall,m) * &8463 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_veg_wall) * & 8463 8464 sigma_sb * t_surf_wall_v(l)%t(m) ** 4 + & 8464 8465 f_shf * surf_usm_v(l)%pt1(m) + & 8465 8466 lambda_surface * t_wall_v(l)%t(nzb_wall,m) 8466 IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_v(l)%frac( ind_wat_win,m) > 0.0_wp ) ) THEN8467 IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_v(l)%frac(m,ind_wat_win) > 0.0_wp ) ) THEN 8467 8468 coef_window_1 = surf_usm_v(l)%rad_net_l(m) + & ! coef +1 corresponds to -lwout 8468 8469 ! included in calculation of radnet_l 8469 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity( ind_wat_win,m) * &8470 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_wat_win) * & 8470 8471 sigma_sb * t_surf_window_v(l)%t(m) ** 4 + & 8471 8472 f_shf * surf_usm_v(l)%pt1(m) + & 8472 8473 lambda_surface_window * t_window_v(l)%t(nzb_wall,m) 8473 8474 ENDIF 8474 IF ( ( humidity ) .AND. ( surf_usm_v(l)%frac( ind_pav_green,m) > 0.0_wp ) ) THEN8475 IF ( ( humidity ) .AND. ( surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp ) ) THEN 8475 8476 coef_green_1 = surf_usm_v(l)%rad_net_l(m) + & ! coef +1 corresponds to -lwout 8476 8477 ! included in calculation of radnet_l 8477 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity( ind_pav_green,m) * sigma_sb * &8478 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb * & 8478 8479 t_surf_green_v(l)%t(m) ** 4 + & 8479 8480 f_shf * surf_usm_v(l)%pt1(m) + f_qsws * ( qv1 - q_s & … … 8483 8484 coef_green_1 = surf_usm_v(l)%rad_net_l(m) + & ! coef +1 corresponds to -lwout included 8484 8485 ! in calculation of radnet_l 8485 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity( ind_pav_green,m) * sigma_sb * &8486 ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb * & 8486 8487 t_surf_green_v(l)%t(m) ** 4 + & 8487 8488 f_shf * surf_usm_v(l)%pt1(m) + & … … 8491 8492 ! 8492 8493 !-- denominator of the prognostic equation 8493 coef_2 = 4.0_wp * surf_usm_v(l)%emissivity( ind_veg_wall,m) * sigma_sb * &8494 coef_2 = 4.0_wp * surf_usm_v(l)%emissivity(m,ind_veg_wall) * sigma_sb * & 8494 8495 t_surf_wall_v(l)%t(m) ** 3 & 8495 8496 + lambda_surface + f_shf / exner(k) 8496 IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_v(l)%frac( ind_wat_win,m) > 0.0_wp ) ) THEN8497 coef_window_2 = 4.0_wp * surf_usm_v(l)%emissivity( ind_wat_win,m) * sigma_sb * &8497 IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_v(l)%frac(m,ind_wat_win) > 0.0_wp ) ) THEN 8498 coef_window_2 = 4.0_wp * surf_usm_v(l)%emissivity(m,ind_wat_win) * sigma_sb * & 8498 8499 t_surf_window_v(l)%t(m) ** 3 & 8499 8500 + lambda_surface_window + f_shf / exner(k) 8500 8501 ENDIF 8501 IF ( ( humidity ) .AND. ( surf_usm_v(l)%frac( ind_pav_green,m) > 0.0_wp ) ) THEN8502 coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity( ind_pav_green,m) * sigma_sb * &8502 IF ( ( humidity ) .AND. ( surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp ) ) THEN 8503 coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb * & 8503 8504 t_surf_green_v(l)%t(m) ** 3 + f_qsws * dq_s_dt & 8504 8505 + lambda_surface_green + f_shf / exner(k) 8505 8506 ELSE 8506 coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity( ind_pav_green,m) * sigma_sb * &8507 coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(m,ind_pav_green) * sigma_sb * & 8507 8508 t_surf_green_v(l)%t(m) ** 3 & 8508 8509 + lambda_surface_green + f_shf / exner(k) … … 8514 8515 surf_usm_v(l)%c_surface(m) * t_surf_wall_v(l)%t(m) ) / & 8515 8516 ( surf_usm_v(l)%c_surface(m) + coef_2 * dt_3d * tsc(2) ) 8516 IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_v(l)%frac( ind_wat_win,m) > 0.0_wp ) ) THEN8517 IF ( ( .NOT. during_spinup ) .AND. ( surf_usm_v(l)%frac(m,ind_wat_win) > 0.0_wp ) ) THEN 8517 8518 t_surf_window_v_p(l)%t(m) = ( coef_window_1 * dt_3d * tsc(2) + & 8518 8519 surf_usm_v(l)%c_surface_window(m) * t_surf_window_v(l)%t(m) ) / & … … 8534 8535 !-- store also vpt_surface, which is, due to the lack of moisture on roofs simply 8535 8536 !-- assumed to be the surface temperature. 8536 surf_usm_v(l)%pt_surface(m) = ( surf_usm_v(l)%frac( ind_veg_wall,m) * t_surf_wall_v_p(l)%t(m) &8537 + surf_usm_v(l)%frac( ind_wat_win,m) * t_surf_window_v_p(l)%t(m) &8538 + surf_usm_v(l)%frac( ind_pav_green,m) * t_surf_green_v_p(l)%t(m) ) &8537 surf_usm_v(l)%pt_surface(m) = ( surf_usm_v(l)%frac(m,ind_veg_wall) * t_surf_wall_v_p(l)%t(m) & 8538 + surf_usm_v(l)%frac(m,ind_wat_win) * t_surf_window_v_p(l)%t(m) & 8539 + surf_usm_v(l)%frac(m,ind_pav_green) * t_surf_green_v_p(l)%t(m) ) & 8539 8540 / exner(k) 8540 8541 … … 8582 8583 !-- calculate fluxes 8583 8584 !-- prognostic rad_net_l is used just for output! 8584 surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%frac( ind_veg_wall,m) * &8585 surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%frac(m,ind_veg_wall) * & 8585 8586 ( surf_usm_v(l)%rad_net_l(m) + & 8586 8587 3.0_wp * sigma_sb * & 8587 8588 t_surf_wall_v(l)%t(m)**4 - 4.0_wp * sigma_sb * & 8588 8589 t_surf_wall_v(l)%t(m)**3 * t_surf_wall_v_p(l)%t(m) ) & 8589 + surf_usm_v(l)%frac( ind_wat_win,m) * &8590 + surf_usm_v(l)%frac(m,ind_wat_win) * & 8590 8591 ( surf_usm_v(l)%rad_net_l(m) + & 8591 8592 3.0_wp * sigma_sb * & 8592 8593 t_surf_window_v(l)%t(m)**4 - 4.0_wp * sigma_sb * & 8593 8594 t_surf_window_v(l)%t(m)**3 * t_surf_window_v_p(l)%t(m) ) & 8594 + surf_usm_v(l)%frac( ind_pav_green,m) * &8595 + surf_usm_v(l)%frac(m,ind_pav_green) * & 8595 8596 ( surf_usm_v(l)%rad_net_l(m) + & 8596 8597 3.0_wp * sigma_sb * & … … 8609 8610 surf_usm_v(l)%wshf_eb(m) = & 8610 8611 - f_shf * ( surf_usm_v(l)%pt1(m) - & 8611 t_surf_wall_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac( ind_veg_wall,m) &8612 t_surf_wall_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac(m,ind_veg_wall) & 8612 8613 - f_shf_window * ( surf_usm_v(l)%pt1(m) - & 8613 t_surf_window_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac( ind_wat_win,m)&8614 t_surf_window_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac(m,ind_wat_win)& 8614 8615 - f_shf_green * ( surf_usm_v(l)%pt1(m) - & 8615 t_surf_green_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac( ind_pav_green,m)8616 t_surf_green_v_p(l)%t(m) / exner(k) ) * surf_usm_v(l)%frac(m,ind_pav_green) 8616 8617 8617 8618 ! … … 8627 8628 ENDIF 8628 8629 8629 IF ( surf_usm_v(l)%frac( ind_pav_green,m) > 0.0_wp ) THEN8630 IF ( surf_usm_v(l)%frac(m,ind_pav_green) > 0.0_wp ) THEN 8630 8631 8631 8632 … … 8683 8684 !-- values are restored. 8684 8685 IF ( during_spinup ) THEN 8685 surf_usm_v(l)%frac( ind_wat_win,m) = frac_win8686 surf_usm_v(l)%frac( ind_veg_wall,m) = frac_wall8687 surf_usm_v(l)%frac( ind_pav_green,m) = frac_green8686 surf_usm_v(l)%frac(m,ind_wat_win) = frac_win 8687 surf_usm_v(l)%frac(m,ind_veg_wall) = frac_wall 8688 surf_usm_v(l)%frac(m,ind_pav_green) = frac_green 8688 8689 ENDIF 8689 8690
Note: See TracChangeset
for help on using the changeset viewer.