Changeset 4210 for palm/trunk/SOURCE


Ignore:
Timestamp:
Sep 2, 2019 1:07:09 PM (5 years ago)
Author:
suehring
Message:

Radiation: revise steering of splitting diffuse and direct radiation; revise some checks; optimize mapping of radiation components onto 2D arrays, avoid unnecessary operations

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r4208 r4210  
    2828! -----------------
    2929! $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
    3036! Bugfix in accessing albedo_pars in the clear-sky branch (merge from branch)
    3137!
     
    26942700!--       Currently, 2D external radiation input is not possible in
    26952701!--       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.      &
    26972703                 rad_sw_in_dif_f%lod == 2  )  .AND. average_radiation )  THEN
    26982704             message_string = 'External radiation with lod = 2 is currently '//&
     
    27042710!--       of lods divided by the number of available radiation arrays must be
    27052711!--       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 ) +       &
    27072713                     MERGE( rad_sw_in_f%lod, 0, rad_sw_in_f%from_file ) +       &
    27082714                     MERGE( rad_sw_in_dif_f%lod, 0, rad_sw_in_dif_f%from_file ),&
    27092715                     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 ) +           &
    27112717                     MERGE( 1.0_wp, 0.0_wp, rad_sw_in_f%from_file ) +           &
    27122718                     MERGE( 1.0_wp, 0.0_wp, rad_sw_in_dif_f%from_file ) )       &
    27132719                     /= 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 ) +       &
    27152721                     MERGE( rad_sw_in_f%lod, 0, rad_sw_in_f%from_file ) +       &
    27162722                     MERGE( rad_sw_in_dif_f%lod, 0, rad_sw_in_dif_f%from_file ),&
    27172723                     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 ) +           &
    27192725                     MERGE( 1.0_wp, 0.0_wp, rad_sw_in_f%from_file ) +           &
    27202726                     MERGE( 1.0_wp, 0.0_wp, rad_sw_in_dif_f%from_file ) )       &
     
    28082814       INTEGER(iwp) ::  t   !< index of current timestep
    28092815       INTEGER(iwp) ::  tm  !< index of previous timestep
     2816       
     2817       LOGICAL      ::  horizontal !< flag indicating treatment of horinzontal surfaces
    28102818       
    28112819       REAL(wp) ::  fac_dt     !< interpolation factor 
     
    28372845!--    Call clear-sky calculation for each surface orientation.
    28382846!--    First, horizontal surfaces
     2847       horizontal = .TRUE.
    28392848       surf => surf_lsm_h
    28402849       CALL radiation_external_surf
    28412850       surf => surf_usm_h
    28422851       CALL radiation_external_surf
     2852       horizontal = .FALSE.
    28432853!
    28442854!--    Vertical surfaces
     
    30183028!--                   longwave radiation
    30193029                      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)
    30213031                   ENDIF
    30223032
     
    30263036!
    30273037!--          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
    30383051 
    30393052          END SUBROUTINE radiation_external_surf
     
    30523065
    30533066       INTEGER(iwp) ::  l         !< running index for surface orientation
     3067       
     3068       LOGICAL      ::  horizontal !< flag indicating treatment of horinzontal surfaces
     3069       
    30543070       REAL(wp)     ::  pt1       !< potential temperature at first grid level or mean value at urban layer top
    30553071       REAL(wp)     ::  pt1_l     !< potential temperature at first grid level or mean value at urban layer top at local subdomain
     
    31073123!--    Call clear-sky calculation for each surface orientation.
    31083124!--    First, horizontal surfaces
     3125       horizontal = .TRUE.
    31093126       surf => surf_lsm_h
    31103127       CALL radiation_clearsky_surf
    31113128       surf => surf_usm_h
    31123129       CALL radiation_clearsky_surf
     3130       horizontal = .FALSE.
    31133131!
    31143132!--    Vertical surfaces
     
    32153233
    32163234!
    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
    32263247 
    32273248          END SUBROUTINE radiation_clearsky_surf
     
    32413262
    32423263       INTEGER(iwp) ::  l         !< running index for surface orientation
     3264       
     3265       LOGICAL      ::  horizontal !< flag indicating treatment of horinzontal surfaces
    32433266
    32443267       REAL(wp)     ::  pt1       !< potential temperature at first grid level or mean value at urban layer top
     
    32853308!
    32863309!--    First, horizontal surfaces
     3310       horizontal = .TRUE.
    32873311       surf => surf_lsm_h
    32883312       CALL radiation_constant_surf
    32893313       surf => surf_usm_h
    32903314       CALL radiation_constant_surf
     3315       horizontal = .FALSE.
    32913316!
    32923317!--    Vertical surfaces
     
    33973422
    33983423!
    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
    34083436
    34093437          END SUBROUTINE radiation_constant_surf
     
    54215449!--  Split downwelling shortwave radiation into a diffuse and a direct part.
    54225450!--  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
    54265462
    54275463!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     
    61106146      area_hor = pinlw / rad_lw_in_diff(nyn,nxl)
    61116147      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     
    61136149
    61146150     IF ( debug_output_timestep )  CALL debug_message( 'radiation_interaction', 'end' )
Note: See TracChangeset for help on using the changeset viewer.