Changeset 4210
- Timestamp:
- Sep 2, 2019 1:07:09 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r4208 r4210 28 28 ! ----------------- 29 29 ! $Id$ 30 ! - Revise steering of splitting diffuse and direct radiation 31 ! - Bugfixes in checks 32 ! - Optimize mapping of radiation components onto 2D arrays, avoid unnecessary 33 ! operations 34 ! 35 ! 4208 2019-09-02 09:01:07Z suehring 30 36 ! Bugfix in accessing albedo_pars in the clear-sky branch (merge from branch) 31 37 ! … … 2694 2700 !-- Currently, 2D external radiation input is not possible in 2695 2701 !-- combination with topography where average radiation is used. 2696 IF ( ( rad_ sw_in_f%lod == 2 .OR. rad_sw_in_f%lod == 2 .OR. &2702 IF ( ( rad_lw_in_f%lod == 2 .OR. rad_sw_in_f%lod == 2 .OR. & 2697 2703 rad_sw_in_dif_f%lod == 2 ) .AND. average_radiation ) THEN 2698 2704 message_string = 'External radiation with lod = 2 is currently '//& … … 2704 2710 !-- of lods divided by the number of available radiation arrays must be 2705 2711 !-- 1 (if all are lod = 1) or 2 (if all are lod = 2). 2706 IF ( REAL( MERGE( rad_ sw_in_f%lod, 0, rad_sw_in_f%from_file ) + &2712 IF ( REAL( MERGE( rad_lw_in_f%lod, 0, rad_lw_in_f%from_file ) + & 2707 2713 MERGE( rad_sw_in_f%lod, 0, rad_sw_in_f%from_file ) + & 2708 2714 MERGE( rad_sw_in_dif_f%lod, 0, rad_sw_in_dif_f%from_file ),& 2709 2715 KIND = wp ) / & 2710 ( MERGE( 1.0_wp, 0.0_wp, rad_ sw_in_f%from_file ) + &2716 ( MERGE( 1.0_wp, 0.0_wp, rad_lw_in_f%from_file ) + & 2711 2717 MERGE( 1.0_wp, 0.0_wp, rad_sw_in_f%from_file ) + & 2712 2718 MERGE( 1.0_wp, 0.0_wp, rad_sw_in_dif_f%from_file ) ) & 2713 2719 /= 1.0_wp .AND. & 2714 REAL( MERGE( rad_ sw_in_f%lod, 0, rad_sw_in_f%from_file ) + &2720 REAL( MERGE( rad_lw_in_f%lod, 0, rad_lw_in_f%from_file ) + & 2715 2721 MERGE( rad_sw_in_f%lod, 0, rad_sw_in_f%from_file ) + & 2716 2722 MERGE( rad_sw_in_dif_f%lod, 0, rad_sw_in_dif_f%from_file ),& 2717 2723 KIND = wp ) / & 2718 ( MERGE( 1.0_wp, 0.0_wp, rad_ sw_in_f%from_file ) + &2724 ( MERGE( 1.0_wp, 0.0_wp, rad_lw_in_f%from_file ) + & 2719 2725 MERGE( 1.0_wp, 0.0_wp, rad_sw_in_f%from_file ) + & 2720 2726 MERGE( 1.0_wp, 0.0_wp, rad_sw_in_dif_f%from_file ) ) & … … 2808 2814 INTEGER(iwp) :: t !< index of current timestep 2809 2815 INTEGER(iwp) :: tm !< index of previous timestep 2816 2817 LOGICAL :: horizontal !< flag indicating treatment of horinzontal surfaces 2810 2818 2811 2819 REAL(wp) :: fac_dt !< interpolation factor … … 2837 2845 !-- Call clear-sky calculation for each surface orientation. 2838 2846 !-- First, horizontal surfaces 2847 horizontal = .TRUE. 2839 2848 surf => surf_lsm_h 2840 2849 CALL radiation_external_surf 2841 2850 surf => surf_usm_h 2842 2851 CALL radiation_external_surf 2852 horizontal = .FALSE. 2843 2853 ! 2844 2854 !-- Vertical surfaces … … 3018 3028 !-- longwave radiation 3019 3029 IF ( ALLOCATED( rad_lw_in_diff ) ) & 3020 rad_lw_in_diff = surf%rad_lw_in(m)3030 rad_lw_in_diff(j,i) = surf%rad_lw_in(m) 3021 3031 ENDIF 3022 3032 … … 3026 3036 ! 3027 3037 !-- Store radiation also on 2D arrays, which are still used for 3028 !-- direct-diffuse splitting. 3029 DO m = 1, surf%ns 3030 i = surf%i(m) 3031 j = surf%j(m) 3032 3033 rad_sw_in(0,:,:) = surf%rad_sw_in(m) 3034 rad_lw_in(0,:,:) = surf%rad_lw_in(m) 3035 rad_sw_out(0,j,i) = surf%rad_sw_out(m) 3036 rad_lw_out(0,j,i) = surf%rad_lw_out(m) 3037 ENDDO 3038 !-- direct-diffuse splitting. Note, this is only required 3039 !-- for horizontal surfaces, which covers all x,y position. 3040 IF ( horizontal ) THEN 3041 DO m = 1, surf%ns 3042 i = surf%i(m) 3043 j = surf%j(m) 3044 3045 rad_sw_in(0,j,i) = surf%rad_sw_in(m) 3046 rad_lw_in(0,j,i) = surf%rad_lw_in(m) 3047 rad_sw_out(0,j,i) = surf%rad_sw_out(m) 3048 rad_lw_out(0,j,i) = surf%rad_lw_out(m) 3049 ENDDO 3050 ENDIF 3038 3051 3039 3052 END SUBROUTINE radiation_external_surf … … 3052 3065 3053 3066 INTEGER(iwp) :: l !< running index for surface orientation 3067 3068 LOGICAL :: horizontal !< flag indicating treatment of horinzontal surfaces 3069 3054 3070 REAL(wp) :: pt1 !< potential temperature at first grid level or mean value at urban layer top 3055 3071 REAL(wp) :: pt1_l !< potential temperature at first grid level or mean value at urban layer top at local subdomain … … 3107 3123 !-- Call clear-sky calculation for each surface orientation. 3108 3124 !-- First, horizontal surfaces 3125 horizontal = .TRUE. 3109 3126 surf => surf_lsm_h 3110 3127 CALL radiation_clearsky_surf 3111 3128 surf => surf_usm_h 3112 3129 CALL radiation_clearsky_surf 3130 horizontal = .FALSE. 3113 3131 ! 3114 3132 !-- Vertical surfaces … … 3215 3233 3216 3234 ! 3217 !-- Fill out values in radiation arrays 3218 DO m = 1, surf%ns 3219 i = surf%i(m) 3220 j = surf%j(m) 3221 rad_sw_in(0,j,i) = surf%rad_sw_in(m) 3222 rad_sw_out(0,j,i) = surf%rad_sw_out(m) 3223 rad_lw_in(0,j,i) = surf%rad_lw_in(m) 3224 rad_lw_out(0,j,i) = surf%rad_lw_out(m) 3225 ENDDO 3235 !-- Fill out values in radiation arrays. Note, this is only required 3236 !-- for horizontal surfaces, which covers all x,y position. 3237 IF ( horizontal ) THEN 3238 DO m = 1, surf%ns 3239 i = surf%i(m) 3240 j = surf%j(m) 3241 rad_sw_in(0,j,i) = surf%rad_sw_in(m) 3242 rad_sw_out(0,j,i) = surf%rad_sw_out(m) 3243 rad_lw_in(0,j,i) = surf%rad_lw_in(m) 3244 rad_lw_out(0,j,i) = surf%rad_lw_out(m) 3245 ENDDO 3246 ENDIF 3226 3247 3227 3248 END SUBROUTINE radiation_clearsky_surf … … 3241 3262 3242 3263 INTEGER(iwp) :: l !< running index for surface orientation 3264 3265 LOGICAL :: horizontal !< flag indicating treatment of horinzontal surfaces 3243 3266 3244 3267 REAL(wp) :: pt1 !< potential temperature at first grid level or mean value at urban layer top … … 3285 3308 ! 3286 3309 !-- First, horizontal surfaces 3310 horizontal = .TRUE. 3287 3311 surf => surf_lsm_h 3288 3312 CALL radiation_constant_surf 3289 3313 surf => surf_usm_h 3290 3314 CALL radiation_constant_surf 3315 horizontal = .FALSE. 3291 3316 ! 3292 3317 !-- Vertical surfaces … … 3397 3422 3398 3423 ! 3399 !-- Fill out values in radiation arrays 3400 DO m = 1, surf%ns 3401 i = surf%i(m) 3402 j = surf%j(m) 3403 rad_sw_in(0,j,i) = surf%rad_sw_in(m) 3404 rad_sw_out(0,j,i) = surf%rad_sw_out(m) 3405 rad_lw_in(0,j,i) = surf%rad_lw_in(m) 3406 rad_lw_out(0,j,i) = surf%rad_lw_out(m) 3407 ENDDO 3424 !-- Fill out values in radiation arrays. Note, this is only required 3425 !-- for horizontal surfaces, which covers all x,y position. 3426 IF ( horizontal ) THEN 3427 DO m = 1, surf%ns 3428 i = surf%i(m) 3429 j = surf%j(m) 3430 rad_sw_in(0,j,i) = surf%rad_sw_in(m) 3431 rad_sw_out(0,j,i) = surf%rad_sw_out(m) 3432 rad_lw_in(0,j,i) = surf%rad_lw_in(m) 3433 rad_lw_out(0,j,i) = surf%rad_lw_out(m) 3434 ENDDO 3435 ENDIF 3408 3436 3409 3437 END SUBROUTINE radiation_constant_surf … … 5421 5449 !-- Split downwelling shortwave radiation into a diffuse and a direct part. 5422 5450 !-- Note, if radiation scheme is RRTMG or diffuse radiation is externally 5423 !-- prescribed, this is not required. 5424 IF ( radiation_scheme /= 'rrtmg' .AND. & 5425 .NOT. rad_sw_in_dif_f%from_file ) CALL calc_diffusion_radiation 5451 !-- prescribed, this is not required. Please note, in case of external 5452 !-- radiation, the clear-sky model is applied during spinup, so that 5453 !-- radiation need to be split also in this case. 5454 IF ( radiation_scheme == 'constant' .OR. & 5455 radiation_scheme == 'clear-sky' .OR. & 5456 ( radiation_scheme == 'external' .AND. & 5457 .NOT. rad_sw_in_dif_f%from_file ) .OR. & 5458 ( radiation_scheme == 'external' .AND. & 5459 time_since_reference_point < 0.0_wp ) ) THEN 5460 CALL calc_diffusion_radiation 5461 ENDIF 5426 5462 5427 5463 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 6110 6146 area_hor = pinlw / rad_lw_in_diff(nyn,nxl) 6111 6147 t_rad_urb = ( ( pemitlw - pabslw + emissivity_urb * pinlw ) / & 6112 (emissivity_urb * sigma_sb * area_hor) )**0.25_wp 6148 (emissivity_urb * sigma_sb * area_hor) )**0.25_wp 6113 6149 6114 6150 IF ( debug_output_timestep ) CALL debug_message( 'radiation_interaction', 'end' )
Note: See TracChangeset
for help on using the changeset viewer.
