Changeset 3378 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Oct 19, 2018 12:34:59 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r3372 r3378 28 28 ! ----------------- 29 29 ! $Id$ 30 ! merge from radiation branch (r3362) into trunk 31 ! (moh.hefny): 32 ! - removed read/write_svf_on_init and read_dist_max_svf (not used anymore) 33 ! - bugfix nzut > nzpt in calculating maxboxes 34 ! 35 ! 3372 2018-10-18 14:03:19Z raasch 30 36 ! bugfix: kind type of 2nd argument of mpi_win_allocate changed, misplaced 31 37 ! __parallel directive … … 619 625 radiation_interactions = .FALSE., & !< flag to activiate RTM (TRUE only if vertical urban/land surface and trees exist) 620 626 surface_reflections = .TRUE., & !< flag to switch the calculation of radiation interaction between surfaces. 621 !< When it switched off, only the effect of buildings and trees shadow will627 !< When it switched off, only the effect of buildings and trees shadow 622 628 !< will be considered. However fewer SVFs are expected. 623 629 radiation_interactions_on = .TRUE. !< namelist flag to force RTM activiation regardless to vertical urban/land surface and trees … … 776 782 rrtm_swhr, & !< RRTM output of shortwave radiation heating rate (K/d) 777 783 rrtm_swhrc, & !< RRTM output of incoming shortwave clear sky radiation heating rate (K/d) 778 rrtm_dirdflux, & !< RRTM output of incoming direct shortwave (W/m )779 rrtm_difdflux !< RRTM output of incoming diffuse shortwave (W/m )784 rrtm_dirdflux, & !< RRTM output of incoming direct shortwave (W/m2) 785 rrtm_difdflux !< RRTM output of incoming diffuse shortwave (W/m2) 780 786 781 787 REAL(wp), DIMENSION(1) :: rrtm_aldif, & !< surface albedo for longwave diffuse radiation … … 987 993 INTEGER(iwp), PARAMETER :: gasize = 100000 !< initial size of growing arrays 988 994 REAL(wp), PARAMETER :: grow_factor = 1.4_wp !< growth factor of growing arrays 989 REAL(wp) :: dist_max_svf = -9999.0 !< maximum distance to calculate the minimum svf to be considered. It is990 !< used to avoid very small SVFs resulting from too far surfaces with mutual visibility991 995 INTEGER(iwp) :: nsvfl !< number of svf for local processor 992 996 INTEGER(iwp) :: ncsfl !< no. of csf in local processor … … 1158 1162 skip_time_do_radiation, time_radiation, unscheduled_radiation_calls,& 1159 1163 zenith, calc_zenith, sun_direction, sun_dir_lat, sun_dir_lon, & 1160 write_svf_on_init, read_svf_on_init, & 1161 nrefsteps, dist_max_svf, nsvfl, svf, & 1164 nrefsteps, nsvfl, svf, & 1162 1165 svfsurf, surfinsw, surfinlw, surfins, surfinl, surfinswdir, & 1163 1166 surfinswdif, surfoutsw, surfoutlw, surfinlwdif, rad_sw_in_dir, & … … 1167 1170 iup_u, inorth_u, isouth_u, ieast_u, iwest_u, & 1168 1171 iup_l, inorth_l, isouth_l, ieast_l, iwest_l, & 1169 nsurf_type, nzub, nzut, nz pt, nzu, pch, nsurf,&1172 nsurf_type, nzub, nzut, nzu, pch, nsurf, & 1170 1173 idsvf, ndsvf, idcsf, ndcsf, kdcsf, pct, & 1171 1174 radiation_interactions, startwall, startland, endland, endwall, & … … 2910 2913 radiation_scheme, skip_time_do_radiation, & 2911 2914 sw_radiation, unscheduled_radiation_calls, & 2912 read_svf_on_init, write_svf_on_init, &2913 2915 max_raytracing_dist, min_irrf_value, & 2914 2916 nrefsteps, raytrace_mpi_rma, & 2915 dist_max_svf, &2916 2917 surface_reflections, svfnorm_report_thresh, & 2917 2918 radiation_interactions_on, & … … 2929 2930 max_raytracing_dist, min_irrf_value, & 2930 2931 nrefsteps, raytrace_mpi_rma, & 2931 dist_max_svf, &2932 2932 surface_reflections, svfnorm_report_thresh, & 2933 2933 radiation_interactions_on, & … … 4629 4629 REAL(wp), PARAMETER :: alpha = 0._wp !< grid rotation (TODO: add to namelist or remove) 4630 4630 REAL(wp) :: pc_box_area, pc_abs_frac, pc_abs_eff 4631 ! REAL(wp) :: count_surfaces !< number of all surfaces in model domain4632 ! REAL(wp) :: count_surfaces_l !< number of all surfaces in sub-domain4633 ! REAL(wp) :: pt_surf_urb !< mean surface temperature of all surfaces in model domain, temporal work-around4634 ! REAL(wp) :: pt_surf_urb_l !< mean surface temperature of all surfaces in sub-domain, temporal work-around4635 4636 4631 REAL(wp), DIMENSION(0:nsurf_type) :: facearea 4637 4632 REAL(wp) :: pabsswl = 0.0_wp !< total absorbed SW radiation energy in local processor (W) … … 4686 4681 !-- precompute effective box depth with prototype Leaf Area Density 4687 4682 pc_box_dimshift = MAXLOC(ABS(sunorig), 1) - 1 4688 CALL box_absorb(CSHIFT((/dz(1),dy,dx/), pc_box_dimshift), &4683 CALL box_absorb(CSHIFT((/dz(1),dy,dx/), pc_box_dimshift), & 4689 4684 60, prototype_lad, & 4690 4685 CSHIFT(ABS(sunorig), pc_box_dimshift), & 4691 4686 pc_box_area, pc_abs_frac) 4692 pc_box_area = pc_box_area * ABS(sunorig(pc_box_dimshift+1) / sunorig(1)) 4687 pc_box_area = pc_box_area * ABS(sunorig(pc_box_dimshift+1) & 4688 / sunorig(1)) 4693 4689 pc_abs_eff = LOG(1._wp - pc_abs_frac) / prototype_lad 4694 4690 ENDIF … … 4838 4834 j = surfl(iy, isurf) 4839 4835 i = surfl(ix, isurf) 4840 surfinswdir(isurf) = rad_sw_in_dir(j,i) * costheta(surfl(id, isurf)) * dsitrans(isurf, isd) / zenith(0) 4836 surfinswdir(isurf) = rad_sw_in_dir(j,i) * & 4837 costheta(surfl(id, isurf)) * dsitrans(isurf, isd) / zenith(0) 4841 4838 ENDDO 4842 4839 ! … … 5248 5245 t_rad_urb = ( (pemitlw - pabslw + emissivity_urb*pinlw) / & 5249 5246 (emissivity_urb*sigma_sb * area_hor) )**0.25_wp 5250 !5251 !-- It has been turned out that the effective radiative temperature is far5252 !-- too high during nighttime, resulting in unphysical radiative forcing5253 !-- with wrong signs. For the moment, as a work-around, compute the mean5254 !-- surface temperature from all surface elements, resulting in more5255 !-- physically meaningful radiative forcings.5256 ! pt_surf_urb_l = 0.0_wp5257 ! count_surfaces_l = 0.0_wp5258 ! DO m = 1, surf_lsm_h%ns5259 ! k = surf_lsm_h%k(m)5260 ! pt_surf_urb_l = pt_surf_urb_l + surf_lsm_h%pt_surface(m) &5261 ! * exner(k)5262 ! count_surfaces_l = count_surfaces_l + 1.0_wp5263 ! ENDDO5264 ! DO m = 1, surf_usm_h%ns5265 ! k = surf_usm_h%k(m)5266 ! pt_surf_urb_l = pt_surf_urb_l + surf_usm_h%pt_surface(m) &5267 ! * exner(k)5268 ! count_surfaces_l = count_surfaces_l + 1.0_wp5269 ! ENDDO5270 ! DO l = 0, 35271 ! DO m = 1, surf_lsm_v(l)%ns5272 ! k = surf_lsm_v(l)%k(m)5273 ! pt_surf_urb_l = pt_surf_urb_l + surf_lsm_v(l)%pt_surface(m) &5274 ! * exner(k)5275 ! count_surfaces_l = count_surfaces_l + 1.0_wp5276 ! ENDDO5277 ! DO m = 1, surf_usm_v(l)%ns5278 ! k = surf_usm_v(l)%k(m)5279 ! pt_surf_urb_l = pt_surf_urb_l + surf_usm_v(l)%pt_surface(m) * exner(k)5280 ! count_surfaces_l = count_surfaces_l + 1.0_wp5281 ! ENDDO5282 ! ENDDO5283 !5284 ! pt_surf_urb = 0.0_wp5285 ! count_surfaces = 0.0_wp5286 !5287 ! #if defined( __parallel )5288 ! CALL MPI_ALLREDUCE( count_surfaces_l, count_surfaces, 1, MPI_REAL, &5289 ! MPI_SUM, comm2d, ierr)5290 ! CALL MPI_ALLREDUCE( pt_surf_urb_l, pt_surf_urb, 1, MPI_REAL, &5291 ! MPI_SUM, comm2d, ierr)5292 ! #else5293 ! count_surfaces_l = count_surfaces5294 ! pt_surf_urb_l = pt_surf_urb5295 ! #endif5296 !5297 ! t_rad_urb = pt_surf_urb / count_surfaces5298 5299 5247 5300 5248 CONTAINS … … 5469 5417 #endif 5470 5418 5471 5472 !INTEGER(iwp), DIMENSION(1:4,inorth_b:iwest_b) :: ijdb !< start and end of the local domain border coordinates (set in code)5473 !LOGICAL, DIMENSION(inorth_b:iwest_b) :: isborder !< is PE on the border of the domain in four corresponding directions5474 5475 5419 ! 5476 5420 !-- Find nzub, nzut, nzu via wall_flag_0 array (nzb_s_inner will be … … 5566 5510 !-- check max_raytracing_dist relative to urban surface layer height 5567 5511 mrl = 2.0_wp * nzu * dz(1) 5512 !-- set max_raytracing_dist to double the urban surface layer height, if not set 5568 5513 IF ( max_raytracing_dist == -999.0_wp ) THEN 5569 5514 max_raytracing_dist = mrl 5515 ENDIF 5516 !-- check if max_raytracing_dist set too low (here we only warn the user. Other 5517 ! option is to correct the value again to double the urban surface layer height) 5518 IF ( max_raytracing_dist < mrl ) THEN 5519 WRITE(message_string, '(a,f6.1)') 'Max_raytracing_dist is set less than ', & 5520 'double the urban surface layer height, i.e. ', mrl 5521 CALL message('radiation_interaction_init', 'PA0521', 0, 0, -1, 6, 0) 5570 5522 ENDIF 5571 5523 ! IF ( max_raytracing_dist <= mrl ) THEN … … 6303 6255 ENDDO 6304 6256 6305 6306 !--Advance itarget indices6257 ! 6258 !-- Advance itarget indices 6307 6259 itarg0 = itarg1 + 1 6308 6260 itarg1 = itarg1 + nzn … … 7467 7419 !-- 7468 7420 maxboxes = (ntrack + MAX(CEILING(origin(1)-.5_wp) - nzub, & 7469 nz pt - CEILING(origin(1)-.5_wp))) * nrays7421 nzut - CEILING(origin(1)-.5_wp))) * nrays 7470 7422 IF ( ncsfl + maxboxes > ncsfla ) THEN 7471 7423 !-- use this code for growing by fixed exponential increments (equivalent to case where ncsfl always increases by 1) … … 8284 8236 !> It is called outside from usm_urban_surface_mod whenever the radiation fluxes 8285 8237 !> are needed. 8238 !> 8239 !> This routine is not used so far. However, it may serve as an interface for radiation 8240 !> fluxes of urban and land surfaces 8286 8241 !> 8287 8242 !> TODO:
Note: See TracChangeset
for help on using the changeset viewer.
