diff --git a/src/biogeophys/UrbanAlbedoMod.F90 b/src/biogeophys/UrbanAlbedoMod.F90 index 25555b2da8..3e84f73176 100644 --- a/src/biogeophys/UrbanAlbedoMod.F90 +++ b/src/biogeophys/UrbanAlbedoMod.F90 @@ -175,9 +175,6 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & endc => bounds%endc & ) - !TODO KO - Indentation needs to be done properly throughout this module. Will do later - ! to make the changes easier to review now. - ! Allocate urbanl and urbanc coszen filters allocate(filter_urbanl_coszen_gt0(bounds%endl-bounds%begl+1)) allocate(filter_nourbanl_coszen_gt0(bounds%endl-bounds%begl+1)) @@ -307,184 +304,179 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & ! ---------------------------------------------------------------------------- - ! Set constants - solar fluxes are per unit incoming flux + ! Set constants - solar fluxes are per unit incoming flux - do ib = 1,numrad - do fl = 1,num_urbanl_coszen_gt0 - l = filter_urbanl_coszen_gt0(fl) - sdir(l,ib) = 1._r8 - sdif(l,ib) = 1._r8 - end do + do ib = 1,numrad + do fl = 1,num_urbanl_coszen_gt0 + l = filter_urbanl_coszen_gt0(fl) + sdir(l,ib) = 1._r8 + sdif(l,ib) = 1._r8 end do + end do - ! Incident direct beam radiation for - ! (a) roof and (b) road and both walls in urban canyon - - if (num_urbanl > 0) then - call incident_direct (bounds, & - num_urbanl_coszen_gt0, & - filter_urbanl_coszen_gt0, & - num_nourbanl_coszen_gt0, & - filter_nourbanl_coszen_gt0, & - canyon_hwr(begl:endl), & - zen(begl:endl), & - sdir(begl:endl, :), & - sdir_road(begl:endl, :), & - sdir_sunwall(begl:endl, :), & - sdir_shadewall(begl:endl, :)) - end if - - ! Incident diffuse radiation for - ! (a) roof and (b) road and both walls in urban canyon. - - if (num_urbanl_coszen_gt0 > 0) then - call incident_diffuse (bounds, & - num_urbanl_coszen_gt0, & - filter_urbanl_coszen_gt0, & - canyon_hwr(begl:endl), & - sdif(begl:endl, :), & - sdif_road(begl:endl, :), & - sdif_sunwall(begl:endl, :), & - sdif_shadewall(begl:endl, :), & - urbanparams_inst) - end if - - ! Get snow albedos for roof and impervious and pervious road - if (num_urbanl > 0) then - ic = 0 - call SnowAlbedo(bounds, & - num_urbanc, filter_urbanc, & - num_urbanc_coszen_gt0, & - filter_urbanc_coszen_gt0, & - ic, & - albsnd_roof(begl:endl, :), & - albsnd_improad(begl:endl, :), & - albsnd_perroad(begl:endl, :), & - waterstatebulk_inst) - - ic = 1 - call SnowAlbedo(bounds, & - num_urbanc, filter_urbanc, & - num_urbanc_coszen_gt0, & - filter_urbanc_coszen_gt0, & - ic, & - albsni_roof(begl:endl, :), & - albsni_improad(begl:endl, :), & - albsni_perroad(begl:endl, :), & - waterstatebulk_inst) - end if - - ! Combine snow-free and snow albedos - do ib = 1,numrad - do fc = 1,num_urbanc_coszen_gt0 - c = filter_urbanc_coszen_gt0(fc) - l = col%landunit(c) - if (ctype(c) == icol_roof) then - alb_roof_dir_s(l,ib) = alb_roof_dir(l,ib)*(1._r8-frac_sno(c)) & - + albsnd_roof(l,ib)*frac_sno(c) - alb_roof_dif_s(l,ib) = alb_roof_dif(l,ib)*(1._r8-frac_sno(c)) & - + albsni_roof(l,ib)*frac_sno(c) - else if (ctype(c) == icol_road_imperv) then - alb_improad_dir_s(l,ib) = alb_improad_dir(l,ib)*(1._r8-frac_sno(c)) & - + albsnd_improad(l,ib)*frac_sno(c) - alb_improad_dif_s(l,ib) = alb_improad_dif(l,ib)*(1._r8-frac_sno(c)) & - + albsni_improad(l,ib)*frac_sno(c) - else if (ctype(c) == icol_road_perv) then - alb_perroad_dir_s(l,ib) = alb_perroad_dir(l,ib)*(1._r8-frac_sno(c)) & - + albsnd_perroad(l,ib)*frac_sno(c) - alb_perroad_dif_s(l,ib) = alb_perroad_dif(l,ib)*(1._r8-frac_sno(c)) & - + albsni_perroad(l,ib)*frac_sno(c) - end if - end do + ! Incident direct beam radiation for + ! (a) roof and (b) road and both walls in urban canyon + + if (num_urbanl > 0) then + call incident_direct (bounds, & + num_urbanl_coszen_gt0, & + filter_urbanl_coszen_gt0, & + num_nourbanl_coszen_gt0, & + filter_nourbanl_coszen_gt0, & + canyon_hwr(begl:endl), & + zen(begl:endl), & + sdir(begl:endl, :), & + sdir_road(begl:endl, :), & + sdir_sunwall(begl:endl, :), & + sdir_shadewall(begl:endl, :)) + end if + + ! Incident diffuse radiation for + ! (a) roof and (b) road and both walls in urban canyon. + + if (num_urbanl_coszen_gt0 > 0) then + call incident_diffuse (bounds, & + num_urbanl_coszen_gt0, & + filter_urbanl_coszen_gt0, & + canyon_hwr(begl:endl), & + sdif(begl:endl, :), & + sdif_road(begl:endl, :), & + sdif_sunwall(begl:endl, :), & + sdif_shadewall(begl:endl, :), & + urbanparams_inst) + end if + + ! Get snow albedos for roof and impervious and pervious road + if (num_urbanl > 0) then + ic = 0 + call SnowAlbedo(bounds, & + num_urbanc, filter_urbanc, & + num_urbanc_coszen_gt0, & + filter_urbanc_coszen_gt0, & + ic, & + albsnd_roof(begl:endl, :), & + albsnd_improad(begl:endl, :), & + albsnd_perroad(begl:endl, :), & + waterstatebulk_inst) + + ic = 1 + call SnowAlbedo(bounds, & + num_urbanc, filter_urbanc, & + num_urbanc_coszen_gt0, & + filter_urbanc_coszen_gt0, & + ic, & + albsni_roof(begl:endl, :), & + albsni_improad(begl:endl, :), & + albsni_perroad(begl:endl, :), & + waterstatebulk_inst) + end if + + ! Combine snow-free and snow albedos + do ib = 1,numrad + do fc = 1,num_urbanc_coszen_gt0 + c = filter_urbanc_coszen_gt0(fc) + l = col%landunit(c) + if (ctype(c) == icol_roof) then + alb_roof_dir_s(l,ib) = alb_roof_dir(l,ib)*(1._r8-frac_sno(c)) & + + albsnd_roof(l,ib)*frac_sno(c) + alb_roof_dif_s(l,ib) = alb_roof_dif(l,ib)*(1._r8-frac_sno(c)) & + + albsni_roof(l,ib)*frac_sno(c) + else if (ctype(c) == icol_road_imperv) then + alb_improad_dir_s(l,ib) = alb_improad_dir(l,ib)*(1._r8-frac_sno(c)) & + + albsnd_improad(l,ib)*frac_sno(c) + alb_improad_dif_s(l,ib) = alb_improad_dif(l,ib)*(1._r8-frac_sno(c)) & + + albsni_improad(l,ib)*frac_sno(c) + else if (ctype(c) == icol_road_perv) then + alb_perroad_dir_s(l,ib) = alb_perroad_dir(l,ib)*(1._r8-frac_sno(c)) & + + albsnd_perroad(l,ib)*frac_sno(c) + alb_perroad_dif_s(l,ib) = alb_perroad_dif(l,ib)*(1._r8-frac_sno(c)) & + + albsni_perroad(l,ib)*frac_sno(c) + end if end do + end do - ! Reflected and absorbed solar radiation per unit incident radiation - ! for road and both walls in urban canyon allowing for multiple reflection - ! Reflected and absorbed solar radiation per unit incident radiation for roof + ! Reflected and absorbed solar radiation per unit incident radiation + ! for road and both walls in urban canyon allowing for multiple reflection + ! Reflected and absorbed solar radiation per unit incident radiation for roof + + if (num_urbanl_coszen_gt0 > 0) then + call net_solar (bounds, & + num_urbanl_coszen_gt0, & + filter_urbanl_coszen_gt0, & + canyon_hwr (begl:endl), & + wtroad_perv (begl:endl), & + sdir (begl:endl, :), & + sdif (begl:endl, :), & + alb_improad_dir_s (begl:endl, :), & + alb_perroad_dir_s (begl:endl, :), & + alb_wall_dir (begl:endl, :), & + alb_roof_dir_s (begl:endl, :), & + alb_improad_dif_s (begl:endl, :), & + alb_perroad_dif_s (begl:endl, :), & + alb_wall_dif (begl:endl, :), & + alb_roof_dif_s (begl:endl, :), & + sdir_road (begl:endl, :), & + sdir_sunwall (begl:endl, :), & + sdir_shadewall (begl:endl, :), & + sdif_road (begl:endl, :), & + sdif_sunwall (begl:endl, :), & + sdif_shadewall (begl:endl, :), & + sref_improad_dir (begl:endl, :), & + sref_perroad_dir (begl:endl, :), & + sref_sunwall_dir (begl:endl, :), & + sref_shadewall_dir (begl:endl, :), & + sref_roof_dir (begl:endl, :), & + sref_improad_dif (begl:endl, :), & + sref_perroad_dif (begl:endl, :), & + sref_sunwall_dif (begl:endl, :), & + sref_shadewall_dif (begl:endl, :), & + sref_roof_dif (begl:endl, :), & + urbanparams_inst, solarabs_inst) + end if - if (num_urbanl_coszen_gt0 > 0) then - call net_solar (bounds, & - num_urbanl_coszen_gt0, & - filter_urbanl_coszen_gt0, & - canyon_hwr (begl:endl), & - wtroad_perv (begl:endl), & - sdir (begl:endl, :), & - sdif (begl:endl, :), & - alb_improad_dir_s (begl:endl, :), & - alb_perroad_dir_s (begl:endl, :), & - alb_wall_dir (begl:endl, :), & - alb_roof_dir_s (begl:endl, :), & - alb_improad_dif_s (begl:endl, :), & - alb_perroad_dif_s (begl:endl, :), & - alb_wall_dif (begl:endl, :), & - alb_roof_dif_s (begl:endl, :), & - sdir_road (begl:endl, :), & - sdir_sunwall (begl:endl, :), & - sdir_shadewall (begl:endl, :), & - sdif_road (begl:endl, :), & - sdif_sunwall (begl:endl, :), & - sdif_shadewall (begl:endl, :), & - sref_improad_dir (begl:endl, :), & - sref_perroad_dir (begl:endl, :), & - sref_sunwall_dir (begl:endl, :), & - sref_shadewall_dir (begl:endl, :), & - sref_roof_dir (begl:endl, :), & - sref_improad_dif (begl:endl, :), & - sref_perroad_dif (begl:endl, :), & - sref_sunwall_dif (begl:endl, :), & - sref_shadewall_dif (begl:endl, :), & - sref_roof_dif (begl:endl, :), & - urbanparams_inst, solarabs_inst) - end if + ! ---------------------------------------------------------------------------- + ! Map urban output to surfalb_inst components + ! ---------------------------------------------------------------------------- - ! ---------------------------------------------------------------------------- - ! Map urban output to surfalb_inst components - ! ---------------------------------------------------------------------------- - - ! Set albgrd and albgri (ground albedos) and albd and albi (surface albedos) - - do ib = 1,numrad - do fc = 1,num_urbanc - c = filter_urbanc(fc) - l = col%landunit(c) - if (ctype(c) == icol_roof) then - albgrd(c,ib) = sref_roof_dir(l,ib) - albgri(c,ib) = sref_roof_dif(l,ib) - else if (ctype(c) == icol_sunwall) then - albgrd(c,ib) = sref_sunwall_dir(l,ib) - albgri(c,ib) = sref_sunwall_dif(l,ib) - else if (ctype(c) == icol_shadewall) then - albgrd(c,ib) = sref_shadewall_dir(l,ib) - albgri(c,ib) = sref_shadewall_dif(l,ib) - else if (ctype(c) == icol_road_perv) then - albgrd(c,ib) = sref_perroad_dir(l,ib) - albgri(c,ib) = sref_perroad_dif(l,ib) - else if (ctype(c) == icol_road_imperv) then - albgrd(c,ib) = sref_improad_dir(l,ib) - albgri(c,ib) = sref_improad_dif(l,ib) - endif - !TODO KO - Clean up these SNICAR comments (not needed?) -! add new snicar albedo variables for history fields - if (coszen(l) > 0._r8) then - albgrd_hst(c,ib) = albgrd(c,ib) - albgri_hst(c,ib) = albgri(c,ib) - end if -! end add new snicar - end do - do fp = 1,num_urbanp - p = filter_urbanp(fp) - c = patch%column(p) - l = patch%landunit(p) - albd(p,ib) = albgrd(c,ib) - albi(p,ib) = albgri(c,ib) -! add new snicar albedo variables for history fields - if (coszen(l) > 0._r8) then - albd_hst(p,ib) = albd(p,ib) - albi_hst(p,ib) = albi(p,ib) - end if -! end add new snicar - end do + ! Set albgrd and albgri (ground albedos) and albd and albi (surface albedos) + + do ib = 1,numrad + do fc = 1,num_urbanc + c = filter_urbanc(fc) + l = col%landunit(c) + if (ctype(c) == icol_roof) then + albgrd(c,ib) = sref_roof_dir(l,ib) + albgri(c,ib) = sref_roof_dif(l,ib) + else if (ctype(c) == icol_sunwall) then + albgrd(c,ib) = sref_sunwall_dir(l,ib) + albgri(c,ib) = sref_sunwall_dif(l,ib) + else if (ctype(c) == icol_shadewall) then + albgrd(c,ib) = sref_shadewall_dir(l,ib) + albgri(c,ib) = sref_shadewall_dif(l,ib) + else if (ctype(c) == icol_road_perv) then + albgrd(c,ib) = sref_perroad_dir(l,ib) + albgri(c,ib) = sref_perroad_dif(l,ib) + else if (ctype(c) == icol_road_imperv) then + albgrd(c,ib) = sref_improad_dir(l,ib) + albgri(c,ib) = sref_improad_dif(l,ib) + endif + if (coszen(l) > 0._r8) then + albgrd_hst(c,ib) = albgrd(c,ib) + albgri_hst(c,ib) = albgri(c,ib) + end if + end do + do fp = 1,num_urbanp + p = filter_urbanp(fp) + c = patch%column(p) + l = patch%landunit(p) + albd(p,ib) = albgrd(c,ib) + albi(p,ib) = albgri(c,ib) + if (coszen(l) > 0._r8) then + albd_hst(p,ib) = albd(p,ib) + albi_hst(p,ib) = albi(p,ib) + end if end do + end do end associate @@ -653,19 +645,19 @@ subroutine incident_direct (bounds, & do fl = 1,num_urbanl_coszen_gt0 l = filter_urbanl_coszen_gt0(fl) - sdir_shadewall(l,ib) = 0._r8 + sdir_shadewall(l,ib) = 0._r8 - ! incident solar radiation on wall and road integrated over all canyon orientations (0 <= theta <= pi/2) + ! incident solar radiation on wall and road integrated over all canyon orientations (0 <= theta <= pi/2) - sdir_road(l,ib) = sdir(l,ib) * & - (2._r8*theta0(l)/rpi - 2./rpi*canyon_hwr(l)*tanzen(l)*(1._r8-cos(theta0(l)))) - sdir_sunwall(l,ib) = 2._r8 * sdir(l,ib) * ((1._r8/canyon_hwr(l))* & - (0.5_r8-theta0(l)/rpi) + (1._r8/rpi)*tanzen(l)*(1._r8-cos(theta0(l)))) + sdir_road(l,ib) = sdir(l,ib) * & + (2._r8*theta0(l)/rpi - 2./rpi*canyon_hwr(l)*tanzen(l)*(1._r8-cos(theta0(l)))) + sdir_sunwall(l,ib) = 2._r8 * sdir(l,ib) * ((1._r8/canyon_hwr(l))* & + (0.5_r8-theta0(l)/rpi) + (1._r8/rpi)*tanzen(l)*(1._r8-cos(theta0(l)))) - ! conservation check for road and wall. need to use wall fluxes converted to ground area + ! conservation check for road and wall. need to use wall fluxes converted to ground area - swall_projected = (sdir_shadewall(l,ib) + sdir_sunwall(l,ib)) * canyon_hwr(l) - err1(l) = sdir(l,ib) - (sdir_road(l,ib) + swall_projected) + swall_projected = (sdir_shadewall(l,ib) + sdir_sunwall(l,ib)) * canyon_hwr(l) + err1(l) = sdir(l,ib) - (sdir_road(l,ib) + swall_projected) end do do fl = 1,num_nourbanl_coszen_gt0 l = filter_nourbanl_coszen_gt0(fl) @@ -689,36 +681,36 @@ subroutine incident_direct (bounds, & if (numchk) then do fl = 1,num_urbanl_coszen_gt0 l = filter_urbanl_coszen_gt0(fl) - sumr = 0._r8 - sumw = 0._r8 - num = 0._r8 - do i = 1, 9000 - theta = i/100._r8 * rpi/180._r8 - zen0 = atan(1._r8/(canyon_hwr(l)*sin(theta))) - if (zen(l) >= zen0) then - sumr = sumr + 0._r8 - sumw = sumw + sdir(l,ib) / canyon_hwr(l) - else - sumr = sumr + sdir(l,ib) * (1._r8-canyon_hwr(l)*sin(theta)*tanzen(l)) - sumw = sumw + sdir(l,ib) * sin(theta)*tanzen(l) - end if - num = num + 1._r8 - end do - err2(l) = sumr/num - sdir_road(l,ib) - err3(l) = sumw/num - sdir_sunwall(l,ib) + sumr = 0._r8 + sumw = 0._r8 + num = 0._r8 + do i = 1, 9000 + theta = i/100._r8 * rpi/180._r8 + zen0 = atan(1._r8/(canyon_hwr(l)*sin(theta))) + if (zen(l) >= zen0) then + sumr = sumr + 0._r8 + sumw = sumw + sdir(l,ib) / canyon_hwr(l) + else + sumr = sumr + sdir(l,ib) * (1._r8-canyon_hwr(l)*sin(theta)*tanzen(l)) + sumw = sumw + sdir(l,ib) * sin(theta)*tanzen(l) + end if + num = num + 1._r8 + end do + err2(l) = sumr/num - sdir_road(l,ib) + err3(l) = sumw/num - sdir_sunwall(l,ib) end do do fl = 1,num_urbanl_coszen_gt0 l = filter_urbanl_coszen_gt0(fl) - if (abs(err2(l)) > 0.0006_r8 ) then - write (iulog,*) 'urban road incident direct beam solar radiation error',err2(l) - write (iulog,*) 'clm model is stopping' - call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) - endif - if (abs(err3(l)) > 0.0006_r8 ) then - write (iulog,*) 'urban wall incident direct beam solar radiation error',err3(l) - write (iulog,*) 'clm model is stopping' - call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) - end if + if (abs(err2(l)) > 0.0006_r8 ) then + write (iulog,*) 'urban road incident direct beam solar radiation error',err2(l) + write (iulog,*) 'clm model is stopping' + call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) + endif + if (abs(err3(l)) > 0.0006_r8 ) then + write (iulog,*) 'urban wall incident direct beam solar radiation error',err3(l) + write (iulog,*) 'clm model is stopping' + call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) + end if end do end if @@ -803,8 +795,8 @@ subroutine net_solar (bounds num_urbanl_coszen_gt0, filter_urbanl_coszen_gt0, canyon_hwr, wtroad_perv, sdir, sdif , & alb_improad_dir, alb_perroad_dir, alb_wall_dir, alb_roof_dir , & alb_improad_dif, alb_perroad_dif, alb_wall_dif, alb_roof_dif , & - sdir_road, sdir_sunwall, sdir_shadewall, & - sdif_road, sdif_sunwall, sdif_shadewall, & + sdir_road, sdir_sunwall, sdir_shadewall , & + sdif_road, sdif_sunwall, sdif_shadewall , & sref_improad_dir, sref_perroad_dir, sref_sunwall_dir, sref_shadewall_dir, sref_roof_dir , & sref_improad_dif, sref_perroad_dif, sref_sunwall_dif, sref_shadewall_dif, sref_roof_dif , & urbanparams_inst, solarabs_inst) @@ -988,329 +980,329 @@ subroutine net_solar (bounds do fl = 1,num_urbanl_coszen_gt0 l = filter_urbanl_coszen_gt0(fl) - ! initial absorption and reflection for road and both walls. - ! distribute reflected radiation to sky, road, and walls - ! according to appropriate view factor. radiation reflected to - ! road and walls will undergo multiple reflections within the canyon. - ! do separately for direct beam and diffuse radiation. + ! initial absorption and reflection for road and both walls. + ! distribute reflected radiation to sky, road, and walls + ! according to appropriate view factor. radiation reflected to + ! road and walls will undergo multiple reflections within the canyon. + ! do separately for direct beam and diffuse radiation. + + ! direct beam + + road_a_dir(l) = 0.0_r8 + road_r_dir(l) = 0.0_r8 + improad_a_dir(l) = (1._r8-alb_improad_dir(l,ib)) * sdir_road(l,ib) + improad_r_dir(l) = alb_improad_dir(l,ib) * sdir_road(l,ib) + improad_r_sky_dir(l) = improad_r_dir(l) * vf_sr(l) + improad_r_sunwall_dir(l) = improad_r_dir(l) * vf_wr(l) + improad_r_shadewall_dir(l) = improad_r_dir(l) * vf_wr(l) + road_a_dir(l) = road_a_dir(l) + improad_a_dir(l)*wtroad_imperv(l) + road_r_dir(l) = road_r_dir(l) + improad_r_dir(l)*wtroad_imperv(l) + + perroad_a_dir(l) = (1._r8-alb_perroad_dir(l,ib)) * sdir_road(l,ib) + perroad_r_dir(l) = alb_perroad_dir(l,ib) * sdir_road(l,ib) + perroad_r_sky_dir(l) = perroad_r_dir(l) * vf_sr(l) + perroad_r_sunwall_dir(l) = perroad_r_dir(l) * vf_wr(l) + perroad_r_shadewall_dir(l) = perroad_r_dir(l) * vf_wr(l) + road_a_dir(l) = road_a_dir(l) + perroad_a_dir(l)*wtroad_perv(l) + road_r_dir(l) = road_r_dir(l) + perroad_r_dir(l)*wtroad_perv(l) + + road_r_sky_dir(l) = road_r_dir(l) * vf_sr(l) + road_r_sunwall_dir(l) = road_r_dir(l) * vf_wr(l) + road_r_shadewall_dir(l) = road_r_dir(l) * vf_wr(l) + + sunwall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * sdir_sunwall(l,ib) + sunwall_r_dir(l) = alb_wall_dir(l,ib) * sdir_sunwall(l,ib) + sunwall_r_sky_dir(l) = sunwall_r_dir(l) * vf_sw(l) + sunwall_r_road_dir(l) = sunwall_r_dir(l) * vf_rw(l) + sunwall_r_shadewall_dir(l) = sunwall_r_dir(l) * vf_ww(l) + + shadewall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * sdir_shadewall(l,ib) + shadewall_r_dir(l) = alb_wall_dir(l,ib) * sdir_shadewall(l,ib) + shadewall_r_sky_dir(l) = shadewall_r_dir(l) * vf_sw(l) + shadewall_r_road_dir(l) = shadewall_r_dir(l) * vf_rw(l) + shadewall_r_sunwall_dir(l) = shadewall_r_dir(l) * vf_ww(l) + + ! diffuse + + road_a_dif(l) = 0.0_r8 + road_r_dif(l) = 0.0_r8 + improad_a_dif(l) = (1._r8-alb_improad_dif(l,ib)) * sdif_road(l,ib) + improad_r_dif(l) = alb_improad_dif(l,ib) * sdif_road(l,ib) + improad_r_sky_dif(l) = improad_r_dif(l) * vf_sr(l) + improad_r_sunwall_dif(l) = improad_r_dif(l) * vf_wr(l) + improad_r_shadewall_dif(l) = improad_r_dif(l) * vf_wr(l) + road_a_dif(l) = road_a_dif(l) + improad_a_dif(l)*wtroad_imperv(l) + road_r_dif(l) = road_r_dif(l) + improad_r_dif(l)*wtroad_imperv(l) + + perroad_a_dif(l) = (1._r8-alb_perroad_dif(l,ib)) * sdif_road(l,ib) + perroad_r_dif(l) = alb_perroad_dif(l,ib) * sdif_road(l,ib) + perroad_r_sky_dif(l) = perroad_r_dif(l) * vf_sr(l) + perroad_r_sunwall_dif(l) = perroad_r_dif(l) * vf_wr(l) + perroad_r_shadewall_dif(l) = perroad_r_dif(l) * vf_wr(l) + road_a_dif(l) = road_a_dif(l) + perroad_a_dif(l)*wtroad_perv(l) + road_r_dif(l) = road_r_dif(l) + perroad_r_dif(l)*wtroad_perv(l) + + road_r_sky_dif(l) = road_r_dif(l) * vf_sr(l) + road_r_sunwall_dif(l) = road_r_dif(l) * vf_wr(l) + road_r_shadewall_dif(l) = road_r_dif(l) * vf_wr(l) + + sunwall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * sdif_sunwall(l,ib) + sunwall_r_dif(l) = alb_wall_dif(l,ib) * sdif_sunwall(l,ib) + sunwall_r_sky_dif(l) = sunwall_r_dif(l) * vf_sw(l) + sunwall_r_road_dif(l) = sunwall_r_dif(l) * vf_rw(l) + sunwall_r_shadewall_dif(l) = sunwall_r_dif(l) * vf_ww(l) + + shadewall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * sdif_shadewall(l,ib) + shadewall_r_dif(l) = alb_wall_dif(l,ib) * sdif_shadewall(l,ib) + shadewall_r_sky_dif(l) = shadewall_r_dif(l) * vf_sw(l) + shadewall_r_road_dif(l) = shadewall_r_dif(l) * vf_rw(l) + shadewall_r_sunwall_dif(l) = shadewall_r_dif(l) * vf_ww(l) + + ! initialize sum of direct and diffuse solar absorption and reflection for road and both walls + + sabs_improad_dir(l,ib) = improad_a_dir(l) + sabs_perroad_dir(l,ib) = perroad_a_dir(l) + sabs_sunwall_dir(l,ib) = sunwall_a_dir(l) + sabs_shadewall_dir(l,ib) = shadewall_a_dir(l) + + sabs_improad_dif(l,ib) = improad_a_dif(l) + sabs_perroad_dif(l,ib) = perroad_a_dif(l) + sabs_sunwall_dif(l,ib) = sunwall_a_dif(l) + sabs_shadewall_dif(l,ib) = shadewall_a_dif(l) + + sref_improad_dir(l,ib) = improad_r_sky_dir(l) + sref_perroad_dir(l,ib) = perroad_r_sky_dir(l) + sref_sunwall_dir(l,ib) = sunwall_r_sky_dir(l) + sref_shadewall_dir(l,ib) = shadewall_r_sky_dir(l) + + sref_improad_dif(l,ib) = improad_r_sky_dif(l) + sref_perroad_dif(l,ib) = perroad_r_sky_dif(l) + sref_sunwall_dif(l,ib) = sunwall_r_sky_dif(l) + sref_shadewall_dif(l,ib) = shadewall_r_sky_dif(l) + + end do + + ! absorption and reflection for walls and road with multiple reflections + ! (i.e., absorb and reflect initial reflection in canyon and allow for + ! subsequent scattering) + ! + ! (1) absorption and reflection of scattered solar radiation + ! road: reflected fluxes from walls need to be projected to ground area + ! wall: reflected flux from road needs to be projected to wall area + ! + ! (2) add absorbed radiation for ith reflection to total absorbed + ! + ! (3) distribute reflected radiation to sky, road, and walls according to view factors + ! + ! (4) add solar reflection to sky for ith reflection to total reflection + ! + ! (5) stop iteration when absorption for ith reflection is less than some nominal amount. + ! small convergence criteria is required to ensure solar radiation is conserved + ! + ! do separately for direct beam and diffuse + + do fl = 1,num_urbanl_coszen_gt0 + l = filter_urbanl_coszen_gt0(fl) + + ! reflected direct beam + + do iter_dir = 1, n + ! step (1) + + stot(l) = (sunwall_r_road_dir(l) + shadewall_r_road_dir(l))*canyon_hwr(l) + + road_a_dir(l) = 0.0_r8 + road_r_dir(l) = 0.0_r8 + improad_a_dir(l) = (1._r8-alb_improad_dir(l,ib)) * stot(l) + improad_r_dir(l) = alb_improad_dir(l,ib) * stot(l) + road_a_dir(l) = road_a_dir(l) + improad_a_dir(l)*wtroad_imperv(l) + road_r_dir(l) = road_r_dir(l) + improad_r_dir(l)*wtroad_imperv(l) + perroad_a_dir(l) = (1._r8-alb_perroad_dir(l,ib)) * stot(l) + perroad_r_dir(l) = alb_perroad_dir(l,ib) * stot(l) + road_a_dir(l) = road_a_dir(l) + perroad_a_dir(l)*wtroad_perv(l) + road_r_dir(l) = road_r_dir(l) + perroad_r_dir(l)*wtroad_perv(l) + + stot(l) = road_r_sunwall_dir(l)/canyon_hwr(l) + shadewall_r_sunwall_dir(l) + sunwall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * stot(l) + sunwall_r_dir(l) = alb_wall_dir(l,ib) * stot(l) + + stot(l) = road_r_shadewall_dir(l)/canyon_hwr(l) + sunwall_r_shadewall_dir(l) + shadewall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * stot(l) + shadewall_r_dir(l) = alb_wall_dir(l,ib) * stot(l) + + ! step (2) - ! direct beam + sabs_improad_dir(l,ib) = sabs_improad_dir(l,ib) + improad_a_dir(l) + sabs_perroad_dir(l,ib) = sabs_perroad_dir(l,ib) + perroad_a_dir(l) + sabs_sunwall_dir(l,ib) = sabs_sunwall_dir(l,ib) + sunwall_a_dir(l) + sabs_shadewall_dir(l,ib) = sabs_shadewall_dir(l,ib) + shadewall_a_dir(l) + + ! step (3) - road_a_dir(l) = 0.0_r8 - road_r_dir(l) = 0.0_r8 - improad_a_dir(l) = (1._r8-alb_improad_dir(l,ib)) * sdir_road(l,ib) - improad_r_dir(l) = alb_improad_dir(l,ib) * sdir_road(l,ib) improad_r_sky_dir(l) = improad_r_dir(l) * vf_sr(l) improad_r_sunwall_dir(l) = improad_r_dir(l) * vf_wr(l) improad_r_shadewall_dir(l) = improad_r_dir(l) * vf_wr(l) - road_a_dir(l) = road_a_dir(l) + improad_a_dir(l)*wtroad_imperv(l) - road_r_dir(l) = road_r_dir(l) + improad_r_dir(l)*wtroad_imperv(l) - perroad_a_dir(l) = (1._r8-alb_perroad_dir(l,ib)) * sdir_road(l,ib) - perroad_r_dir(l) = alb_perroad_dir(l,ib) * sdir_road(l,ib) perroad_r_sky_dir(l) = perroad_r_dir(l) * vf_sr(l) perroad_r_sunwall_dir(l) = perroad_r_dir(l) * vf_wr(l) perroad_r_shadewall_dir(l) = perroad_r_dir(l) * vf_wr(l) - road_a_dir(l) = road_a_dir(l) + perroad_a_dir(l)*wtroad_perv(l) - road_r_dir(l) = road_r_dir(l) + perroad_r_dir(l)*wtroad_perv(l) road_r_sky_dir(l) = road_r_dir(l) * vf_sr(l) road_r_sunwall_dir(l) = road_r_dir(l) * vf_wr(l) road_r_shadewall_dir(l) = road_r_dir(l) * vf_wr(l) - sunwall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * sdir_sunwall(l,ib) - sunwall_r_dir(l) = alb_wall_dir(l,ib) * sdir_sunwall(l,ib) sunwall_r_sky_dir(l) = sunwall_r_dir(l) * vf_sw(l) sunwall_r_road_dir(l) = sunwall_r_dir(l) * vf_rw(l) sunwall_r_shadewall_dir(l) = sunwall_r_dir(l) * vf_ww(l) - shadewall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * sdir_shadewall(l,ib) - shadewall_r_dir(l) = alb_wall_dir(l,ib) * sdir_shadewall(l,ib) shadewall_r_sky_dir(l) = shadewall_r_dir(l) * vf_sw(l) shadewall_r_road_dir(l) = shadewall_r_dir(l) * vf_rw(l) shadewall_r_sunwall_dir(l) = shadewall_r_dir(l) * vf_ww(l) - ! diffuse + ! step (4) + + sref_improad_dir(l,ib) = sref_improad_dir(l,ib) + improad_r_sky_dir(l) + sref_perroad_dir(l,ib) = sref_perroad_dir(l,ib) + perroad_r_sky_dir(l) + sref_sunwall_dir(l,ib) = sref_sunwall_dir(l,ib) + sunwall_r_sky_dir(l) + sref_shadewall_dir(l,ib) = sref_shadewall_dir(l,ib) + shadewall_r_sky_dir(l) + + ! step (5) + + crit = max(road_a_dir(l), sunwall_a_dir(l), shadewall_a_dir(l)) + if (crit < errcrit) exit + end do + if (iter_dir >= n) then + write (iulog,*) 'urban net solar radiation error: no convergence, direct beam' + write (iulog,*) 'clm model is stopping' + call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) + endif + + ! reflected diffuse + + do iter_dif = 1, n + ! step (1) + + stot(l) = (sunwall_r_road_dif(l) + shadewall_r_road_dif(l))*canyon_hwr(l) + road_a_dif(l) = 0.0_r8 + road_r_dif(l) = 0.0_r8 + improad_a_dif(l) = (1._r8-alb_improad_dif(l,ib)) * stot(l) + improad_r_dif(l) = alb_improad_dif(l,ib) * stot(l) + road_a_dif(l) = road_a_dif(l) + improad_a_dif(l)*wtroad_imperv(l) + road_r_dif(l) = road_r_dif(l) + improad_r_dif(l)*wtroad_imperv(l) + perroad_a_dif(l) = (1._r8-alb_perroad_dif(l,ib)) * stot(l) + perroad_r_dif(l) = alb_perroad_dif(l,ib) * stot(l) + road_a_dif(l) = road_a_dif(l) + perroad_a_dif(l)*wtroad_perv(l) + road_r_dif(l) = road_r_dif(l) + perroad_r_dif(l)*wtroad_perv(l) + + stot(l) = road_r_sunwall_dif(l)/canyon_hwr(l) + shadewall_r_sunwall_dif(l) + sunwall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * stot(l) + sunwall_r_dif(l) = alb_wall_dif(l,ib) * stot(l) + + stot(l) = road_r_shadewall_dif(l)/canyon_hwr(l) + sunwall_r_shadewall_dif(l) + shadewall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * stot(l) + shadewall_r_dif(l) = alb_wall_dif(l,ib) * stot(l) + + ! step (2) + + sabs_improad_dif(l,ib) = sabs_improad_dif(l,ib) + improad_a_dif(l) + sabs_perroad_dif(l,ib) = sabs_perroad_dif(l,ib) + perroad_a_dif(l) + sabs_sunwall_dif(l,ib) = sabs_sunwall_dif(l,ib) + sunwall_a_dif(l) + sabs_shadewall_dif(l,ib) = sabs_shadewall_dif(l,ib) + shadewall_a_dif(l) + + ! step (3) - road_a_dif(l) = 0.0_r8 - road_r_dif(l) = 0.0_r8 - improad_a_dif(l) = (1._r8-alb_improad_dif(l,ib)) * sdif_road(l,ib) - improad_r_dif(l) = alb_improad_dif(l,ib) * sdif_road(l,ib) improad_r_sky_dif(l) = improad_r_dif(l) * vf_sr(l) improad_r_sunwall_dif(l) = improad_r_dif(l) * vf_wr(l) improad_r_shadewall_dif(l) = improad_r_dif(l) * vf_wr(l) - road_a_dif(l) = road_a_dif(l) + improad_a_dif(l)*wtroad_imperv(l) - road_r_dif(l) = road_r_dif(l) + improad_r_dif(l)*wtroad_imperv(l) - perroad_a_dif(l) = (1._r8-alb_perroad_dif(l,ib)) * sdif_road(l,ib) - perroad_r_dif(l) = alb_perroad_dif(l,ib) * sdif_road(l,ib) perroad_r_sky_dif(l) = perroad_r_dif(l) * vf_sr(l) perroad_r_sunwall_dif(l) = perroad_r_dif(l) * vf_wr(l) perroad_r_shadewall_dif(l) = perroad_r_dif(l) * vf_wr(l) - road_a_dif(l) = road_a_dif(l) + perroad_a_dif(l)*wtroad_perv(l) - road_r_dif(l) = road_r_dif(l) + perroad_r_dif(l)*wtroad_perv(l) road_r_sky_dif(l) = road_r_dif(l) * vf_sr(l) road_r_sunwall_dif(l) = road_r_dif(l) * vf_wr(l) road_r_shadewall_dif(l) = road_r_dif(l) * vf_wr(l) - sunwall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * sdif_sunwall(l,ib) - sunwall_r_dif(l) = alb_wall_dif(l,ib) * sdif_sunwall(l,ib) sunwall_r_sky_dif(l) = sunwall_r_dif(l) * vf_sw(l) sunwall_r_road_dif(l) = sunwall_r_dif(l) * vf_rw(l) sunwall_r_shadewall_dif(l) = sunwall_r_dif(l) * vf_ww(l) - shadewall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * sdif_shadewall(l,ib) - shadewall_r_dif(l) = alb_wall_dif(l,ib) * sdif_shadewall(l,ib) shadewall_r_sky_dif(l) = shadewall_r_dif(l) * vf_sw(l) - shadewall_r_road_dif(l) = shadewall_r_dif(l) * vf_rw(l) - shadewall_r_sunwall_dif(l) = shadewall_r_dif(l) * vf_ww(l) - - ! initialize sum of direct and diffuse solar absorption and reflection for road and both walls - - sabs_improad_dir(l,ib) = improad_a_dir(l) - sabs_perroad_dir(l,ib) = perroad_a_dir(l) - sabs_sunwall_dir(l,ib) = sunwall_a_dir(l) - sabs_shadewall_dir(l,ib) = shadewall_a_dir(l) - - sabs_improad_dif(l,ib) = improad_a_dif(l) - sabs_perroad_dif(l,ib) = perroad_a_dif(l) - sabs_sunwall_dif(l,ib) = sunwall_a_dif(l) - sabs_shadewall_dif(l,ib) = shadewall_a_dif(l) - - sref_improad_dir(l,ib) = improad_r_sky_dir(l) - sref_perroad_dir(l,ib) = perroad_r_sky_dir(l) - sref_sunwall_dir(l,ib) = sunwall_r_sky_dir(l) - sref_shadewall_dir(l,ib) = shadewall_r_sky_dir(l) - - sref_improad_dif(l,ib) = improad_r_sky_dif(l) - sref_perroad_dif(l,ib) = perroad_r_sky_dif(l) - sref_sunwall_dif(l,ib) = sunwall_r_sky_dif(l) - sref_shadewall_dif(l,ib) = shadewall_r_sky_dif(l) - - end do - - ! absorption and reflection for walls and road with multiple reflections - ! (i.e., absorb and reflect initial reflection in canyon and allow for - ! subsequent scattering) - ! - ! (1) absorption and reflection of scattered solar radiation - ! road: reflected fluxes from walls need to be projected to ground area - ! wall: reflected flux from road needs to be projected to wall area - ! - ! (2) add absorbed radiation for ith reflection to total absorbed - ! - ! (3) distribute reflected radiation to sky, road, and walls according to view factors - ! - ! (4) add solar reflection to sky for ith reflection to total reflection - ! - ! (5) stop iteration when absorption for ith reflection is less than some nominal amount. - ! small convergence criteria is required to ensure solar radiation is conserved - ! - ! do separately for direct beam and diffuse - - do fl = 1,num_urbanl_coszen_gt0 - l = filter_urbanl_coszen_gt0(fl) - - ! reflected direct beam - - do iter_dir = 1, n - ! step (1) - - stot(l) = (sunwall_r_road_dir(l) + shadewall_r_road_dir(l))*canyon_hwr(l) + shadewall_r_road_dif(l) = shadewall_r_dif(l) * vf_rw(l) + shadewall_r_sunwall_dif(l) = shadewall_r_dif(l) * vf_ww(l) - road_a_dir(l) = 0.0_r8 - road_r_dir(l) = 0.0_r8 - improad_a_dir(l) = (1._r8-alb_improad_dir(l,ib)) * stot(l) - improad_r_dir(l) = alb_improad_dir(l,ib) * stot(l) - road_a_dir(l) = road_a_dir(l) + improad_a_dir(l)*wtroad_imperv(l) - road_r_dir(l) = road_r_dir(l) + improad_r_dir(l)*wtroad_imperv(l) - perroad_a_dir(l) = (1._r8-alb_perroad_dir(l,ib)) * stot(l) - perroad_r_dir(l) = alb_perroad_dir(l,ib) * stot(l) - road_a_dir(l) = road_a_dir(l) + perroad_a_dir(l)*wtroad_perv(l) - road_r_dir(l) = road_r_dir(l) + perroad_r_dir(l)*wtroad_perv(l) + ! step (4) - stot(l) = road_r_sunwall_dir(l)/canyon_hwr(l) + shadewall_r_sunwall_dir(l) - sunwall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * stot(l) - sunwall_r_dir(l) = alb_wall_dir(l,ib) * stot(l) + sref_improad_dif(l,ib) = sref_improad_dif(l,ib) + improad_r_sky_dif(l) + sref_perroad_dif(l,ib) = sref_perroad_dif(l,ib) + perroad_r_sky_dif(l) + sref_sunwall_dif(l,ib) = sref_sunwall_dif(l,ib) + sunwall_r_sky_dif(l) + sref_shadewall_dif(l,ib) = sref_shadewall_dif(l,ib) + shadewall_r_sky_dif(l) - stot(l) = road_r_shadewall_dir(l)/canyon_hwr(l) + sunwall_r_shadewall_dir(l) - shadewall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * stot(l) - shadewall_r_dir(l) = alb_wall_dir(l,ib) * stot(l) + ! step (5) - ! step (2) - - sabs_improad_dir(l,ib) = sabs_improad_dir(l,ib) + improad_a_dir(l) - sabs_perroad_dir(l,ib) = sabs_perroad_dir(l,ib) + perroad_a_dir(l) - sabs_sunwall_dir(l,ib) = sabs_sunwall_dir(l,ib) + sunwall_a_dir(l) - sabs_shadewall_dir(l,ib) = sabs_shadewall_dir(l,ib) + shadewall_a_dir(l) + crit = max(road_a_dif(l), sunwall_a_dif(l), shadewall_a_dif(l)) + if (crit < errcrit) exit + end do + if (iter_dif >= n) then + write (iulog,*) 'urban net solar radiation error: no convergence, diffuse' + write (iulog,*) 'clm model is stopping' + call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) + endif - ! step (3) + ! total reflected by canyon - sum of solar reflection to sky from canyon. + ! project wall fluxes to horizontal surface + + sref_canyon_dir(l) = 0.0_r8 + sref_canyon_dif(l) = 0.0_r8 + sref_canyon_dir(l) = sref_canyon_dir(l) + sref_improad_dir(l,ib)*wtroad_imperv(l) + sref_canyon_dif(l) = sref_canyon_dif(l) + sref_improad_dif(l,ib)*wtroad_imperv(l) + sref_canyon_dir(l) = sref_canyon_dir(l) + sref_perroad_dir(l,ib)*wtroad_perv(l) + sref_canyon_dif(l) = sref_canyon_dif(l) + sref_perroad_dif(l,ib)*wtroad_perv(l) + sref_canyon_dir(l) = sref_canyon_dir(l) + (sref_sunwall_dir(l,ib) + sref_shadewall_dir(l,ib))*canyon_hwr(l) + sref_canyon_dif(l) = sref_canyon_dif(l) + (sref_sunwall_dif(l,ib) + sref_shadewall_dif(l,ib))*canyon_hwr(l) + + ! total absorbed by canyon. project wall fluxes to horizontal surface + + sabs_canyon_dir(l) = 0.0_r8 + sabs_canyon_dif(l) = 0.0_r8 + sabs_canyon_dir(l) = sabs_canyon_dir(l) + sabs_improad_dir(l,ib)*wtroad_imperv(l) + sabs_canyon_dif(l) = sabs_canyon_dif(l) + sabs_improad_dif(l,ib)*wtroad_imperv(l) + sabs_canyon_dir(l) = sabs_canyon_dir(l) + sabs_perroad_dir(l,ib)*wtroad_perv(l) + sabs_canyon_dif(l) = sabs_canyon_dif(l) + sabs_perroad_dif(l,ib)*wtroad_perv(l) + sabs_canyon_dir(l) = sabs_canyon_dir(l) + (sabs_sunwall_dir(l,ib) + sabs_shadewall_dir(l,ib))*canyon_hwr(l) + sabs_canyon_dif(l) = sabs_canyon_dif(l) + (sabs_sunwall_dif(l,ib) + sabs_shadewall_dif(l,ib))*canyon_hwr(l) + + ! conservation check. note: previous conservation checks confirm partioning of total direct + ! beam and diffuse radiation from atmosphere to road and walls is conserved as + ! sdir (from atmosphere) = sdir_road + (sdir_sunwall + sdir_shadewall)*canyon_hwr + ! sdif (from atmosphere) = sdif_road + (sdif_sunwall + sdif_shadewall)*canyon_hwr + + stot_dir(l) = sdir_road(l,ib) + (sdir_sunwall(l,ib) + sdir_shadewall(l,ib))*canyon_hwr(l) + stot_dif(l) = sdif_road(l,ib) + (sdif_sunwall(l,ib) + sdif_shadewall(l,ib))*canyon_hwr(l) + + err = stot_dir(l) + stot_dif(l) & + - (sabs_canyon_dir(l) + sabs_canyon_dif(l) + sref_canyon_dir(l) + sref_canyon_dif(l)) + if (abs(err) > 0.001_r8 ) then + write(iulog,*)'urban net solar radiation balance error for ib=',ib,' err= ',err + write(iulog,*)' l= ',l,' ib= ',ib + write(iulog,*)' stot_dir = ',stot_dir(l) + write(iulog,*)' stot_dif = ',stot_dif(l) + write(iulog,*)' sabs_canyon_dir = ',sabs_canyon_dir(l) + write(iulog,*)' sabs_canyon_dif = ',sabs_canyon_dif(l) + write(iulog,*)' sref_canyon_dir = ',sref_canyon_dir(l) + write(iulog,*)' sref_canyon_dif = ',sref_canyon_dir(l) + write(iulog,*) 'clm model is stopping' + call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) + endif - improad_r_sky_dir(l) = improad_r_dir(l) * vf_sr(l) - improad_r_sunwall_dir(l) = improad_r_dir(l) * vf_wr(l) - improad_r_shadewall_dir(l) = improad_r_dir(l) * vf_wr(l) + ! canyon albedo - perroad_r_sky_dir(l) = perroad_r_dir(l) * vf_sr(l) - perroad_r_sunwall_dir(l) = perroad_r_dir(l) * vf_wr(l) - perroad_r_shadewall_dir(l) = perroad_r_dir(l) * vf_wr(l) - - road_r_sky_dir(l) = road_r_dir(l) * vf_sr(l) - road_r_sunwall_dir(l) = road_r_dir(l) * vf_wr(l) - road_r_shadewall_dir(l) = road_r_dir(l) * vf_wr(l) - - sunwall_r_sky_dir(l) = sunwall_r_dir(l) * vf_sw(l) - sunwall_r_road_dir(l) = sunwall_r_dir(l) * vf_rw(l) - sunwall_r_shadewall_dir(l) = sunwall_r_dir(l) * vf_ww(l) - - shadewall_r_sky_dir(l) = shadewall_r_dir(l) * vf_sw(l) - shadewall_r_road_dir(l) = shadewall_r_dir(l) * vf_rw(l) - shadewall_r_sunwall_dir(l) = shadewall_r_dir(l) * vf_ww(l) - - ! step (4) - - sref_improad_dir(l,ib) = sref_improad_dir(l,ib) + improad_r_sky_dir(l) - sref_perroad_dir(l,ib) = sref_perroad_dir(l,ib) + perroad_r_sky_dir(l) - sref_sunwall_dir(l,ib) = sref_sunwall_dir(l,ib) + sunwall_r_sky_dir(l) - sref_shadewall_dir(l,ib) = sref_shadewall_dir(l,ib) + shadewall_r_sky_dir(l) - - ! step (5) - - crit = max(road_a_dir(l), sunwall_a_dir(l), shadewall_a_dir(l)) - if (crit < errcrit) exit - end do - if (iter_dir >= n) then - write (iulog,*) 'urban net solar radiation error: no convergence, direct beam' - write (iulog,*) 'clm model is stopping' - call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) - endif - - ! reflected diffuse - - do iter_dif = 1, n - ! step (1) - - stot(l) = (sunwall_r_road_dif(l) + shadewall_r_road_dif(l))*canyon_hwr(l) - road_a_dif(l) = 0.0_r8 - road_r_dif(l) = 0.0_r8 - improad_a_dif(l) = (1._r8-alb_improad_dif(l,ib)) * stot(l) - improad_r_dif(l) = alb_improad_dif(l,ib) * stot(l) - road_a_dif(l) = road_a_dif(l) + improad_a_dif(l)*wtroad_imperv(l) - road_r_dif(l) = road_r_dif(l) + improad_r_dif(l)*wtroad_imperv(l) - perroad_a_dif(l) = (1._r8-alb_perroad_dif(l,ib)) * stot(l) - perroad_r_dif(l) = alb_perroad_dif(l,ib) * stot(l) - road_a_dif(l) = road_a_dif(l) + perroad_a_dif(l)*wtroad_perv(l) - road_r_dif(l) = road_r_dif(l) + perroad_r_dif(l)*wtroad_perv(l) - - stot(l) = road_r_sunwall_dif(l)/canyon_hwr(l) + shadewall_r_sunwall_dif(l) - sunwall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * stot(l) - sunwall_r_dif(l) = alb_wall_dif(l,ib) * stot(l) - - stot(l) = road_r_shadewall_dif(l)/canyon_hwr(l) + sunwall_r_shadewall_dif(l) - shadewall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * stot(l) - shadewall_r_dif(l) = alb_wall_dif(l,ib) * stot(l) - - ! step (2) - - sabs_improad_dif(l,ib) = sabs_improad_dif(l,ib) + improad_a_dif(l) - sabs_perroad_dif(l,ib) = sabs_perroad_dif(l,ib) + perroad_a_dif(l) - sabs_sunwall_dif(l,ib) = sabs_sunwall_dif(l,ib) + sunwall_a_dif(l) - sabs_shadewall_dif(l,ib) = sabs_shadewall_dif(l,ib) + shadewall_a_dif(l) - - ! step (3) - - improad_r_sky_dif(l) = improad_r_dif(l) * vf_sr(l) - improad_r_sunwall_dif(l) = improad_r_dif(l) * vf_wr(l) - improad_r_shadewall_dif(l) = improad_r_dif(l) * vf_wr(l) - - perroad_r_sky_dif(l) = perroad_r_dif(l) * vf_sr(l) - perroad_r_sunwall_dif(l) = perroad_r_dif(l) * vf_wr(l) - perroad_r_shadewall_dif(l) = perroad_r_dif(l) * vf_wr(l) - - road_r_sky_dif(l) = road_r_dif(l) * vf_sr(l) - road_r_sunwall_dif(l) = road_r_dif(l) * vf_wr(l) - road_r_shadewall_dif(l) = road_r_dif(l) * vf_wr(l) - - sunwall_r_sky_dif(l) = sunwall_r_dif(l) * vf_sw(l) - sunwall_r_road_dif(l) = sunwall_r_dif(l) * vf_rw(l) - sunwall_r_shadewall_dif(l) = sunwall_r_dif(l) * vf_ww(l) - - shadewall_r_sky_dif(l) = shadewall_r_dif(l) * vf_sw(l) - shadewall_r_road_dif(l) = shadewall_r_dif(l) * vf_rw(l) - shadewall_r_sunwall_dif(l) = shadewall_r_dif(l) * vf_ww(l) - - ! step (4) - - sref_improad_dif(l,ib) = sref_improad_dif(l,ib) + improad_r_sky_dif(l) - sref_perroad_dif(l,ib) = sref_perroad_dif(l,ib) + perroad_r_sky_dif(l) - sref_sunwall_dif(l,ib) = sref_sunwall_dif(l,ib) + sunwall_r_sky_dif(l) - sref_shadewall_dif(l,ib) = sref_shadewall_dif(l,ib) + shadewall_r_sky_dif(l) - - ! step (5) - - crit = max(road_a_dif(l), sunwall_a_dif(l), shadewall_a_dif(l)) - if (crit < errcrit) exit - end do - if (iter_dif >= n) then - write (iulog,*) 'urban net solar radiation error: no convergence, diffuse' - write (iulog,*) 'clm model is stopping' - call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) - endif - - ! total reflected by canyon - sum of solar reflection to sky from canyon. - ! project wall fluxes to horizontal surface - - sref_canyon_dir(l) = 0.0_r8 - sref_canyon_dif(l) = 0.0_r8 - sref_canyon_dir(l) = sref_canyon_dir(l) + sref_improad_dir(l,ib)*wtroad_imperv(l) - sref_canyon_dif(l) = sref_canyon_dif(l) + sref_improad_dif(l,ib)*wtroad_imperv(l) - sref_canyon_dir(l) = sref_canyon_dir(l) + sref_perroad_dir(l,ib)*wtroad_perv(l) - sref_canyon_dif(l) = sref_canyon_dif(l) + sref_perroad_dif(l,ib)*wtroad_perv(l) - sref_canyon_dir(l) = sref_canyon_dir(l) + (sref_sunwall_dir(l,ib) + sref_shadewall_dir(l,ib))*canyon_hwr(l) - sref_canyon_dif(l) = sref_canyon_dif(l) + (sref_sunwall_dif(l,ib) + sref_shadewall_dif(l,ib))*canyon_hwr(l) - - ! total absorbed by canyon. project wall fluxes to horizontal surface - - sabs_canyon_dir(l) = 0.0_r8 - sabs_canyon_dif(l) = 0.0_r8 - sabs_canyon_dir(l) = sabs_canyon_dir(l) + sabs_improad_dir(l,ib)*wtroad_imperv(l) - sabs_canyon_dif(l) = sabs_canyon_dif(l) + sabs_improad_dif(l,ib)*wtroad_imperv(l) - sabs_canyon_dir(l) = sabs_canyon_dir(l) + sabs_perroad_dir(l,ib)*wtroad_perv(l) - sabs_canyon_dif(l) = sabs_canyon_dif(l) + sabs_perroad_dif(l,ib)*wtroad_perv(l) - sabs_canyon_dir(l) = sabs_canyon_dir(l) + (sabs_sunwall_dir(l,ib) + sabs_shadewall_dir(l,ib))*canyon_hwr(l) - sabs_canyon_dif(l) = sabs_canyon_dif(l) + (sabs_sunwall_dif(l,ib) + sabs_shadewall_dif(l,ib))*canyon_hwr(l) - - ! conservation check. note: previous conservation checks confirm partioning of total direct - ! beam and diffuse radiation from atmosphere to road and walls is conserved as - ! sdir (from atmosphere) = sdir_road + (sdir_sunwall + sdir_shadewall)*canyon_hwr - ! sdif (from atmosphere) = sdif_road + (sdif_sunwall + sdif_shadewall)*canyon_hwr - - stot_dir(l) = sdir_road(l,ib) + (sdir_sunwall(l,ib) + sdir_shadewall(l,ib))*canyon_hwr(l) - stot_dif(l) = sdif_road(l,ib) + (sdif_sunwall(l,ib) + sdif_shadewall(l,ib))*canyon_hwr(l) - - err = stot_dir(l) + stot_dif(l) & - - (sabs_canyon_dir(l) + sabs_canyon_dif(l) + sref_canyon_dir(l) + sref_canyon_dif(l)) - if (abs(err) > 0.001_r8 ) then - write(iulog,*)'urban net solar radiation balance error for ib=',ib,' err= ',err - write(iulog,*)' l= ',l,' ib= ',ib - write(iulog,*)' stot_dir = ',stot_dir(l) - write(iulog,*)' stot_dif = ',stot_dif(l) - write(iulog,*)' sabs_canyon_dir = ',sabs_canyon_dir(l) - write(iulog,*)' sabs_canyon_dif = ',sabs_canyon_dif(l) - write(iulog,*)' sref_canyon_dir = ',sref_canyon_dir(l) - write(iulog,*)' sref_canyon_dif = ',sref_canyon_dir(l) - write(iulog,*) 'clm model is stopping' - call endrun(subgrid_index=l, subgrid_level=subgrid_level_landunit, msg=errmsg(sourcefile, __LINE__)) - endif - - ! canyon albedo - - canyon_alb_dif(l) = sref_canyon_dif(l) / max(stot_dif(l), 1.e-06_r8) - canyon_alb_dir(l) = sref_canyon_dir(l) / max(stot_dir(l), 1.e-06_r8) + canyon_alb_dif(l) = sref_canyon_dif(l) / max(stot_dif(l), 1.e-06_r8) + canyon_alb_dir(l) = sref_canyon_dir(l) / max(stot_dir(l), 1.e-06_r8) end do ! end of landunit loop - ! Refected and absorbed solar radiation per unit incident radiation for roof + ! Reflected and absorbed solar radiation per unit incident radiation for roof do fl = 1,num_urbanl_coszen_gt0 l = filter_urbanl_coszen_gt0(fl)