source: palm/trunk/SOURCE/radiation_model_mod.f90 @ 3608

!> @file radiation_model_mod.f90
!------------------------------------------------------------------------------!
! This file is part of the PALM model system.
!
! PALM is free software: you can redistribute it and/or modify it under the
! terms of the GNU General Public License as published by the Free Software
! Foundation, either version 3 of the License, or (at your option) any later
! version.
!
! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License along with
! PALM. If not, see <http://www.gnu.org/licenses/>.
!
! Copyright 2015-2018 Institute of Computer Science of the 
!                     Czech Academy of Sciences, Prague
! Copyright 2015-2018 Czech Technical University in Prague
! Copyright 1997-2018 Leibniz Universitaet Hannover
!------------------------------------------------------------------------------!
!
! Current revisions:
! ------------------
! 
! 
! Former revisions:
! -----------------
! $Id: radiation_model_mod.f90 3608 2018-12-07 12:59:57Z suehring $
! Bugfix radiation output
! 
! 3607 2018-12-07 11:56:58Z suehring
! Output of radiation-related quantities migrated to radiation_model_mod.
! 
! 3589 2018-11-30 15:09:51Z suehring
! Remove erroneous UTF encoding
! 
! 3572 2018-11-28 11:40:28Z suehring
! Add filling the short- and longwave radiation flux arrays (e.g. diffuse, 
! direct, reflected, resedual) for all surfaces. This is required to surface
! outputs in suface_output_mod. (M. Salim)
! 
! 3571 2018-11-28 09:24:03Z moh.hefny
! Add an epsilon value to compare values in if statement to fix possible 
! precsion related errors in raytrace routines.
! 
! 3524 2018-11-14 13:36:44Z raasch
! missing cpp-directives added
! 
! 3495 2018-11-06 15:22:17Z kanani
! Resort control_parameters ONLY list,
! From branch radiation@3491 moh.hefny:
! bugfix in calculating the apparent solar positions by updating 
! the simulated time so that the actual time is correct.
! 
! 3464 2018-10-30 18:08:55Z kanani
! From branch resler@3462, pavelkrc:
! add MRT shaping function for human
! 
! 3449 2018-10-29 19:36:56Z suehring
! New RTM version 3.0: (Pavel Krc, Jaroslav Resler, ICS, Prague)
!   - Interaction of plant canopy with LW radiation
!   - Transpiration from resolved plant canopy dependent on radiation
!     called from RTM
! 
! 
! 3435 2018-10-26 18:25:44Z gronemeier
! - workaround: return unit=illegal in check_data_output for certain variables
!   when check called from init_masks
! - Use pointer in masked output to reduce code redundancies
! - Add terrain-following masked output
! 
! 3424 2018-10-25 07:29:10Z gronemeier
! bugfix: add rad_lw_in, rad_lw_out, rad_sw_out to radiation_check_data_output
! 
! 3378 2018-10-19 12:34:59Z kanani
! merge from radiation branch (r3362) into trunk
! (moh.hefny):
! - removed read/write_svf_on_init and read_dist_max_svf (not used anymore)
! - bugfix nzut > nzpt in calculating maxboxes
! 
! 3372 2018-10-18 14:03:19Z raasch
! bugfix: kind type of 2nd argument of mpi_win_allocate changed, misplaced
!         __parallel directive
! 
! 3351 2018-10-15 18:40:42Z suehring
! Do not overwrite values of spectral and broadband albedo during initialization
! if they are already initialized in the urban-surface model via ASCII input.
! 
! 3337 2018-10-12 15:17:09Z kanani
! - New RTM version 2.9: (Pavel Krc, Jaroslav Resler, ICS, Prague)
!   added calculation of the MRT inside the RTM module
!   MRT fluxes are consequently used in the new biometeorology module
!   for calculation of biological indices (MRT, PET)
!   Fixes of v. 2.5 and SVN trunk:
!    - proper initialization of rad_net_l
!    - make arrays nsurfs and surfstart TARGET to prevent some MPI problems
!    - initialization of arrays used in MPI one-sided operation as 1-D arrays
!      to prevent problems with some MPI/compiler combinations
!    - fix indexing of target displacement in subroutine request_itarget to 
!      consider nzub
!    - fix LAD dimmension range in PCB calculation
!    - check ierr in all MPI calls
!    - use proper per-gridbox sky and diffuse irradiance
!    - fix shading for reflected irradiance
!    - clear away the residuals of "atmospheric surfaces" implementation
!    - fix rounding bug in raytrace_2d introduced in SVN trunk
! - New RTM version 2.5: (Pavel Krc, Jaroslav Resler, ICS, Prague)
!   can use angular discretization for all SVF
!   (i.e. reflected and emitted radiation in addition to direct and diffuse),
!   allowing for much better scaling wih high resoltion and/or complex terrain
! - Unite array grow factors
! - Fix slightly shifted terrain height in raytrace_2d
! - Use more efficient MPI_Win_allocate for reverse gridsurf index
! - Fix random MPI RMA bugs on Intel compilers
! - Fix approx. double plant canopy sink values for reflected radiation
! - Fix mostly missing plant canopy sinks for direct radiation
! - Fix discretization errors for plant canopy sink in diffuse radiation
! - Fix rounding errors in raytrace_2d
!
! 3274 2018-09-24 15:42:55Z knoop
! Modularization of all bulk cloud physics code components
! 
! 3272 2018-09-24 10:16:32Z suehring
! - split direct and diffusion shortwave radiation using RRTMG rather than using
!   calc_diffusion_radiation, in case of RRTMG
! - removed the namelist variable split_diffusion_radiation. Now splitting depends
!   on the choise of radiation radiation scheme
! - removed calculating the rdiation flux for surfaces at the radiation scheme
!   in case of using RTM since it will be calculated anyway in the radiation 
!   interaction routine.
! - set SW radiation flux for surfaces to zero at night in case of no RTM is used
! - precalculate the unit vector yxdir of ray direction to avoid the temporarly 
!   array allocation during the subroutine call
! - fixed a bug in calculating the max number of boxes ray can cross in the domain
! 
! 3264 2018-09-20 13:54:11Z moh.hefny
! Bugfix in raytrace_2d calls
! 
! 3248 2018-09-14 09:42:06Z sward
! Minor formating changes
! 
! 3246 2018-09-13 15:14:50Z sward
! Added error handling for input namelist via parin_fail_message
! 
! 3241 2018-09-12 15:02:00Z raasch
! unused variables removed or commented
! 
! 3233 2018-09-07 13:21:24Z schwenkel
! Adapted for the use of cloud_droplets 
! 
! 3230 2018-09-05 09:29:05Z schwenkel
! Bugfix in radiation_constant_surf: changed (10.0 - emissivity_urb) to 
! (1.0 - emissivity_urb)
! 
! 3226 2018-08-31 12:27:09Z suehring
! Bugfixes in calculation of sky-view factors and canopy-sink factors.
! 
! 3186 2018-07-30 17:07:14Z suehring
! Remove print statement
! 
! 3180 2018-07-27 11:00:56Z suehring
! Revise concept for calculation of effective radiative temperature and mapping
! of radiative heating
! 
! 3175 2018-07-26 14:07:38Z suehring
! Bugfix for commit 3172
! 
! 3173 2018-07-26 12:55:23Z suehring
! Revise output of surface radiation quantities in case of overhanging 
! structures
! 
! 3172 2018-07-26 12:06:06Z suehring
! Bugfixes:
!  - temporal work-around for calculation of effective radiative surface 
!    temperature
!  - prevent positive solar radiation during nighttime
! 
! 3170 2018-07-25 15:19:37Z suehring
! Bugfix, map signle-column radiation forcing profiles on top of any topography
! 
! 3156 2018-07-19 16:30:54Z knoop
! Bugfix: replaced usage of the pt array with the surf%pt_surface array
!
! 3137 2018-07-17 06:44:21Z maronga
! String length for trace_names fixed
! 
! 3127 2018-07-15 08:01:25Z maronga
! A few pavement parameters updated.
! 
! 3123 2018-07-12 16:21:53Z suehring
! Correct working precision for INTEGER number
! 
! 3122 2018-07-11 21:46:41Z maronga
! Bugfix: maximum distance for raytracing was set to  -999 m by default,
! effectively switching off all surface reflections when max_raytracing_dist
! was not explicitly set in namelist
! 
! 3117 2018-07-11 09:59:11Z maronga
! Bugfix: water vapor was not transfered to RRTMG when bulk_cloud_model = .F.
! Bugfix: changed the calculation of RRTMG boundary conditions (Mohamed Salim)
! Bugfix: dry residual atmosphere is replaced by standard RRTMG atmosphere
! 
! 3116 2018-07-10 14:31:58Z suehring
! Output of long/shortwave radiation at surface
! 
! 3107 2018-07-06 15:55:51Z suehring
! Bugfix, missing index for dz
! 
! 3066 2018-06-12 08:55:55Z Giersch
! Error message revised 
! 
! 3065 2018-06-12 07:03:02Z Giersch
! dz was replaced by dz(1), error message concerning vertical stretching was 
! added  
! 
! 3049 2018-05-29 13:52:36Z Giersch
! Error messages revised
! 
! 3045 2018-05-28 07:55:41Z Giersch
! Error message revised
! 
! 3026 2018-05-22 10:30:53Z schwenkel
! Changed the name specific humidity to mixing ratio, since we are computing
! mixing ratios.
! 
! 3016 2018-05-09 10:53:37Z Giersch
! Revised structure of reading svf data according to PALM coding standard: 
! svf_code_field/len and fsvf removed, error messages PA0493 and PA0494 added,
! allocation status of output arrays checked. 
! 
! 3014 2018-05-09 08:42:38Z maronga
! Introduced plant canopy height similar to urban canopy height to limit
! the memory requirement to allocate lad.
! Deactivated automatic setting of minimum raytracing distance.
! 
! 3004 2018-04-27 12:33:25Z Giersch
! Further allocation checks implemented (averaged data will be assigned to fill
! values if no allocation happened so far) 
! 
! 2995 2018-04-19 12:13:16Z Giersch
! IF-statement in radiation_init removed so that the calculation of radiative 
! fluxes at model start is done in any case, bugfix in 
! radiation_presimulate_solar_pos (end_time is the sum of end_time and the 
! spinup_time specified in the p3d_file ), list of variables/fields that have
! to be written out or read in case of restarts has been extended
! 
! 2977 2018-04-17 10:27:57Z kanani
! Implement changes from branch radiation (r2948-2971) with minor modifications,
! plus some formatting.
! (moh.hefny):
! - replaced plant_canopy by npcbl to check tree existence to avoid weird 
!   allocation of related arrays (after domain decomposition some domains 
!   contains no trees although plant_canopy (global parameter) is still TRUE).
! - added a namelist parameter to force RTM settings
! - enabled the option to switch radiation reflections off
! - renamed surf_reflections to surface_reflections 
! - removed average_radiation flag from the namelist (now it is implicitly set 
!   in init_3d_model according to RTM)
! - edited read and write sky view factors and CSF routines to account for
!   the sub-domains which may not contain any of them
! 
! 2967 2018-04-13 11:22:08Z raasch
! bugfix: missing parallel cpp-directives added
! 
! 2964 2018-04-12 16:04:03Z Giersch
! Error message PA0491 has been introduced which could be previously found in 
! check_open. The variable numprocs_previous_run is only known in case of 
! initializing_actions == read_restart_data
! 
! 2963 2018-04-12 14:47:44Z suehring
! - Introduce index for vegetation/wall, pavement/green-wall and water/window 
!   surfaces, for clearer access of surface fraction, albedo, emissivity, etc. .
! - Minor bugfix in initialization of albedo for window surfaces
! 
! 2944 2018-04-03 16:20:18Z suehring
! Fixed bad commit
! 
! 2943 2018-04-03 16:17:10Z suehring
! No read of nsurfl from SVF file since it is calculated in
! radiation_interaction_init,
! allocation of arrays in radiation_read_svf only if not yet allocated,
! update of 2920 revision comment.
! 
! 2932 2018-03-26 09:39:22Z maronga
! renamed radiation_par to radiation_parameters
! 
! 2930 2018-03-23 16:30:46Z suehring
! Remove default surfaces from radiation model, does not make much sense to 
! apply radiation model without energy-balance solvers; Further, add check for 
! this. 
! 
! 2920 2018-03-22 11:22:01Z kanani
! - Bugfix: Initialize pcbl array (=-1)
! RTM version 2.0 (Jaroslav Resler, Pavel Krc, Mohamed Salim):
! - new major version of radiation interactions
! - substantially enhanced performance and scalability
! - processing of direct and diffuse solar radiation separated from reflected 
!   radiation, removed virtual surfaces
! - new type of sky discretization by azimuth and elevation angles
! - diffuse radiation processed cumulatively using sky view factor
! - used precalculated apparent solar positions for direct irradiance
! - added new 2D raytracing process for processing whole vertical column at once
!   to increase memory efficiency and decrease number of MPI RMA operations
! - enabled limiting the number of view factors between surfaces by the distance
!   and value
! - fixing issues induced by transferring radiation interactions from 
!   urban_surface_mod to radiation_mod
! - bugfixes and other minor enhancements
! 
! 2906 2018-03-19 08:56:40Z Giersch
! NAMELIST paramter read/write_svf_on_init have been removed, functions 
! check_open and close_file are used now for opening/closing files related to
! svf data, adjusted unit number and error numbers 
! 
! 2894 2018-03-15 09:17:58Z Giersch
! Calculations of the index range of the subdomain on file which overlaps with
! the current subdomain are already done in read_restart_data_mod
! radiation_read_restart_data was renamed to radiation_rrd_local and 
! radiation_last_actions was renamed to radiation_wrd_local, variable named 
! found has been introduced for checking if restart data was found, reading 
! of restart strings has been moved completely to read_restart_data_mod, 
! radiation_rrd_local is already inside the overlap loop programmed in 
! read_restart_data_mod, the marker *** end rad *** is not necessary anymore,
! strings and their respective lengths are written out and read now in case of 
! restart runs to get rid of prescribed character lengths (Giersch)
!
! 2809 2018-02-15 09:55:58Z suehring
! Bugfix for gfortran: Replace the function C_SIZEOF with STORAGE_SIZE
! 
! 2753 2018-01-16 14:16:49Z suehring
! Tile approach for spectral albedo implemented. 
! 
! 2746 2018-01-15 12:06:04Z suehring
! Move flag plant canopy to modules
! 
! 2724 2018-01-05 12:12:38Z maronga
! Set default of average_radiation to .FALSE.
! 
! 2723 2018-01-05 09:27:03Z maronga
! Bugfix in calculation of rad_lw_out (clear-sky). First grid level was used
! instead of the surface value
! 
! 2718 2018-01-02 08:49:38Z maronga
! Corrected "Former revisions" section
! 
! 2707 2017-12-18 18:34:46Z suehring
! Changes from last commit documented
! 
! 2706 2017-12-18 18:33:49Z suehring
! Bugfix, in average radiation case calculate exner function before using it.
!
! 2701 2017-12-15 15:40:50Z suehring
! Changes from last commit documented
! 
! 2698 2017-12-14 18:46:24Z suehring
! Bugfix in get_topography_top_index
!
! 2696 2017-12-14 17:12:51Z kanani
! - Change in file header (GPL part)
! - Improved reading/writing of SVF from/to file (BM)
! - Bugfixes concerning RRTMG as well as average_radiation options (M. Salim)
! - Revised initialization of surface albedo and some minor bugfixes (MS)
! - Update net radiation after running radiation interaction routine (MS)
! - Revisions from M Salim included
! - Adjustment to topography and surface structure (MS)
! - Initialization of albedo and surface emissivity via input file (MS)
! - albedo_pars extended (MS)
! 
! 2604 2017-11-06 13:29:00Z schwenkel
! bugfix for calculation of effective radius using morrison microphysics
! 
! 2601 2017-11-02 16:22:46Z scharf
! added emissivity to namelist
! 
! 2575 2017-10-24 09:57:58Z maronga
! Bugfix: calculation of shortwave and longwave albedos for RRTMG swapped
! 
! 2547 2017-10-16 12:41:56Z schwenkel
! extended by cloud_droplets option, minor bugfix and correct calculation of
! cloud droplet number concentration
! 
! 2544 2017-10-13 18:09:32Z maronga
! Moved date and time quantitis to separate module date_and_time_mod
! 
! 2512 2017-10-04 08:26:59Z raasch
! upper bounds of cross section and 3d output changed from nx+1,ny+1 to nx,ny
! no output of ghost layer data
! 
! 2504 2017-09-27 10:36:13Z maronga
! Updates pavement types and albedo parameters
! 
! 2328 2017-08-03 12:34:22Z maronga
! Emissivity can now be set individually for each pixel.
! Albedo type can be inferred from land surface model.
! Added default albedo type for bare soil
! 
! 2318 2017-07-20 17:27:44Z suehring
! Get topography top index via Function call 
! 
! 2317 2017-07-20 17:27:19Z suehring
! Improved syntax layout
! 
! 2298 2017-06-29 09:28:18Z raasch
! type of write_binary changed from CHARACTER to LOGICAL
! 
! 2296 2017-06-28 07:53:56Z maronga
! Added output of rad_sw_out for radiation_scheme = 'constant'
! 
! 2270 2017-06-09 12:18:47Z maronga
! Numbering changed (2 timeseries removed)
! 
! 2249 2017-06-06 13:58:01Z sward
! Allow for RRTMG runs without humidity/cloud physics
! 
! 2248 2017-06-06 13:52:54Z sward
! Error no changed
! 
! 2233 2017-05-30 18:08:54Z suehring
! 
! 2232 2017-05-30 17:47:52Z suehring
! Adjustments to new topography concept
! Bugfix in read restart
! 
! 2200 2017-04-11 11:37:51Z suehring
! Bugfix in call of exchange_horiz_2d and read restart data
! 
! 2163 2017-03-01 13:23:15Z schwenkel
! Bugfix in radiation_check_data_output
! 
! 2157 2017-02-22 15:10:35Z suehring
! Bugfix in read_restart data
! 
! 2011 2016-09-19 17:29:57Z kanani
! Removed CALL of auxiliary SUBROUTINE get_usm_info,
! flag urban_surface is now defined in module control_parameters.
! 
! 2007 2016-08-24 15:47:17Z kanani
! Added calculation of solar directional vector for new urban surface 
! model,
! accounted for urban_surface model in radiation_check_parameters,
! correction of comments for zenith angle.
! 
! 2000 2016-08-20 18:09:15Z knoop
! Forced header and separation lines into 80 columns
! 
! 1976 2016-07-27 13:28:04Z maronga
! Output of 2D/3D/masked data is now directly done within this module. The
! radiation schemes have been simplified for better usability so that
! rad_lw_in, rad_lw_out, rad_sw_in, and rad_sw_out are available independent of
! the radiation code used.
! 
! 1856 2016-04-13 12:56:17Z maronga
! Bugfix: allocation of rad_lw_out for radiation_scheme = 'clear-sky'
! 
! 1853 2016-04-11 09:00:35Z maronga
! Added routine for radiation_scheme = constant.
!  
! 1849 2016-04-08 11:33:18Z hoffmann 
! Adapted for modularization of microphysics
!
! 1826 2016-04-07 12:01:39Z maronga
! Further modularization.
! 
! 1788 2016-03-10 11:01:04Z maronga
! Added new albedo class for pavements / roads.
!
! 1783 2016-03-06 18:36:17Z raasch
! palm-netcdf-module removed in order to avoid a circular module dependency,
! netcdf-variables moved to netcdf-module, new routine netcdf_handle_error_rad
! added
!
! 1757 2016-02-22 15:49:32Z maronga
! Added parameter unscheduled_radiation_calls. Bugfix: interpolation of sounding
! profiles for pressure and temperature above the LES domain.
! 
! 1709 2015-11-04 14:47:01Z maronga
! Bugfix: set initial value for rrtm_lwuflx_dt to zero, small formatting
! corrections
! 
! 1701 2015-11-02 07:43:04Z maronga
! Bugfixes: wrong index for output of timeseries, setting of nz_snd_end
! 
! 1691 2015-10-26 16:17:44Z maronga
! Added option for spin-up runs without radiation (skip_time_do_radiation). Bugfix
! in calculation of pressure profiles. Bugfix in calculation of trace gas profiles.
! Added output of radiative heating rates.
! 
! 1682 2015-10-07 23:56:08Z knoop
! Code annotations made doxygen readable 
! 
! 1606 2015-06-29 10:43:37Z maronga
! Added preprocessor directive __netcdf to allow for compiling without netCDF.
! Note, however, that RRTMG cannot be used without netCDF.
! 
! 1590 2015-05-08 13:56:27Z maronga
! Bugfix: definition of character strings requires same length for all elements
! 
! 1587 2015-05-04 14:19:01Z maronga
! Added albedo class for snow
! 
! 1585 2015-04-30 07:05:52Z maronga
! Added support for RRTMG
! 
! 1571 2015-03-12 16:12:49Z maronga
! Added missing KIND attribute. Removed upper-case variable names
! 
! 1551 2015-03-03 14:18:16Z maronga
! Added support for data output. Various variables have been renamed. Added
! interface for different radiation schemes (currently: clear-sky, constant, and
! RRTM (not yet implemented).
! 
! 1496 2014-12-02 17:25:50Z maronga
! Initial revision
! 
!
! Description:
! ------------
!> Radiation models and interfaces
!> @todo Replace dz(1) appropriatly to account for grid stretching
!> @todo move variable definitions used in radiation_init only to the subroutine
!>       as they are no longer required after initialization.
!> @todo Output of full column vertical profiles used in RRTMG
!> @todo Output of other rrtm arrays (such as volume mixing ratios)
!> @todo Check for mis-used NINT() calls in raytrace_2d
!>       RESULT: Original was correct (carefully verified formula), the change
!>               to INT broke raytracing      -- P. Krc
!> @todo Optimize radiation_tendency routines
!>
!> @note Many variables have a leading dummy dimension (0:0) in order to
!>       match the assume-size shape expected by the RRTMG model.
!------------------------------------------------------------------------------!
 MODULE radiation_model_mod
 
    USE arrays_3d,                                                             &
        ONLY:  dzw, hyp, nc, pt, p, q, ql, u, v, w, zu, zw, exner, d_exner

    USE basic_constants_and_equations_mod,                                     &
        ONLY:  c_p, g, lv_d_cp, l_v, pi, r_d, rho_l, solar_constant,      &
               barometric_formula

    USE calc_mean_profile_mod,                                                 &
        ONLY:  calc_mean_profile

    USE control_parameters,                                                    &
        ONLY:  cloud_droplets, coupling_char, dz, dt_spinup, end_time,         &
               humidity,                                                       &
               initializing_actions, io_blocks, io_group,                      &
               land_surface, large_scale_forcing,                              &
               latitude, longitude, lsf_surf,                                  &
               message_string, plant_canopy, pt_surface,                       &
               rho_surface, simulated_time, spinup_time, surface_pressure,     &
               time_since_reference_point, urban_surface, varnamelength

    USE cpulog,                                                                &
        ONLY:  cpu_log, log_point, log_point_s

    USE grid_variables,                                                        &
         ONLY:  ddx, ddy, dx, dy 

    USE date_and_time_mod,                                                     &
        ONLY:  calc_date_and_time, d_hours_day, d_seconds_hour, day_of_year,   &
               d_seconds_year, day_of_year_init, time_utc_init, time_utc

    USE indices,                                                               &
        ONLY:  nnx, nny, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg,   &
               nzb, nzt

    USE, INTRINSIC :: iso_c_binding

    USE kinds

    USE bulk_cloud_model_mod,                                                  &
        ONLY:  bulk_cloud_model, microphysics_morrison, na_init, nc_const, sigma_gc

#if defined ( __netcdf )
    USE NETCDF
#endif

    USE netcdf_data_input_mod,                                                 &
        ONLY:  albedo_type_f, albedo_pars_f, building_type_f, pavement_type_f, &
               vegetation_type_f, water_type_f

    USE plant_canopy_model_mod,                                                &
        ONLY:  lad_s, pc_heating_rate, pc_transpiration_rate, pc_latent_rate,  &
               plant_canopy_transpiration, pcm_calc_transpiration_rate

    USE pegrid

#if defined ( __rrtmg )
    USE parrrsw,                                                               &
        ONLY:  naerec, nbndsw

    USE parrrtm,                                                               &
        ONLY:  nbndlw

    USE rrtmg_lw_init,                                                         &
        ONLY:  rrtmg_lw_ini

    USE rrtmg_sw_init,                                                         &
        ONLY:  rrtmg_sw_ini

    USE rrtmg_lw_rad,                                                          &
        ONLY:  rrtmg_lw

    USE rrtmg_sw_rad,                                                          &
        ONLY:  rrtmg_sw
#endif
    USE statistics,                                                            &
        ONLY:  hom

    USE surface_mod,                                                           &
        ONLY:  get_topography_top_index, get_topography_top_index_ji,          &
               ind_pav_green, ind_veg_wall, ind_wat_win,                       &
               surf_lsm_h, surf_lsm_v, surf_type, surf_usm_h, surf_usm_v

    IMPLICIT NONE

    CHARACTER(10) :: radiation_scheme = 'clear-sky' ! 'constant', 'clear-sky', or 'rrtmg'

!
!-- Predefined Land surface classes (albedo_type) after Briegleb (1992)
    CHARACTER(37), DIMENSION(0:33), PARAMETER :: albedo_type_name = (/      &
                                   'user defined                         ', & !  0 
                                   'ocean                                ', & !  1
                                   'mixed farming, tall grassland        ', & !  2
                                   'tall/medium grassland                ', & !  3 
                                   'evergreen shrubland                  ', & !  4
                                   'short grassland/meadow/shrubland     ', & !  5
                                   'evergreen needleleaf forest          ', & !  6
                                   'mixed deciduous evergreen forest     ', & !  7
                                   'deciduous forest                     ', & !  8
                                   'tropical evergreen broadleaved forest', & !  9
                                   'medium/tall grassland/woodland       ', & ! 10
                                   'desert, sandy                        ', & ! 11 
                                   'desert, rocky                        ', & ! 12 
                                   'tundra                               ', & ! 13
                                   'land ice                             ', & ! 14 
                                   'sea ice                              ', & ! 15 
                                   'snow                                 ', & ! 16
                                   'bare soil                            ', & ! 17
                                   'asphalt/concrete mix                 ', & ! 18
                                   'asphalt (asphalt concrete)           ', & ! 19
                                   'concrete (Portland concrete)         ', & ! 20
                                   'sett                                 ', & ! 21
                                   'paving stones                        ', & ! 22
                                   'cobblestone                          ', & ! 23
                                   'metal                                ', & ! 24
                                   'wood                                 ', & ! 25
                                   'gravel                               ', & ! 26
                                   'fine gravel                          ', & ! 27
                                   'pebblestone                          ', & ! 28
                                   'woodchips                            ', & ! 29
                                   'tartan (sports)                      ', & ! 30
                                   'artifical turf (sports)              ', & ! 31
                                   'clay (sports)                        ', & ! 32
                                   'building (dummy)                     '  & ! 33
                                                         /)

    REAL(wp), PARAMETER :: sigma_sb       = 5.67037321E-8_wp !< Stefan-Boltzmann constant

    INTEGER(iwp) :: albedo_type  = 9999999, & !< Albedo surface type
                    dots_rad     = 0          !< starting index for timeseries output 

    LOGICAL ::  unscheduled_radiation_calls = .TRUE., & !< flag parameter indicating whether additional calls of the radiation code are allowed
                constant_albedo = .FALSE.,            & !< flag parameter indicating whether the albedo may change depending on zenith
                force_radiation_call = .FALSE.,       & !< flag parameter for unscheduled radiation calls
                lw_radiation = .TRUE.,                & !< flag parameter indicating whether longwave radiation shall be calculated
                radiation = .FALSE.,                  & !< flag parameter indicating whether the radiation model is used
                sun_up    = .TRUE.,                   & !< flag parameter indicating whether the sun is up or down
                sw_radiation = .TRUE.,                & !< flag parameter indicating whether shortwave radiation shall be calculated
                sun_direction = .FALSE.,              & !< flag parameter indicating whether solar direction shall be calculated
                average_radiation = .FALSE.,          & !< flag to set the calculation of radiation averaging for the domain
                radiation_interactions = .FALSE.,     & !< flag to activiate RTM (TRUE only if vertical urban/land surface and trees exist)
                surface_reflections = .TRUE.,         & !< flag to switch the calculation of radiation interaction between surfaces.
                                                        !< When it switched off, only the effect of buildings and trees shadow
                                                        !< will be considered. However fewer SVFs are expected.
                radiation_interactions_on = .TRUE.      !< namelist flag to force RTM activiation regardless to vertical urban/land surface and trees

    REAL(wp) :: albedo = 9999999.9_wp,           & !< NAMELIST alpha
                albedo_lw_dif = 9999999.9_wp,    & !< NAMELIST aldif
                albedo_lw_dir = 9999999.9_wp,    & !< NAMELIST aldir
                albedo_sw_dif = 9999999.9_wp,    & !< NAMELIST asdif
                albedo_sw_dir = 9999999.9_wp,    & !< NAMELIST asdir
                decl_1,                          & !< declination coef. 1
                decl_2,                          & !< declination coef. 2
                decl_3,                          & !< declination coef. 3
                dt_radiation = 0.0_wp,           & !< radiation model timestep
                emissivity = 9999999.9_wp,       & !< NAMELIST surface emissivity
                lon = 0.0_wp,                    & !< longitude in radians
                lat = 0.0_wp,                    & !< latitude in radians
                net_radiation = 0.0_wp,          & !< net radiation at surface
                skip_time_do_radiation = 0.0_wp, & !< Radiation model is not called before this time
                sky_trans,                       & !< sky transmissivity
                time_radiation = 0.0_wp            !< time since last call of radiation code


    REAL(wp), DIMENSION(0:0) ::  zenith,         & !< cosine of solar zenith angle
                                 sun_dir_lat,    & !< solar directional vector in latitudes
                                 sun_dir_lon       !< solar directional vector in longitudes

    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_net_av       !< average of net radiation (rad_net) at surface
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_lw_in_xy_av  !< average of incoming longwave radiation at surface
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_lw_out_xy_av !< average of outgoing longwave radiation at surface
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_sw_in_xy_av  !< average of incoming shortwave radiation at surface
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_sw_out_xy_av !< average of outgoing shortwave radiation at surface
!
!-- Land surface albedos for solar zenith angle of 60degree after Briegleb (1992)     
!-- (shortwave, longwave, broadband):   sw,      lw,      bb,
    REAL(wp), DIMENSION(0:2,1:33), PARAMETER :: albedo_pars = RESHAPE( (/& 
                                   0.06_wp, 0.06_wp, 0.06_wp,            & !  1
                                   0.09_wp, 0.28_wp, 0.19_wp,            & !  2
                                   0.11_wp, 0.33_wp, 0.23_wp,            & !  3
                                   0.11_wp, 0.33_wp, 0.23_wp,            & !  4
                                   0.14_wp, 0.34_wp, 0.25_wp,            & !  5
                                   0.06_wp, 0.22_wp, 0.14_wp,            & !  6
                                   0.06_wp, 0.27_wp, 0.17_wp,            & !  7
                                   0.06_wp, 0.31_wp, 0.19_wp,            & !  8
                                   0.06_wp, 0.22_wp, 0.14_wp,            & !  9
                                   0.06_wp, 0.28_wp, 0.18_wp,            & ! 10
                                   0.35_wp, 0.51_wp, 0.43_wp,            & ! 11
                                   0.24_wp, 0.40_wp, 0.32_wp,            & ! 12
                                   0.10_wp, 0.27_wp, 0.19_wp,            & ! 13
                                   0.90_wp, 0.65_wp, 0.77_wp,            & ! 14
                                   0.90_wp, 0.65_wp, 0.77_wp,            & ! 15
                                   0.95_wp, 0.70_wp, 0.82_wp,            & ! 16
                                   0.08_wp, 0.08_wp, 0.08_wp,            & ! 17
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 18
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 19
                                   0.30_wp, 0.30_wp, 0.30_wp,            & ! 20
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 21
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 22
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 23
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 24
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 25
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 26
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 27
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 28
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 29
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 30
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 31
                                   0.17_wp, 0.17_wp, 0.17_wp,            & ! 32
                                   0.17_wp, 0.17_wp, 0.17_wp             & ! 33
                                 /), (/ 3, 33 /) )

    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: &
                        rad_lw_cs_hr,                  & !< longwave clear sky radiation heating rate (K/s)
                        rad_lw_cs_hr_av,               & !< average of rad_lw_cs_hr
                        rad_lw_hr,                     & !< longwave radiation heating rate (K/s)
                        rad_lw_hr_av,                  & !< average of rad_sw_hr
                        rad_lw_in,                     & !< incoming longwave radiation (W/m2)
                        rad_lw_in_av,                  & !< average of rad_lw_in
                        rad_lw_out,                    & !< outgoing longwave radiation (W/m2)
                        rad_lw_out_av,                 & !< average of rad_lw_out
                        rad_sw_cs_hr,                  & !< shortwave clear sky radiation heating rate (K/s)
                        rad_sw_cs_hr_av,               & !< average of rad_sw_cs_hr
                        rad_sw_hr,                     & !< shortwave radiation heating rate (K/s)
                        rad_sw_hr_av,                  & !< average of rad_sw_hr
                        rad_sw_in,                     & !< incoming shortwave radiation (W/m2)
                        rad_sw_in_av,                  & !< average of rad_sw_in
                        rad_sw_out,                    & !< outgoing shortwave radiation (W/m2)
                        rad_sw_out_av                    !< average of rad_sw_out


!
!-- Variables and parameters used in RRTMG only
#if defined ( __rrtmg )
    CHARACTER(LEN=12) :: rrtm_input_file = "RAD_SND_DATA" !< name of the NetCDF input file (sounding data)


!
!-- Flag parameters for RRTMGS (should not be changed)
    INTEGER(iwp), PARAMETER :: rrtm_idrv     = 1, & !< flag for longwave upward flux calculation option (0,1)
                               rrtm_inflglw  = 2, & !< flag for lw cloud optical properties (0,1,2)
                               rrtm_iceflglw = 0, & !< flag for lw ice particle specifications (0,1,2,3)
                               rrtm_liqflglw = 1, & !< flag for lw liquid droplet specifications
                               rrtm_inflgsw  = 2, & !< flag for sw cloud optical properties (0,1,2)
                               rrtm_iceflgsw = 0, & !< flag for sw ice particle specifications (0,1,2,3)
                               rrtm_liqflgsw = 1    !< flag for sw liquid droplet specifications

!
!-- The following variables should be only changed with care, as this will 
!-- require further setting of some variables, which is currently not
!-- implemented (aerosols, ice phase).
    INTEGER(iwp) :: nzt_rad,           & !< upper vertical limit for radiation calculations
                    rrtm_icld = 0,     & !< cloud flag (0: clear sky column, 1: cloudy column)
                    rrtm_iaer = 0        !< aerosol option flag (0: no aerosol layers, for lw only: 6 (requires setting of rrtm_sw_ecaer), 10: one or more aerosol layers (not implemented)

    INTEGER(iwp) :: nc_stat !< local variable for storin the result of netCDF calls for error message handling

    LOGICAL :: snd_exists = .FALSE.      !< flag parameter to check whether a user-defined input files exists

    REAL(wp), PARAMETER :: mol_mass_air_d_wv = 1.607793_wp !< molecular weight dry air / water vapor

    REAL(wp), DIMENSION(:), ALLOCATABLE :: hyp_snd,     & !< hypostatic pressure from sounding data (hPa)
                                           rrtm_tsfc,   & !< dummy array for storing surface temperature
                                           t_snd          !< actual temperature from sounding data (hPa)

    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_ccl4vmr,   & !< CCL4 volume mixing ratio (g/mol)
                                             rrtm_cfc11vmr,  & !< CFC11 volume mixing ratio (g/mol)
                                             rrtm_cfc12vmr,  & !< CFC12 volume mixing ratio (g/mol)
                                             rrtm_cfc22vmr,  & !< CFC22 volume mixing ratio (g/mol)
                                             rrtm_ch4vmr,    & !< CH4 volume mixing ratio
                                             rrtm_cicewp,    & !< in-cloud ice water path (g/m2)
                                             rrtm_cldfr,     & !< cloud fraction (0,1)
                                             rrtm_cliqwp,    & !< in-cloud liquid water path (g/m2)
                                             rrtm_co2vmr,    & !< CO2 volume mixing ratio (g/mol)
                                             rrtm_emis,      & !< surface emissivity (0-1)  
                                             rrtm_h2ovmr,    & !< H2O volume mixing ratio
                                             rrtm_n2ovmr,    & !< N2O volume mixing ratio
                                             rrtm_o2vmr,     & !< O2 volume mixing ratio
                                             rrtm_o3vmr,     & !< O3 volume mixing ratio
                                             rrtm_play,      & !< pressure layers (hPa, zu-grid)
                                             rrtm_plev,      & !< pressure layers (hPa, zw-grid)
                                             rrtm_reice,     & !< cloud ice effective radius (microns)
                                             rrtm_reliq,     & !< cloud water drop effective radius (microns)
                                             rrtm_tlay,      & !< actual temperature (K, zu-grid)
                                             rrtm_tlev,      & !< actual temperature (K, zw-grid)
                                             rrtm_lwdflx,    & !< RRTM output of incoming longwave radiation flux (W/m2)
                                             rrtm_lwdflxc,   & !< RRTM output of outgoing clear sky longwave radiation flux (W/m2) 
                                             rrtm_lwuflx,    & !< RRTM output of outgoing longwave radiation flux (W/m2)
                                             rrtm_lwuflxc,   & !< RRTM output of incoming clear sky longwave radiation flux (W/m2)
                                             rrtm_lwuflx_dt, & !< RRTM output of incoming clear sky longwave radiation flux (W/m2)
                                             rrtm_lwuflxc_dt,& !< RRTM output of outgoing clear sky longwave radiation flux (W/m2)
                                             rrtm_lwhr,      & !< RRTM output of longwave radiation heating rate (K/d)
                                             rrtm_lwhrc,     & !< RRTM output of incoming longwave clear sky radiation heating rate (K/d)
                                             rrtm_swdflx,    & !< RRTM output of incoming shortwave radiation flux (W/m2)
                                             rrtm_swdflxc,   & !< RRTM output of outgoing clear sky shortwave radiation flux (W/m2) 
                                             rrtm_swuflx,    & !< RRTM output of outgoing shortwave radiation flux (W/m2)
                                             rrtm_swuflxc,   & !< RRTM output of incoming clear sky shortwave radiation flux (W/m2)
                                             rrtm_swhr,      & !< RRTM output of shortwave radiation heating rate (K/d)
                                             rrtm_swhrc,     & !< RRTM output of incoming shortwave clear sky radiation heating rate (K/d) 
                                             rrtm_dirdflux,  & !< RRTM output of incoming direct shortwave (W/m2) 
                                             rrtm_difdflux     !< RRTM output of incoming diffuse shortwave (W/m2) 

    REAL(wp), DIMENSION(1) ::                rrtm_aldif,     & !< surface albedo for longwave diffuse radiation
                                             rrtm_aldir,     & !< surface albedo for longwave direct radiation
                                             rrtm_asdif,     & !< surface albedo for shortwave diffuse radiation
                                             rrtm_asdir        !< surface albedo for shortwave direct radiation

!
!-- Definition of arrays that are currently not used for calling RRTMG (due to setting of flag parameters)
    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rad_lw_cs_in,   & !< incoming clear sky longwave radiation (W/m2) (not used)
                                                rad_lw_cs_out,  & !< outgoing clear sky longwave radiation (W/m2) (not used)
                                                rad_sw_cs_in,   & !< incoming clear sky shortwave radiation (W/m2) (not used)
                                                rad_sw_cs_out,  & !< outgoing clear sky shortwave radiation (W/m2) (not used)
                                                rrtm_lw_tauaer, & !< lw aerosol optical depth
                                                rrtm_lw_taucld, & !< lw in-cloud optical depth
                                                rrtm_sw_taucld, & !< sw in-cloud optical depth
                                                rrtm_sw_ssacld, & !< sw in-cloud single scattering albedo
                                                rrtm_sw_asmcld, & !< sw in-cloud asymmetry parameter
                                                rrtm_sw_fsfcld, & !< sw in-cloud forward scattering fraction
                                                rrtm_sw_tauaer, & !< sw aerosol optical depth
                                                rrtm_sw_ssaaer, & !< sw aerosol single scattering albedo
                                                rrtm_sw_asmaer, & !< sw aerosol asymmetry parameter
                                                rrtm_sw_ecaer     !< sw aerosol optical detph at 0.55 microns (rrtm_iaer = 6 only)

#endif
!
!-- Parameters of urban and land surface models
    INTEGER(iwp)                                   ::  nzu                                !< number of layers of urban surface (will be calculated)
    INTEGER(iwp)                                   ::  nzp                                !< number of layers of plant canopy (will be calculated)
    INTEGER(iwp)                                   ::  nzub,nzut                          !< bottom and top layer of urban surface (will be calculated)
    INTEGER(iwp)                                   ::  nzpt                               !< top layer of plant canopy (will be calculated)
!-- parameters of urban and land surface models
    INTEGER(iwp), PARAMETER                        ::  nzut_free = 3                      !< number of free layers above top of of topography
    INTEGER(iwp), PARAMETER                        ::  ndsvf = 2                          !< number of dimensions of real values in SVF
    INTEGER(iwp), PARAMETER                        ::  idsvf = 2                          !< number of dimensions of integer values in SVF
    INTEGER(iwp), PARAMETER                        ::  ndcsf = 1                          !< number of dimensions of real values in CSF
    INTEGER(iwp), PARAMETER                        ::  idcsf = 2                          !< number of dimensions of integer values in CSF
    INTEGER(iwp), PARAMETER                        ::  kdcsf = 4                          !< number of dimensions of integer values in CSF calculation array
    INTEGER(iwp), PARAMETER                        ::  id = 1                             !< position of d-index in surfl and surf
    INTEGER(iwp), PARAMETER                        ::  iz = 2                             !< position of k-index in surfl and surf
    INTEGER(iwp), PARAMETER                        ::  iy = 3                             !< position of j-index in surfl and surf
    INTEGER(iwp), PARAMETER                        ::  ix = 4                             !< position of i-index in surfl and surf

    INTEGER(iwp), PARAMETER                        ::  nsurf_type = 10                    !< number of surf types incl. phys.(land+urban) & (atm.,sky,boundary) surfaces - 1

    INTEGER(iwp), PARAMETER                        ::  iup_u    = 0                       !< 0 - index of urban upward surface (ground or roof)
    INTEGER(iwp), PARAMETER                        ::  idown_u  = 1                       !< 1 - index of urban downward surface (overhanging)
    INTEGER(iwp), PARAMETER                        ::  inorth_u = 2                       !< 2 - index of urban northward facing wall
    INTEGER(iwp), PARAMETER                        ::  isouth_u = 3                       !< 3 - index of urban southward facing wall
    INTEGER(iwp), PARAMETER                        ::  ieast_u  = 4                       !< 4 - index of urban eastward facing wall
    INTEGER(iwp), PARAMETER                        ::  iwest_u  = 5                       !< 5 - index of urban westward facing wall

    INTEGER(iwp), PARAMETER                        ::  iup_l    = 6                       !< 6 - index of land upward surface (ground or roof)
    INTEGER(iwp), PARAMETER                        ::  inorth_l = 7                       !< 7 - index of land northward facing wall
    INTEGER(iwp), PARAMETER                        ::  isouth_l = 8                       !< 8 - index of land southward facing wall
    INTEGER(iwp), PARAMETER                        ::  ieast_l  = 9                       !< 9 - index of land eastward facing wall
    INTEGER(iwp), PARAMETER                        ::  iwest_l  = 10                      !< 10- index of land westward facing wall

    INTEGER(iwp), DIMENSION(0:nsurf_type), PARAMETER ::  idir = (/0, 0,0, 0,1,-1,0,0, 0,1,-1/)   !< surface normal direction x indices
    INTEGER(iwp), DIMENSION(0:nsurf_type), PARAMETER ::  jdir = (/0, 0,1,-1,0, 0,0,1,-1,0, 0/)   !< surface normal direction y indices
    INTEGER(iwp), DIMENSION(0:nsurf_type), PARAMETER ::  kdir = (/1,-1,0, 0,0, 0,1,0, 0,0, 0/)   !< surface normal direction z indices
    REAL(wp),     DIMENSION(0:nsurf_type)          :: facearea                            !< area of single face in respective
                                                                                          !< direction (will be calc'd)


!-- indices and sizes of urban and land surface models
    INTEGER(iwp)                                   ::  startland        !< start index of block of land and roof surfaces
    INTEGER(iwp)                                   ::  endland          !< end index of block of land and roof surfaces
    INTEGER(iwp)                                   ::  nlands           !< number of land and roof surfaces in local processor
    INTEGER(iwp)                                   ::  startwall        !< start index of block of wall surfaces
    INTEGER(iwp)                                   ::  endwall          !< end index of block of wall surfaces
    INTEGER(iwp)                                   ::  nwalls           !< number of wall surfaces in local processor

!-- indices needed for RTM netcdf output subroutines
    INTEGER(iwp), PARAMETER                        :: nd = 5
    CHARACTER(LEN=6), DIMENSION(0:nd-1), PARAMETER :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
    INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER     :: dirint_u = (/ iup_u, isouth_u, inorth_u, iwest_u, ieast_u /)
    INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER     :: dirint_l = (/ iup_l, isouth_l, inorth_l, iwest_l, ieast_l /)
    INTEGER(iwp), DIMENSION(0:nd-1)                :: dirstart
    INTEGER(iwp), DIMENSION(0:nd-1)                :: dirend

!-- indices and sizes of urban and land surface models
    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  surfl_l          !< coordinates of i-th local surface in local grid - surfl[:,k] = [d, z, y, x]
    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  surf_l           !< coordinates of i-th surface in grid - surf[:,k] = [d, z, y, x]
    INTEGER(iwp), DIMENSION(:,:), POINTER          ::  surfl            !< coordinates of i-th local surface in local grid - surfl[:,k] = [d, z, y, x]
    INTEGER(iwp), DIMENSION(:,:), POINTER          ::  surf             !< coordinates of i-th surface in grid - surf[:,k] = [d, z, y, x]
    INTEGER(iwp)                                   ::  nsurfl           !< number of all surfaces in local processor
    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  nsurfs           !< array of number of all surfaces in individual processors
    INTEGER(iwp)                                   ::  nsurf            !< global number of surfaces in index array of surfaces (nsurf = proc nsurfs)
    INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET ::  surfstart        !< starts of blocks of surfaces for individual processors in array surf (indexed from 1)
                                                                        !< respective block for particular processor is surfstart[iproc+1]+1 : surfstart[iproc+1]+nsurfs[iproc+1]

!-- block variables needed for calculation of the plant canopy model inside the urban surface model
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pct              !< top layer of the plant canopy
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pch              !< heights of the plant canopy
    INTEGER(iwp)                                   ::  npcbl = 0        !< number of the plant canopy gridboxes in local processor
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pcbl             !< k,j,i coordinates of l-th local plant canopy box pcbl[:,l] = [k, j, i]
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinsw          !< array of absorbed sw radiation for local plant canopy box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinswdir       !< array of absorbed direct sw radiation for local plant canopy box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinswdif       !< array of absorbed diffusion sw radiation for local plant canopy box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinlw          !< array of absorbed lw radiation for local plant canopy box

!-- configuration parameters (they can be setup in PALM config)
    LOGICAL                                        ::  raytrace_mpi_rma = .TRUE.          !< use MPI RMA to access LAD and gridsurf from remote processes during raytracing
    LOGICAL                                        ::  rad_angular_discretization = .TRUE.!< whether to use fixed resolution discretization of view factors for
                                                                                          !< reflected radiation (as opposed to all mutually visible pairs)
    LOGICAL                                        ::  plant_lw_interact = .TRUE.         !< whether plant canopy interacts with LW radiation (in addition to SW)
    INTEGER(iwp)                                   ::  mrt_nlevels = 0                    !< number of vertical boxes above surface for which to calculate MRT
    LOGICAL                                        ::  mrt_skip_roof = .TRUE.             !< do not calculate MRT above roof surfaces
    LOGICAL                                        ::  mrt_include_sw = .TRUE.            !< should MRT calculation include SW radiation as well?
    LOGICAL                                        ::  mrt_geom_human = .TRUE.            !< MRT direction weights simulate human body instead of a sphere
    INTEGER(iwp)                                   ::  nrefsteps = 3                      !< number of reflection steps to perform
    REAL(wp), PARAMETER                            ::  ext_coef = 0.6_wp                  !< extinction coefficient (a.k.a. alpha)
    INTEGER(iwp), PARAMETER                        ::  rad_version_len = 10               !< length of identification string of rad version
    CHARACTER(rad_version_len), PARAMETER          ::  rad_version = 'RAD v. 3.0'         !< identification of version of binary svf and restart files
    INTEGER(iwp)                                   ::  raytrace_discrete_elevs = 40       !< number of discretization steps for elevation (nadir to zenith)
    INTEGER(iwp)                                   ::  raytrace_discrete_azims = 80       !< number of discretization steps for azimuth (out of 360 degrees)
    REAL(wp)                                       ::  max_raytracing_dist = -999.0_wp    !< maximum distance for raytracing (in metres)
    REAL(wp)                                       ::  min_irrf_value = 1e-6_wp           !< minimum potential irradiance factor value for raytracing
    REAL(wp), DIMENSION(1:30)                      ::  svfnorm_report_thresh = 1e21_wp    !< thresholds of SVF normalization values to report
    INTEGER(iwp)                                   ::  svfnorm_report_num                 !< number of SVF normalization thresholds to report

!-- radiation related arrays to be used in radiation_interaction routine
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  rad_sw_in_dir    !< direct sw radiation
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  rad_sw_in_diff   !< diffusion sw radiation
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  rad_lw_in_diff   !< diffusion lw radiation

!-- parameters required for RRTMG lower boundary condition
    REAL(wp)                   :: albedo_urb      !< albedo value retuned to RRTMG boundary cond.
    REAL(wp)                   :: emissivity_urb  !< emissivity value retuned to RRTMG boundary cond.
    REAL(wp)                   :: t_rad_urb       !< temperature value retuned to RRTMG boundary cond.

!-- type for calculation of svf
    TYPE t_svf
        INTEGER(iwp)                               :: isurflt           !< 
        INTEGER(iwp)                               :: isurfs            !< 
        REAL(wp)                                   :: rsvf              !< 
        REAL(wp)                                   :: rtransp           !< 
    END TYPE

!-- type for calculation of csf
    TYPE t_csf
        INTEGER(iwp)                               :: ip                !< 
        INTEGER(iwp)                               :: itx               !< 
        INTEGER(iwp)                               :: ity               !< 
        INTEGER(iwp)                               :: itz               !< 
        INTEGER(iwp)                               :: isurfs            !< Idx of source face / -1 for sky
        REAL(wp)                                   :: rcvf              !< Canopy view factor for faces /
                                                                        !< canopy sink factor for sky (-1)
    END TYPE

!-- arrays storing the values of USM
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  svfsurf          !< svfsurf[:,isvf] = index of target and source surface for svf[isvf]
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  svf              !< array of shape view factors+direct irradiation factors for local surfaces
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfins          !< array of sw radiation falling to local surface after i-th reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinl          !< array of lw radiation for local surface after i-th reflection

    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  skyvf            !< array of sky view factor for each local surface
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  skyvft           !< array of sky view factor including transparency for each local surface
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  dsitrans         !< dsidir[isvfl,i] = path transmittance of i-th
                                                                        !< direction of direct solar irradiance per target surface
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  dsitransc        !< dtto per plant canopy box
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  dsidir           !< dsidir[:,i] = unit vector of i-th
                                                                        !< direction of direct solar irradiance
    INTEGER(iwp)                                   ::  ndsidir          !< number of apparent solar directions used
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  dsidir_rev       !< dsidir_rev[ielev,iazim] = i for dsidir or -1 if not present

    INTEGER(iwp)                                   ::  nmrtbl           !< No. of local grid boxes for which MRT is calculated
    INTEGER(iwp)                                   ::  nmrtf            !< number of MRT factors for local processor
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  mrtbl            !< coordinates of i-th local MRT box - surfl[:,i] = [z, y, x]
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  mrtfsurf         !< mrtfsurf[:,imrtf] = index of target MRT box and source surface for mrtf[imrtf]
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrtf             !< array of MRT factors for each local MRT box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrtft            !< array of MRT factors including transparency for each local MRT box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrtsky           !< array of sky view factor for each local MRT box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrtskyt          !< array of sky view factor including transparency for each local MRT box
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  mrtdsit          !< array of direct solar transparencies for each local MRT box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrtinsw          !< mean SW radiant flux for each MRT box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrtinlw          !< mean LW radiant flux for each MRT box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrt              !< mean radiant temperature for each MRT box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrtinsw_av       !< time average mean SW radiant flux for each MRT box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrtinlw_av       !< time average mean LW radiant flux for each MRT box
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  mrt_av           !< time average mean radiant temperature for each MRT box

    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinsw         !< array of sw radiation falling to local surface including radiation from reflections
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinlw         !< array of lw radiation falling to local surface including radiation from reflections
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinswdir      !< array of direct sw radiation falling to local surface
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinswdif      !< array of diffuse sw radiation from sky and model boundary falling to local surface
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinlwdif      !< array of diffuse lw radiation from sky and model boundary falling to local surface
    
                                                                        !< Outward radiation is only valid for nonvirtual surfaces
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutsl        !< array of reflected sw radiation for local surface in i-th reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutll        !< array of reflected + emitted lw radiation for local surface in i-th reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfouts         !< array of reflected sw radiation for all surfaces in i-th reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutl         !< array of reflected + emitted lw radiation for all surfaces in i-th reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinlg         !< global array of incoming lw radiation from plant canopy
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutsw        !< array of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutlw        !< array of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfemitlwl      !< array of emitted lw radiation for local surface used to calculate effective surface temperature for radiation model

!-- block variables needed for calculation of the plant canopy model inside the urban surface model
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  csfsurf          !< csfsurf[:,icsf] = index of target surface and csf grid index for csf[icsf]
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  csf              !< array of plant canopy sink fators + direct irradiation factors (transparency)
    REAL(wp), DIMENSION(:,:,:), POINTER            ::  sub_lad          !< subset of lad_s within urban surface, transformed to plain Z coordinate
    REAL(wp), DIMENSION(:), POINTER                ::  sub_lad_g        !< sub_lad globalized (used to avoid MPI RMA calls in raytracing)
    REAL(wp)                                       ::  prototype_lad    !< prototype leaf area density for computing effective optical depth
    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  nzterr, plantt   !< temporary global arrays for raytracing
    INTEGER(iwp)                                   ::  plantt_max

!-- arrays and variables for calculation of svf and csf
    TYPE(t_svf), DIMENSION(:), POINTER             ::  asvf             !< pointer to growing svc array
    TYPE(t_csf), DIMENSION(:), POINTER             ::  acsf             !< pointer to growing csf array
    TYPE(t_svf), DIMENSION(:), POINTER             ::  amrtf            !< pointer to growing mrtf array
    TYPE(t_svf), DIMENSION(:), ALLOCATABLE, TARGET ::  asvf1, asvf2     !< realizations of svf array
    TYPE(t_csf), DIMENSION(:), ALLOCATABLE, TARGET ::  acsf1, acsf2     !< realizations of csf array
    TYPE(t_svf), DIMENSION(:), ALLOCATABLE, TARGET ::  amrtf1, amrtf2   !< realizations of mftf array
    INTEGER(iwp)                                   ::  nsvfla           !< dimmension of array allocated for storage of svf in local processor
    INTEGER(iwp)                                   ::  ncsfla           !< dimmension of array allocated for storage of csf in local processor
    INTEGER(iwp)                                   ::  nmrtfa           !< dimmension of array allocated for storage of mrt
    INTEGER(iwp)                                   ::  msvf, mcsf, mmrtf!< mod for swapping the growing array
    INTEGER(iwp), PARAMETER                        ::  gasize = 100000  !< initial size of growing arrays
    REAL(wp), PARAMETER                            ::  grow_factor = 1.4_wp !< growth factor of growing arrays
    INTEGER(iwp)                                   ::  nsvfl            !< number of svf for local processor
    INTEGER(iwp)                                   ::  ncsfl            !< no. of csf in local processor
                                                                        !< needed only during calc_svf but must be here because it is
                                                                        !< shared between subroutines calc_svf and raytrace
    INTEGER(iwp), DIMENSION(:,:,:,:), POINTER      ::  gridsurf         !< reverse index of local surfl[d,k,j,i] (for case rad_angular_discretization)
    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE    ::  gridpcbl         !< reverse index of local pcbl[k,j,i]
    INTEGER(iwp), PARAMETER                        ::  nsurf_type_u = 6 !< number of urban surf types (used in gridsurf)

!-- temporary arrays for calculation of csf in raytracing
    INTEGER(iwp)                                   ::  maxboxesg        !< max number of boxes ray can cross in the domain
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  boxes            !< coordinates of gridboxes being crossed by ray
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  crlens           !< array of crossing lengths of ray for particular grid boxes
    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  lad_ip           !< array of numbers of process where lad is stored 
#if defined( __parallel )
    INTEGER(kind=MPI_ADDRESS_KIND), &
                  DIMENSION(:), ALLOCATABLE        ::  lad_disp         !< array of displaycements of lad in local array of proc lad_ip
    INTEGER(iwp)                                   ::  win_lad          !< MPI RMA window for leaf area density
    INTEGER(iwp)                                   ::  win_gridsurf     !< MPI RMA window for reverse grid surface index
#endif
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  lad_s_ray        !< array of received lad_s for appropriate gridboxes crossed by ray
    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  target_surfl
    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  rt2_track
    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  rt2_track_lad
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  rt2_track_dist
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  rt2_dist

!-- arrays for time averages
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfradnet_av    !< average of net radiation to local surface including radiation from reflections
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinsw_av      !< average of sw radiation falling to local surface including radiation from reflections
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinlw_av      !< average of lw radiation falling to local surface including radiation from reflections
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinswdir_av   !< average of direct sw radiation falling to local surface
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinswdif_av   !< average of diffuse sw radiation from sky and model boundary falling to local surface
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinlwdif_av   !< average of diffuse lw radiation from sky and model boundary falling to local surface
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinswref_av   !< average of sw radiation falling to surface from reflections
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinlwref_av   !< average of lw radiation falling to surface from reflections
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutsw_av     !< average of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutlw_av     !< average of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfins_av       !< average of array of residua of sw radiation absorbed in surface after last reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinl_av       !< average of array of residua of lw radiation absorbed in surface after last reflection
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinlw_av       !< Average of pcbinlw
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinsw_av       !< Average of pcbinsw
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinswdir_av    !< Average of pcbinswdir
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinswdif_av    !< Average of pcbinswdif
    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinswref_av    !< Average of pcbinswref


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!-- Energy balance variables
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!-- parameters of the land, roof and wall surfaces
    REAL(wp), DIMENSION(:), ALLOCATABLE            :: albedo_surf        !< albedo of the surface
    REAL(wp), DIMENSION(:), ALLOCATABLE            :: emiss_surf         !< emissivity of the wall surface


    INTERFACE radiation_check_data_output
       MODULE PROCEDURE radiation_check_data_output
    END INTERFACE radiation_check_data_output

    INTERFACE radiation_check_data_output_pr
       MODULE PROCEDURE radiation_check_data_output_pr
    END INTERFACE radiation_check_data_output_pr
  
    INTERFACE radiation_check_parameters
       MODULE PROCEDURE radiation_check_parameters
    END INTERFACE radiation_check_parameters
  
    INTERFACE radiation_clearsky
       MODULE PROCEDURE radiation_clearsky
    END INTERFACE radiation_clearsky
 
    INTERFACE radiation_constant
       MODULE PROCEDURE radiation_constant
    END INTERFACE radiation_constant
 
    INTERFACE radiation_control
       MODULE PROCEDURE radiation_control
    END INTERFACE radiation_control

    INTERFACE radiation_3d_data_averaging
       MODULE PROCEDURE radiation_3d_data_averaging
    END INTERFACE radiation_3d_data_averaging

    INTERFACE radiation_data_output_2d
       MODULE PROCEDURE radiation_data_output_2d
    END INTERFACE radiation_data_output_2d

    INTERFACE radiation_data_output_3d
       MODULE PROCEDURE radiation_data_output_3d
    END INTERFACE radiation_data_output_3d

    INTERFACE radiation_data_output_mask
       MODULE PROCEDURE radiation_data_output_mask
    END INTERFACE radiation_data_output_mask

    INTERFACE radiation_define_netcdf_grid
       MODULE PROCEDURE radiation_define_netcdf_grid
    END INTERFACE radiation_define_netcdf_grid

    INTERFACE radiation_header
       MODULE PROCEDURE radiation_header
    END INTERFACE radiation_header 
  
    INTERFACE radiation_init
       MODULE PROCEDURE radiation_init
    END INTERFACE radiation_init

    INTERFACE radiation_parin
       MODULE PROCEDURE radiation_parin
    END INTERFACE radiation_parin
    
    INTERFACE radiation_rrtmg
       MODULE PROCEDURE radiation_rrtmg
    END INTERFACE radiation_rrtmg

    INTERFACE radiation_tendency
       MODULE PROCEDURE radiation_tendency
       MODULE PROCEDURE radiation_tendency_ij
    END INTERFACE radiation_tendency

    INTERFACE radiation_rrd_local
       MODULE PROCEDURE radiation_rrd_local
    END INTERFACE radiation_rrd_local

    INTERFACE radiation_wrd_local
       MODULE PROCEDURE radiation_wrd_local
    END INTERFACE radiation_wrd_local

    INTERFACE radiation_interaction
       MODULE PROCEDURE radiation_interaction
    END INTERFACE radiation_interaction

    INTERFACE radiation_interaction_init
       MODULE PROCEDURE radiation_interaction_init
    END INTERFACE radiation_interaction_init
 
    INTERFACE radiation_presimulate_solar_pos
       MODULE PROCEDURE radiation_presimulate_solar_pos
    END INTERFACE radiation_presimulate_solar_pos

    INTERFACE radiation_radflux_gridbox
       MODULE PROCEDURE radiation_radflux_gridbox
    END INTERFACE radiation_radflux_gridbox

    INTERFACE radiation_calc_svf
       MODULE PROCEDURE radiation_calc_svf
    END INTERFACE radiation_calc_svf

    INTERFACE radiation_write_svf
       MODULE PROCEDURE radiation_write_svf
    END INTERFACE radiation_write_svf

    INTERFACE radiation_read_svf
       MODULE PROCEDURE radiation_read_svf
    END INTERFACE radiation_read_svf


    SAVE

    PRIVATE

!
!-- Public functions / NEEDS SORTING
    PUBLIC radiation_check_data_output, radiation_check_data_output_pr,        &
           radiation_check_parameters, radiation_control,                      &
           radiation_header, radiation_init, radiation_parin,                  &
           radiation_3d_data_averaging, radiation_tendency,                    &
           radiation_data_output_2d, radiation_data_output_3d,                 &
           radiation_define_netcdf_grid, radiation_wrd_local,                  &
           radiation_rrd_local, radiation_data_output_mask,                    &
           radiation_radflux_gridbox, radiation_calc_svf, radiation_write_svf, &
           radiation_interaction, radiation_interaction_init,                  &
           radiation_read_svf, radiation_presimulate_solar_pos
            

    
!
!-- Public variables and constants / NEEDS SORTING
    PUBLIC albedo, albedo_type, decl_1, decl_2, decl_3, dots_rad, dt_radiation,&
           emissivity, force_radiation_call, lat, lon, mrt_geom_human,         &
           mrt_include_sw, mrt_nlevels, mrtbl, mrtinsw, mrtinlw, nmrtbl,       &
           rad_net_av, radiation, radiation_scheme, rad_lw_in,                 &
           rad_lw_in_av, rad_lw_out, rad_lw_out_av,                            &
           rad_lw_cs_hr, rad_lw_cs_hr_av, rad_lw_hr, rad_lw_hr_av, rad_sw_in,  &
           rad_sw_in_av, rad_sw_out, rad_sw_out_av, rad_sw_cs_hr,              &
           rad_sw_cs_hr_av, rad_sw_hr, rad_sw_hr_av, sigma_sb, solar_constant, &
           skip_time_do_radiation, time_radiation, unscheduled_radiation_calls,&
           zenith, calc_zenith, sun_direction, sun_dir_lat, sun_dir_lon,       &
           idir, jdir, kdir, id, iz, iy, ix,                                   &
           iup_u, inorth_u, isouth_u, ieast_u, iwest_u,                        &
           iup_l, inorth_l, isouth_l, ieast_l, iwest_l,                        &
           nsurf_type, nzub, nzut, nzu, pch, nsurf,                            &
           idsvf, ndsvf, idcsf, ndcsf, kdcsf, pct,                             &
           radiation_interactions, startwall, startland, endland, endwall,     &
           skyvf, skyvft, radiation_interactions_on, average_radiation


#if defined ( __rrtmg )
    PUBLIC rrtm_aldif, rrtm_aldir, rrtm_asdif, rrtm_asdir
#endif

 CONTAINS


!------------------------------------------------------------------------------!
! Description:
! ------------
!> This subroutine controls the calls of the radiation schemes
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_control
 
 
       IMPLICIT NONE


       SELECT CASE ( TRIM( radiation_scheme ) )

          CASE ( 'constant' )
             CALL radiation_constant
          
          CASE ( 'clear-sky' ) 
             CALL radiation_clearsky
       
          CASE ( 'rrtmg' )
             CALL radiation_rrtmg

          CASE DEFAULT

       END SELECT


    END SUBROUTINE radiation_control

!------------------------------------------------------------------------------!
! Description:
! ------------
!> Check data output for radiation model
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_check_data_output( variable, unit, i, ilen, k )
 
 
       USE control_parameters,                                                 &
           ONLY: data_output, message_string

       IMPLICIT NONE

       CHARACTER (LEN=*) ::  unit          !<
       CHARACTER (LEN=*) ::  variable      !<

       INTEGER(iwp) :: i, j, k, l
       INTEGER(iwp) :: ilen
       CHARACTER(LEN=varnamelength) :: var          !< TRIM(variable)

       var = TRIM(variable)

!--    first process diractional variables
       IF ( var(1:12) == 'rtm_rad_net_'  .OR.  var(1:13) == 'rtm_rad_insw_'  .OR.        &
            var(1:13) == 'rtm_rad_inlw_'  .OR.  var(1:16) == 'rtm_rad_inswdir_'  .OR.    &
            var(1:16) == 'rtm_rad_inswdif_'  .OR.  var(1:16) == 'rtm_rad_inswref_'  .OR. &
            var(1:16) == 'rtm_rad_inlwdif_'  .OR.  var(1:16) == 'rtm_rad_inlwref_'  .OR. &
            var(1:14) == 'rtm_rad_outsw_'  .OR.  var(1:14) == 'rtm_rad_outlw_'  .OR.     &
            var(1:14) == 'rtm_rad_ressw_'  .OR.  var(1:14) == 'rtm_rad_reslw_'  ) THEN
          IF ( .NOT.  radiation ) THEN
                message_string = 'output of "' // TRIM( var ) // '" require'&
                                 // 's radiation = .TRUE.'
                CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
          ENDIF
          unit = 'W/m2'
       ELSE IF ( var(1:7) == 'rtm_svf'  .OR.  var(1:7) == 'rtm_dif'  .OR.                &
                 var(1:9) == 'rtm_skyvf' .OR. var(1:9) == 'rtm_skyvft' )  THEN
          IF ( .NOT.  radiation ) THEN
                message_string = 'output of "' // TRIM( var ) // '" require'&
                                 // 's radiation = .TRUE.'
                CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
          ENDIF
          unit = '1'
       ELSE
!--       non-directional variables
          SELECT CASE ( TRIM( var ) )
             CASE ( 'rad_lw_cs_hr', 'rad_lw_hr', 'rad_lw_in', 'rad_lw_out', &
                    'rad_sw_cs_hr', 'rad_sw_hr', 'rad_sw_in', 'rad_sw_out'  )
                IF (  .NOT.  radiation  .OR.  radiation_scheme /= 'rrtmg' )  THEN
                   message_string = '"output of "' // TRIM( var ) // '" requi' // &
                                    'res radiation = .TRUE. and ' //              &
                                    'radiation_scheme = "rrtmg"'
                   CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 )
                ENDIF
                unit = 'K/h'

             CASE ( 'rad_net*', 'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*',      &
                    'rrtm_asdir*', 'rad_lw_in*', 'rad_lw_out*', 'rad_sw_in*',     &
                    'rad_sw_out*')
                IF ( i == 0 .AND. ilen == 0 .AND. k == 0)  THEN
                   ! Workaround for masked output (calls with i=ilen=k=0)
                   unit = 'illegal'
                   RETURN
                ENDIF
                IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
                   message_string = 'illegal value for data_output: "' //         &
                                    TRIM( var ) // '" & only 2d-horizontal ' //   &
                                    'cross sections are allowed for this value'
                   CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
                ENDIF
                IF (  .NOT.  radiation  .OR.  radiation_scheme /= "rrtmg" )  THEN
                   IF ( TRIM( var ) == 'rrtm_aldif*'  .OR.                        &
                        TRIM( var ) == 'rrtm_aldir*'  .OR.                        &
                        TRIM( var ) == 'rrtm_asdif*'  .OR.                        &
                        TRIM( var ) == 'rrtm_asdir*'      )                       &
                   THEN
                      message_string = 'output of "' // TRIM( var ) // '" require'&
                                       // 's radiation = .TRUE. and radiation_sch'&
                                       // 'eme = "rrtmg"'
                      CALL message( 'check_parameters', 'PA0409', 1, 2, 0, 6, 0 )
                   ENDIF
                ENDIF

                IF ( TRIM( var ) == 'rad_net*'      ) unit = 'W/m2'
                IF ( TRIM( var ) == 'rad_lw_in*'    ) unit = 'W/m2'
                IF ( TRIM( var ) == 'rad_lw_out*'   ) unit = 'W/m2'
                IF ( TRIM( var ) == 'rad_sw_in*'    ) unit = 'W/m2'
                IF ( TRIM( var ) == 'rad_sw_out*'   ) unit = 'W/m2'
                IF ( TRIM( var ) == 'rad_sw_in'     ) unit = 'W/m2'
                IF ( TRIM( var ) == 'rrtm_aldif*'   ) unit = ''
                IF ( TRIM( var ) == 'rrtm_aldir*'   ) unit = ''
                IF ( TRIM( var ) == 'rrtm_asdif*'   ) unit = ''
                IF ( TRIM( var ) == 'rrtm_asdir*'   ) unit = ''

             CASE ( 'rtm_rad_pc_inlw', 'rtm_rad_pc_insw', 'rtm_rad_pc_inswdir', &
                    'rtm_rad_pc_inswdif', 'rtm_rad_pc_inswref')
                IF ( .NOT.  radiation ) THEN
                   message_string = 'output of "' // TRIM( var ) // '" require'&
                                    // 's radiation = .TRUE.'
                   CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
                ENDIF
                unit = 'W'

             CASE ( 'rtm_mrt', 'rtm_mrt_sw', 'rtm_mrt_lw'  )
                IF ( i == 0 .AND. ilen == 0 .AND. k == 0)  THEN
                   ! Workaround for masked output (calls with i=ilen=k=0)
                   unit = 'illegal'
                   RETURN
                ENDIF

                IF ( .NOT.  radiation ) THEN
                   message_string = 'output of "' // TRIM( var ) // '" require'&
                                    // 's radiation = .TRUE.'
                   CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
                ENDIF
                IF ( mrt_nlevels == 0 ) THEN
                   message_string = 'output of "' // TRIM( var ) // '" require'&
                                    // 's mrt_nlevels > 0'
                   CALL message( 'check_parameters', 'PA0510', 1, 2, 0, 6, 0 )
                ENDIF
                IF ( TRIM( var ) == 'rtm_mrt_sw'  .AND.  .NOT. mrt_include_sw ) THEN
                   message_string = 'output of "' // TRIM( var ) // '" require'&
                                    // 's rtm_mrt_sw = .TRUE.'
                   CALL message( 'check_parameters', 'PA0511', 1, 2, 0, 6, 0 )
                ENDIF
                IF ( TRIM( var ) == 'rtm_mrt' ) THEN
                   unit = 'K'
                ELSE
                   unit = 'W m-2'
                ENDIF

             CASE DEFAULT
                unit = 'illegal'

          END SELECT
       ENDIF

    END SUBROUTINE radiation_check_data_output

!------------------------------------------------------------------------------!
! Description:
! ------------
!> Check data output of profiles for radiation model
!------------------------------------------------------------------------------!  
    SUBROUTINE radiation_check_data_output_pr( variable, var_count, unit,      &
               dopr_unit )
 
       USE arrays_3d,                                                          &
           ONLY: zu

       USE control_parameters,                                                 &
           ONLY: data_output_pr, message_string

       USE indices

       USE profil_parameter

       USE statistics

       IMPLICIT NONE
   
       CHARACTER (LEN=*) ::  unit      !< 
       CHARACTER (LEN=*) ::  variable  !< 
       CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
 
       INTEGER(iwp) ::  var_count     !< 

       SELECT CASE ( TRIM( variable ) )
       
         CASE ( 'rad_net' )
             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme == 'constant' )&
             THEN
                message_string = 'data_output_pr = ' //                        &
                                 TRIM( data_output_pr(var_count) ) // ' is' // &
                                 'not available for radiation = .FALSE. or ' //&
                                 'radiation_scheme = "constant"'
                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
             ELSE
                dopr_index(var_count) = 99
                dopr_unit  = 'W/m2'
                hom(:,2,99,:)  = SPREAD( zw, 2, statistic_regions+1 )
                unit = dopr_unit
             ENDIF

          CASE ( 'rad_lw_in' )
             IF ( (  .NOT.  radiation)  .OR.  radiation_scheme == 'constant' ) &
             THEN
                message_string = 'data_output_pr = ' //                        &
                                 TRIM( data_output_pr(var_count) ) // ' is' // &
                                 'not available for radiation = .FALSE. or ' //&
                                 'radiation_scheme = "constant"'
                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
             ELSE
                dopr_index(var_count) = 100
                dopr_unit  = 'W/m2'
                hom(:,2,100,:)  = SPREAD( zw, 2, statistic_regions+1 )
                unit = dopr_unit 
             ENDIF

          CASE ( 'rad_lw_out' )
             IF ( (  .NOT. radiation )  .OR.  radiation_scheme == 'constant' ) &
             THEN
                message_string = 'data_output_pr = ' //                        &
                                 TRIM( data_output_pr(var_count) ) // ' is' // &
                                 'not available for radiation = .FALSE. or ' //&
                                 'radiation_scheme = "constant"'
                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
             ELSE
                dopr_index(var_count) = 101
                dopr_unit  = 'W/m2'
                hom(:,2,101,:)  = SPREAD( zw, 2, statistic_regions+1 )
                unit = dopr_unit   
             ENDIF

          CASE ( 'rad_sw_in' )
             IF ( (  .NOT. radiation )  .OR.  radiation_scheme == 'constant' ) &
             THEN
                message_string = 'data_output_pr = ' //                        &
                                 TRIM( data_output_pr(var_count) ) // ' is' // &
                                 'not available for radiation = .FALSE. or ' //&
                                 'radiation_scheme = "constant"'
                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
             ELSE
                dopr_index(var_count) = 102
                dopr_unit  = 'W/m2'
                hom(:,2,102,:)  = SPREAD( zw, 2, statistic_regions+1 )
                unit = dopr_unit
             ENDIF

          CASE ( 'rad_sw_out')
             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme == 'constant' )&
             THEN
                message_string = 'data_output_pr = ' //                        &
                                 TRIM( data_output_pr(var_count) ) // ' is' // &
                                 'not available for radiation = .FALSE. or ' //&
                                 'radiation_scheme = "constant"'
                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
             ELSE
                dopr_index(var_count) = 103
                dopr_unit  = 'W/m2'
                hom(:,2,103,:)  = SPREAD( zw, 2, statistic_regions+1 )
                unit = dopr_unit
             ENDIF

          CASE ( 'rad_lw_cs_hr' )
             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
             THEN
                message_string = 'data_output_pr = ' //                        &
                                 TRIM( data_output_pr(var_count) ) // ' is' // &
                                 'not available for radiation = .FALSE. or ' //&
                                 'radiation_scheme /= "rrtmg"'
                CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
             ELSE
                dopr_index(var_count) = 104
                dopr_unit  = 'K/h'
                hom(:,2,104,:)  = SPREAD( zu, 2, statistic_regions+1 )
                unit = dopr_unit
             ENDIF

          CASE ( 'rad_lw_hr' )
             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
             THEN
                message_string = 'data_output_pr = ' //                        &
                                 TRIM( data_output_pr(var_count) ) // ' is' // &
                                 'not available for radiation = .FALSE. or ' //&
                                 'radiation_scheme /= "rrtmg"'
                CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
             ELSE
                dopr_index(var_count) = 105
                dopr_unit  = 'K/h'
                hom(:,2,105,:)  = SPREAD( zu, 2, statistic_regions+1 )
                unit = dopr_unit
             ENDIF

          CASE ( 'rad_sw_cs_hr' )
             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
             THEN
                message_string = 'data_output_pr = ' //                        &
                                 TRIM( data_output_pr(var_count) ) // ' is' // &
                                 'not available for radiation = .FALSE. or ' //&
                                 'radiation_scheme /= "rrtmg"'
                CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
             ELSE
                dopr_index(var_count) = 106
                dopr_unit  = 'K/h'
                hom(:,2,106,:)  = SPREAD( zu, 2, statistic_regions+1 )
                unit = dopr_unit
             ENDIF

          CASE ( 'rad_sw_hr' )
             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
             THEN
                message_string = 'data_output_pr = ' //                        &
                                 TRIM( data_output_pr(var_count) ) // ' is' // &
                                 'not available for radiation = .FALSE. or ' //&
                                 'radiation_scheme /= "rrtmg"'
                CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
             ELSE
                dopr_index(var_count) = 107
                dopr_unit  = 'K/h'
                hom(:,2,107,:)  = SPREAD( zu, 2, statistic_regions+1 )
                unit = dopr_unit
             ENDIF


          CASE DEFAULT
             unit = 'illegal'

       END SELECT


    END SUBROUTINE radiation_check_data_output_pr
 
 
!------------------------------------------------------------------------------!
! Description:
! ------------
!> Check parameters routine for radiation model
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_check_parameters

       USE control_parameters,                                                 &
           ONLY: land_surface, message_string, urban_surface

       USE netcdf_data_input_mod,                                              &
           ONLY:  input_pids_static                 
    
       IMPLICIT NONE
       
!
!--    In case no urban-surface or land-surface model is applied, usage of 
!--    a radiation model make no sense.         
       IF ( .NOT. land_surface  .AND.  .NOT. urban_surface )  THEN
          message_string = 'Usage of radiation module is only allowed if ' //  &
                           'land-surface and/or urban-surface model is applied.'
          CALL message( 'check_parameters', 'PA0486', 1, 2, 0, 6, 0 )
       ENDIF

       IF ( radiation_scheme /= 'constant'   .AND.                             &
            radiation_scheme /= 'clear-sky'  .AND.                             &
            radiation_scheme /= 'rrtmg' )  THEN
          message_string = 'unknown radiation_scheme = '//                     &
                           TRIM( radiation_scheme )
          CALL message( 'check_parameters', 'PA0405', 1, 2, 0, 6, 0 )
       ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
#if ! defined ( __rrtmg )
          message_string = 'radiation_scheme = "rrtmg" requires ' //           & 
                           'compilation of PALM with pre-processor ' //        &
                           'directive -D__rrtmg'
          CALL message( 'check_parameters', 'PA0407', 1, 2, 0, 6, 0 )
#endif
#if defined ( __rrtmg ) && ! defined( __netcdf )
          message_string = 'radiation_scheme = "rrtmg" requires ' //           & 
                           'the use of NetCDF (preprocessor directive ' //     &
                           '-D__netcdf'
          CALL message( 'check_parameters', 'PA0412', 1, 2, 0, 6, 0 )
#endif

       ENDIF
!
!--    Checks performed only if data is given via namelist only. 
       IF ( .NOT. input_pids_static )  THEN
          IF ( albedo_type == 0  .AND.  albedo == 9999999.9_wp  .AND.          &
               radiation_scheme == 'clear-sky')  THEN
             message_string = 'radiation_scheme = "clear-sky" in combination'//& 
                              'with albedo_type = 0 requires setting of'//     &
                              'albedo /= 9999999.9'
             CALL message( 'check_parameters', 'PA0410', 1, 2, 0, 6, 0 )
          ENDIF

          IF ( albedo_type == 0  .AND.  radiation_scheme == 'rrtmg'  .AND.     &
             ( albedo_lw_dif == 9999999.9_wp .OR. albedo_lw_dir == 9999999.9_wp&
          .OR. albedo_sw_dif == 9999999.9_wp .OR. albedo_sw_dir == 9999999.9_wp& 
             ) ) THEN
             message_string = 'radiation_scheme = "rrtmg" in combination' //   & 
                              'with albedo_type = 0 requires setting of ' //   &
                              'albedo_lw_dif /= 9999999.9' //                  &
                              'albedo_lw_dir /= 9999999.9' //                  &
                              'albedo_sw_dif /= 9999999.9 and' //              &
                              'albedo_sw_dir /= 9999999.9'
             CALL message( 'check_parameters', 'PA0411', 1, 2, 0, 6, 0 )
          ENDIF
       ENDIF
!
!--    Parallel rad_angular_discretization without raytrace_mpi_rma is not implemented
#if defined( __parallel )      
       IF ( rad_angular_discretization  .AND.  .NOT. raytrace_mpi_rma )  THEN
          message_string = 'rad_angular_discretization can only be used ' //  &
                           'together with raytrace_mpi_rma or when ' //  &
                           'no parallelization is applied.'
          CALL message( 'check_parameters', 'PA0486', 1, 2, 0, 6, 0 )
       ENDIF
#endif

       IF ( cloud_droplets  .AND.   radiation_scheme == 'rrtmg'  .AND.         &
            average_radiation ) THEN
          message_string = 'average_radiation = .T. with radiation_scheme'//   & 
                           '= "rrtmg" in combination cloud_droplets = .T.'//   &
                           'is not implementd'
          CALL message( 'check_parameters', 'PA0560', 1, 2, 0, 6, 0 )
       ENDIF

!
!--    Incialize svf normalization reporting histogram
       svfnorm_report_num = 1
       DO WHILE ( svfnorm_report_thresh(svfnorm_report_num) < 1e20_wp          &
                   .AND. svfnorm_report_num <= 30 )
          svfnorm_report_num = svfnorm_report_num + 1
       ENDDO
       svfnorm_report_num = svfnorm_report_num - 1


 
    END SUBROUTINE radiation_check_parameters 
 
 
!------------------------------------------------------------------------------!
! Description:
! ------------
!> Initialization of the radiation model
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_init
    
       IMPLICIT NONE

       INTEGER(iwp) ::  i         !< running index x-direction 
       INTEGER(iwp) ::  ioff      !< offset in x between surface element reference grid point in atmosphere and actual surface 
       INTEGER(iwp) ::  j         !< running index y-direction 
       INTEGER(iwp) ::  joff      !< offset in y between surface element reference grid point in atmosphere and actual surface 
       INTEGER(iwp) ::  l         !< running index for orientation of vertical surfaces 
       INTEGER(iwp) ::  m         !< running index for surface elements
#if defined( __rrtmg )
       INTEGER(iwp) ::  ind_type  !< running index for subgrid-surface tiles
#endif

!
!--    Allocate array for storing the surface net radiation
       IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_net )  .AND.                      &
                  surf_lsm_h%ns > 0  )   THEN
          ALLOCATE( surf_lsm_h%rad_net(1:surf_lsm_h%ns) )
          surf_lsm_h%rad_net = 0.0_wp 
       ENDIF
       IF ( .NOT. ALLOCATED ( surf_usm_h%rad_net )  .AND.                      &
                  surf_usm_h%ns > 0  )  THEN
          ALLOCATE( surf_usm_h%rad_net(1:surf_usm_h%ns) )
          surf_usm_h%rad_net = 0.0_wp 
       ENDIF
       DO  l = 0, 3
          IF ( .NOT. ALLOCATED ( surf_lsm_v(l)%rad_net )  .AND.                &
                     surf_lsm_v(l)%ns > 0  )  THEN
             ALLOCATE( surf_lsm_v(l)%rad_net(1:surf_lsm_v(l)%ns) )
             surf_lsm_v(l)%rad_net = 0.0_wp 
          ENDIF
          IF ( .NOT. ALLOCATED ( surf_usm_v(l)%rad_net )  .AND.                &
                     surf_usm_v(l)%ns > 0  )  THEN
             ALLOCATE( surf_usm_v(l)%rad_net(1:surf_usm_v(l)%ns) )
             surf_usm_v(l)%rad_net = 0.0_wp 
          ENDIF
       ENDDO


!
!--    Allocate array for storing the surface longwave (out) radiation change
       IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_lw_out_change_0 )  .AND.          &
                  surf_lsm_h%ns > 0  )   THEN
          ALLOCATE( surf_lsm_h%rad_lw_out_change_0(1:surf_lsm_h%ns) )
          surf_lsm_h%rad_lw_out_change_0 = 0.0_wp 
       ENDIF
       IF ( .NOT. ALLOCATED ( surf_usm_h%rad_lw_out_change_0 )  .AND.          &
                  surf_usm_h%ns > 0  )  THEN
          ALLOCATE( surf_usm_h%rad_lw_out_change_0(1:surf_usm_h%ns) )
          surf_usm_h%rad_lw_out_change_0 = 0.0_wp 
       ENDIF
       DO  l = 0, 3
          IF ( .NOT. ALLOCATED ( surf_lsm_v(l)%rad_lw_out_change_0 )  .AND.    &
                     surf_lsm_v(l)%ns > 0  )  THEN
             ALLOCATE( surf_lsm_v(l)%rad_lw_out_change_0(1:surf_lsm_v(l)%ns) )
             surf_lsm_v(l)%rad_lw_out_change_0 = 0.0_wp 
          ENDIF
          IF ( .NOT. ALLOCATED ( surf_usm_v(l)%rad_lw_out_change_0 )  .AND.    &
                     surf_usm_v(l)%ns > 0  )  THEN
             ALLOCATE( surf_usm_v(l)%rad_lw_out_change_0(1:surf_usm_v(l)%ns) )
             surf_usm_v(l)%rad_lw_out_change_0 = 0.0_wp 
          ENDIF
       ENDDO

!
!--    Allocate surface arrays for incoming/outgoing short/longwave radiation
       IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_sw_in )  .AND.                    &
                  surf_lsm_h%ns > 0  )   THEN
          ALLOCATE( surf_lsm_h%rad_sw_in(1:surf_lsm_h%ns)  )
          ALLOCATE( surf_lsm_h%rad_sw_out(1:surf_lsm_h%ns) )
          ALLOCATE( surf_lsm_h%rad_sw_dir(1:surf_lsm_h%ns) )
          ALLOCATE( surf_lsm_h%rad_sw_dif(1:surf_lsm_h%ns) )
          ALLOCATE( surf_lsm_h%rad_sw_ref(1:surf_lsm_h%ns) )
          ALLOCATE( surf_lsm_h%rad_sw_res(1:surf_lsm_h%ns) )
          ALLOCATE( surf_lsm_h%rad_lw_in(1:surf_lsm_h%ns)  )
          ALLOCATE( surf_lsm_h%rad_lw_out(1:surf_lsm_h%ns) )
          ALLOCATE( surf_lsm_h%rad_lw_dif(1:surf_lsm_h%ns) )
          ALLOCATE( surf_lsm_h%rad_lw_ref(1:surf_lsm_h%ns) )
          ALLOCATE( surf_lsm_h%rad_lw_res(1:surf_lsm_h%ns) )
          surf_lsm_h%rad_sw_in  = 0.0_wp 
          surf_lsm_h%rad_sw_out = 0.0_wp 
          surf_lsm_h%rad_sw_dir = 0.0_wp 
          surf_lsm_h%rad_sw_dif = 0.0_wp 
          surf_lsm_h%rad_sw_ref = 0.0_wp 
          surf_lsm_h%rad_sw_res = 0.0_wp 
          surf_lsm_h%rad_lw_in  = 0.0_wp 
          surf_lsm_h%rad_lw_out = 0.0_wp 
          surf_lsm_h%rad_lw_dif = 0.0_wp 
          surf_lsm_h%rad_lw_ref = 0.0_wp 
          surf_lsm_h%rad_lw_res = 0.0_wp 
       ENDIF
       IF ( .NOT. ALLOCATED ( surf_usm_h%rad_sw_in )  .AND.                    &
                  surf_usm_h%ns > 0  )  THEN
          ALLOCATE( surf_usm_h%rad_sw_in(1:surf_usm_h%ns)  )
          ALLOCATE( surf_usm_h%rad_sw_out(1:surf_usm_h%ns) )
          ALLOCATE( surf_usm_h%rad_sw_dir(1:surf_usm_h%ns) )
          ALLOCATE( surf_usm_h%rad_sw_dif(1:surf_usm_h%ns) )
          ALLOCATE( surf_usm_h%rad_sw_ref(1:surf_usm_h%ns) )
          ALLOCATE( surf_usm_h%rad_sw_res(1:surf_usm_h%ns) )
          ALLOCATE( surf_usm_h%rad_lw_in(1:surf_usm_h%ns)  )
          ALLOCATE( surf_usm_h%rad_lw_out(1:surf_usm_h%ns) )
          ALLOCATE( surf_usm_h%rad_lw_dif(1:surf_usm_h%ns) )
          ALLOCATE( surf_usm_h%rad_lw_ref(1:surf_usm_h%ns) )
          ALLOCATE( surf_usm_h%rad_lw_res(1:surf_usm_h%ns) )
          surf_usm_h%rad_sw_in  = 0.0_wp 
          surf_usm_h%rad_sw_out = 0.0_wp 
          surf_usm_h%rad_sw_dir = 0.0_wp 
          surf_usm_h%rad_sw_dif = 0.0_wp 
          surf_usm_h%rad_sw_ref = 0.0_wp 
          surf_usm_h%rad_sw_res = 0.0_wp 
          surf_usm_h%rad_lw_in  = 0.0_wp 
          surf_usm_h%rad_lw_out = 0.0_wp 
          surf_usm_h%rad_lw_dif = 0.0_wp 
          surf_usm_h%rad_lw_ref = 0.0_wp 
          surf_usm_h%rad_lw_res = 0.0_wp 
       ENDIF
       DO  l = 0, 3
          IF ( .NOT. ALLOCATED ( surf_lsm_v(l)%rad_sw_in )  .AND.              &
                     surf_lsm_v(l)%ns > 0  )  THEN
             ALLOCATE( surf_lsm_v(l)%rad_sw_in(1:surf_lsm_v(l)%ns)  )
             ALLOCATE( surf_lsm_v(l)%rad_sw_out(1:surf_lsm_v(l)%ns) )
             ALLOCATE( surf_lsm_v(l)%rad_sw_dir(1:surf_lsm_v(l)%ns) )
             ALLOCATE( surf_lsm_v(l)%rad_sw_dif(1:surf_lsm_v(l)%ns) )
             ALLOCATE( surf_lsm_v(l)%rad_sw_ref(1:surf_lsm_v(l)%ns) )
             ALLOCATE( surf_lsm_v(l)%rad_sw_res(1:surf_lsm_v(l)%ns) )

             ALLOCATE( surf_lsm_v(l)%rad_lw_in(1:surf_lsm_v(l)%ns)  )
             ALLOCATE( surf_lsm_v(l)%rad_lw_out(1:surf_lsm_v(l)%ns) )
             ALLOCATE( surf_lsm_v(l)%rad_lw_dif(1:surf_lsm_v(l)%ns) )
             ALLOCATE( surf_lsm_v(l)%rad_lw_ref(1:surf_lsm_v(l)%ns) )
             ALLOCATE( surf_lsm_v(l)%rad_lw_res(1:surf_lsm_v(l)%ns) )

             surf_lsm_v(l)%rad_sw_in  = 0.0_wp 
             surf_lsm_v(l)%rad_sw_out = 0.0_wp
             surf_lsm_v(l)%rad_sw_dir = 0.0_wp
             surf_lsm_v(l)%rad_sw_dif = 0.0_wp
             surf_lsm_v(l)%rad_sw_ref = 0.0_wp
             surf_lsm_v(l)%rad_sw_res = 0.0_wp

             surf_lsm_v(l)%rad_lw_in  = 0.0_wp 
             surf_lsm_v(l)%rad_lw_out = 0.0_wp 
             surf_lsm_v(l)%rad_lw_dif = 0.0_wp 
             surf_lsm_v(l)%rad_lw_ref = 0.0_wp 
             surf_lsm_v(l)%rad_lw_res = 0.0_wp 
          ENDIF
          IF ( .NOT. ALLOCATED ( surf_usm_v(l)%rad_sw_in )  .AND.              &
                     surf_usm_v(l)%ns > 0  )  THEN
             ALLOCATE( surf_usm_v(l)%rad_sw_in(1:surf_usm_v(l)%ns)  )
             ALLOCATE( surf_usm_v(l)%rad_sw_out(1:surf_usm_v(l)%ns) )
             ALLOCATE( surf_usm_v(l)%rad_sw_dir(1:surf_usm_v(l)%ns) )
             ALLOCATE( surf_usm_v(l)%rad_sw_dif(1:surf_usm_v(l)%ns) )
             ALLOCATE( surf_usm_v(l)%rad_sw_ref(1:surf_usm_v(l)%ns) )
             ALLOCATE( surf_usm_v(l)%rad_sw_res(1:surf_usm_v(l)%ns) )
             ALLOCATE( surf_usm_v(l)%rad_lw_in(1:surf_usm_v(l)%ns)  )
             ALLOCATE( surf_usm_v(l)%rad_lw_out(1:surf_usm_v(l)%ns) )
             ALLOCATE( surf_usm_v(l)%rad_lw_dif(1:surf_usm_v(l)%ns) )
             ALLOCATE( surf_usm_v(l)%rad_lw_ref(1:surf_usm_v(l)%ns) )
             ALLOCATE( surf_usm_v(l)%rad_lw_res(1:surf_usm_v(l)%ns) )
             surf_usm_v(l)%rad_sw_in  = 0.0_wp 
             surf_usm_v(l)%rad_sw_out = 0.0_wp
             surf_usm_v(l)%rad_sw_dir = 0.0_wp
             surf_usm_v(l)%rad_sw_dif = 0.0_wp
             surf_usm_v(l)%rad_sw_ref = 0.0_wp
             surf_usm_v(l)%rad_sw_res = 0.0_wp
             surf_usm_v(l)%rad_lw_in  = 0.0_wp 
             surf_usm_v(l)%rad_lw_out = 0.0_wp 
             surf_usm_v(l)%rad_lw_dif = 0.0_wp 
             surf_usm_v(l)%rad_lw_ref = 0.0_wp 
             surf_usm_v(l)%rad_lw_res = 0.0_wp 
          ENDIF
       ENDDO
!
!--    Fix net radiation in case of radiation_scheme = 'constant'
       IF ( radiation_scheme == 'constant' )  THEN
          IF ( ALLOCATED( surf_lsm_h%rad_net ) )                               &
             surf_lsm_h%rad_net    = net_radiation
          IF ( ALLOCATED( surf_usm_h%rad_net ) )                               &
             surf_usm_h%rad_net    = net_radiation
!
!--       Todo: weight with inclination angle
          DO  l = 0, 3
             IF ( ALLOCATED( surf_lsm_v(l)%rad_net ) )                         &
                surf_lsm_v(l)%rad_net = net_radiation
             IF ( ALLOCATED( surf_usm_v(l)%rad_net ) )                         &
                surf_usm_v(l)%rad_net = net_radiation
          ENDDO
!          radiation = .FALSE.
!
!--    Calculate orbital constants
       ELSE
          decl_1 = SIN(23.45_wp * pi / 180.0_wp)
          decl_2 = 2.0_wp * pi / 365.0_wp
          decl_3 = decl_2 * 81.0_wp
          lat    = latitude * pi / 180.0_wp
          lon    = longitude * pi / 180.0_wp
       ENDIF

       IF ( radiation_scheme == 'clear-sky'  .OR.                              &
            radiation_scheme == 'constant')  THEN


!
!--       Allocate arrays for incoming/outgoing short/longwave radiation
          IF ( .NOT. ALLOCATED ( rad_sw_in ) )  THEN
             ALLOCATE ( rad_sw_in(0:0,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( .NOT. ALLOCATED ( rad_sw_out ) )  THEN
             ALLOCATE ( rad_sw_out(0:0,nysg:nyng,nxlg:nxrg) )
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_in ) )  THEN
             ALLOCATE ( rad_lw_in(0:0,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( .NOT. ALLOCATED ( rad_lw_out ) )  THEN
             ALLOCATE ( rad_lw_out(0:0,nysg:nyng,nxlg:nxrg) )
          ENDIF

!
!--       Allocate average arrays for incoming/outgoing short/longwave radiation
          IF ( .NOT. ALLOCATED ( rad_sw_in_av ) )  THEN
             ALLOCATE ( rad_sw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( .NOT. ALLOCATED ( rad_sw_out_av ) )  THEN
             ALLOCATE ( rad_sw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_in_av ) )  THEN
             ALLOCATE ( rad_lw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( .NOT. ALLOCATED ( rad_lw_out_av ) )  THEN
             ALLOCATE ( rad_lw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
          ENDIF
!
!--       Allocate arrays for broadband albedo, and level 1 initialization
!--       via namelist paramter, unless not already allocated.
          IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) )  THEN
             ALLOCATE( surf_lsm_h%albedo(0:2,1:surf_lsm_h%ns)     )
             surf_lsm_h%albedo    = albedo
          ENDIF
          IF ( .NOT. ALLOCATED(surf_usm_h%albedo) )  THEN
             ALLOCATE( surf_usm_h%albedo(0:2,1:surf_usm_h%ns)     )
             surf_usm_h%albedo    = albedo
          ENDIF

          DO  l = 0, 3
             IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) )  THEN
                ALLOCATE( surf_lsm_v(l)%albedo(0:2,1:surf_lsm_v(l)%ns) )
                surf_lsm_v(l)%albedo = albedo
             ENDIF
             IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) )  THEN
                ALLOCATE( surf_usm_v(l)%albedo(0:2,1:surf_usm_v(l)%ns) )
                surf_usm_v(l)%albedo = albedo
             ENDIF
          ENDDO
!
!--       Level 2 initialization of broadband albedo via given albedo_type. 
!--       Only if albedo_type is non-zero. In case of urban surface and 
!--       input data is read from ASCII file, albedo_type will be zero, so that
!--       albedo won't be overwritten. 
          DO  m = 1, surf_lsm_h%ns
             IF ( surf_lsm_h%albedo_type(ind_veg_wall,m) /= 0 )                &
                surf_lsm_h%albedo(ind_veg_wall,m) =                            &
                           albedo_pars(2,surf_lsm_h%albedo_type(ind_veg_wall,m))
             IF ( surf_lsm_h%albedo_type(ind_pav_green,m) /= 0 )               &
                surf_lsm_h%albedo(ind_pav_green,m) =                           &
                           albedo_pars(2,surf_lsm_h%albedo_type(ind_pav_green,m))
             IF ( surf_lsm_h%albedo_type(ind_wat_win,m) /= 0 )                 &
                surf_lsm_h%albedo(ind_wat_win,m) =                             &
                           albedo_pars(2,surf_lsm_h%albedo_type(ind_wat_win,m))
          ENDDO
          DO  m = 1, surf_usm_h%ns
             IF ( surf_usm_h%albedo_type(ind_veg_wall,m) /= 0 )                &
                surf_usm_h%albedo(ind_veg_wall,m) =                            &
                           albedo_pars(2,surf_usm_h%albedo_type(ind_veg_wall,m))
             IF ( surf_usm_h%albedo_type(ind_pav_green,m) /= 0 )               &
                surf_usm_h%albedo(ind_pav_green,m) =                           &
                           albedo_pars(2,surf_usm_h%albedo_type(ind_pav_green,m))
             IF ( surf_usm_h%albedo_type(ind_wat_win,m) /= 0 )                 &
                surf_usm_h%albedo(ind_wat_win,m) =                             &
                           albedo_pars(2,surf_usm_h%albedo_type(ind_wat_win,m))
          ENDDO

          DO  l = 0, 3
             DO  m = 1, surf_lsm_v(l)%ns
                IF ( surf_lsm_v(l)%albedo_type(ind_veg_wall,m) /= 0 )          &
                   surf_lsm_v(l)%albedo(ind_veg_wall,m) =                      &
                        albedo_pars(2,surf_lsm_v(l)%albedo_type(ind_veg_wall,m))
                IF ( surf_lsm_v(l)%albedo_type(ind_pav_green,m) /= 0 )         &
                   surf_lsm_v(l)%albedo(ind_pav_green,m) =                     &
                        albedo_pars(2,surf_lsm_v(l)%albedo_type(ind_pav_green,m))
                IF ( surf_lsm_v(l)%albedo_type(ind_wat_win,m) /= 0 )           &
                   surf_lsm_v(l)%albedo(ind_wat_win,m) =                       &
                        albedo_pars(2,surf_lsm_v(l)%albedo_type(ind_wat_win,m))
             ENDDO
             DO  m = 1, surf_usm_v(l)%ns
                IF ( surf_usm_v(l)%albedo_type(ind_veg_wall,m) /= 0 )          &
                   surf_usm_v(l)%albedo(ind_veg_wall,m) =                      &
                        albedo_pars(2,surf_usm_v(l)%albedo_type(ind_veg_wall,m))
                IF ( surf_usm_v(l)%albedo_type(ind_pav_green,m) /= 0 )         &
                   surf_usm_v(l)%albedo(ind_pav_green,m) =                     &
                        albedo_pars(2,surf_usm_v(l)%albedo_type(ind_pav_green,m))
                IF ( surf_usm_v(l)%albedo_type(ind_wat_win,m) /= 0 )           &
                   surf_usm_v(l)%albedo(ind_wat_win,m) =                       &
                        albedo_pars(2,surf_usm_v(l)%albedo_type(ind_wat_win,m))
             ENDDO
          ENDDO

!
!--       Level 3 initialization at grid points where albedo type is zero.
!--       This case, albedo is taken from file. In case of constant radiation
!--       or clear sky, only broadband albedo is given.
          IF ( albedo_pars_f%from_file )  THEN
!
!--          Horizontal surfaces
             DO  m = 1, surf_lsm_h%ns
                i = surf_lsm_h%i(m)
                j = surf_lsm_h%j(m)
                IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
                   IF ( surf_lsm_h%albedo_type(ind_veg_wall,m) == 0 )          &
                      surf_lsm_h%albedo(ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)
                   IF ( surf_lsm_h%albedo_type(ind_pav_green,m) == 0 )         &
                      surf_lsm_h%albedo(ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)
                   IF ( surf_lsm_h%albedo_type(ind_wat_win,m) == 0 )           &
                      surf_lsm_h%albedo(ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)
                ENDIF
             ENDDO
             DO  m = 1, surf_usm_h%ns
                i = surf_usm_h%i(m)
                j = surf_usm_h%j(m)
                IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
                   IF ( surf_usm_h%albedo_type(ind_veg_wall,m) == 0 )          &
                      surf_usm_h%albedo(ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)
                   IF ( surf_usm_h%albedo_type(ind_pav_green,m) == 0 )         &
                      surf_usm_h%albedo(ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)
                   IF ( surf_usm_h%albedo_type(ind_wat_win,m) == 0 )           &
                      surf_usm_h%albedo(ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)
                ENDIF
             ENDDO 
!
!--          Vertical surfaces            
             DO  l = 0, 3

                ioff = surf_lsm_v(l)%ioff
                joff = surf_lsm_v(l)%joff
                DO  m = 1, surf_lsm_v(l)%ns
                   i = surf_lsm_v(l)%i(m) + ioff
                   j = surf_lsm_v(l)%j(m) + joff
                   IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
                      IF ( surf_lsm_v(l)%albedo_type(ind_veg_wall,m) == 0 )    &
                         surf_lsm_v(l)%albedo(ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)
                      IF ( surf_lsm_v(l)%albedo_type(ind_pav_green,m) == 0 )   &
                         surf_lsm_v(l)%albedo(ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)
                      IF ( surf_lsm_v(l)%albedo_type(ind_wat_win,m) == 0 )     &
                         surf_lsm_v(l)%albedo(ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)
                   ENDIF
                ENDDO

                ioff = surf_usm_v(l)%ioff
                joff = surf_usm_v(l)%joff
                DO  m = 1, surf_usm_h%ns
                   i = surf_usm_h%i(m) + joff
                   j = surf_usm_h%j(m) + joff
                   IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
                      IF ( surf_usm_v(l)%albedo_type(ind_veg_wall,m) == 0 )    &
                         surf_usm_v(l)%albedo(ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i)
                      IF ( surf_usm_v(l)%albedo_type(ind_pav_green,m) == 0 )   &
                         surf_usm_v(l)%albedo(ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i)
                      IF ( surf_usm_v(l)%albedo_type(ind_wat_win,m) == 0 )     &
                         surf_lsm_v(l)%albedo(ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i)
                   ENDIF
                ENDDO
             ENDDO

          ENDIF  
!
!--    Initialization actions for RRTMG
       ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
#if defined ( __rrtmg )
!
!--       Allocate albedos for short/longwave radiation, horizontal surfaces
!--       for wall/green/window (USM) or vegetation/pavement/water surfaces
!--       (LSM). 
          ALLOCATE ( surf_lsm_h%aldif(0:2,1:surf_lsm_h%ns)       )
          ALLOCATE ( surf_lsm_h%aldir(0:2,1:surf_lsm_h%ns)       )
          ALLOCATE ( surf_lsm_h%asdif(0:2,1:surf_lsm_h%ns)       )
          ALLOCATE ( surf_lsm_h%asdir(0:2,1:surf_lsm_h%ns)       )
          ALLOCATE ( surf_lsm_h%rrtm_aldif(0:2,1:surf_lsm_h%ns)  )
          ALLOCATE ( surf_lsm_h%rrtm_aldir(0:2,1:surf_lsm_h%ns)  )
          ALLOCATE ( surf_lsm_h%rrtm_asdif(0:2,1:surf_lsm_h%ns)  )
          ALLOCATE ( surf_lsm_h%rrtm_asdir(0:2,1:surf_lsm_h%ns)  )

          ALLOCATE ( surf_usm_h%aldif(0:2,1:surf_usm_h%ns)       )
          ALLOCATE ( surf_usm_h%aldir(0:2,1:surf_usm_h%ns)       )
          ALLOCATE ( surf_usm_h%asdif(0:2,1:surf_usm_h%ns)       )
          ALLOCATE ( surf_usm_h%asdir(0:2,1:surf_usm_h%ns)       )
          ALLOCATE ( surf_usm_h%rrtm_aldif(0:2,1:surf_usm_h%ns)  )
          ALLOCATE ( surf_usm_h%rrtm_aldir(0:2,1:surf_usm_h%ns)  )
          ALLOCATE ( surf_usm_h%rrtm_asdif(0:2,1:surf_usm_h%ns)  )
          ALLOCATE ( surf_usm_h%rrtm_asdir(0:2,1:surf_usm_h%ns)  )

!
!--       Allocate broadband albedo (temporary for the current radiation 
!--       implementations)
          IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) )                            &
             ALLOCATE( surf_lsm_h%albedo(0:2,1:surf_lsm_h%ns)     )
          IF ( .NOT. ALLOCATED(surf_usm_h%albedo) )                            &
             ALLOCATE( surf_usm_h%albedo(0:2,1:surf_usm_h%ns)     )

!
!--       Allocate albedos for short/longwave radiation, vertical surfaces 
          DO  l = 0, 3

             ALLOCATE ( surf_lsm_v(l)%aldif(0:2,1:surf_lsm_v(l)%ns)      )
             ALLOCATE ( surf_lsm_v(l)%aldir(0:2,1:surf_lsm_v(l)%ns)      )
             ALLOCATE ( surf_lsm_v(l)%asdif(0:2,1:surf_lsm_v(l)%ns)      )
             ALLOCATE ( surf_lsm_v(l)%asdir(0:2,1:surf_lsm_v(l)%ns)      )

             ALLOCATE ( surf_lsm_v(l)%rrtm_aldif(0:2,1:surf_lsm_v(l)%ns) )
             ALLOCATE ( surf_lsm_v(l)%rrtm_aldir(0:2,1:surf_lsm_v(l)%ns) )
             ALLOCATE ( surf_lsm_v(l)%rrtm_asdif(0:2,1:surf_lsm_v(l)%ns) )
             ALLOCATE ( surf_lsm_v(l)%rrtm_asdir(0:2,1:surf_lsm_v(l)%ns) )

             ALLOCATE ( surf_usm_v(l)%aldif(0:2,1:surf_usm_v(l)%ns)      )
             ALLOCATE ( surf_usm_v(l)%aldir(0:2,1:surf_usm_v(l)%ns)      )
             ALLOCATE ( surf_usm_v(l)%asdif(0:2,1:surf_usm_v(l)%ns)      )
             ALLOCATE ( surf_usm_v(l)%asdir(0:2,1:surf_usm_v(l)%ns)      )

             ALLOCATE ( surf_usm_v(l)%rrtm_aldif(0:2,1:surf_usm_v(l)%ns) )
             ALLOCATE ( surf_usm_v(l)%rrtm_aldir(0:2,1:surf_usm_v(l)%ns) )
             ALLOCATE ( surf_usm_v(l)%rrtm_asdif(0:2,1:surf_usm_v(l)%ns) )
             ALLOCATE ( surf_usm_v(l)%rrtm_asdir(0:2,1:surf_usm_v(l)%ns) )
!
!--          Allocate broadband albedo (temporary for the current radiation
!--          implementations)
             IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) )                    &
                ALLOCATE( surf_lsm_v(l)%albedo(0:2,1:surf_lsm_v(l)%ns) )
             IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) )                    &
                ALLOCATE( surf_usm_v(l)%albedo(0:2,1:surf_usm_v(l)%ns) )

          ENDDO
!
!--       Level 1 initialization of spectral albedos via namelist 
!--       paramters. Please note, this case all surface tiles are initialized 
!--       the same. 
          IF ( surf_lsm_h%ns > 0 )  THEN
             surf_lsm_h%aldif  = albedo_lw_dif
             surf_lsm_h%aldir  = albedo_lw_dir
             surf_lsm_h%asdif  = albedo_sw_dif
             surf_lsm_h%asdir  = albedo_sw_dir
             surf_lsm_h%albedo = albedo_sw_dif
          ENDIF
          IF ( surf_usm_h%ns > 0 )  THEN
             IF ( surf_usm_h%albedo_from_ascii )  THEN
                surf_usm_h%aldif  = surf_usm_h%albedo
                surf_usm_h%aldir  = surf_usm_h%albedo
                surf_usm_h%asdif  = surf_usm_h%albedo
                surf_usm_h%asdir  = surf_usm_h%albedo
             ELSE
                surf_usm_h%aldif  = albedo_lw_dif
                surf_usm_h%aldir  = albedo_lw_dir
                surf_usm_h%asdif  = albedo_sw_dif
                surf_usm_h%asdir  = albedo_sw_dir
                surf_usm_h%albedo = albedo_sw_dif
             ENDIF
          ENDIF

          DO  l = 0, 3

             IF ( surf_lsm_v(l)%ns > 0 )  THEN
                surf_lsm_v(l)%aldif  = albedo_lw_dif
                surf_lsm_v(l)%aldir  = albedo_lw_dir
                surf_lsm_v(l)%asdif  = albedo_sw_dif
                surf_lsm_v(l)%asdir  = albedo_sw_dir
                surf_lsm_v(l)%albedo = albedo_sw_dif
             ENDIF

             IF ( surf_usm_v(l)%ns > 0 )  THEN
                IF ( surf_usm_v(l)%albedo_from_ascii )  THEN
                   surf_usm_v(l)%aldif  = surf_usm_v(l)%albedo
                   surf_usm_v(l)%aldir  = surf_usm_v(l)%albedo
                   surf_usm_v(l)%asdif  = surf_usm_v(l)%albedo
                   surf_usm_v(l)%asdir  = surf_usm_v(l)%albedo
                ELSE
                   surf_usm_v(l)%aldif  = albedo_lw_dif
                   surf_usm_v(l)%aldir  = albedo_lw_dir
                   surf_usm_v(l)%asdif  = albedo_sw_dif
                   surf_usm_v(l)%asdir  = albedo_sw_dir
                ENDIF
             ENDIF
          ENDDO

!
!--       Level 2 initialization of spectral albedos via albedo_type. 
!--       Please note, for natural- and urban-type surfaces, a tile approach 
!--       is applied so that the resulting albedo is calculated via the weighted 
!--       average of respective surface fractions. 
          DO  m = 1, surf_lsm_h%ns
!
!--          Spectral albedos for vegetation/pavement/water surfaces
             DO  ind_type = 0, 2
                IF ( surf_lsm_h%albedo_type(ind_type,m) /= 0 )  THEN
                   surf_lsm_h%aldif(ind_type,m) =                              &
                               albedo_pars(0,surf_lsm_h%albedo_type(ind_type,m))
                   surf_lsm_h%asdif(ind_type,m) =                              &
                               albedo_pars(1,surf_lsm_h%albedo_type(ind_type,m))
                   surf_lsm_h%aldir(ind_type,m) =                              &
                               albedo_pars(0,surf_lsm_h%albedo_type(ind_type,m))
                   surf_lsm_h%asdir(ind_type,m) =                              &
                               albedo_pars(1,surf_lsm_h%albedo_type(ind_type,m))
                   surf_lsm_h%albedo(ind_type,m) =                             &
                               albedo_pars(2,surf_lsm_h%albedo_type(ind_type,m))
                ENDIF
             ENDDO

          ENDDO
!
!--       For urban surface only if albedo has not been already initialized 
!--       in the urban-surface model via the ASCII file.
          IF ( .NOT. surf_usm_h%albedo_from_ascii )  THEN
             DO  m = 1, surf_usm_h%ns
!
!--             Spectral albedos for wall/green/window surfaces
                DO  ind_type = 0, 2
                   IF ( surf_usm_h%albedo_type(ind_type,m) /= 0 )  THEN
                      surf_usm_h%aldif(ind_type,m) =                           &
                               albedo_pars(0,surf_usm_h%albedo_type(ind_type,m))
                      surf_usm_h%asdif(ind_type,m) =                           &
                               albedo_pars(1,surf_usm_h%albedo_type(ind_type,m))
                      surf_usm_h%aldir(ind_type,m) =                           &
                               albedo_pars(0,surf_usm_h%albedo_type(ind_type,m))
                      surf_usm_h%asdir(ind_type,m) =                           &
                               albedo_pars(1,surf_usm_h%albedo_type(ind_type,m))
                      surf_usm_h%albedo(ind_type,m) =                          &
                               albedo_pars(2,surf_usm_h%albedo_type(ind_type,m))
                   ENDIF
                ENDDO

             ENDDO
          ENDIF

          DO l = 0, 3

             DO  m = 1, surf_lsm_v(l)%ns
!
!--             Spectral albedos for vegetation/pavement/water surfaces
                DO  ind_type = 0, 2
                   IF ( surf_lsm_v(l)%albedo_type(ind_type,m) /= 0 )  THEN
                      surf_lsm_v(l)%aldif(ind_type,m) =                        &
                            albedo_pars(0,surf_lsm_v(l)%albedo_type(ind_type,m))
                      surf_lsm_v(l)%asdif(ind_type,m) =                        &
                            albedo_pars(1,surf_lsm_v(l)%albedo_type(ind_type,m))
                      surf_lsm_v(l)%aldir(ind_type,m) =                        &
                            albedo_pars(0,surf_lsm_v(l)%albedo_type(ind_type,m))
                      surf_lsm_v(l)%asdir(ind_type,m) =                        &
                            albedo_pars(1,surf_lsm_v(l)%albedo_type(ind_type,m))
                      surf_lsm_v(l)%albedo(ind_type,m) =                       &
                            albedo_pars(2,surf_lsm_v(l)%albedo_type(ind_type,m))
                   ENDIF
                ENDDO
             ENDDO
!
!--          For urban surface only if albedo has not been already initialized 
!--          in the urban-surface model via the ASCII file.
             IF ( .NOT. surf_usm_v(l)%albedo_from_ascii )  THEN
                DO  m = 1, surf_usm_v(l)%ns
!
!--                Spectral albedos for wall/green/window surfaces
                   DO  ind_type = 0, 2
                      IF ( surf_usm_v(l)%albedo_type(ind_type,m) /= 0 )  THEN
                         surf_usm_v(l)%aldif(ind_type,m) =                     &
                            albedo_pars(0,surf_usm_v(l)%albedo_type(ind_type,m))
                         surf_usm_v(l)%asdif(ind_type,m) =                     &
                            albedo_pars(1,surf_usm_v(l)%albedo_type(ind_type,m))
                         surf_usm_v(l)%aldir(ind_type,m) =                     &
                            albedo_pars(0,surf_usm_v(l)%albedo_type(ind_type,m))
                         surf_usm_v(l)%asdir(ind_type,m) =                     &
                            albedo_pars(1,surf_usm_v(l)%albedo_type(ind_type,m))
                         surf_usm_v(l)%albedo(ind_type,m) =                    &
                            albedo_pars(2,surf_usm_v(l)%albedo_type(ind_type,m))
                      ENDIF
                   ENDDO

                ENDDO
             ENDIF
          ENDDO
!
!--       Level 3 initialization at grid points where albedo type is zero.
!--       This case, spectral albedos are taken from file if available
          IF ( albedo_pars_f%from_file )  THEN
!
!--          Horizontal
             DO  m = 1, surf_lsm_h%ns
                i = surf_lsm_h%i(m)
                j = surf_lsm_h%j(m)
!
!--             Spectral albedos for vegetation/pavement/water surfaces
                DO  ind_type = 0, 2
                   IF ( surf_lsm_h%albedo_type(ind_type,m) == 0 )  THEN
                      IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )&
                         surf_lsm_h%albedo(ind_type,m) =                       &
                                                albedo_pars_f%pars_xy(1,j,i)
                      IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )&
                         surf_lsm_h%aldir(ind_type,m) =                        &
                                                albedo_pars_f%pars_xy(1,j,i)
                      IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )&
                         surf_lsm_h%aldif(ind_type,m) =                        &
                                                albedo_pars_f%pars_xy(2,j,i)
                      IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )&
                         surf_lsm_h%asdir(ind_type,m) =                        &
                                                albedo_pars_f%pars_xy(3,j,i)
                      IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )&
                         surf_lsm_h%asdif(ind_type,m) =                        &
                                                albedo_pars_f%pars_xy(4,j,i)
                   ENDIF
                ENDDO
             ENDDO
!
!--          For urban surface only if albedo has not been already initialized 
!--          in the urban-surface model via the ASCII file.
             IF ( .NOT. surf_usm_h%albedo_from_ascii )  THEN
                DO  m = 1, surf_usm_h%ns
                   i = surf_usm_h%i(m)
                   j = surf_usm_h%j(m)
!
!--                Spectral albedos for wall/green/window surfaces
                   DO  ind_type = 0, 2
                      IF ( surf_usm_h%albedo_type(ind_type,m) == 0 )  THEN
                         IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )&
                            surf_usm_h%albedo(ind_type,m) =                       &
                                                albedo_pars_f%pars_xy(1,j,i)
                         IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )&
                            surf_usm_h%aldir(ind_type,m) =                        &
                                                albedo_pars_f%pars_xy(1,j,i)
                         IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )&
                            surf_usm_h%aldif(ind_type,m) =                        &
                                                albedo_pars_f%pars_xy(2,j,i)
                         IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )&
                            surf_usm_h%asdir(ind_type,m) =                        &
                                                albedo_pars_f%pars_xy(3,j,i)
                         IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )&
                            surf_usm_h%asdif(ind_type,m) =                        &
                                                albedo_pars_f%pars_xy(4,j,i)
                      ENDIF
                   ENDDO

                ENDDO
             ENDIF
!
!--          Vertical
             DO  l = 0, 3
                ioff = surf_lsm_v(l)%ioff
                joff = surf_lsm_v(l)%joff

                DO  m = 1, surf_lsm_v(l)%ns
                   i = surf_lsm_v(l)%i(m)
                   j = surf_lsm_v(l)%j(m)
!
!--                Spectral albedos for vegetation/pavement/water surfaces
                   DO  ind_type = 0, 2
                      IF ( surf_lsm_v(l)%albedo_type(ind_type,m) == 0 )  THEN
                         IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /=        &
                              albedo_pars_f%fill )                             &
                            surf_lsm_v(l)%albedo(ind_type,m) =                 &
                                          albedo_pars_f%pars_xy(1,j+joff,i+ioff)
                         IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /=        &
                              albedo_pars_f%fill )                             &
                            surf_lsm_v(l)%aldir(ind_type,m) =                  &
                                          albedo_pars_f%pars_xy(1,j+joff,i+ioff)
                         IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /=        &
                              albedo_pars_f%fill )                             &
                            surf_lsm_v(l)%aldif(ind_type,m) =                  &
                                          albedo_pars_f%pars_xy(2,j+joff,i+ioff)
                         IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /=        &
                              albedo_pars_f%fill )                             &
                            surf_lsm_v(l)%asdir(ind_type,m) =                  &
                                          albedo_pars_f%pars_xy(3,j+joff,i+ioff)
                         IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /=        &
                              albedo_pars_f%fill )                             &
                            surf_lsm_v(l)%asdif(ind_type,m) =                  &
                                          albedo_pars_f%pars_xy(4,j+joff,i+ioff)
                      ENDIF
                   ENDDO
                ENDDO
!
!--             For urban surface only if albedo has not been already initialized 
!--             in the urban-surface model via the ASCII file.
                IF ( .NOT. surf_usm_v(l)%albedo_from_ascii )  THEN
                   ioff = surf_usm_v(l)%ioff
                   joff = surf_usm_v(l)%joff

                   DO  m = 1, surf_usm_v(l)%ns
                      i = surf_usm_v(l)%i(m)
                      j = surf_usm_v(l)%j(m)
!
!--                   Spectral albedos for wall/green/window surfaces
                      DO  ind_type = 0, 2
                         IF ( surf_usm_v(l)%albedo_type(ind_type,m) == 0 )  THEN
                            IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /=        &
                                 albedo_pars_f%fill )                             &
                               surf_usm_v(l)%albedo(ind_type,m) =                 &
                                             albedo_pars_f%pars_xy(1,j+joff,i+ioff)
                            IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /=        &
                                 albedo_pars_f%fill )                             &
                               surf_usm_v(l)%aldir(ind_type,m) =                  &
                                             albedo_pars_f%pars_xy(1,j+joff,i+ioff)
                            IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /=        &
                                 albedo_pars_f%fill )                             &
                               surf_usm_v(l)%aldif(ind_type,m) =                  &
                                             albedo_pars_f%pars_xy(2,j+joff,i+ioff)
                            IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /=        &
                                 albedo_pars_f%fill )                             &
                               surf_usm_v(l)%asdir(ind_type,m) =                  &
                                             albedo_pars_f%pars_xy(3,j+joff,i+ioff)
                            IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /=        &
                                 albedo_pars_f%fill )                             &
                               surf_usm_v(l)%asdif(ind_type,m) =                  &
                                             albedo_pars_f%pars_xy(4,j+joff,i+ioff)
                         ENDIF
                      ENDDO

                   ENDDO
                ENDIF
             ENDDO

          ENDIF

!
!--       Calculate initial values of current (cosine of) the zenith angle and 
!--       whether the sun is up
          CALL calc_zenith     
!
!--       Calculate initial surface albedo for different surfaces
          IF ( .NOT. constant_albedo )  THEN
#if defined( __netcdf )
!
!--          Horizontally aligned natural and urban surfaces
             CALL calc_albedo( surf_lsm_h    )
             CALL calc_albedo( surf_usm_h    )
!
!--          Vertically aligned natural and urban surfaces
             DO  l = 0, 3
                CALL calc_albedo( surf_lsm_v(l) )
                CALL calc_albedo( surf_usm_v(l) )
             ENDDO
#endif
          ELSE
!
!--          Initialize sun-inclination independent spectral albedos
!--          Horizontal surfaces
             IF ( surf_lsm_h%ns > 0 )  THEN
                surf_lsm_h%rrtm_aldir = surf_lsm_h%aldir
                surf_lsm_h%rrtm_asdir = surf_lsm_h%asdir
                surf_lsm_h%rrtm_aldif = surf_lsm_h%aldif
                surf_lsm_h%rrtm_asdif = surf_lsm_h%asdif
             ENDIF
             IF ( surf_usm_h%ns > 0 )  THEN
                surf_usm_h%rrtm_aldir = surf_usm_h%aldir
                surf_usm_h%rrtm_asdir = surf_usm_h%asdir
                surf_usm_h%rrtm_aldif = surf_usm_h%aldif
                surf_usm_h%rrtm_asdif = surf_usm_h%asdif
             ENDIF
!
!--          Vertical surfaces
             DO  l = 0, 3
                IF ( surf_lsm_v(l)%ns > 0 )  THEN
                   surf_lsm_v(l)%rrtm_aldir = surf_lsm_v(l)%aldir
                   surf_lsm_v(l)%rrtm_asdir = surf_lsm_v(l)%asdir
                   surf_lsm_v(l)%rrtm_aldif = surf_lsm_v(l)%aldif
                   surf_lsm_v(l)%rrtm_asdif = surf_lsm_v(l)%asdif
                ENDIF
                IF ( surf_usm_v(l)%ns > 0 )  THEN
                   surf_usm_v(l)%rrtm_aldir = surf_usm_v(l)%aldir
                   surf_usm_v(l)%rrtm_asdir = surf_usm_v(l)%asdir
                   surf_usm_v(l)%rrtm_aldif = surf_usm_v(l)%aldif
                   surf_usm_v(l)%rrtm_asdif = surf_usm_v(l)%asdif
                ENDIF
             ENDDO

          ENDIF

!
!--       Allocate 3d arrays of radiative fluxes and heating rates
          IF ( .NOT. ALLOCATED ( rad_sw_in ) )  THEN
             ALLOCATE ( rad_sw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_sw_in = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_sw_in_av ) )  THEN
             ALLOCATE ( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_sw_out ) )  THEN
             ALLOCATE ( rad_sw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_sw_out = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_sw_out_av ) )  THEN
             ALLOCATE ( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_sw_hr ) )  THEN
             ALLOCATE ( rad_sw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_sw_hr = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_sw_hr_av ) )  THEN
             ALLOCATE ( rad_sw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_sw_hr_av = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_sw_cs_hr ) )  THEN
             ALLOCATE ( rad_sw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_sw_cs_hr = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_sw_cs_hr_av ) )  THEN
             ALLOCATE ( rad_sw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_sw_cs_hr_av = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_in ) )  THEN
             ALLOCATE ( rad_lw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_lw_in     = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_in_av ) )  THEN
             ALLOCATE ( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_out ) )  THEN
             ALLOCATE ( rad_lw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
            rad_lw_out    = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_out_av ) )  THEN
             ALLOCATE ( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_hr ) )  THEN
             ALLOCATE ( rad_lw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_lw_hr = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_hr_av ) )  THEN
             ALLOCATE ( rad_lw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_lw_hr_av = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_cs_hr ) )  THEN
             ALLOCATE ( rad_lw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_lw_cs_hr = 0.0_wp
          ENDIF

          IF ( .NOT. ALLOCATED ( rad_lw_cs_hr_av ) )  THEN
             ALLOCATE ( rad_lw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             rad_lw_cs_hr_av = 0.0_wp
          ENDIF

          ALLOCATE ( rad_sw_cs_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ALLOCATE ( rad_sw_cs_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          rad_sw_cs_in  = 0.0_wp
          rad_sw_cs_out = 0.0_wp

          ALLOCATE ( rad_lw_cs_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ALLOCATE ( rad_lw_cs_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          rad_lw_cs_in  = 0.0_wp
          rad_lw_cs_out = 0.0_wp

!
!--       Allocate 1-element array for surface temperature 
!--       (RRTMG anticipates an array as passed argument).
          ALLOCATE ( rrtm_tsfc(1) )
!
!--       Allocate surface emissivity. 
!--       Values will be given directly before calling rrtm_lw.
          ALLOCATE ( rrtm_emis(0:0,1:nbndlw+1) )

!
!--       Initialize RRTMG
          IF ( lw_radiation )  CALL rrtmg_lw_ini ( c_p )
          IF ( sw_radiation )  CALL rrtmg_sw_ini ( c_p )

!
!--       Set input files for RRTMG
          INQUIRE(FILE="RAD_SND_DATA", EXIST=snd_exists) 
          IF ( .NOT. snd_exists )  THEN
             rrtm_input_file = "rrtmg_lw.nc"
          ENDIF

!
!--       Read vertical layers for RRTMG from sounding data
!--       The routine provides nzt_rad, hyp_snd(1:nzt_rad),
!--       t_snd(nzt+2:nzt_rad), rrtm_play(1:nzt_rad), rrtm_plev(1_nzt_rad+1), 
!--       rrtm_tlay(nzt+2:nzt_rad), rrtm_tlev(nzt+2:nzt_rad+1)
          CALL read_sounding_data

!
!--       Read trace gas profiles from file. This routine provides
!--       the rrtm_ arrays (1:nzt_rad+1)
          CALL read_trace_gas_data
#endif
       ENDIF

!
!--    Perform user actions if required
       CALL user_init_radiation

!
!--    Calculate radiative fluxes at model start
       SELECT CASE ( TRIM( radiation_scheme ) )

          CASE ( 'rrtmg' )
             CALL radiation_rrtmg

          CASE ( 'clear-sky' )
             CALL radiation_clearsky

          CASE ( 'constant' )
             CALL radiation_constant

          CASE DEFAULT

       END SELECT

       RETURN

    END SUBROUTINE radiation_init


!------------------------------------------------------------------------------!
! Description:
! ------------
!> A simple clear sky radiation model
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_clearsky


       IMPLICIT NONE

       INTEGER(iwp) ::  l         !< running index for surface orientation
       REAL(wp)     ::  pt1       !< potential temperature at first grid level or mean value at urban layer top 
       REAL(wp)     ::  pt1_l     !< potential temperature at first grid level or mean value at urban layer top at local subdomain 
       REAL(wp)     ::  ql1       !< liquid water mixing ratio at first grid level or mean value at urban layer top 
       REAL(wp)     ::  ql1_l     !< liquid water mixing ratio at first grid level or mean value at urban layer top at local subdomain 

       TYPE(surf_type), POINTER ::  surf !< pointer on respective surface type, used to generalize routine   

!
!--    Calculate current zenith angle
       CALL calc_zenith

!
!--    Calculate sky transmissivity
       sky_trans = 0.6_wp + 0.2_wp * zenith(0)

!
!--    Calculate value of the Exner function at model surface
!
!--    In case averaged radiation is used, calculate mean temperature and 
!--    liquid water mixing ratio at the urban-layer top.
       IF ( average_radiation ) THEN
          pt1   = 0.0_wp
          IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1   = 0.0_wp

          pt1_l = SUM( pt(nzut,nys:nyn,nxl:nxr) )
          IF ( bulk_cloud_model  .OR.  cloud_droplets  )  ql1_l = SUM( ql(nzut,nys:nyn,nxl:nxr) )

#if defined( __parallel )      
          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
          CALL MPI_ALLREDUCE( pt1_l, pt1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
          IF ( ierr /= 0 ) THEN
              WRITE(9,*) 'Error MPI_AllReduce1:', ierr, pt1_l, pt1
              FLUSH(9)
          ENDIF

          IF ( bulk_cloud_model  .OR.  cloud_droplets ) THEN
              CALL MPI_ALLREDUCE( ql1_l, ql1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
              IF ( ierr /= 0 ) THEN
                  WRITE(9,*) 'Error MPI_AllReduce2:', ierr, ql1_l, ql1
                  FLUSH(9)
              ENDIF
          ENDIF
#else
          pt1 = pt1_l 
          IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1 = ql1_l
#endif

          IF ( bulk_cloud_model  .OR.  cloud_droplets  )  pt1 = pt1 + lv_d_cp / exner(nzut) * ql1
!
!--       Finally, divide by number of grid points
          pt1 = pt1 / REAL( ( nx + 1 ) * ( ny + 1 ), KIND=wp )
       ENDIF
!
!--    Call clear-sky calculation for each surface orientation. 
!--    First, horizontal surfaces
       surf => surf_lsm_h
       CALL radiation_clearsky_surf
       surf => surf_usm_h
       CALL radiation_clearsky_surf
!
!--    Vertical surfaces
       DO  l = 0, 3
          surf => surf_lsm_v(l)
          CALL radiation_clearsky_surf
          surf => surf_usm_v(l)
          CALL radiation_clearsky_surf
       ENDDO

       CONTAINS

          SUBROUTINE radiation_clearsky_surf

             IMPLICIT NONE

             INTEGER(iwp) ::  i         !< index x-direction
             INTEGER(iwp) ::  j         !< index y-direction
             INTEGER(iwp) ::  k         !< index z-direction
             INTEGER(iwp) ::  m         !< running index for surface elements

             IF ( surf%ns < 1 )  RETURN

!
!--          Calculate radiation fluxes and net radiation (rad_net) assuming 
!--          homogeneous urban radiation conditions. 
             IF ( average_radiation ) THEN       

                k = nzut

                surf%rad_sw_in  = solar_constant * sky_trans * zenith(0)
                surf%rad_sw_out = albedo_urb * surf%rad_sw_in
                
                surf%rad_lw_in  = 0.8_wp * sigma_sb * (pt1 * exner(k+1))**4

                surf%rad_lw_out = emissivity_urb * sigma_sb * (t_rad_urb)**4   &
                                    + (1.0_wp - emissivity_urb) * surf%rad_lw_in

                surf%rad_net = surf%rad_sw_in - surf%rad_sw_out                &
                             + surf%rad_lw_in - surf%rad_lw_out

                surf%rad_lw_out_change_0 = 3.0_wp * emissivity_urb * sigma_sb  &
                                           * (t_rad_urb)**3

!
!--          Calculate radiation fluxes and net radiation (rad_net) for each surface 
!--          element.
             ELSE

                DO  m = 1, surf%ns
                   i = surf%i(m)
                   j = surf%j(m)
                   k = surf%k(m)

                   surf%rad_sw_in(m) = solar_constant * sky_trans * zenith(0)

!
!--                Weighted average according to surface fraction. 
!--                ATTENTION: when radiation interactions are switched on the 
!--                calculated fluxes below are not actually used as they are 
!--                overwritten in radiation_interaction.
                   surf%rad_sw_out(m) = ( surf%frac(ind_veg_wall,m)  *         &
                                          surf%albedo(ind_veg_wall,m)          &
                                        + surf%frac(ind_pav_green,m) *         &
                                          surf%albedo(ind_pav_green,m)         &
                                        + surf%frac(ind_wat_win,m)   *         &
                                          surf%albedo(ind_wat_win,m) )         &
                                        * surf%rad_sw_in(m)

                   surf%rad_lw_out(m) = ( surf%frac(ind_veg_wall,m)  *         &
                                          surf%emissivity(ind_veg_wall,m)      &
                                        + surf%frac(ind_pav_green,m) *         &
                                          surf%emissivity(ind_pav_green,m)     &
                                        + surf%frac(ind_wat_win,m)   *         &
                                          surf%emissivity(ind_wat_win,m)       &
                                        )                                      &
                                        * sigma_sb                             &
                                        * ( surf%pt_surface(m) * exner(nzb) )**4

                   surf%rad_lw_out_change_0(m) =                               &
                                      ( surf%frac(ind_veg_wall,m)  *           &
                                        surf%emissivity(ind_veg_wall,m)        &
                                      + surf%frac(ind_pav_green,m) *           &
                                        surf%emissivity(ind_pav_green,m)       &
                                      + surf%frac(ind_wat_win,m)   *           &
                                        surf%emissivity(ind_wat_win,m)         &
                                      ) * 3.0_wp * sigma_sb                    &
                                      * ( surf%pt_surface(m) * exner(nzb) )** 3


                   IF ( bulk_cloud_model  .OR.  cloud_droplets  )  THEN
                      pt1 = pt(k,j,i) + lv_d_cp / exner(k) * ql(k,j,i)
                      surf%rad_lw_in(m)  = 0.8_wp * sigma_sb * (pt1 * exner(k))**4
                   ELSE
                      surf%rad_lw_in(m)  = 0.8_wp * sigma_sb * (pt(k,j,i) * exner(k))**4
                   ENDIF

                   surf%rad_net(m) = surf%rad_sw_in(m) - surf%rad_sw_out(m)    &
                                   + surf%rad_lw_in(m) - surf%rad_lw_out(m)

                ENDDO

             ENDIF

!
!--          Fill out values in radiation arrays
             DO  m = 1, surf%ns
                i = surf%i(m)
                j = surf%j(m)
                rad_sw_in(0,j,i) = surf%rad_sw_in(m)
                rad_sw_out(0,j,i) = surf%rad_sw_out(m)
                rad_lw_in(0,j,i) = surf%rad_lw_in(m)
                rad_lw_out(0,j,i) = surf%rad_lw_out(m)
             ENDDO
 
          END SUBROUTINE radiation_clearsky_surf

    END SUBROUTINE radiation_clearsky


!------------------------------------------------------------------------------!
! Description:
! ------------
!> This scheme keeps the prescribed net radiation constant during the run
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_constant


       IMPLICIT NONE

       INTEGER(iwp) ::  l         !< running index for surface orientation

       REAL(wp)     ::  pt1       !< potential temperature at first grid level or mean value at urban layer top 
       REAL(wp)     ::  pt1_l     !< potential temperature at first grid level or mean value at urban layer top at local subdomain 
       REAL(wp)     ::  ql1       !< liquid water mixing ratio at first grid level or mean value at urban layer top 
       REAL(wp)     ::  ql1_l     !< liquid water mixing ratio at first grid level or mean value at urban layer top at local subdomain 

       TYPE(surf_type), POINTER ::  surf !< pointer on respective surface type, used to generalize routine

!
!--    In case averaged radiation is used, calculate mean temperature and 
!--    liquid water mixing ratio at the urban-layer top.
       IF ( average_radiation ) THEN   
          pt1   = 0.0_wp
          IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1   = 0.0_wp

          pt1_l = SUM( pt(nzut,nys:nyn,nxl:nxr) )
          IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1_l = SUM( ql(nzut,nys:nyn,nxl:nxr) )

#if defined( __parallel )      
          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
          CALL MPI_ALLREDUCE( pt1_l, pt1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
          IF ( ierr /= 0 ) THEN
              WRITE(9,*) 'Error MPI_AllReduce3:', ierr, pt1_l, pt1
              FLUSH(9)
          ENDIF
          IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
             CALL MPI_ALLREDUCE( ql1_l, ql1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
             IF ( ierr /= 0 ) THEN
                 WRITE(9,*) 'Error MPI_AllReduce4:', ierr, ql1_l, ql1
                 FLUSH(9)
             ENDIF
          ENDIF
#else
          pt1 = pt1_l
          IF ( bulk_cloud_model  .OR.  cloud_droplets )  ql1 = ql1_l
#endif
          IF ( bulk_cloud_model  .OR.  cloud_droplets )  pt1 = pt1 + lv_d_cp / exner(nzut+1) * ql1
!
!--       Finally, divide by number of grid points
          pt1 = pt1 / REAL( ( nx + 1 ) * ( ny + 1 ), KIND=wp )
       ENDIF

!
!--    First, horizontal surfaces
       surf => surf_lsm_h
       CALL radiation_constant_surf
       surf => surf_usm_h
       CALL radiation_constant_surf
!
!--    Vertical surfaces
       DO  l = 0, 3
          surf => surf_lsm_v(l)
          CALL radiation_constant_surf
          surf => surf_usm_v(l)
          CALL radiation_constant_surf
       ENDDO

       CONTAINS

          SUBROUTINE radiation_constant_surf

             IMPLICIT NONE

             INTEGER(iwp) ::  i         !< index x-direction
             INTEGER(iwp) ::  ioff      !< offset between surface element and adjacent grid point along x
             INTEGER(iwp) ::  j         !< index y-direction
             INTEGER(iwp) ::  joff      !< offset between surface element and adjacent grid point along y
             INTEGER(iwp) ::  k         !< index z-direction
             INTEGER(iwp) ::  koff      !< offset between surface element and adjacent grid point along z
             INTEGER(iwp) ::  m         !< running index for surface elements

             IF ( surf%ns < 1 )  RETURN

!--          Calculate homogenoeus urban radiation fluxes
             IF ( average_radiation ) THEN

                surf%rad_net = net_radiation

                surf%rad_lw_in  = 0.8_wp * sigma_sb * (pt1 * exner(nzut+1))**4

                surf%rad_lw_out = emissivity_urb * sigma_sb * (t_rad_urb)**4   &
                                    + ( 1.0_wp - emissivity_urb )             & ! shouldn't be this a bulk value -- emissivity_urb?
                                    * surf%rad_lw_in

                surf%rad_lw_out_change_0 = 3.0_wp * emissivity_urb * sigma_sb  &
                                           * t_rad_urb**3

                surf%rad_sw_in = ( surf%rad_net - surf%rad_lw_in               &
                                     + surf%rad_lw_out )                       &
                                     / ( 1.0_wp - albedo_urb )

                surf%rad_sw_out =  albedo_urb * surf%rad_sw_in

!
!--          Calculate radiation fluxes for each surface element
             ELSE
!
!--             Determine index offset between surface element and adjacent 
!--             atmospheric grid point
                ioff = surf%ioff
                joff = surf%joff
                koff = surf%koff

!
!--             Prescribe net radiation and estimate the remaining radiative fluxes
                DO  m = 1, surf%ns
                   i = surf%i(m)
                   j = surf%j(m)
                   k = surf%k(m)

                   surf%rad_net(m) = net_radiation

                   IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
                      pt1 = pt(k,j,i) + lv_d_cp / exner(k) * ql(k,j,i)
                      surf%rad_lw_in(m)  = 0.8_wp * sigma_sb * (pt1 * exner(k))**4
                   ELSE
                      surf%rad_lw_in(m)  = 0.8_wp * sigma_sb *                 &
                                             ( pt(k,j,i) * exner(k) )**4
                   ENDIF

!
!--                Weighted average according to surface fraction. 
                   surf%rad_lw_out(m) = ( surf%frac(ind_veg_wall,m)  *         &
                                          surf%emissivity(ind_veg_wall,m)      &
                                        + surf%frac(ind_pav_green,m) *         &
                                          surf%emissivity(ind_pav_green,m)     &
                                        + surf%frac(ind_wat_win,m)   *         &
                                          surf%emissivity(ind_wat_win,m)       &
                                        )                                      &
                                      * sigma_sb                               &
                                      * ( surf%pt_surface(m) * exner(nzb) )**4

                   surf%rad_sw_in(m) = ( surf%rad_net(m) - surf%rad_lw_in(m)   &
                                       + surf%rad_lw_out(m) )                  &
                                       / ( 1.0_wp -                            &
                                          ( surf%frac(ind_veg_wall,m)  *       &
                                            surf%albedo(ind_veg_wall,m)        &
                                         +  surf%frac(ind_pav_green,m) *       &
                                            surf%albedo(ind_pav_green,m)       &
                                         +  surf%frac(ind_wat_win,m)   *       &
                                            surf%albedo(ind_wat_win,m) )       &
                                         )

                   surf%rad_sw_out(m) = ( surf%frac(ind_veg_wall,m)  *         &
                                          surf%albedo(ind_veg_wall,m)          &
                                        + surf%frac(ind_pav_green,m) *         &
                                          surf%albedo(ind_pav_green,m)         &
                                        + surf%frac(ind_wat_win,m)   *         &
                                          surf%albedo(ind_wat_win,m) )         &
                                      * surf%rad_sw_in(m)

                ENDDO

             ENDIF

!
!--          Fill out values in radiation arrays
             DO  m = 1, surf%ns
                i = surf%i(m)
                j = surf%j(m)
                rad_sw_in(0,j,i) = surf%rad_sw_in(m)
                rad_sw_out(0,j,i) = surf%rad_sw_out(m)
                rad_lw_in(0,j,i) = surf%rad_lw_in(m)
                rad_lw_out(0,j,i) = surf%rad_lw_out(m)
             ENDDO

          END SUBROUTINE radiation_constant_surf
          

    END SUBROUTINE radiation_constant

!------------------------------------------------------------------------------!
! Description:
! ------------
!> Header output for radiation model
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_header ( io )


       IMPLICIT NONE
 
       INTEGER(iwp), INTENT(IN) ::  io            !< Unit of the output file
    

       
!
!--    Write radiation model header
       WRITE( io, 3 )

       IF ( radiation_scheme == "constant" )  THEN
          WRITE( io, 4 ) net_radiation
       ELSEIF ( radiation_scheme == "clear-sky" )  THEN
          WRITE( io, 5 )
       ELSEIF ( radiation_scheme == "rrtmg" )  THEN
          WRITE( io, 6 )
          IF ( .NOT. lw_radiation )  WRITE( io, 10 )
          IF ( .NOT. sw_radiation )  WRITE( io, 11 )
       ENDIF 

       IF ( albedo_type_f%from_file  .OR.  vegetation_type_f%from_file  .OR.   &
            pavement_type_f%from_file  .OR.  water_type_f%from_file  .OR.      &
            building_type_f%from_file )  THEN
             WRITE( io, 13 )
       ELSE  
          IF ( albedo_type == 0 )  THEN
             WRITE( io, 7 ) albedo
          ELSE
             WRITE( io, 8 ) TRIM( albedo_type_name(albedo_type) )
          ENDIF
       ENDIF
       IF ( constant_albedo )  THEN
          WRITE( io, 9 )
       ENDIF
       
       WRITE( io, 12 ) dt_radiation
 

 3 FORMAT (//' Radiation model information:'/                                  &
              ' ----------------------------'/)
 4 FORMAT ('    --> Using constant net radiation: net_radiation = ', F6.2,     &
           // 'W/m**2')
 5 FORMAT ('    --> Simple radiation scheme for clear sky is used (no clouds,',&
                   ' default)')
 6 FORMAT ('    --> RRTMG scheme is used')
 7 FORMAT (/'    User-specific surface albedo: albedo =', F6.3)
 8 FORMAT (/'    Albedo is set for land surface type: ', A)
 9 FORMAT (/'    --> Albedo is fixed during the run')
10 FORMAT (/'    --> Longwave radiation is disabled')
11 FORMAT (/'    --> Shortwave radiation is disabled.')
12 FORMAT  ('    Timestep: dt_radiation = ', F6.2, '  s')
13 FORMAT (/'    Albedo is set individually for each xy-location, according ', &
                 'to given surface type.')


    END SUBROUTINE radiation_header
   

!------------------------------------------------------------------------------!
! Description:
! ------------
!> Parin for &radiation_parameters for radiation model
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_parin


       IMPLICIT NONE

       CHARACTER (LEN=80) ::  line  !< dummy string that contains the current line of the parameter file 
       
       NAMELIST /radiation_par/   albedo, albedo_lw_dif, albedo_lw_dir,         &
                                  albedo_sw_dif, albedo_sw_dir, albedo_type,    &
                                  constant_albedo, dt_radiation, emissivity,    &
                                  lw_radiation, max_raytracing_dist,            &
                                  min_irrf_value, mrt_geom_human,               &
                                  mrt_include_sw, mrt_nlevels,                  &
                                  mrt_skip_roof, net_radiation, nrefsteps,      &
                                  plant_lw_interact, rad_angular_discretization,&
                                  radiation_interactions_on, radiation_scheme,  &
                                  raytrace_discrete_azims,                      &
                                  raytrace_discrete_elevs, raytrace_mpi_rma,    &
                                  skip_time_do_radiation, surface_reflections,  &
                                  svfnorm_report_thresh, sw_radiation,          &
                                  unscheduled_radiation_calls

   
       NAMELIST /radiation_parameters/ albedo, albedo_lw_dif, albedo_lw_dir,    &
                                  albedo_sw_dif, albedo_sw_dir, albedo_type,    &
                                  constant_albedo, dt_radiation, emissivity,    &
                                  lw_radiation, max_raytracing_dist,            &
                                  min_irrf_value, mrt_geom_human,               &
                                  mrt_include_sw, mrt_nlevels,                  &
                                  mrt_skip_roof, net_radiation, nrefsteps,      &
                                  plant_lw_interact, rad_angular_discretization,&
                                  radiation_interactions_on, radiation_scheme,  &
                                  raytrace_discrete_azims,                      &
                                  raytrace_discrete_elevs, raytrace_mpi_rma,    &
                                  skip_time_do_radiation, surface_reflections,  &
                                  svfnorm_report_thresh, sw_radiation,          &
                                  unscheduled_radiation_calls
   
       line = ' '
       
!
!--    Try to find radiation model namelist
       REWIND ( 11 )
       line = ' '
       DO WHILE ( INDEX( line, '&radiation_parameters' ) == 0 )
          READ ( 11, '(A)', END=12 )  line
       ENDDO
       BACKSPACE ( 11 )

!
!--    Read user-defined namelist
       READ ( 11, radiation_parameters, ERR = 10 )

!
!--    Set flag that indicates that the radiation model is switched on
       radiation = .TRUE.

       GOTO 14

 10    BACKSPACE( 11 )
       READ( 11 , '(A)') line
       CALL parin_fail_message( 'radiation_parameters', line )
!
!--    Try to find old namelist
 12    REWIND ( 11 )
       line = ' '
       DO WHILE ( INDEX( line, '&radiation_par' ) == 0 )
          READ ( 11, '(A)', END=14 )  line
       ENDDO
       BACKSPACE ( 11 )

!
!--    Read user-defined namelist
       READ ( 11, radiation_par, ERR = 13, END = 14 )

       message_string = 'namelist radiation_par is deprecated and will be ' // &
                     'removed in near future. Please use namelist ' //         &
                     'radiation_parameters instead'
       CALL message( 'radiation_parin', 'PA0487', 0, 1, 0, 6, 0 )

!
!--    Set flag that indicates that the radiation model is switched on
       radiation = .TRUE.

       IF ( .NOT.  radiation_interactions_on  .AND.  surface_reflections )  THEN
          message_string = 'surface_reflections is allowed only when '      // &
               'radiation_interactions_on is set to TRUE'
          CALL message( 'radiation_parin', 'PA0293',1, 2, 0, 6, 0 )
       ENDIF

       GOTO 14

 13    BACKSPACE( 11 )
       READ( 11 , '(A)') line
       CALL parin_fail_message( 'radiation_par', line )

 14    CONTINUE
       
    END SUBROUTINE radiation_parin


!------------------------------------------------------------------------------!
! Description:
! ------------
!> Implementation of the RRTMG radiation_scheme
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_rrtmg

#if defined ( __rrtmg )
       USE indices,                                                            &
           ONLY:  nbgp

       USE particle_attributes,                                                &
           ONLY:  grid_particles, number_of_particles, particles,              &
                  particle_advection_start, prt_count

       IMPLICIT NONE


       INTEGER(iwp) ::  i, j, k, l, m, n !< loop indices
       INTEGER(iwp) ::  k_topo     !< topography top index

       REAL(wp)     ::  nc_rad, &    !< number concentration of cloud droplets
                        s_r2,   &    !< weighted sum over all droplets with r^2
                        s_r3         !< weighted sum over all droplets with r^3

       REAL(wp), DIMENSION(0:nzt+1) :: pt_av, q_av, ql_av
!
!--    Just dummy arguments
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: rrtm_lw_taucld_dum,          &
                                                  rrtm_lw_tauaer_dum,          &
                                                  rrtm_sw_taucld_dum,          &
                                                  rrtm_sw_ssacld_dum,          &
                                                  rrtm_sw_asmcld_dum,          &
                                                  rrtm_sw_fsfcld_dum,          &
                                                  rrtm_sw_tauaer_dum,          &
                                                  rrtm_sw_ssaaer_dum,          &
                                                  rrtm_sw_asmaer_dum,          &
                                                  rrtm_sw_ecaer_dum

!
!--    Calculate current (cosine of) zenith angle and whether the sun is up
       CALL calc_zenith     
!
!--    Calculate surface albedo. In case average radiation is applied, 
!--    this is not required.
#if defined( __netcdf )
       IF ( .NOT. constant_albedo )  THEN
!
!--       Horizontally aligned default, natural and urban surfaces
          CALL calc_albedo( surf_lsm_h    )
          CALL calc_albedo( surf_usm_h    )
!
!--       Vertically aligned default, natural and urban surfaces
          DO  l = 0, 3
             CALL calc_albedo( surf_lsm_v(l) )
             CALL calc_albedo( surf_usm_v(l) )
          ENDDO
       ENDIF
#endif

!
!--    Prepare input data for RRTMG

!
!--    In case of large scale forcing with surface data, calculate new pressure
!--    profile. nzt_rad might be modified by these calls and all required arrays
!--    will then be re-allocated
       IF ( large_scale_forcing  .AND.  lsf_surf )  THEN
          CALL read_sounding_data
          CALL read_trace_gas_data
       ENDIF


       IF ( average_radiation ) THEN

          rrtm_asdir(1)  = albedo_urb
          rrtm_asdif(1)  = albedo_urb
          rrtm_aldir(1)  = albedo_urb
          rrtm_aldif(1)  = albedo_urb

          rrtm_emis = emissivity_urb
!
!--       Calculate mean pt profile. Actually, only one height level is required.
          CALL calc_mean_profile( pt, 4 )
          pt_av = hom(:, 1, 4, 0)
          
          IF ( humidity )  THEN
             CALL calc_mean_profile( q, 41 )
             q_av  = hom(:, 1, 41, 0)
          ENDIF
!
!--       Prepare profiles of temperature and H2O volume mixing ratio
          rrtm_tlev(0,nzb+1) = t_rad_urb

          IF ( bulk_cloud_model )  THEN

             CALL calc_mean_profile( ql, 54 )
             ! average ql is now in hom(:, 1, 54, 0)
             ql_av = hom(:, 1, 54, 0)
             
             DO k = nzb+1, nzt+1
                rrtm_tlay(0,k) = pt_av(k) * ( (hyp(k) ) / 100000._wp       &
                                 )**.286_wp + lv_d_cp * ql_av(k)
                rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * (q_av(k) - ql_av(k))
             ENDDO
          ELSE
             DO k = nzb+1, nzt+1
                rrtm_tlay(0,k) = pt_av(k) * ( (hyp(k) ) / 100000._wp       &
                                 )**.286_wp
             ENDDO

             IF ( humidity )  THEN
                DO k = nzb+1, nzt+1
                   rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * q_av(k)
                ENDDO
             ELSE
                rrtm_h2ovmr(0,nzb+1:nzt+1) = 0.0_wp
             ENDIF
          ENDIF

!
!--       Avoid temperature/humidity jumps at the top of the LES domain by 
!--       linear interpolation from nzt+2 to nzt+7
          DO k = nzt+2, nzt+7
             rrtm_tlay(0,k) = rrtm_tlay(0,nzt+1)                            &
                           + ( rrtm_tlay(0,nzt+8) - rrtm_tlay(0,nzt+1) )    &
                           / ( rrtm_play(0,nzt+8) - rrtm_play(0,nzt+1) )    &
                           * ( rrtm_play(0,k) - rrtm_play(0,nzt+1) )

             rrtm_h2ovmr(0,k) = rrtm_h2ovmr(0,nzt+1)                        &
                           + ( rrtm_h2ovmr(0,nzt+8) - rrtm_h2ovmr(0,nzt+1) )&
                           / ( rrtm_play(0,nzt+8)   - rrtm_play(0,nzt+1)   )&
                           * ( rrtm_play(0,k) - rrtm_play(0,nzt+1) )

          ENDDO

!--       Linear interpolate to zw grid
          DO k = nzb+2, nzt+8
             rrtm_tlev(0,k)   = rrtm_tlay(0,k-1) + (rrtm_tlay(0,k) -        &
                                rrtm_tlay(0,k-1))                           &
                                / ( rrtm_play(0,k) - rrtm_play(0,k-1) )     &
                                * ( rrtm_plev(0,k) - rrtm_play(0,k-1) )
          ENDDO


!
!--       Calculate liquid water path and cloud fraction for each column.
!--       Note that LWP is required in g/m2 instead of kg/kg m.
          rrtm_cldfr  = 0.0_wp
          rrtm_reliq  = 0.0_wp
          rrtm_cliqwp = 0.0_wp
          rrtm_icld   = 0

          IF ( bulk_cloud_model )  THEN
             DO k = nzb+1, nzt+1
                rrtm_cliqwp(0,k) =  ql_av(k) * 1000._wp *                   &
                                    (rrtm_plev(0,k) - rrtm_plev(0,k+1))     &
                                    * 100._wp / g 

                IF ( rrtm_cliqwp(0,k) > 0._wp )  THEN
                   rrtm_cldfr(0,k) = 1._wp
                   IF ( rrtm_icld == 0 )  rrtm_icld = 1

!
!--                Calculate cloud droplet effective radius
                   rrtm_reliq(0,k) = 1.0E6_wp * ( 3.0_wp * ql_av(k)         &
                                     * rho_surface                          &
                                     / ( 4.0_wp * pi * nc_const * rho_l )   &
                                     )**0.33333333333333_wp                 &
                                     * EXP( LOG( sigma_gc )**2 )
!
!--                Limit effective radius
                   IF ( rrtm_reliq(0,k) > 0.0_wp )  THEN
                      rrtm_reliq(0,k) = MAX(rrtm_reliq(0,k),2.5_wp)
                      rrtm_reliq(0,k) = MIN(rrtm_reliq(0,k),60.0_wp)
                   ENDIF
                ENDIF
             ENDDO
          ENDIF

!
!--       Set surface temperature
          rrtm_tsfc = t_rad_urb
          
          IF ( lw_radiation )  THEN        
          
             CALL rrtmg_lw( 1, nzt_rad      , rrtm_icld    , rrtm_idrv      ,&
             rrtm_play       , rrtm_plev    , rrtm_tlay    , rrtm_tlev      ,&
             rrtm_tsfc       , rrtm_h2ovmr  , rrtm_o3vmr   , rrtm_co2vmr    ,&
             rrtm_ch4vmr     , rrtm_n2ovmr  , rrtm_o2vmr   , rrtm_cfc11vmr  ,&
             rrtm_cfc12vmr   , rrtm_cfc22vmr, rrtm_ccl4vmr , rrtm_emis      ,&
             rrtm_inflglw    , rrtm_iceflglw, rrtm_liqflglw, rrtm_cldfr     ,&
             rrtm_lw_taucld  , rrtm_cicewp  , rrtm_cliqwp  , rrtm_reice     ,& 
             rrtm_reliq      , rrtm_lw_tauaer,                               &
             rrtm_lwuflx     , rrtm_lwdflx  , rrtm_lwhr  ,                   &
             rrtm_lwuflxc    , rrtm_lwdflxc , rrtm_lwhrc ,                   &
             rrtm_lwuflx_dt  ,  rrtm_lwuflxc_dt )

!
!--          Save fluxes
             DO k = nzb, nzt+1
                rad_lw_in(k,:,:)  = rrtm_lwdflx(0,k)
                rad_lw_out(k,:,:) = rrtm_lwuflx(0,k)
             ENDDO
             rad_lw_in_diff(:,:) = rad_lw_in(0,:,:)
!
!--          Save heating rates (convert from K/d to K/h). 
!--          Further, even though an aggregated radiation is computed, map
!--          signle-column profiles on top of any topography, in order to 
!--          obtain correct near surface radiation heating/cooling rates.
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   k_topo = get_topography_top_index_ji( j, i, 's' )
                   DO k = k_topo+1, nzt+1
                      rad_lw_hr(k,j,i)     = rrtm_lwhr(0,k-k_topo)  * d_hours_day
                      rad_lw_cs_hr(k,j,i)  = rrtm_lwhrc(0,k-k_topo) * d_hours_day
                   ENDDO
                ENDDO
             ENDDO

          ENDIF

          IF ( sw_radiation .AND. sun_up )  THEN
             CALL rrtmg_sw( 1, nzt_rad      , rrtm_icld     , rrtm_iaer      ,&
             rrtm_play      , rrtm_plev     , rrtm_tlay     , rrtm_tlev      ,&
             rrtm_tsfc      , rrtm_h2ovmr   , rrtm_o3vmr    , rrtm_co2vmr    ,&
             rrtm_ch4vmr    , rrtm_n2ovmr   , rrtm_o2vmr    , rrtm_asdir     ,&
             rrtm_asdif     , rrtm_aldir    , rrtm_aldif    , zenith         ,&
             0.0_wp         , day_of_year   , solar_constant, rrtm_inflgsw   ,&
             rrtm_iceflgsw  , rrtm_liqflgsw , rrtm_cldfr    , rrtm_sw_taucld ,&
             rrtm_sw_ssacld , rrtm_sw_asmcld, rrtm_sw_fsfcld, rrtm_cicewp    ,&
             rrtm_cliqwp    , rrtm_reice    , rrtm_reliq    , rrtm_sw_tauaer ,&
             rrtm_sw_ssaaer , rrtm_sw_asmaer, rrtm_sw_ecaer , rrtm_swuflx    ,&
             rrtm_swdflx    , rrtm_swhr     , rrtm_swuflxc  , rrtm_swdflxc   ,&
             rrtm_swhrc     , rrtm_dirdflux , rrtm_difdflux )
  
!
!--          Save fluxes:
!--          - whole domain
             DO k = nzb, nzt+1
                rad_sw_in(k,:,:)  = rrtm_swdflx(0,k)
                rad_sw_out(k,:,:) = rrtm_swuflx(0,k)
             ENDDO
!--          - direct and diffuse SW at urban-surface-layer (required by RTM)
             rad_sw_in_dir(:,:) = rrtm_dirdflux(0,nzb)
             rad_sw_in_diff(:,:) = rrtm_difdflux(0,nzb)

!
!--          Save heating rates (convert from K/d to K/s)
             DO k = nzb+1, nzt+1
                rad_sw_hr(k,:,:)     = rrtm_swhr(0,k)  * d_hours_day
                rad_sw_cs_hr(k,:,:)  = rrtm_swhrc(0,k) * d_hours_day
             ENDDO
!
!--       Solar radiation is zero during night
          ELSE
             rad_sw_in  = 0.0_wp
             rad_sw_out = 0.0_wp
             rad_sw_in_dir(:,:) = 0.0_wp
             rad_sw_in_diff(:,:) = 0.0_wp
          ENDIF
!
!--    RRTMG is called for each (j,i) grid point separately, starting at the 
!--    highest topography level. Here no RTM is used since average_radiation is false
       ELSE
!
!--       Loop over all grid points
          DO i = nxl, nxr
             DO j = nys, nyn

!
!--             Prepare profiles of temperature and H2O volume mixing ratio
                DO  m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
                   rrtm_tlev(0,nzb+1) = surf_lsm_h%pt_surface(m) * exner(nzb)
                ENDDO
                DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
                   rrtm_tlev(0,nzb+1) = surf_usm_h%pt_surface(m) * exner(nzb)
                ENDDO


                IF ( bulk_cloud_model )  THEN
                   DO k = nzb+1, nzt+1
                      rrtm_tlay(0,k) = pt(k,j,i) * exner(k)                    &
                                        + lv_d_cp * ql(k,j,i)
                      rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * (q(k,j,i) - ql(k,j,i))
                   ENDDO
                ELSEIF ( cloud_droplets )  THEN
                   DO k = nzb+1, nzt+1
                      rrtm_tlay(0,k) = pt(k,j,i) * exner(k)                     &
                                        + lv_d_cp * ql(k,j,i)
                      rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * q(k,j,i) 
                   ENDDO
                ELSE
                   DO k = nzb+1, nzt+1
                      rrtm_tlay(0,k) = pt(k,j,i) * exner(k)
                   ENDDO

                   IF ( humidity )  THEN
                      DO k = nzb+1, nzt+1
                         rrtm_h2ovmr(0,k) =  mol_mass_air_d_wv * q(k,j,i)
                      ENDDO   
                   ELSE
                      rrtm_h2ovmr(0,nzb+1:nzt+1) = 0.0_wp
                   ENDIF
                ENDIF

!
!--             Avoid temperature/humidity jumps at the top of the LES domain by 
!--             linear interpolation from nzt+2 to nzt+7
                DO k = nzt+2, nzt+7
                   rrtm_tlay(0,k) = rrtm_tlay(0,nzt+1)                         &
                                 + ( rrtm_tlay(0,nzt+8) - rrtm_tlay(0,nzt+1) ) &
                                 / ( rrtm_play(0,nzt+8) - rrtm_play(0,nzt+1) ) &
                                 * ( rrtm_play(0,k)     - rrtm_play(0,nzt+1) )

                   rrtm_h2ovmr(0,k) = rrtm_h2ovmr(0,nzt+1)                     &
                              + ( rrtm_h2ovmr(0,nzt+8) - rrtm_h2ovmr(0,nzt+1) )&
                              / ( rrtm_play(0,nzt+8)   - rrtm_play(0,nzt+1)   )&
                              * ( rrtm_play(0,k)       - rrtm_play(0,nzt+1) )

                ENDDO

!--             Linear interpolate to zw grid
                DO k = nzb+2, nzt+8
                   rrtm_tlev(0,k)   = rrtm_tlay(0,k-1) + (rrtm_tlay(0,k) -     &
                                      rrtm_tlay(0,k-1))                        &
                                      / ( rrtm_play(0,k) - rrtm_play(0,k-1) )  &
                                      * ( rrtm_plev(0,k) - rrtm_play(0,k-1) )
                ENDDO


!
!--             Calculate liquid water path and cloud fraction for each column.
!--             Note that LWP is required in g/m2 instead of kg/kg m.
                rrtm_cldfr  = 0.0_wp
                rrtm_reliq  = 0.0_wp
                rrtm_cliqwp = 0.0_wp
                rrtm_icld   = 0

                IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
                   DO k = nzb+1, nzt+1
                      rrtm_cliqwp(0,k) =  ql(k,j,i) * 1000.0_wp *              &
                                          (rrtm_plev(0,k) - rrtm_plev(0,k+1))  &
                                          * 100.0_wp / g 

                      IF ( rrtm_cliqwp(0,k) > 0.0_wp )  THEN
                         rrtm_cldfr(0,k) = 1.0_wp
                         IF ( rrtm_icld == 0 )  rrtm_icld = 1

!
!--                      Calculate cloud droplet effective radius
                         IF ( bulk_cloud_model )  THEN
!
!--                         Calculete effective droplet radius. In case of using 
!--                         cloud_scheme = 'morrison' and a non reasonable number 
!--                         of cloud droplets the inital aerosol number  
!--                         concentration is considered.
                            IF ( microphysics_morrison )  THEN
                               IF ( nc(k,j,i) > 1.0E-20_wp )  THEN
                                  nc_rad = nc(k,j,i)
                               ELSE
                                  nc_rad = na_init
                               ENDIF 
                            ELSE
                               nc_rad = nc_const
                            ENDIF  

                            rrtm_reliq(0,k) = 1.0E6_wp * ( 3.0_wp * ql(k,j,i)     &
                                              * rho_surface                       &
                                              / ( 4.0_wp * pi * nc_rad * rho_l )  &
                                              )**0.33333333333333_wp              &
                                              * EXP( LOG( sigma_gc )**2 )

                         ELSEIF ( cloud_droplets )  THEN
                            number_of_particles = prt_count(k,j,i)

                            IF (number_of_particles <= 0)  CYCLE
                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
                            s_r2 = 0.0_wp
                            s_r3 = 0.0_wp

                            DO  n = 1, number_of_particles
                               IF ( particles(n)%particle_mask )  THEN
                                  s_r2 = s_r2 + particles(n)%radius**2 *       &
                                         particles(n)%weight_factor
                                  s_r3 = s_r3 + particles(n)%radius**3 *       &
                                         particles(n)%weight_factor
                               ENDIF
                            ENDDO

                            IF ( s_r2 > 0.0_wp )  rrtm_reliq(0,k) = s_r3 / s_r2

                         ENDIF

!
!--                      Limit effective radius
                         IF ( rrtm_reliq(0,k) > 0.0_wp )  THEN
                            rrtm_reliq(0,k) = MAX(rrtm_reliq(0,k),2.5_wp)
                            rrtm_reliq(0,k) = MIN(rrtm_reliq(0,k),60.0_wp)
                        ENDIF
                      ENDIF
                   ENDDO
                ENDIF

!
!--             Write surface emissivity and surface temperature at current 
!--             surface element on RRTMG-shaped array.
!--             Please note, as RRTMG is a single column model, surface attributes
!--             are only obtained from horizontally aligned surfaces (for 
!--             simplicity). Taking surface attributes from horizontal and 
!--             vertical walls would lead to multiple solutions.  
!--             Moreover, for natural- and urban-type surfaces, several surface
!--             classes can exist at a surface element next to each other. 
!--             To obtain bulk parameters, apply a weighted average for these 
!--             surfaces. 
                DO  m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
                   rrtm_emis = surf_lsm_h%frac(ind_veg_wall,m)  *              &
                               surf_lsm_h%emissivity(ind_veg_wall,m)  +        &
                               surf_lsm_h%frac(ind_pav_green,m) *              &
                               surf_lsm_h%emissivity(ind_pav_green,m) +        & 
                               surf_lsm_h%frac(ind_wat_win,m)   *              &
                               surf_lsm_h%emissivity(ind_wat_win,m)
                   rrtm_tsfc = surf_lsm_h%pt_surface(m) * exner(nzb)
                ENDDO             
                DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
                   rrtm_emis = surf_usm_h%frac(ind_veg_wall,m)  *              &
                               surf_usm_h%emissivity(ind_veg_wall,m)  +        &
                               surf_usm_h%frac(ind_pav_green,m) *              &
                               surf_usm_h%emissivity(ind_pav_green,m) +        & 
                               surf_usm_h%frac(ind_wat_win,m)   *              &
                               surf_usm_h%emissivity(ind_wat_win,m)
                   rrtm_tsfc = surf_usm_h%pt_surface(m) * exner(nzb)
                ENDDO
!
!--             Obtain topography top index (lower bound of RRTMG)
                k_topo = get_topography_top_index_ji( j, i, 's' )

                IF ( lw_radiation )  THEN
!
!--                Due to technical reasons, copy optical depth to dummy arguments
!--                which are allocated on the exact size as the rrtmg_lw is called.
!--                As one dimesion is allocated with zero size, compiler complains
!--                that rank of the array does not match that of the 
!--                assumed-shaped arguments in the RRTMG library. In order to 
!--                avoid this, write to dummy arguments and give pass the entire 
!--                dummy array. Seems to be the only existing work-around.  
                   ALLOCATE( rrtm_lw_taucld_dum(1:nbndlw+1,0:0,k_topo+1:nzt_rad+1) )
                   ALLOCATE( rrtm_lw_tauaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndlw+1) )

                   rrtm_lw_taucld_dum =                                        &
                               rrtm_lw_taucld(1:nbndlw+1,0:0,k_topo+1:nzt_rad+1)
                   rrtm_lw_tauaer_dum =                                        &
                               rrtm_lw_tauaer(0:0,k_topo+1:nzt_rad+1,1:nbndlw+1)

                   CALL rrtmg_lw( 1,                                           &                                        
                                  nzt_rad-k_topo,                              &
                                  rrtm_icld,                                   &
                                  rrtm_idrv,                                   &
                                  rrtm_play(:,k_topo+1:nzt_rad+1),             &
                                  rrtm_plev(:,k_topo+1:nzt_rad+2),             &
                                  rrtm_tlay(:,k_topo+1:nzt_rad+1),             &
                                  rrtm_tlev(:,k_topo+1:nzt_rad+2),             &
                                  rrtm_tsfc,                                   &
                                  rrtm_h2ovmr(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_o3vmr(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_co2vmr(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_ch4vmr(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_n2ovmr(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_o2vmr(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_cfc11vmr(:,k_topo+1:nzt_rad+1),         &
                                  rrtm_cfc12vmr(:,k_topo+1:nzt_rad+1),         &
                                  rrtm_cfc22vmr(:,k_topo+1:nzt_rad+1),         &
                                  rrtm_ccl4vmr(:,k_topo+1:nzt_rad+1),          &
                                  rrtm_emis,                                   &
                                  rrtm_inflglw,                                &
                                  rrtm_iceflglw,                               &
                                  rrtm_liqflglw,                               &
                                  rrtm_cldfr(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_lw_taucld_dum,                          &
                                  rrtm_cicewp(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_cliqwp(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_reice(:,k_topo+1:nzt_rad+1),            & 
                                  rrtm_reliq(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_lw_tauaer_dum,                          &
                                  rrtm_lwuflx(:,k_topo:nzt_rad+1),             &
                                  rrtm_lwdflx(:,k_topo:nzt_rad+1),             &
                                  rrtm_lwhr(:,k_topo+1:nzt_rad+1),             &
                                  rrtm_lwuflxc(:,k_topo:nzt_rad+1),            &
                                  rrtm_lwdflxc(:,k_topo:nzt_rad+1),            &
                                  rrtm_lwhrc(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_lwuflx_dt(:,k_topo:nzt_rad+1),          &
                                  rrtm_lwuflxc_dt(:,k_topo:nzt_rad+1) )

                   DEALLOCATE ( rrtm_lw_taucld_dum )
                   DEALLOCATE ( rrtm_lw_tauaer_dum )
!
!--                Save fluxes
                   DO k = k_topo, nzt+1
                      rad_lw_in(k,j,i)  = rrtm_lwdflx(0,k)
                      rad_lw_out(k,j,i) = rrtm_lwuflx(0,k)
                   ENDDO

!
!--                Save heating rates (convert from K/d to K/h)
                   DO k = k_topo+1, nzt+1
                      rad_lw_hr(k,j,i)     = rrtm_lwhr(0,k-k_topo)  * d_hours_day
                      rad_lw_cs_hr(k,j,i)  = rrtm_lwhrc(0,k-k_topo) * d_hours_day
                   ENDDO

!
!--                Save surface radiative fluxes and change in LW heating rate 
!--                onto respective surface elements
!--                Horizontal surfaces
                   DO  m = surf_lsm_h%start_index(j,i),                        &
                           surf_lsm_h%end_index(j,i)
                      surf_lsm_h%rad_lw_in(m)           = rrtm_lwdflx(0,k_topo)
                      surf_lsm_h%rad_lw_out(m)          = rrtm_lwuflx(0,k_topo)
                      surf_lsm_h%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo)
                   ENDDO             
                   DO  m = surf_usm_h%start_index(j,i),                        &
                           surf_usm_h%end_index(j,i)
                      surf_usm_h%rad_lw_in(m)           = rrtm_lwdflx(0,k_topo)
                      surf_usm_h%rad_lw_out(m)          = rrtm_lwuflx(0,k_topo)
                      surf_usm_h%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo)
                   ENDDO 
!
!--                Vertical surfaces. Fluxes are obtain at vertical level of the 
!--                respective surface element
                   DO  l = 0, 3
                      DO  m = surf_lsm_v(l)%start_index(j,i),                  &
                              surf_lsm_v(l)%end_index(j,i)
                         k                                    = surf_lsm_v(l)%k(m)
                         surf_lsm_v(l)%rad_lw_in(m)           = rrtm_lwdflx(0,k)
                         surf_lsm_v(l)%rad_lw_out(m)          = rrtm_lwuflx(0,k)
                         surf_lsm_v(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k)
                      ENDDO             
                      DO  m = surf_usm_v(l)%start_index(j,i),                  &
                              surf_usm_v(l)%end_index(j,i)
                         k                                    = surf_usm_v(l)%k(m)
                         surf_usm_v(l)%rad_lw_in(m)           = rrtm_lwdflx(0,k)
                         surf_usm_v(l)%rad_lw_out(m)          = rrtm_lwuflx(0,k)
                         surf_usm_v(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k)
                      ENDDO 
                   ENDDO

                ENDIF

                IF ( sw_radiation .AND. sun_up )  THEN
!
!--                Get albedo for direct/diffusive long/shortwave radiation at 
!--                current (y,x)-location from surface variables. 
!--                Only obtain it from horizontal surfaces, as RRTMG is a single 
!--                column model
!--                (Please note, only one loop will entered, controlled by 
!--                start-end index.)
                   DO  m = surf_lsm_h%start_index(j,i),                        &
                           surf_lsm_h%end_index(j,i)
                      rrtm_asdir(1)  = SUM( surf_lsm_h%frac(:,m) *             &
                                            surf_lsm_h%rrtm_asdir(:,m) )
                      rrtm_asdif(1)  = SUM( surf_lsm_h%frac(:,m) *             &
                                            surf_lsm_h%rrtm_asdif(:,m) )
                      rrtm_aldir(1)  = SUM( surf_lsm_h%frac(:,m) *             &
                                            surf_lsm_h%rrtm_aldir(:,m) )
                      rrtm_aldif(1)  = SUM( surf_lsm_h%frac(:,m) *             &
                                            surf_lsm_h%rrtm_aldif(:,m) )
                   ENDDO             
                   DO  m = surf_usm_h%start_index(j,i),                        &
                           surf_usm_h%end_index(j,i)
                      rrtm_asdir(1)  = SUM( surf_usm_h%frac(:,m) *             &
                                            surf_usm_h%rrtm_asdir(:,m) )
                      rrtm_asdif(1)  = SUM( surf_usm_h%frac(:,m) *             &
                                            surf_usm_h%rrtm_asdif(:,m) )
                      rrtm_aldir(1)  = SUM( surf_usm_h%frac(:,m) *             &
                                            surf_usm_h%rrtm_aldir(:,m) )
                      rrtm_aldif(1)  = SUM( surf_usm_h%frac(:,m) *             &
                                            surf_usm_h%rrtm_aldif(:,m) )
                   ENDDO
!
!--                Due to technical reasons, copy optical depths and other 
!--                to dummy arguments which are allocated on the exact size as the 
!--                rrtmg_sw is called.
!--                As one dimesion is allocated with zero size, compiler complains
!--                that rank of the array does not match that of the 
!--                assumed-shaped arguments in the RRTMG library. In order to 
!--                avoid this, write to dummy arguments and give pass the entire 
!--                dummy array. Seems to be the only existing work-around.  
                   ALLOCATE( rrtm_sw_taucld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
                   ALLOCATE( rrtm_sw_ssacld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
                   ALLOCATE( rrtm_sw_asmcld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
                   ALLOCATE( rrtm_sw_fsfcld_dum(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1) )
                   ALLOCATE( rrtm_sw_tauaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) )
                   ALLOCATE( rrtm_sw_ssaaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) )
                   ALLOCATE( rrtm_sw_asmaer_dum(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1) )
                   ALLOCATE( rrtm_sw_ecaer_dum(0:0,k_topo+1:nzt_rad+1,1:naerec+1)  )
     
                   rrtm_sw_taucld_dum = rrtm_sw_taucld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
                   rrtm_sw_ssacld_dum = rrtm_sw_ssacld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
                   rrtm_sw_asmcld_dum = rrtm_sw_asmcld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
                   rrtm_sw_fsfcld_dum = rrtm_sw_fsfcld(1:nbndsw+1,0:0,k_topo+1:nzt_rad+1)
                   rrtm_sw_tauaer_dum = rrtm_sw_tauaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1)
                   rrtm_sw_ssaaer_dum = rrtm_sw_ssaaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1)
                   rrtm_sw_asmaer_dum = rrtm_sw_asmaer(0:0,k_topo+1:nzt_rad+1,1:nbndsw+1)
                   rrtm_sw_ecaer_dum  = rrtm_sw_ecaer(0:0,k_topo+1:nzt_rad+1,1:naerec+1)

                   CALL rrtmg_sw( 1,                                           &
                                  nzt_rad-k_topo,                              &
                                  rrtm_icld,                                   &
                                  rrtm_iaer,                                   &
                                  rrtm_play(:,k_topo+1:nzt_rad+1),             &
                                  rrtm_plev(:,k_topo+1:nzt_rad+2),             &
                                  rrtm_tlay(:,k_topo+1:nzt_rad+1),             &
                                  rrtm_tlev(:,k_topo+1:nzt_rad+2),             &
                                  rrtm_tsfc,                                   &
                                  rrtm_h2ovmr(:,k_topo+1:nzt_rad+1),           &                               
                                  rrtm_o3vmr(:,k_topo+1:nzt_rad+1),            &        
                                  rrtm_co2vmr(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_ch4vmr(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_n2ovmr(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_o2vmr(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_asdir,                                  & 
                                  rrtm_asdif,                                  &
                                  rrtm_aldir,                                  &
                                  rrtm_aldif,                                  &
                                  zenith,                                      &
                                  0.0_wp,                                      &
                                  day_of_year,                                 &
                                  solar_constant,                              &
                                  rrtm_inflgsw,                                &
                                  rrtm_iceflgsw,                               &
                                  rrtm_liqflgsw,                               &
                                  rrtm_cldfr(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_sw_taucld_dum,                          &
                                  rrtm_sw_ssacld_dum,                          &
                                  rrtm_sw_asmcld_dum,                          &
                                  rrtm_sw_fsfcld_dum,                          &
                                  rrtm_cicewp(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_cliqwp(:,k_topo+1:nzt_rad+1),           &
                                  rrtm_reice(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_reliq(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_sw_tauaer_dum,                          &
                                  rrtm_sw_ssaaer_dum,                          &
                                  rrtm_sw_asmaer_dum,                          &
                                  rrtm_sw_ecaer_dum,                           &
                                  rrtm_swuflx(:,k_topo:nzt_rad+1),             &  
                                  rrtm_swdflx(:,k_topo:nzt_rad+1),             & 
                                  rrtm_swhr(:,k_topo+1:nzt_rad+1),             & 
                                  rrtm_swuflxc(:,k_topo:nzt_rad+1),            & 
                                  rrtm_swdflxc(:,k_topo:nzt_rad+1),            &
                                  rrtm_swhrc(:,k_topo+1:nzt_rad+1),            &
                                  rrtm_dirdflux(:,k_topo:nzt_rad+1),           &
                                  rrtm_difdflux(:,k_topo:nzt_rad+1) )

                   DEALLOCATE( rrtm_sw_taucld_dum )
                   DEALLOCATE( rrtm_sw_ssacld_dum )
                   DEALLOCATE( rrtm_sw_asmcld_dum )
                   DEALLOCATE( rrtm_sw_fsfcld_dum )
                   DEALLOCATE( rrtm_sw_tauaer_dum )
                   DEALLOCATE( rrtm_sw_ssaaer_dum )
                   DEALLOCATE( rrtm_sw_asmaer_dum )
                   DEALLOCATE( rrtm_sw_ecaer_dum )
!
!--                Save fluxes
                   DO k = nzb, nzt+1
                      rad_sw_in(k,j,i)  = rrtm_swdflx(0,k)
                      rad_sw_out(k,j,i) = rrtm_swuflx(0,k)
                   ENDDO
!
!--                Save heating rates (convert from K/d to K/s)
                   DO k = nzb+1, nzt+1
                      rad_sw_hr(k,j,i)     = rrtm_swhr(0,k)  * d_hours_day
                      rad_sw_cs_hr(k,j,i)  = rrtm_swhrc(0,k) * d_hours_day
                   ENDDO

!
!--                Save surface radiative fluxes onto respective surface elements
!--                Horizontal surfaces
                   DO  m = surf_lsm_h%start_index(j,i),                        &
                           surf_lsm_h%end_index(j,i)
                      surf_lsm_h%rad_sw_in(m)     = rrtm_swdflx(0,k_topo)
                      surf_lsm_h%rad_sw_out(m)    = rrtm_swuflx(0,k_topo)
                   ENDDO             
                   DO  m = surf_usm_h%start_index(j,i),                        &
                           surf_usm_h%end_index(j,i)
                      surf_usm_h%rad_sw_in(m)     = rrtm_swdflx(0,k_topo)
                      surf_usm_h%rad_sw_out(m)    = rrtm_swuflx(0,k_topo)
                   ENDDO 
!
!--                Vertical surfaces. Fluxes are obtain at respective vertical 
!--                level of the surface element
                   DO  l = 0, 3
                      DO  m = surf_lsm_v(l)%start_index(j,i),                  &
                              surf_lsm_v(l)%end_index(j,i)
                         k                           = surf_lsm_v(l)%k(m)
                         surf_lsm_v(l)%rad_sw_in(m)  = rrtm_swdflx(0,k)
                         surf_lsm_v(l)%rad_sw_out(m) = rrtm_swuflx(0,k)
                      ENDDO             
                      DO  m = surf_usm_v(l)%start_index(j,i),                  &
                              surf_usm_v(l)%end_index(j,i)
                         k                           = surf_usm_v(l)%k(m)
                         surf_usm_v(l)%rad_sw_in(m)  = rrtm_swdflx(0,k)
                         surf_usm_v(l)%rad_sw_out(m) = rrtm_swuflx(0,k)
                      ENDDO 
                   ENDDO
!
!--             Solar radiation is zero during night
                ELSE
                   rad_sw_in  = 0.0_wp
                   rad_sw_out = 0.0_wp
!--             !!!!!!!! ATTENSION !!!!!!!!!!!!!!!
!--             Surface radiative fluxes should be also set to zero here                  
!--                Save surface radiative fluxes onto respective surface elements
!--                Horizontal surfaces
                   DO  m = surf_lsm_h%start_index(j,i),                        &
                           surf_lsm_h%end_index(j,i)
                      surf_lsm_h%rad_sw_in(m)     = 0.0_wp
                      surf_lsm_h%rad_sw_out(m)    = 0.0_wp
                   ENDDO             
                   DO  m = surf_usm_h%start_index(j,i),                        &
                           surf_usm_h%end_index(j,i)
                      surf_usm_h%rad_sw_in(m)     = 0.0_wp
                      surf_usm_h%rad_sw_out(m)    = 0.0_wp
                   ENDDO 
!
!--                Vertical surfaces. Fluxes are obtain at respective vertical 
!--                level of the surface element
                   DO  l = 0, 3
                      DO  m = surf_lsm_v(l)%start_index(j,i),                  &
                              surf_lsm_v(l)%end_index(j,i)
                         k                           = surf_lsm_v(l)%k(m)
                         surf_lsm_v(l)%rad_sw_in(m)  = 0.0_wp
                         surf_lsm_v(l)%rad_sw_out(m) = 0.0_wp
                      ENDDO             
                      DO  m = surf_usm_v(l)%start_index(j,i),                  &
                              surf_usm_v(l)%end_index(j,i)
                         k                           = surf_usm_v(l)%k(m)
                         surf_usm_v(l)%rad_sw_in(m)  = 0.0_wp
                         surf_usm_v(l)%rad_sw_out(m) = 0.0_wp
                      ENDDO 
                   ENDDO
                ENDIF

             ENDDO
          ENDDO

       ENDIF
!
!--    Finally, calculate surface net radiation for surface elements.
       IF (  .NOT.  radiation_interactions  ) THEN
!--       First, for horizontal surfaces    
          DO  m = 1, surf_lsm_h%ns
             surf_lsm_h%rad_net(m) = surf_lsm_h%rad_sw_in(m)                   &
                                   - surf_lsm_h%rad_sw_out(m)                  &
                                   + surf_lsm_h%rad_lw_in(m)                   &
                                   - surf_lsm_h%rad_lw_out(m)
          ENDDO
          DO  m = 1, surf_usm_h%ns
             surf_usm_h%rad_net(m) = surf_usm_h%rad_sw_in(m)                   &
                                   - surf_usm_h%rad_sw_out(m)                  &
                                   + surf_usm_h%rad_lw_in(m)                   &
                                   - surf_usm_h%rad_lw_out(m)
          ENDDO
!
!--       Vertical surfaces. 
!--       Todo: weight with azimuth and zenith angle according to their orientation!
          DO  l = 0, 3     
             DO  m = 1, surf_lsm_v(l)%ns
                surf_lsm_v(l)%rad_net(m) = surf_lsm_v(l)%rad_sw_in(m)          &
                                         - surf_lsm_v(l)%rad_sw_out(m)         &
                                         + surf_lsm_v(l)%rad_lw_in(m)          &
                                         - surf_lsm_v(l)%rad_lw_out(m)
             ENDDO
             DO  m = 1, surf_usm_v(l)%ns
                surf_usm_v(l)%rad_net(m) = surf_usm_v(l)%rad_sw_in(m)          &
                                         - surf_usm_v(l)%rad_sw_out(m)         &
                                         + surf_usm_v(l)%rad_lw_in(m)          &
                                         - surf_usm_v(l)%rad_lw_out(m)
             ENDDO
          ENDDO
       ENDIF


       CALL exchange_horiz( rad_lw_in,  nbgp )
       CALL exchange_horiz( rad_lw_out, nbgp )
       CALL exchange_horiz( rad_lw_hr,    nbgp )
       CALL exchange_horiz( rad_lw_cs_hr, nbgp )

       CALL exchange_horiz( rad_sw_in,  nbgp )
       CALL exchange_horiz( rad_sw_out, nbgp ) 
       CALL exchange_horiz( rad_sw_hr,    nbgp )
       CALL exchange_horiz( rad_sw_cs_hr, nbgp )

#endif

    END SUBROUTINE radiation_rrtmg


!------------------------------------------------------------------------------!
! Description:
! ------------
!> Calculate the cosine of the zenith angle (variable is called zenith)
!------------------------------------------------------------------------------!
    SUBROUTINE calc_zenith

       IMPLICIT NONE

       REAL(wp) ::  declination,  & !< solar declination angle
                    hour_angle      !< solar hour angle
!
!--    Calculate current day and time based on the initial values and simulation
!--    time
       CALL calc_date_and_time

!
!--    Calculate solar declination and hour angle   
       declination = ASIN( decl_1 * SIN(decl_2 * REAL(day_of_year, KIND=wp) - decl_3) )
       hour_angle  = 2.0_wp * pi * (time_utc / 86400.0_wp) + lon - pi

!
!--    Calculate cosine of solar zenith angle
       zenith(0) = SIN(lat) * SIN(declination) + COS(lat) * COS(declination)   &
                                            * COS(hour_angle)
       zenith(0) = MAX(0.0_wp,zenith(0))

!
!--    Calculate solar directional vector
       IF ( sun_direction )  THEN

!
!--       Direction in longitudes equals to sin(solar_azimuth) * sin(zenith)
          sun_dir_lon(0) = -SIN(hour_angle) * COS(declination)

!
!--       Direction in latitues equals to cos(solar_azimuth) * sin(zenith)
          sun_dir_lat(0) = SIN(declination) * COS(lat) - COS(hour_angle) &
                              * COS(declination) * SIN(lat)
       ENDIF

!
!--    Check if the sun is up (otheriwse shortwave calculations can be skipped)
       IF ( zenith(0) > 0.0_wp )  THEN
          sun_up = .TRUE.
       ELSE
          sun_up = .FALSE.
       END IF

    END SUBROUTINE calc_zenith

#if defined ( __rrtmg ) && defined ( __netcdf )
!------------------------------------------------------------------------------!
! Description:
! ------------
!> Calculates surface albedo components based on Briegleb (1992) and 
!> Briegleb et al. (1986)
!------------------------------------------------------------------------------!
    SUBROUTINE calc_albedo( surf )

        IMPLICIT NONE

        INTEGER(iwp)    ::  ind_type !< running index surface tiles
        INTEGER(iwp)    ::  m        !< running index surface elements

        TYPE(surf_type) ::  surf !< treated surfaces

        IF ( sun_up  .AND.  .NOT. average_radiation )  THEN

           DO  m = 1, surf%ns
!
!--           Loop over surface elements
              DO  ind_type = 0, SIZE( surf%albedo_type, 1 ) - 1
           
!
!--              Ocean
                 IF ( surf%albedo_type(ind_type,m) == 1 )  THEN
                    surf%rrtm_aldir(ind_type,m) = 0.026_wp /                    &
                                                ( zenith(0)**1.7_wp + 0.065_wp )&
                                     + 0.15_wp * ( zenith(0) - 0.1_wp )         &
                                               * ( zenith(0) - 0.5_wp )         &
                                               * ( zenith(0) - 1.0_wp )
                    surf%rrtm_asdir(ind_type,m) = surf%rrtm_aldir(ind_type,m)
!
!--              Snow
                 ELSEIF ( surf%albedo_type(ind_type,m) == 16 )  THEN
                    IF ( zenith(0) < 0.5_wp )  THEN
                       surf%rrtm_aldir(ind_type,m) =                           &
                                 0.5_wp * ( 1.0_wp - surf%aldif(ind_type,m) )  &
                                        * ( 3.0_wp / ( 1.0_wp + 4.0_wp         &
                                        * zenith(0) ) ) - 1.0_wp
                       surf%rrtm_asdir(ind_type,m) =                           &
                                 0.5_wp * ( 1.0_wp - surf%asdif(ind_type,m) )  &
                                        * ( 3.0_wp / ( 1.0_wp + 4.0_wp         &
                                        * zenith(0) ) ) - 1.0_wp

                       surf%rrtm_aldir(ind_type,m) =                           &
                                       MIN(0.98_wp, surf%rrtm_aldir(ind_type,m))
                       surf%rrtm_asdir(ind_type,m) =                           &
                                       MIN(0.98_wp, surf%rrtm_asdir(ind_type,m))
                    ELSE
                       surf%rrtm_aldir(ind_type,m) = surf%aldif(ind_type,m)
                       surf%rrtm_asdir(ind_type,m) = surf%asdif(ind_type,m)
                    ENDIF
!
!--              Sea ice
                 ELSEIF ( surf%albedo_type(ind_type,m) == 15 )  THEN
                    surf%rrtm_aldir(ind_type,m) = surf%aldif(ind_type,m)
                    surf%rrtm_asdir(ind_type,m) = surf%asdif(ind_type,m)

!
!--              Asphalt
                 ELSEIF ( surf%albedo_type(ind_type,m) == 17 )  THEN
                    surf%rrtm_aldir(ind_type,m) = surf%aldif(ind_type,m)
                    surf%rrtm_asdir(ind_type,m) = surf%asdif(ind_type,m)


!
!--              Bare soil
                 ELSEIF ( surf%albedo_type(ind_type,m) == 18 )  THEN
                    surf%rrtm_aldir(ind_type,m) = surf%aldif(ind_type,m)
                    surf%rrtm_asdir(ind_type,m) = surf%asdif(ind_type,m)

!
!--              Land surfaces
                 ELSE
                    SELECT CASE ( surf%albedo_type(ind_type,m) )

!
!--                    Surface types with strong zenith dependence
                       CASE ( 1, 2, 3, 4, 11, 12, 13 )
                          surf%rrtm_aldir(ind_type,m) =                        &
                                surf%aldif(ind_type,m) * 1.4_wp /              &
                                           ( 1.0_wp + 0.8_wp * zenith(0) )
                          surf%rrtm_asdir(ind_type,m) =                        &
                                surf%asdif(ind_type,m) * 1.4_wp /              &
                                           ( 1.0_wp + 0.8_wp * zenith(0) )
!
!--                    Surface types with weak zenith dependence
                       CASE ( 5, 6, 7, 8, 9, 10, 14 )
                          surf%rrtm_aldir(ind_type,m) =                        &
                                surf%aldif(ind_type,m) * 1.1_wp /              &
                                           ( 1.0_wp + 0.2_wp * zenith(0) )
                          surf%rrtm_asdir(ind_type,m) =                        &
                                surf%asdif(ind_type,m) * 1.1_wp /              &
                                           ( 1.0_wp + 0.2_wp * zenith(0) )

                       CASE DEFAULT

                    END SELECT
                 ENDIF
!
!--              Diffusive albedo is taken from Table 2
                 surf%rrtm_aldif(ind_type,m) = surf%aldif(ind_type,m)
                 surf%rrtm_asdif(ind_type,m) = surf%asdif(ind_type,m)
              ENDDO
           ENDDO
!
!--     Set albedo in case of average radiation
        ELSEIF ( sun_up  .AND.  average_radiation )  THEN
           surf%rrtm_asdir = albedo_urb
           surf%rrtm_asdif = albedo_urb
           surf%rrtm_aldir = albedo_urb
           surf%rrtm_aldif = albedo_urb  
!
!--     Darkness
        ELSE
           surf%rrtm_aldir = 0.0_wp
           surf%rrtm_asdir = 0.0_wp
           surf%rrtm_aldif = 0.0_wp
           surf%rrtm_asdif = 0.0_wp
        ENDIF

    END SUBROUTINE calc_albedo

!------------------------------------------------------------------------------!
! Description:
! ------------
!> Read sounding data (pressure and temperature) from RADIATION_DATA.
!------------------------------------------------------------------------------!
    SUBROUTINE read_sounding_data

       IMPLICIT NONE

       INTEGER(iwp) :: id,           & !< NetCDF id of input file
                       id_dim_zrad,  & !< pressure level id in the NetCDF file
                       id_var,       & !< NetCDF variable id
                       k,            & !< loop index
                       nz_snd,       & !< number of vertical levels in the sounding data
                       nz_snd_start, & !< start vertical index for sounding data to be used
                       nz_snd_end      !< end vertical index for souding data to be used

       REAL(wp) :: t_surface           !< actual surface temperature

       REAL(wp), DIMENSION(:), ALLOCATABLE ::  hyp_snd_tmp, & !< temporary hydrostatic pressure profile (sounding)
                                               t_snd_tmp      !< temporary temperature profile (sounding)

!
!--    In case of updates, deallocate arrays first (sufficient to check one
!--    array as the others are automatically allocated). This is required
!--    because nzt_rad might change during the update
       IF ( ALLOCATED ( hyp_snd ) )  THEN
          DEALLOCATE( hyp_snd )
          DEALLOCATE( t_snd )
          DEALLOCATE ( rrtm_play )
          DEALLOCATE ( rrtm_plev )
          DEALLOCATE ( rrtm_tlay )
          DEALLOCATE ( rrtm_tlev )

          DEALLOCATE ( rrtm_cicewp )
          DEALLOCATE ( rrtm_cldfr )
          DEALLOCATE ( rrtm_cliqwp )
          DEALLOCATE ( rrtm_reice )
          DEALLOCATE ( rrtm_reliq )
          DEALLOCATE ( rrtm_lw_taucld )
          DEALLOCATE ( rrtm_lw_tauaer )

          DEALLOCATE ( rrtm_lwdflx  )
          DEALLOCATE ( rrtm_lwdflxc )
          DEALLOCATE ( rrtm_lwuflx  )
          DEALLOCATE ( rrtm_lwuflxc )
          DEALLOCATE ( rrtm_lwuflx_dt )
          DEALLOCATE ( rrtm_lwuflxc_dt )
          DEALLOCATE ( rrtm_lwhr  )
          DEALLOCATE ( rrtm_lwhrc )

          DEALLOCATE ( rrtm_sw_taucld )
          DEALLOCATE ( rrtm_sw_ssacld )
          DEALLOCATE ( rrtm_sw_asmcld )
          DEALLOCATE ( rrtm_sw_fsfcld )
          DEALLOCATE ( rrtm_sw_tauaer )
          DEALLOCATE ( rrtm_sw_ssaaer )
          DEALLOCATE ( rrtm_sw_asmaer ) 
          DEALLOCATE ( rrtm_sw_ecaer )   
 
          DEALLOCATE ( rrtm_swdflx  )
          DEALLOCATE ( rrtm_swdflxc )
          DEALLOCATE ( rrtm_swuflx  )
          DEALLOCATE ( rrtm_swuflxc )
          DEALLOCATE ( rrtm_swhr  )
          DEALLOCATE ( rrtm_swhrc )
          DEALLOCATE ( rrtm_dirdflux )
          DEALLOCATE ( rrtm_difdflux )

       ENDIF

!
!--    Open file for reading
       nc_stat = NF90_OPEN( rrtm_input_file, NF90_NOWRITE, id )
       CALL netcdf_handle_error_rad( 'read_sounding_data', 549 )

!
!--    Inquire dimension of z axis and save in nz_snd
       nc_stat = NF90_INQ_DIMID( id, "Pressure", id_dim_zrad )
       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim_zrad, len = nz_snd )
       CALL netcdf_handle_error_rad( 'read_sounding_data', 551 )

!
! !--    Allocate temporary array for storing pressure data
       ALLOCATE( hyp_snd_tmp(1:nz_snd) )
       hyp_snd_tmp = 0.0_wp


!--    Read pressure from file
       nc_stat = NF90_INQ_VARID( id, "Pressure", id_var )
       nc_stat = NF90_GET_VAR( id, id_var, hyp_snd_tmp(:), start = (/1/),      &
                               count = (/nz_snd/) )
       CALL netcdf_handle_error_rad( 'read_sounding_data', 552 )

!
!--    Allocate temporary array for storing temperature data
       ALLOCATE( t_snd_tmp(1:nz_snd) )
       t_snd_tmp = 0.0_wp

!
!--    Read temperature from file
       nc_stat = NF90_INQ_VARID( id, "ReferenceTemperature", id_var )
       nc_stat = NF90_GET_VAR( id, id_var, t_snd_tmp(:), start = (/1/),        &
                               count = (/nz_snd/) )
       CALL netcdf_handle_error_rad( 'read_sounding_data', 553 )

!
!--    Calculate start of sounding data
       nz_snd_start = nz_snd + 1
       nz_snd_end   = nz_snd + 1

!
!--    Start filling vertical dimension at 10hPa above the model domain (hyp is
!--    in Pa, hyp_snd in hPa).
       DO  k = 1, nz_snd
          IF ( hyp_snd_tmp(k) < ( hyp(nzt+1) - 1000.0_wp) * 0.01_wp )  THEN
             nz_snd_start = k
             EXIT
          END IF
       END DO

       IF ( nz_snd_start <= nz_snd )  THEN
          nz_snd_end = nz_snd
       END IF


!
!--    Calculate of total grid points for RRTMG calculations
       nzt_rad = nzt + nz_snd_end - nz_snd_start + 1

!
!--    Save data above LES domain in hyp_snd, t_snd
       ALLOCATE( hyp_snd(nzb+1:nzt_rad) )
       ALLOCATE( t_snd(nzb+1:nzt_rad)   )
       hyp_snd = 0.0_wp
       t_snd = 0.0_wp

       hyp_snd(nzt+2:nzt_rad) = hyp_snd_tmp(nz_snd_start+1:nz_snd_end)
       t_snd(nzt+2:nzt_rad)   = t_snd_tmp(nz_snd_start+1:nz_snd_end)

       nc_stat = NF90_CLOSE( id )

!
!--    Calculate pressure levels on zu and zw grid. Sounding data is added at 
!--    top of the LES domain. This routine does not consider horizontal or 
!--    vertical variability of pressure and temperature
       ALLOCATE ( rrtm_play(0:0,nzb+1:nzt_rad+1)   )
       ALLOCATE ( rrtm_plev(0:0,nzb+1:nzt_rad+2)   )

       t_surface = pt_surface * exner(nzb)
       DO k = nzb+1, nzt+1
          rrtm_play(0,k) = hyp(k) * 0.01_wp
          rrtm_plev(0,k) = barometric_formula(zw(k-1),                         &
                              pt_surface * exner(nzb), &
                              surface_pressure )
       ENDDO

       DO k = nzt+2, nzt_rad
          rrtm_play(0,k) = hyp_snd(k)
          rrtm_plev(0,k) = 0.5_wp * ( rrtm_play(0,k) + rrtm_play(0,k-1) )
       ENDDO
       rrtm_plev(0,nzt_rad+1) = MAX( 0.5 * hyp_snd(nzt_rad),                   &
                                   1.5 * hyp_snd(nzt_rad)                      &
                                 - 0.5 * hyp_snd(nzt_rad-1) )
       rrtm_plev(0,nzt_rad+2)  = MIN( 1.0E-4_wp,                               &
                                      0.25_wp * rrtm_plev(0,nzt_rad+1) )

       rrtm_play(0,nzt_rad+1) = 0.5 * rrtm_plev(0,nzt_rad+1)

!
!--    Calculate temperature/humidity levels at top of the LES domain. 
!--    Currently, the temperature is taken from sounding data (might lead to a 
!--    temperature jump at interface. To do: Humidity is currently not 
!--    calculated above the LES domain.
       ALLOCATE ( rrtm_tlay(0:0,nzb+1:nzt_rad+1)   )
       ALLOCATE ( rrtm_tlev(0:0,nzb+1:nzt_rad+2)   )

       DO k = nzt+8, nzt_rad
          rrtm_tlay(0,k)   = t_snd(k)
       ENDDO
       rrtm_tlay(0,nzt_rad+1) = 2.0_wp * rrtm_tlay(0,nzt_rad)                  &
                                - rrtm_tlay(0,nzt_rad-1)
       DO k = nzt+9, nzt_rad+1
          rrtm_tlev(0,k)   = rrtm_tlay(0,k-1) + (rrtm_tlay(0,k)                &
                             - rrtm_tlay(0,k-1))                               &
                             / ( rrtm_play(0,k) - rrtm_play(0,k-1) )           &
                             * ( rrtm_plev(0,k) - rrtm_play(0,k-1) )
       ENDDO

       rrtm_tlev(0,nzt_rad+2)   = 2.0_wp * rrtm_tlay(0,nzt_rad+1)              &
                                  - rrtm_tlev(0,nzt_rad)
!
!--    Allocate remaining RRTMG arrays
       ALLOCATE ( rrtm_cicewp(0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_cldfr(0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_cliqwp(0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_reice(0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_reliq(0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_lw_taucld(1:nbndlw+1,0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_lw_tauaer(0:0,nzb+1:nzt_rad+1,1:nbndlw+1) )
       ALLOCATE ( rrtm_sw_taucld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_sw_ssacld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_sw_asmcld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_sw_fsfcld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_sw_tauaer(0:0,nzb+1:nzt_rad+1,1:nbndsw+1) )
       ALLOCATE ( rrtm_sw_ssaaer(0:0,nzb+1:nzt_rad+1,1:nbndsw+1) )
       ALLOCATE ( rrtm_sw_asmaer(0:0,nzb+1:nzt_rad+1,1:nbndsw+1) ) 
       ALLOCATE ( rrtm_sw_ecaer(0:0,nzb+1:nzt_rad+1,1:naerec+1) )    

!
!--    The ice phase is currently not considered in PALM
       rrtm_cicewp = 0.0_wp
       rrtm_reice  = 0.0_wp

!
!--    Set other parameters (move to NAMELIST parameters in the future)
       rrtm_lw_tauaer = 0.0_wp
       rrtm_lw_taucld = 0.0_wp
       rrtm_sw_taucld = 0.0_wp
       rrtm_sw_ssacld = 0.0_wp
       rrtm_sw_asmcld = 0.0_wp
       rrtm_sw_fsfcld = 0.0_wp
       rrtm_sw_tauaer = 0.0_wp
       rrtm_sw_ssaaer = 0.0_wp
       rrtm_sw_asmaer = 0.0_wp
       rrtm_sw_ecaer  = 0.0_wp


       ALLOCATE ( rrtm_swdflx(0:0,nzb:nzt_rad+1)  )
       ALLOCATE ( rrtm_swuflx(0:0,nzb:nzt_rad+1)  )
       ALLOCATE ( rrtm_swhr(0:0,nzb+1:nzt_rad+1)  )
       ALLOCATE ( rrtm_swuflxc(0:0,nzb:nzt_rad+1) )
       ALLOCATE ( rrtm_swdflxc(0:0,nzb:nzt_rad+1) )
       ALLOCATE ( rrtm_swhrc(0:0,nzb+1:nzt_rad+1) )
       ALLOCATE ( rrtm_dirdflux(0:0,nzb:nzt_rad+1) )
       ALLOCATE ( rrtm_difdflux(0:0,nzb:nzt_rad+1) )

       rrtm_swdflx  = 0.0_wp
       rrtm_swuflx  = 0.0_wp
       rrtm_swhr    = 0.0_wp  
       rrtm_swuflxc = 0.0_wp
       rrtm_swdflxc = 0.0_wp
       rrtm_swhrc   = 0.0_wp
       rrtm_dirdflux = 0.0_wp
       rrtm_difdflux = 0.0_wp

       ALLOCATE ( rrtm_lwdflx(0:0,nzb:nzt_rad+1)  )
       ALLOCATE ( rrtm_lwuflx(0:0,nzb:nzt_rad+1)  )
       ALLOCATE ( rrtm_lwhr(0:0,nzb+1:nzt_rad+1)  )
       ALLOCATE ( rrtm_lwuflxc(0:0,nzb:nzt_rad+1) )
       ALLOCATE ( rrtm_lwdflxc(0:0,nzb:nzt_rad+1) )
       ALLOCATE ( rrtm_lwhrc(0:0,nzb+1:nzt_rad+1) )

       rrtm_lwdflx  = 0.0_wp
       rrtm_lwuflx  = 0.0_wp
       rrtm_lwhr    = 0.0_wp  
       rrtm_lwuflxc = 0.0_wp
       rrtm_lwdflxc = 0.0_wp
       rrtm_lwhrc   = 0.0_wp

       ALLOCATE ( rrtm_lwuflx_dt(0:0,nzb:nzt_rad+1) )
       ALLOCATE ( rrtm_lwuflxc_dt(0:0,nzb:nzt_rad+1) )

       rrtm_lwuflx_dt = 0.0_wp
       rrtm_lwuflxc_dt = 0.0_wp

    END SUBROUTINE read_sounding_data


!------------------------------------------------------------------------------!
! Description:
! ------------
!> Read trace gas data from file
!------------------------------------------------------------------------------!
    SUBROUTINE read_trace_gas_data

       USE rrsw_ncpar

       IMPLICIT NONE

       INTEGER(iwp), PARAMETER :: num_trace_gases = 10 !< number of trace gases (absorbers)

       CHARACTER(LEN=5), DIMENSION(num_trace_gases), PARAMETER ::              & !< trace gas names
           trace_names = (/'O3   ', 'CO2  ', 'CH4  ', 'N2O  ', 'O2   ',        &
                           'CFC11', 'CFC12', 'CFC22', 'CCL4 ', 'H2O  '/)

       INTEGER(iwp) :: id,     & !< NetCDF id
                       k,      & !< loop index
                       m,      & !< loop index
                       n,      & !< loop index
                       nabs,   & !< number of absorbers
                       np,     & !< number of pressure levels
                       id_abs, & !< NetCDF id of the respective absorber
                       id_dim, & !< NetCDF id of asborber's dimension
                       id_var    !< NetCDf id ot the absorber

       REAL(wp) :: p_mls_l, p_mls_u, p_wgt_l, p_wgt_u, p_mls_m


       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  p_mls,          & !< pressure levels for the absorbers
                                                 rrtm_play_tmp,  & !< temporary array for pressure zu-levels
                                                 rrtm_plev_tmp,  & !< temporary array for pressure zw-levels
                                                 trace_path_tmp    !< temporary array for storing trace gas path data

       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  trace_mls,      & !< array for storing the absorber amounts
                                                 trace_mls_path, & !< array for storing trace gas path data
                                                 trace_mls_tmp     !< temporary array for storing trace gas data


!
!--    In case of updates, deallocate arrays first (sufficient to check one
!--    array as the others are automatically allocated)
       IF ( ALLOCATED ( rrtm_o3vmr ) )  THEN
          DEALLOCATE ( rrtm_o3vmr  )
          DEALLOCATE ( rrtm_co2vmr )
          DEALLOCATE ( rrtm_ch4vmr )
          DEALLOCATE ( rrtm_n2ovmr )
          DEALLOCATE ( rrtm_o2vmr  )
          DEALLOCATE ( rrtm_cfc11vmr )
          DEALLOCATE ( rrtm_cfc12vmr )
          DEALLOCATE ( rrtm_cfc22vmr )
          DEALLOCATE ( rrtm_ccl4vmr  )
          DEALLOCATE ( rrtm_h2ovmr  )     
       ENDIF

!
!--    Allocate trace gas profiles
       ALLOCATE ( rrtm_o3vmr(0:0,1:nzt_rad+1)  )
       ALLOCATE ( rrtm_co2vmr(0:0,1:nzt_rad+1) )
       ALLOCATE ( rrtm_ch4vmr(0:0,1:nzt_rad+1) )
       ALLOCATE ( rrtm_n2ovmr(0:0,1:nzt_rad+1) )
       ALLOCATE ( rrtm_o2vmr(0:0,1:nzt_rad+1)  )
       ALLOCATE ( rrtm_cfc11vmr(0:0,1:nzt_rad+1) )
       ALLOCATE ( rrtm_cfc12vmr(0:0,1:nzt_rad+1) )
       ALLOCATE ( rrtm_cfc22vmr(0:0,1:nzt_rad+1) )
       ALLOCATE ( rrtm_ccl4vmr(0:0,1:nzt_rad+1)  )
       ALLOCATE ( rrtm_h2ovmr(0:0,1:nzt_rad+1)  )

!
!--    Open file for reading
       nc_stat = NF90_OPEN( rrtm_input_file, NF90_NOWRITE, id )
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 549 )
!
!--    Inquire dimension ids and dimensions
       nc_stat = NF90_INQ_DIMID( id, "Pressure", id_dim )
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, len = np) 
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )

       nc_stat = NF90_INQ_DIMID( id, "Absorber", id_dim )
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, len = nabs ) 
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
   

!
!--    Allocate pressure, and trace gas arrays     
       ALLOCATE( p_mls(1:np) )
       ALLOCATE( trace_mls(1:num_trace_gases,1:np) ) 
       ALLOCATE( trace_mls_tmp(1:nabs,1:np) ) 


       nc_stat = NF90_INQ_VARID( id, "Pressure", id_var )
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
       nc_stat = NF90_GET_VAR( id, id_var, p_mls )
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )

       nc_stat = NF90_INQ_VARID( id, "AbsorberAmountMLS", id_var )
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )
       nc_stat = NF90_GET_VAR( id, id_var, trace_mls_tmp )
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 550 )


!
!--    Write absorber amounts (mls) to trace_mls
       DO n = 1, num_trace_gases
          CALL getAbsorberIndex( TRIM( trace_names(n) ), id_abs )

          trace_mls(n,1:np) = trace_mls_tmp(id_abs,1:np)

!
!--       Replace missing values by zero
          WHERE ( trace_mls(n,:) > 2.0_wp )  
             trace_mls(n,:) = 0.0_wp
          END WHERE
       END DO

       DEALLOCATE ( trace_mls_tmp )

       nc_stat = NF90_CLOSE( id )
       CALL netcdf_handle_error_rad( 'read_trace_gas_data', 551 )

!
!--    Add extra pressure level for calculations of the trace gas paths
       ALLOCATE ( rrtm_play_tmp(1:nzt_rad+1) )
       ALLOCATE ( rrtm_plev_tmp(1:nzt_rad+2) )

       rrtm_play_tmp(1:nzt_rad)   = rrtm_play(0,1:nzt_rad) 
       rrtm_plev_tmp(1:nzt_rad+1) = rrtm_plev(0,1:nzt_rad+1)
       rrtm_play_tmp(nzt_rad+1)   = rrtm_plev(0,nzt_rad+1) * 0.5_wp
       rrtm_plev_tmp(nzt_rad+2)   = MIN( 1.0E-4_wp, 0.25_wp                    &
                                         * rrtm_plev(0,nzt_rad+1) )
 
!
!--    Calculate trace gas path (zero at surface) with interpolation to the
!--    sounding levels
       ALLOCATE ( trace_mls_path(1:nzt_rad+2,1:num_trace_gases) )

       trace_mls_path(nzb+1,:) = 0.0_wp
       
       DO k = nzb+2, nzt_rad+2
          DO m = 1, num_trace_gases
             trace_mls_path(k,m) = trace_mls_path(k-1,m)

!
!--          When the pressure level is higher than the trace gas pressure
!--          level, assume that 
             IF ( rrtm_plev_tmp(k-1) > p_mls(1) )  THEN             
                
                trace_mls_path(k,m) = trace_mls_path(k,m) + trace_mls(m,1)     &
                                      * ( rrtm_plev_tmp(k-1)                   &
                                          - MAX( p_mls(1), rrtm_plev_tmp(k) )  &
                                        ) / g
             ENDIF

!
!--          Integrate for each sounding level from the contributing p_mls 
!--          levels
             DO n = 2, np
!
!--             Limit p_mls so that it is within the model level
                p_mls_u = MIN( rrtm_plev_tmp(k-1),                             &
                          MAX( rrtm_plev_tmp(k), p_mls(n) ) )
                p_mls_l = MIN( rrtm_plev_tmp(k-1),                             &
                          MAX( rrtm_plev_tmp(k), p_mls(n-1) ) )

                IF ( p_mls_l > p_mls_u )  THEN

!
!--                Calculate weights for interpolation
                   p_mls_m = 0.5_wp * (p_mls_l + p_mls_u)
                   p_wgt_u = (p_mls(n-1) - p_mls_m) / (p_mls(n-1) - p_mls(n))
                   p_wgt_l = (p_mls_m - p_mls(n))   / (p_mls(n-1) - p_mls(n))

!
!--                Add level to trace gas path
                   trace_mls_path(k,m) = trace_mls_path(k,m)                   &
                                         +  ( p_wgt_u * trace_mls(m,n)         &
                                            + p_wgt_l * trace_mls(m,n-1) )     &
                                         * (p_mls_l - p_mls_u) / g
                ENDIF
             ENDDO

             IF ( rrtm_plev_tmp(k) < p_mls(np) )  THEN 
                trace_mls_path(k,m) = trace_mls_path(k,m) + trace_mls(m,np)    &
                                      * ( MIN( rrtm_plev_tmp(k-1), p_mls(np) ) &
                                          - rrtm_plev_tmp(k)                   &
                                        ) / g 
             ENDIF  
          ENDDO
       ENDDO


!
!--    Prepare trace gas path profiles
       ALLOCATE ( trace_path_tmp(1:nzt_rad+1) )

       DO m = 1, num_trace_gases

          trace_path_tmp(1:nzt_rad+1) = ( trace_mls_path(2:nzt_rad+2,m)        &
                                       - trace_mls_path(1:nzt_rad+1,m) ) * g   &
                                       / ( rrtm_plev_tmp(1:nzt_rad+1)          &
                                       - rrtm_plev_tmp(2:nzt_rad+2) )

!
!--       Save trace gas paths to the respective arrays
          SELECT CASE ( TRIM( trace_names(m) ) )

             CASE ( 'O3' )

                rrtm_o3vmr(0,:) = trace_path_tmp(:)

             CASE ( 'CO2' )

                rrtm_co2vmr(0,:) = trace_path_tmp(:)

             CASE ( 'CH4' )

                rrtm_ch4vmr(0,:) = trace_path_tmp(:)

             CASE ( 'N2O' )

                rrtm_n2ovmr(0,:) = trace_path_tmp(:)

             CASE ( 'O2' )

                rrtm_o2vmr(0,:) = trace_path_tmp(:)

             CASE ( 'CFC11' )

                rrtm_cfc11vmr(0,:) = trace_path_tmp(:)

             CASE ( 'CFC12' )

                rrtm_cfc12vmr(0,:) = trace_path_tmp(:)

             CASE ( 'CFC22' )

                rrtm_cfc22vmr(0,:) = trace_path_tmp(:)

             CASE ( 'CCL4' )

                rrtm_ccl4vmr(0,:) = trace_path_tmp(:)

             CASE ( 'H2O' )

                rrtm_h2ovmr(0,:) = trace_path_tmp(:)
                
             CASE DEFAULT

          END SELECT

       ENDDO

       DEALLOCATE ( trace_path_tmp )
       DEALLOCATE ( trace_mls_path )
       DEALLOCATE ( rrtm_play_tmp )
       DEALLOCATE ( rrtm_plev_tmp )
       DEALLOCATE ( trace_mls )
       DEALLOCATE ( p_mls )

    END SUBROUTINE read_trace_gas_data


    SUBROUTINE netcdf_handle_error_rad( routine_name, errno )

       USE control_parameters,                                                 &
           ONLY:  message_string

       USE NETCDF

       USE pegrid

       IMPLICIT NONE

       CHARACTER(LEN=6) ::  message_identifier
       CHARACTER(LEN=*) ::  routine_name

       INTEGER(iwp) ::  errno

       IF ( nc_stat /= NF90_NOERR )  THEN

          WRITE( message_identifier, '(''NC'',I4.4)' )  errno
          message_string = TRIM( NF90_STRERROR( nc_stat ) )

          CALL message( routine_name, message_identifier, 2, 2, 0, 6, 1 )

       ENDIF

    END SUBROUTINE netcdf_handle_error_rad
#endif


!------------------------------------------------------------------------------!
! Description:
! ------------
!> Calculate temperature tendency due to radiative cooling/heating.
!> Cache-optimized version.
!------------------------------------------------------------------------------!
 SUBROUTINE radiation_tendency_ij ( i, j, tend )

    IMPLICIT NONE

    INTEGER(iwp) :: i, j, k !< loop indices

    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tend !< pt tendency term

    IF ( radiation_scheme == 'rrtmg' )  THEN
#if defined  ( __rrtmg )
!
!--    Calculate tendency based on heating rate
       DO k = nzb+1, nzt+1
          tend(k,j,i) = tend(k,j,i) + (rad_lw_hr(k,j,i) + rad_sw_hr(k,j,i))    &
                                         * d_exner(k) * d_seconds_hour
       ENDDO
#endif
    ENDIF

    END SUBROUTINE radiation_tendency_ij


!------------------------------------------------------------------------------!
! Description:
! ------------
!> Calculate temperature tendency due to radiative cooling/heating.
!> Vector-optimized version
!------------------------------------------------------------------------------!
 SUBROUTINE radiation_tendency ( tend )

    USE indices,                                                               &
        ONLY:  nxl, nxr, nyn, nys

    IMPLICIT NONE

    INTEGER(iwp) :: i, j, k !< loop indices

    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tend !< pt tendency term

    IF ( radiation_scheme == 'rrtmg' )  THEN
#if defined  ( __rrtmg )
!
!--    Calculate tendency based on heating rate
       DO  i = nxl, nxr
          DO  j = nys, nyn
             DO k = nzb+1, nzt+1
                tend(k,j,i) = tend(k,j,i) + ( rad_lw_hr(k,j,i)                 &
                                          +  rad_sw_hr(k,j,i) ) * d_exner(k)   &
                                          * d_seconds_hour
             ENDDO
          ENDDO
       ENDDO
#endif
    ENDIF


 END SUBROUTINE radiation_tendency

!------------------------------------------------------------------------------!
! Description:
! ------------
!> This subroutine calculates interaction of the solar radiation
!> with urban and land surfaces and updates all surface heatfluxes.
!> It calculates also the required parameters for RRTMG lower BC.
!>
!> For more info. see Resler et al. 2017
!>
!> The new version 2.0 was radically rewriten, the discretization scheme
!> has been changed. This new version significantly improves effectivity
!> of the paralelization and the scalability of the model.
!------------------------------------------------------------------------------!

 SUBROUTINE radiation_interaction

     IMPLICIT NONE

     INTEGER(iwp)                      :: i, j, k, kk, is, js, d, ku, refstep, m, mm, l, ll
     INTEGER(iwp)                      :: isurf, isurfsrc, isvf, icsf, ipcgb
     INTEGER(iwp)                      :: imrt, imrtf
     INTEGER(iwp)                      :: isd                !< solar direction number
     INTEGER(iwp)                      :: pc_box_dimshift    !< transform for best accuracy
     INTEGER(iwp), DIMENSION(0:3)      :: reorder = (/ 1, 0, 3, 2 /)
     
     REAL(wp), DIMENSION(3,3)          :: mrot               !< grid rotation matrix (zyx)
     REAL(wp), DIMENSION(3,0:nsurf_type):: vnorm             !< face direction normal vectors (zyx)
     REAL(wp), DIMENSION(3)            :: sunorig            !< grid rotated solar direction unit vector (zyx)
     REAL(wp), DIMENSION(3)            :: sunorig_grid       !< grid squashed solar direction unit vector (zyx)
     REAL(wp), DIMENSION(0:nsurf_type) :: costheta           !< direct irradiance factor of solar angle
     REAL(wp), DIMENSION(nzub:nzut)    :: pchf_prep          !< precalculated factor for canopy temperature tendency
     REAL(wp), PARAMETER               :: alpha = 0._wp      !< grid rotation (TODO: add to namelist or remove)
     REAL(wp)                          :: pc_box_area, pc_abs_frac, pc_abs_eff
     REAL(wp)                          :: asrc               !< area of source face
     REAL(wp)                          :: pcrad              !< irradiance from plant canopy
     REAL(wp)                          :: pabsswl  = 0.0_wp  !< total absorbed SW radiation energy in local processor (W)
     REAL(wp)                          :: pabssw   = 0.0_wp  !< total absorbed SW radiation energy in all processors (W)
     REAL(wp)                          :: pabslwl  = 0.0_wp  !< total absorbed LW radiation energy in local processor (W)
     REAL(wp)                          :: pabslw   = 0.0_wp  !< total absorbed LW radiation energy in all processors (W)
     REAL(wp)                          :: pemitlwl = 0.0_wp  !< total emitted LW radiation energy in all processors (W)
     REAL(wp)                          :: pemitlw  = 0.0_wp  !< total emitted LW radiation energy in all processors (W)
     REAL(wp)                          :: pinswl   = 0.0_wp  !< total received SW radiation energy in local processor (W)
     REAL(wp)                          :: pinsw    = 0.0_wp  !< total received SW radiation energy in all processor (W)
     REAL(wp)                          :: pinlwl   = 0.0_wp  !< total received LW radiation energy in local processor (W)
     REAL(wp)                          :: pinlw    = 0.0_wp  !< total received LW radiation energy in all processor (W)
     REAL(wp)                          :: emiss_sum_surfl    !< sum of emissisivity of surfaces in local processor
     REAL(wp)                          :: emiss_sum_surf     !< sum of emissisivity of surfaces in all processor
     REAL(wp)                          :: area_surfl         !< total area of surfaces in local processor
     REAL(wp)                          :: area_surf          !< total area of surfaces in all processor
     REAL(wp)                          :: area_hor           !< total horizontal area of domain in all processor

#if ! defined( __nopointer )
     IF ( plant_canopy )  THEN
         pchf_prep(:) = r_d * exner(nzub:nzut)                                 &
                     / (c_p * hyp(nzub:nzut) * dx*dy*dz(1)) !< equals to 1 / (rho * c_p * Vbox * T)
     ENDIF
#endif
     sun_direction = .TRUE.
     CALL calc_zenith  !< required also for diffusion radiation

!--     prepare rotated normal vectors and irradiance factor
     vnorm(1,:) = kdir(:)
     vnorm(2,:) = jdir(:)
     vnorm(3,:) = idir(:)
     mrot(1, :) = (/ 1._wp,  0._wp,      0._wp      /)
     mrot(2, :) = (/ 0._wp,  COS(alpha), SIN(alpha) /)
     mrot(3, :) = (/ 0._wp, -SIN(alpha), COS(alpha) /)
     sunorig = (/ zenith(0), sun_dir_lat, sun_dir_lon /)
     sunorig = MATMUL(mrot, sunorig)
     DO d = 0, nsurf_type
         costheta(d) = DOT_PRODUCT(sunorig, vnorm(:,d))
     ENDDO

     IF ( zenith(0) > 0 )  THEN
!--      now we will "squash" the sunorig vector by grid box size in
!--      each dimension, so that this new direction vector will allow us
!--      to traverse the ray path within grid coordinates directly
         sunorig_grid = (/ sunorig(1)/dz(1), sunorig(2)/dy, sunorig(3)/dx /)
!--      sunorig_grid = sunorig_grid / norm2(sunorig_grid)
         sunorig_grid = sunorig_grid / SQRT(SUM(sunorig_grid**2))

         IF ( npcbl > 0 )  THEN
!--         precompute effective box depth with prototype Leaf Area Density
            pc_box_dimshift = MAXLOC(ABS(sunorig), 1) - 1
            CALL box_absorb(CSHIFT((/dz(1),dy,dx/), pc_box_dimshift),       &
                                60, prototype_lad,                          &
                                CSHIFT(ABS(sunorig), pc_box_dimshift),      &
                                pc_box_area, pc_abs_frac)
            pc_box_area = pc_box_area * ABS(sunorig(pc_box_dimshift+1)      &
                          / sunorig(1))
            pc_abs_eff = LOG(1._wp - pc_abs_frac) / prototype_lad
         ENDIF
     ENDIF

!--  if radiation scheme is not RRTMG, split diffusion and direct part of the solar downward radiation
!--  comming from radiation model and store it in 2D arrays
     IF (  radiation_scheme /= 'rrtmg'  )  CALL calc_diffusion_radiation

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!--     First pass: direct + diffuse irradiance + thermal
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     surfinswdir   = 0._wp !nsurfl
     surfins       = 0._wp !nsurfl
     surfinl       = 0._wp !nsurfl
     surfoutsl(:)  = 0.0_wp !start-end
     surfoutll(:)  = 0.0_wp !start-end
     IF ( nmrtbl > 0 )  THEN
        mrtinsw(:) = 0._wp
        mrtinlw(:) = 0._wp
     ENDIF
     surfinlg(:)  = 0._wp !global


!--  Set up thermal radiation from surfaces
!--  emiss_surf is defined only for surfaces for which energy balance is calculated
!--  Workaround: reorder surface data type back on 1D array including all surfaces,
!--  which implies to reorder horizontal and vertical surfaces
!
!--  Horizontal walls
     mm = 1
     DO  i = nxl, nxr
        DO  j = nys, nyn
!--           urban
           DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
              surfoutll(mm) = SUM ( surf_usm_h%frac(:,m) *                  &
                                    surf_usm_h%emissivity(:,m) )            &
                                  * sigma_sb                                &
                                  * surf_usm_h%pt_surface(m)**4
              albedo_surf(mm) = SUM ( surf_usm_h%frac(:,m) *                &
                                      surf_usm_h%albedo(:,m) )
              emiss_surf(mm)  = SUM ( surf_usm_h%frac(:,m) *                &
                                      surf_usm_h%emissivity(:,m) )
              mm = mm + 1
           ENDDO
!--           land
           DO  m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
              surfoutll(mm) = SUM ( surf_lsm_h%frac(:,m) *                  &
                                    surf_lsm_h%emissivity(:,m) )            &
                                  * sigma_sb                                &
                                  * surf_lsm_h%pt_surface(m)**4
              albedo_surf(mm) = SUM ( surf_lsm_h%frac(:,m) *                &
                                      surf_lsm_h%albedo(:,m) )
              emiss_surf(mm)  = SUM ( surf_lsm_h%frac(:,m) *                &
                                      surf_lsm_h%emissivity(:,m) )
              mm = mm + 1
           ENDDO
        ENDDO
     ENDDO
!
!--     Vertical walls
     DO  i = nxl, nxr
        DO  j = nys, nyn
           DO  ll = 0, 3
              l = reorder(ll)
!--              urban
              DO  m = surf_usm_v(l)%start_index(j,i),                       &
                      surf_usm_v(l)%end_index(j,i)
                 surfoutll(mm) = SUM ( surf_usm_v(l)%frac(:,m) *            &
                                       surf_usm_v(l)%emissivity(:,m) )      &
                                  * sigma_sb                                &
                                  * surf_usm_v(l)%pt_surface(m)**4
                 albedo_surf(mm) = SUM ( surf_usm_v(l)%frac(:,m) *          &
                                         surf_usm_v(l)%albedo(:,m) )
                 emiss_surf(mm)  = SUM ( surf_usm_v(l)%frac(:,m) *          &
                                         surf_usm_v(l)%emissivity(:,m) )
                 mm = mm + 1
              ENDDO
!--              land
              DO  m = surf_lsm_v(l)%start_index(j,i),                       &
                      surf_lsm_v(l)%end_index(j,i)
                 surfoutll(mm) = SUM ( surf_lsm_v(l)%frac(:,m) *            &
                                       surf_lsm_v(l)%emissivity(:,m) )      &
                                  * sigma_sb                                &
                                  * surf_lsm_v(l)%pt_surface(m)**4
                 albedo_surf(mm) = SUM ( surf_lsm_v(l)%frac(:,m) *          &
                                         surf_lsm_v(l)%albedo(:,m) )
                 emiss_surf(mm)  = SUM ( surf_lsm_v(l)%frac(:,m) *          &
                                         surf_lsm_v(l)%emissivity(:,m) )
                 mm = mm + 1
              ENDDO
           ENDDO
        ENDDO
     ENDDO

#if defined( __parallel )
!--     might be optimized and gather only values relevant for current processor
     CALL MPI_AllGatherv(surfoutll, nsurfl, MPI_REAL, &
                         surfoutl, nsurfs, surfstart, MPI_REAL, comm2d, ierr) !nsurf global
     IF ( ierr /= 0 ) THEN
         WRITE(9,*) 'Error MPI_AllGatherv1:', ierr, SIZE(surfoutll), nsurfl, &
                     SIZE(surfoutl), nsurfs, surfstart
         FLUSH(9)
     ENDIF
#else
     surfoutl(:) = surfoutll(:) !nsurf global
#endif

     IF ( surface_reflections)  THEN
        DO  isvf = 1, nsvfl
           isurf = svfsurf(1, isvf)
           k     = surfl(iz, isurf)
           j     = surfl(iy, isurf)
           i     = surfl(ix, isurf)
           isurfsrc = svfsurf(2, isvf)
!
!--        For surface-to-surface factors we calculate thermal radiation in 1st pass
           IF ( plant_lw_interact )  THEN
              surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * svf(2,isvf) * surfoutl(isurfsrc)
           ELSE
              surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
           ENDIF
        ENDDO
     ENDIF
!
!--  diffuse radiation using sky view factor
     DO isurf = 1, nsurfl
        j = surfl(iy, isurf)
        i = surfl(ix, isurf)
        surfinswdif(isurf) = rad_sw_in_diff(j,i) * skyvft(isurf)
        IF ( plant_lw_interact )  THEN
           surfinlwdif(isurf) = rad_lw_in_diff(j,i) * skyvft(isurf)
        ELSE
           surfinlwdif(isurf) = rad_lw_in_diff(j,i) * skyvf(isurf)
        ENDIF
     ENDDO
!
!--  MRT diffuse irradiance
     DO  imrt = 1, nmrtbl
        j = mrtbl(iy, imrt)
        i = mrtbl(ix, imrt)
        mrtinsw(imrt) = mrtskyt(imrt) * rad_sw_in_diff(j,i)
        mrtinlw(imrt) = mrtsky(imrt) * rad_lw_in_diff(j,i)
     ENDDO

     !-- direct radiation
     IF ( zenith(0) > 0 )  THEN
        !--Identify solar direction vector (discretized number) 1)
        !--
        j = FLOOR(ACOS(zenith(0)) / pi * raytrace_discrete_elevs)
        i = MODULO(NINT(ATAN2(sun_dir_lon(0), sun_dir_lat(0))               &
                        / (2._wp*pi) * raytrace_discrete_azims-.5_wp, iwp), &
                   raytrace_discrete_azims)
        isd = dsidir_rev(j, i)
!-- TODO: check if isd = -1 to report that this solar position is not precalculated
        DO isurf = 1, nsurfl
           j = surfl(iy, isurf)
           i = surfl(ix, isurf)
           surfinswdir(isurf) = rad_sw_in_dir(j,i) *                        &
                costheta(surfl(id, isurf)) * dsitrans(isurf, isd) / zenith(0)
        ENDDO
!
!--     MRT direct irradiance
        DO  imrt = 1, nmrtbl
           j = mrtbl(iy, imrt)
           i = mrtbl(ix, imrt)
           mrtinsw(imrt) = mrtinsw(imrt) + mrtdsit(imrt, isd) * rad_sw_in_dir(j,i) &
                                     / zenith(0) / 4._wp ! normal to sphere
        ENDDO
     ENDIF
!
!--  MRT first pass thermal
     DO  imrtf = 1, nmrtf
        imrt = mrtfsurf(1, imrtf)
        isurfsrc = mrtfsurf(2, imrtf)
        mrtinlw(imrt) = mrtinlw(imrt) + mrtf(imrtf) * surfoutl(isurfsrc)
     ENDDO

     IF ( npcbl > 0 )  THEN

         pcbinswdir(:) = 0._wp
         pcbinswdif(:) = 0._wp
         pcbinlw(:) = 0._wp
!
!--      pcsf first pass
         DO icsf = 1, ncsfl
             ipcgb = csfsurf(1, icsf)
             i = pcbl(ix,ipcgb)
             j = pcbl(iy,ipcgb)
             k = pcbl(iz,ipcgb)
             isurfsrc = csfsurf(2, icsf)

             IF ( isurfsrc == -1 )  THEN
!
!--             Diffuse rad from sky.
                pcbinswdif(ipcgb) = csf(1,icsf) * rad_sw_in_diff(j,i)
!
!--             Absorbed diffuse LW from sky minus emitted to sky
                IF ( plant_lw_interact )  THEN
                   pcbinlw(ipcgb) = csf(1,icsf)                                  &
                                       * (rad_lw_in_diff(j, i)                   &
                                          - sigma_sb * (pt(k,j,i)*exner(k))**4)
                ENDIF
!
!--             Direct rad
                IF ( zenith(0) > 0 )  THEN
!--                Estimate directed box absorption
                   pc_abs_frac = 1._wp - exp(pc_abs_eff * lad_s(k,j,i))
!
!--                isd has already been established, see 1)
                   pcbinswdir(ipcgb) = rad_sw_in_dir(j, i) * pc_box_area &
                                       * pc_abs_frac * dsitransc(ipcgb, isd)
                ENDIF
             ELSE
                IF ( plant_lw_interact )  THEN
!
!--                Thermal emission from plan canopy towards respective face
                   pcrad = sigma_sb * (pt(k,j,i) * exner(k))**4 * csf(1,icsf)
                   surfinlg(isurfsrc) = surfinlg(isurfsrc) + pcrad
!
!--                Remove the flux above + absorb LW from first pass from surfaces
                   asrc = facearea(surf(id, isurfsrc))
                   pcbinlw(ipcgb) = pcbinlw(ipcgb)                      &
                                    + (csf(1,icsf) * surfoutl(isurfsrc) & ! Absorb from first pass surf emit
                                       - pcrad)                         & ! Remove emitted heatflux
                                    * asrc
                ENDIF
             ENDIF
         ENDDO

         pcbinsw(:) = pcbinswdir(:) + pcbinswdif(:)
     ENDIF

     IF ( plant_lw_interact )  THEN
!
!--     Exchange incoming lw radiation from plant canopy
#if defined( __parallel )
        CALL MPI_Allreduce(MPI_IN_PLACE, surfinlg, nsurf, MPI_REAL, MPI_SUM, comm2d, ierr)
        IF ( ierr /= 0 )  THEN
           WRITE (9,*) 'Error MPI_Allreduce:', ierr
           FLUSH(9)
        ENDIF
        surfinl(:) = surfinl(:) + surfinlg(surfstart(myid)+1:surfstart(myid+1))
#else
        surfinl(:) = surfinl(:) + surfinlg(:)
#endif
     ENDIF

     surfins = surfinswdir + surfinswdif
     surfinl = surfinl + surfinlwdif
     surfinsw = surfins
     surfinlw = surfinl
     surfoutsw = 0.0_wp
     surfoutlw = surfoutll
     surfemitlwl = surfoutll

     IF ( .NOT.  surface_reflections )  THEN
!
!--     Set nrefsteps to 0 to disable reflections        
        nrefsteps = 0
        surfoutsl = albedo_surf * surfins
        surfoutll = (1._wp - emiss_surf) * surfinl
        surfoutsw = surfoutsw + surfoutsl
        surfoutlw = surfoutlw + surfoutll
     ENDIF

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!--     Next passes - reflections
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     DO refstep = 1, nrefsteps

         surfoutsl = albedo_surf * surfins
!--         for non-transparent surfaces, longwave albedo is 1 - emissivity
         surfoutll = (1._wp - emiss_surf) * surfinl

#if defined( __parallel )
         CALL MPI_AllGatherv(surfoutsl, nsurfl, MPI_REAL, &
             surfouts, nsurfs, surfstart, MPI_REAL, comm2d, ierr)
         IF ( ierr /= 0 ) THEN
             WRITE(9,*) 'Error MPI_AllGatherv2:', ierr, SIZE(surfoutsl), nsurfl, &
                        SIZE(surfouts), nsurfs, surfstart
             FLUSH(9)
         ENDIF

         CALL MPI_AllGatherv(surfoutll, nsurfl, MPI_REAL, &
             surfoutl, nsurfs, surfstart, MPI_REAL, comm2d, ierr)
         IF ( ierr /= 0 ) THEN
             WRITE(9,*) 'Error MPI_AllGatherv3:', ierr, SIZE(surfoutll), nsurfl, &
                        SIZE(surfoutl), nsurfs, surfstart
             FLUSH(9)
         ENDIF

#else
         surfouts = surfoutsl
         surfoutl = surfoutll
#endif

!--         reset for next pass input
         surfins = 0._wp
         surfinl = 0._wp

!--         reflected radiation
         DO isvf = 1, nsvfl
             isurf = svfsurf(1, isvf)
             isurfsrc = svfsurf(2, isvf)
             surfins(isurf) = surfins(isurf) + svf(1,isvf) * svf(2,isvf) * surfouts(isurfsrc)
             IF ( plant_lw_interact )  THEN
                surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * svf(2,isvf) * surfoutl(isurfsrc)
             ELSE
                surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
             ENDIF
         ENDDO
!
!--      NOTE: PC absorbtion and MRT from reflected can both be done at once
!--      after all reflections if we do one more MPI_ALLGATHERV on surfout.
!--      Advantage: less local computation. Disadvantage: one more collective
!--      MPI call.
!
!--      Radiation absorbed by plant canopy
         DO  icsf = 1, ncsfl
             ipcgb = csfsurf(1, icsf)
             isurfsrc = csfsurf(2, icsf)
             IF ( isurfsrc == -1 )  CYCLE ! sky->face only in 1st pass, not here
!
!--          Calculate source surface area. If the `surf' array is removed
!--          before timestepping starts (future version), then asrc must be
!--          stored within `csf'
             asrc = facearea(surf(id, isurfsrc))
             pcbinsw(ipcgb) = pcbinsw(ipcgb) + csf(1,icsf) * surfouts(isurfsrc) * asrc
             IF ( plant_lw_interact )  THEN
                pcbinlw(ipcgb) = pcbinlw(ipcgb) + csf(1,icsf) * surfoutl(isurfsrc) * asrc
             ENDIF
         ENDDO
!
!--      MRT reflected
         DO  imrtf = 1, nmrtf
            imrt = mrtfsurf(1, imrtf)
            isurfsrc = mrtfsurf(2, imrtf)
            mrtinsw(imrt) = mrtinsw(imrt) + mrtft(imrtf) * surfouts(isurfsrc)
            mrtinlw(imrt) = mrtinlw(imrt) + mrtf(imrtf) * surfoutl(isurfsrc)
         ENDDO

         surfinsw = surfinsw  + surfins
         surfinlw = surfinlw  + surfinl
         surfoutsw = surfoutsw + surfoutsl
         surfoutlw = surfoutlw + surfoutll

     ENDDO ! refstep

!--  push heat flux absorbed by plant canopy to respective 3D arrays
     IF ( npcbl > 0 )  THEN
         pc_heating_rate(:,:,:) = 0.0_wp
         DO ipcgb = 1, npcbl
             j = pcbl(iy, ipcgb)
             i = pcbl(ix, ipcgb)
             k = pcbl(iz, ipcgb)
!
!--          Following expression equals former kk = k - nzb_s_inner(j,i)
             kk = k - get_topography_top_index_ji( j, i, 's' )  !- lad arrays are defined flat
             pc_heating_rate(kk, j, i) = (pcbinsw(ipcgb) + pcbinlw(ipcgb)) &
                 * pchf_prep(k) * pt(k, j, i) !-- = dT/dt
         ENDDO

         IF ( humidity .AND. plant_canopy_transpiration ) THEN
!--          Calculation of plant canopy transpiration rate and correspondidng latent heat rate
             pc_transpiration_rate(:,:,:) = 0.0_wp
             pc_latent_rate(:,:,:) = 0.0_wp
             DO ipcgb = 1, npcbl
                 i = pcbl(ix, ipcgb)
                 j = pcbl(iy, ipcgb)
                 k = pcbl(iz, ipcgb)
                 kk = k - get_topography_top_index_ji( j, i, 's' )  !- lad arrays are defined flat
                 CALL pcm_calc_transpiration_rate( i, j, k, kk, pcbinsw(ipcgb), pcbinlw(ipcgb), &
                                                   pc_transpiration_rate(kk,j,i), pc_latent_rate(kk,j,i) )
              ENDDO
         ENDIF
     ENDIF
!
!--  Calculate black body MRT (after all reflections)
     IF ( nmrtbl > 0 )  THEN
        IF ( mrt_include_sw )  THEN
           mrt(:) = ((mrtinsw(:) + mrtinlw(:)) / sigma_sb) ** .25_wp
        ELSE
           mrt(:) = (mrtinlw(:) / sigma_sb) ** .25_wp
        ENDIF
     ENDIF
!
!--     Transfer radiation arrays required for energy balance to the respective data types
     DO  i = 1, nsurfl
        m  = surfl(5,i)
!
!--     (1) Urban surfaces
!--     upward-facing
        IF ( surfl(1,i) == iup_u )  THEN
           surf_usm_h%rad_sw_in(m)  = surfinsw(i)
           surf_usm_h%rad_sw_out(m) = surfoutsw(i)
           surf_usm_h%rad_sw_dir(m) = surfinswdir(i)
           surf_usm_h%rad_sw_dif(m) = surfinswdif(i)
           surf_usm_h%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -        &
                                      surfinswdif(i)
           surf_usm_h%rad_sw_res(m) = surfins(i)
           surf_usm_h%rad_lw_in(m)  = surfinlw(i)
           surf_usm_h%rad_lw_out(m) = surfoutlw(i)
           surf_usm_h%rad_net(m)    = surfinsw(i) - surfoutsw(i) +          &
                                      surfinlw(i) - surfoutlw(i)
           surf_usm_h%rad_net_l(m)  = surf_usm_h%rad_net(m)
           surf_usm_h%rad_lw_dif(m) = surfinlwdif(i)
           surf_usm_h%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_usm_h%rad_lw_res(m) = surfinl(i)
!
!--     northward-facding
        ELSEIF ( surfl(1,i) == inorth_u )  THEN
           surf_usm_v(0)%rad_sw_in(m)  = surfinsw(i)
           surf_usm_v(0)%rad_sw_out(m) = surfoutsw(i)
           surf_usm_v(0)%rad_sw_dir(m) = surfinswdir(i)
           surf_usm_v(0)%rad_sw_dif(m) = surfinswdif(i)
           surf_usm_v(0)%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -     &
                                         surfinswdif(i)
           surf_usm_v(0)%rad_sw_res(m) = surfins(i)
           surf_usm_v(0)%rad_lw_in(m)  = surfinlw(i)
           surf_usm_v(0)%rad_lw_out(m) = surfoutlw(i)
           surf_usm_v(0)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
                                         surfinlw(i) - surfoutlw(i)
           surf_usm_v(0)%rad_net_l(m)  = surf_usm_v(0)%rad_net(m)
           surf_usm_v(0)%rad_lw_dif(m) = surfinlwdif(i)
           surf_usm_v(0)%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_usm_v(0)%rad_lw_res(m) = surfinl(i)
!
!--     southward-facding
        ELSEIF ( surfl(1,i) == isouth_u )  THEN
           surf_usm_v(1)%rad_sw_in(m)  = surfinsw(i)
           surf_usm_v(1)%rad_sw_out(m) = surfoutsw(i)
           surf_usm_v(1)%rad_sw_dir(m) = surfinswdir(i)
           surf_usm_v(1)%rad_sw_dif(m) = surfinswdif(i)
           surf_usm_v(1)%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -     &
                                         surfinswdif(i)
           surf_usm_v(1)%rad_sw_res(m) = surfins(i)
           surf_usm_v(1)%rad_lw_in(m)  = surfinlw(i)
           surf_usm_v(1)%rad_lw_out(m) = surfoutlw(i)
           surf_usm_v(1)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
                                         surfinlw(i) - surfoutlw(i)
           surf_usm_v(1)%rad_net_l(m)  = surf_usm_v(1)%rad_net(m)
           surf_usm_v(1)%rad_lw_dif(m) = surfinlwdif(i)
           surf_usm_v(1)%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_usm_v(1)%rad_lw_res(m) = surfinl(i)
!
!--     eastward-facing
        ELSEIF ( surfl(1,i) == ieast_u )  THEN
           surf_usm_v(2)%rad_sw_in(m)  = surfinsw(i)
           surf_usm_v(2)%rad_sw_out(m) = surfoutsw(i)
           surf_usm_v(2)%rad_sw_dir(m) = surfinswdir(i)
           surf_usm_v(2)%rad_sw_dif(m) = surfinswdif(i)
           surf_usm_v(2)%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -     &
                                         surfinswdif(i)
           surf_usm_v(2)%rad_sw_res(m) = surfins(i)
           surf_usm_v(2)%rad_lw_in(m)  = surfinlw(i)
           surf_usm_v(2)%rad_lw_out(m) = surfoutlw(i)
           surf_usm_v(2)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
                                         surfinlw(i) - surfoutlw(i)
           surf_usm_v(2)%rad_net_l(m)  = surf_usm_v(2)%rad_net(m)
           surf_usm_v(2)%rad_lw_dif(m) = surfinlwdif(i)
           surf_usm_v(2)%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_usm_v(2)%rad_lw_res(m) = surfinl(i)
!
!--     westward-facding
        ELSEIF ( surfl(1,i) == iwest_u )  THEN
           surf_usm_v(3)%rad_sw_in(m)  = surfinsw(i)
           surf_usm_v(3)%rad_sw_out(m) = surfoutsw(i)
           surf_usm_v(3)%rad_sw_dir(m) = surfinswdir(i)
           surf_usm_v(3)%rad_sw_dif(m) = surfinswdif(i)
           surf_usm_v(3)%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -     &
                                         surfinswdif(i)
           surf_usm_v(3)%rad_sw_res(m) = surfins(i)
           surf_usm_v(3)%rad_lw_in(m)  = surfinlw(i)
           surf_usm_v(3)%rad_lw_out(m) = surfoutlw(i)
           surf_usm_v(3)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
                                         surfinlw(i) - surfoutlw(i)
           surf_usm_v(3)%rad_net_l(m)  = surf_usm_v(3)%rad_net(m)
           surf_usm_v(3)%rad_lw_dif(m) = surfinlwdif(i)
           surf_usm_v(3)%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_usm_v(3)%rad_lw_res(m) = surfinl(i)
!
!--     (2) land surfaces
!--     upward-facing
        ELSEIF ( surfl(1,i) == iup_l )  THEN
           surf_lsm_h%rad_sw_in(m)  = surfinsw(i)
           surf_lsm_h%rad_sw_out(m) = surfoutsw(i)
           surf_lsm_h%rad_sw_dir(m) = surfinswdir(i)
           surf_lsm_h%rad_sw_dif(m) = surfinswdif(i)
           surf_lsm_h%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -        &
                                         surfinswdif(i)
           surf_lsm_h%rad_sw_res(m) = surfins(i)
           surf_lsm_h%rad_lw_in(m)  = surfinlw(i)
           surf_lsm_h%rad_lw_out(m) = surfoutlw(i)
           surf_lsm_h%rad_net(m)    = surfinsw(i) - surfoutsw(i) +          &
                                      surfinlw(i) - surfoutlw(i)
           surf_lsm_h%rad_lw_dif(m) = surfinlwdif(i)
           surf_lsm_h%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_lsm_h%rad_lw_res(m) = surfinl(i)
!
!--     northward-facding
        ELSEIF ( surfl(1,i) == inorth_l )  THEN
           surf_lsm_v(0)%rad_sw_in(m)  = surfinsw(i)
           surf_lsm_v(0)%rad_sw_out(m) = surfoutsw(i)
           surf_lsm_v(0)%rad_sw_dir(m) = surfinswdir(i)
           surf_lsm_v(0)%rad_sw_dif(m) = surfinswdif(i)
           surf_lsm_v(0)%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -     &
                                         surfinswdif(i)
           surf_lsm_v(0)%rad_sw_res(m) = surfins(i)
           surf_lsm_v(0)%rad_lw_in(m)  = surfinlw(i)
           surf_lsm_v(0)%rad_lw_out(m) = surfoutlw(i)
           surf_lsm_v(0)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
                                         surfinlw(i) - surfoutlw(i)
           surf_lsm_v(0)%rad_lw_dif(m) = surfinlwdif(i)
           surf_lsm_v(0)%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_lsm_v(0)%rad_lw_res(m) = surfinl(i)
!
!--     southward-facding
        ELSEIF ( surfl(1,i) == isouth_l )  THEN
           surf_lsm_v(1)%rad_sw_in(m)  = surfinsw(i)
           surf_lsm_v(1)%rad_sw_out(m) = surfoutsw(i)
           surf_lsm_v(1)%rad_sw_dir(m) = surfinswdir(i)
           surf_lsm_v(1)%rad_sw_dif(m) = surfinswdif(i)
           surf_lsm_v(1)%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -     &
                                         surfinswdif(i)
           surf_lsm_v(1)%rad_sw_res(m) = surfins(i)
           surf_lsm_v(1)%rad_lw_in(m)  = surfinlw(i)
           surf_lsm_v(1)%rad_lw_out(m) = surfoutlw(i)
           surf_lsm_v(1)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
                                         surfinlw(i) - surfoutlw(i)
           surf_lsm_v(1)%rad_lw_dif(m) = surfinlwdif(i)
           surf_lsm_v(1)%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_lsm_v(1)%rad_lw_res(m) = surfinl(i)
!
!--     eastward-facing
        ELSEIF ( surfl(1,i) == ieast_l )  THEN
           surf_lsm_v(2)%rad_sw_in(m)  = surfinsw(i)
           surf_lsm_v(2)%rad_sw_out(m) = surfoutsw(i)
           surf_lsm_v(2)%rad_sw_dir(m) = surfinswdir(i)
           surf_lsm_v(2)%rad_sw_dif(m) = surfinswdif(i)
           surf_lsm_v(2)%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -     &
                                         surfinswdif(i)
           surf_lsm_v(2)%rad_sw_res(m) = surfins(i)
           surf_lsm_v(2)%rad_lw_in(m)  = surfinlw(i)
           surf_lsm_v(2)%rad_lw_out(m) = surfoutlw(i)
           surf_lsm_v(2)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
                                         surfinlw(i) - surfoutlw(i)
           surf_lsm_v(2)%rad_lw_dif(m) = surfinlwdif(i)
           surf_lsm_v(2)%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_lsm_v(2)%rad_lw_res(m) = surfinl(i)
!
!--     westward-facing
        ELSEIF ( surfl(1,i) == iwest_l )  THEN
           surf_lsm_v(3)%rad_sw_in(m)  = surfinsw(i)
           surf_lsm_v(3)%rad_sw_out(m) = surfoutsw(i)
           surf_lsm_v(3)%rad_sw_dir(m) = surfinswdir(i)
           surf_lsm_v(3)%rad_sw_dif(m) = surfinswdif(i)
           surf_lsm_v(3)%rad_sw_ref(m) = surfinsw(i) - surfinswdir(i) -     &
                                         surfinswdif(i)
           surf_lsm_v(3)%rad_sw_res(m) = surfins(i)
           surf_lsm_v(3)%rad_lw_in(m)  = surfinlw(i)
           surf_lsm_v(3)%rad_lw_out(m) = surfoutlw(i)
           surf_lsm_v(3)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
                                         surfinlw(i) - surfoutlw(i)
           surf_lsm_v(3)%rad_lw_dif(m) = surfinlwdif(i)
           surf_lsm_v(3)%rad_lw_ref(m) = surfinlw(i) - surfinlwdif(i)
           surf_lsm_v(3)%rad_lw_res(m) = surfinl(i)
        ENDIF

     ENDDO

     DO  m = 1, surf_usm_h%ns
        surf_usm_h%surfhf(m) = surf_usm_h%rad_sw_in(m)  +                   &
                               surf_usm_h%rad_lw_in(m)  -                   &
                               surf_usm_h%rad_sw_out(m) -                   &
                               surf_usm_h%rad_lw_out(m)
     ENDDO
     DO  m = 1, surf_lsm_h%ns
        surf_lsm_h%surfhf(m) = surf_lsm_h%rad_sw_in(m)  +                   &
                               surf_lsm_h%rad_lw_in(m)  -                   &
                               surf_lsm_h%rad_sw_out(m) -                   &
                               surf_lsm_h%rad_lw_out(m)
     ENDDO

     DO  l = 0, 3
!--     urban
        DO  m = 1, surf_usm_v(l)%ns
           surf_usm_v(l)%surfhf(m) = surf_usm_v(l)%rad_sw_in(m)  +          &
                                     surf_usm_v(l)%rad_lw_in(m)  -          &
                                     surf_usm_v(l)%rad_sw_out(m) -          &
                                     surf_usm_v(l)%rad_lw_out(m)
        ENDDO
!--     land
        DO  m = 1, surf_lsm_v(l)%ns
           surf_lsm_v(l)%surfhf(m) = surf_lsm_v(l)%rad_sw_in(m)  +          &
                                     surf_lsm_v(l)%rad_lw_in(m)  -          &
                                     surf_lsm_v(l)%rad_sw_out(m) -          &
                                     surf_lsm_v(l)%rad_lw_out(m)

        ENDDO
     ENDDO
!
!--  Calculate the average temperature, albedo, and emissivity for urban/land
!--  domain when using average_radiation in the respective radiation model

!--  calculate horizontal area
! !!! ATTENTION!!! uniform grid is assumed here
     area_hor = (nx+1) * (ny+1) * dx * dy
!
!--  absorbed/received SW & LW and emitted LW energy of all physical
!--  surfaces (land and urban) in local processor
     pinswl = 0._wp
     pinlwl = 0._wp
     pabsswl = 0._wp
     pabslwl = 0._wp
     pemitlwl = 0._wp
     emiss_sum_surfl = 0._wp
     area_surfl = 0._wp
     DO  i = 1, nsurfl
        d = surfl(id, i)
!--  received SW & LW
        pinswl = pinswl + (surfinswdir(i) + surfinswdif(i)) * facearea(d)
        pinlwl = pinlwl + surfinlwdif(i) * facearea(d)
!--   absorbed SW & LW
        pabsswl = pabsswl + (1._wp - albedo_surf(i)) *                   &
                                                surfinsw(i) * facearea(d)
        pabslwl = pabslwl + emiss_surf(i) * surfinlw(i) * facearea(d)
!--   emitted LW
        pemitlwl = pemitlwl + surfemitlwl(i) * facearea(d)
!--   emissivity and area sum
        emiss_sum_surfl = emiss_sum_surfl + emiss_surf(i) * facearea(d)
        area_surfl = area_surfl + facearea(d)
     END DO
!
!--  add the absorbed SW energy by plant canopy
     IF ( npcbl > 0 )  THEN
        pabsswl = pabsswl + SUM(pcbinsw)
        pabslwl = pabslwl + SUM(pcbinlw)
        pinswl = pinswl + SUM(pcbinswdir) + SUM(pcbinswdif)
     ENDIF
!
!--  gather all rad flux energy in all processors
#if defined( __parallel )
     CALL MPI_ALLREDUCE( pinswl, pinsw, 1, MPI_REAL, MPI_SUM, comm2d, ierr)
     IF ( ierr /= 0 ) THEN
         WRITE(9,*) 'Error MPI_AllReduce5:', ierr, pinswl, pinsw
         FLUSH(9)
     ENDIF
     CALL MPI_ALLREDUCE( pinlwl, pinlw, 1, MPI_REAL, MPI_SUM, comm2d, ierr)
     IF ( ierr /= 0 ) THEN
         WRITE(9,*) 'Error MPI_AllReduce6:', ierr, pinlwl, pinlw
         FLUSH(9)
     ENDIF
     CALL MPI_ALLREDUCE( pabsswl, pabssw, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
     IF ( ierr /= 0 ) THEN
         WRITE(9,*) 'Error MPI_AllReduce7:', ierr, pabsswl, pabssw
         FLUSH(9)
     ENDIF
     CALL MPI_ALLREDUCE( pabslwl, pabslw, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
     IF ( ierr /= 0 ) THEN
         WRITE(9,*) 'Error MPI_AllReduce8:', ierr, pabslwl, pabslw
         FLUSH(9)
     ENDIF
     CALL MPI_ALLREDUCE( pemitlwl, pemitlw, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
     IF ( ierr /= 0 ) THEN
         WRITE(9,*) 'Error MPI_AllReduce8:', ierr, pemitlwl, pemitlw
         FLUSH(9)
     ENDIF
     CALL MPI_ALLREDUCE( emiss_sum_surfl, emiss_sum_surf, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
     IF ( ierr /= 0 ) THEN
         WRITE(9,*) 'Error MPI_AllReduce9:', ierr, emiss_sum_surfl, emiss_sum_surf
         FLUSH(9)
     ENDIF
     CALL MPI_ALLREDUCE( area_surfl, area_surf, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
     IF ( ierr /= 0 ) THEN
         WRITE(9,*) 'Error MPI_AllReduce10:', ierr, area_surfl, area_surf
         FLUSH(9)
     ENDIF
#else
     pinsw = pinswl
     pinlw = pinlwl
     pabssw = pabsswl
     pabslw = pabslwl
     pemitlw = pemitlwl
     emiss_sum_surf = emiss_sum_surfl
     area_surf = area_surfl
#endif

!--  (1) albedo
     IF ( pinsw /= 0.0_wp )  &
          albedo_urb = (pinsw - pabssw) / pinsw
!--  (2) average emmsivity
     IF ( area_surf /= 0.0_wp ) &
          emissivity_urb = emiss_sum_surf / area_surf
!
!--  Temporally comment out calculation of effective radiative temperature. 
!--  See below for more explanation.
!--  (3) temperature
!--   first we calculate an effective horizontal area to account for
!--   the effect of vertical surfaces (which contributes to LW emission)
!--   We simply use the ratio of the total LW to the incoming LW flux 
      area_hor = pinlw/rad_lw_in_diff(nyn,nxl)
      t_rad_urb = ( (pemitlw - pabslw + emissivity_urb*pinlw) / &
           (emissivity_urb*sigma_sb * area_hor) )**0.25_wp

    CONTAINS

!------------------------------------------------------------------------------!
!> Calculates radiation absorbed by box with given size and LAD.
!>
!> Simulates resol**2 rays (by equally spacing a bounding horizontal square
!> conatining all possible rays that would cross the box) and calculates
!> average transparency per ray. Returns fraction of absorbed radiation flux
!> and area for which this fraction is effective.
!------------------------------------------------------------------------------!
    PURE SUBROUTINE box_absorb(boxsize, resol, dens, uvec, area, absorb)
       IMPLICIT NONE

       REAL(wp), DIMENSION(3), INTENT(in) :: &
            boxsize, &      !< z, y, x size of box in m
            uvec            !< z, y, x unit vector of incoming flux
       INTEGER(iwp), INTENT(in) :: &
            resol           !< No. of rays in x and y dimensions
       REAL(wp), INTENT(in) :: &
            dens            !< box density (e.g. Leaf Area Density)
       REAL(wp), INTENT(out) :: &
            area, &         !< horizontal area for flux absorbtion
            absorb          !< fraction of absorbed flux
       REAL(wp) :: &
            xshift, yshift, &
            xmin, xmax, ymin, ymax, &
            xorig, yorig, &
            dx1, dy1, dz1, dx2, dy2, dz2, &
            crdist, &
            transp
       INTEGER(iwp) :: &
            i, j

       xshift = uvec(3) / uvec(1) * boxsize(1)
       xmin = min(0._wp, -xshift)
       xmax = boxsize(3) + max(0._wp, -xshift)
       yshift = uvec(2) / uvec(1) * boxsize(1)
       ymin = min(0._wp, -yshift)
       ymax = boxsize(2) + max(0._wp, -yshift)

       transp = 0._wp
       DO i = 1, resol
          xorig = xmin + (xmax-xmin) * (i-.5_wp) / resol
          DO j = 1, resol
             yorig = ymin + (ymax-ymin) * (j-.5_wp) / resol

             dz1 = 0._wp
             dz2 = boxsize(1)/uvec(1)

             IF ( uvec(2) > 0._wp )  THEN
                dy1 = -yorig             / uvec(2) !< crossing with y=0
                dy2 = (boxsize(2)-yorig) / uvec(2) !< crossing with y=boxsize(2)
             ELSE !uvec(2)==0
                dy1 = -huge(1._wp)
                dy2 = huge(1._wp)
             ENDIF

             IF ( uvec(3) > 0._wp )  THEN
                dx1 = -xorig             / uvec(3) !< crossing with x=0
                dx2 = (boxsize(3)-xorig) / uvec(3) !< crossing with x=boxsize(3)
             ELSE !uvec(3)==0
                dx1 = -huge(1._wp)
                dx2 = huge(1._wp)
             ENDIF

             crdist = max(0._wp, (min(dz2, dy2, dx2) - max(dz1, dy1, dx1)))
             transp = transp + exp(-ext_coef * dens * crdist)
          ENDDO
       ENDDO
       transp = transp / resol**2
       area = (boxsize(3)+xshift)*(boxsize(2)+yshift)
       absorb = 1._wp - transp

    END SUBROUTINE box_absorb

!------------------------------------------------------------------------------!
! Description:
! ------------
!> This subroutine splits direct and diffusion dw radiation
!> It sould not be called in case the radiation model already does it
!> It follows <CITATION>
!------------------------------------------------------------------------------!
    SUBROUTINE calc_diffusion_radiation 
    
        REAL(wp), PARAMETER                          :: lowest_solarUp = 0.1_wp  !< limit the sun elevation to protect stability of the calculation
        INTEGER(iwp)                                 :: i, j
        REAL(wp)                                     ::  year_angle              !< angle
        REAL(wp)                                     ::  etr                     !< extraterestrial radiation
        REAL(wp)                                     ::  corrected_solarUp       !< corrected solar up radiation
        REAL(wp)                                     ::  horizontalETR           !< horizontal extraterestrial radiation
        REAL(wp)                                     ::  clearnessIndex          !< clearness index
        REAL(wp)                                     ::  diff_frac               !< diffusion fraction of the radiation

        
!--     Calculate current day and time based on the initial values and simulation time
        year_angle = ( (day_of_year_init * 86400) + time_utc_init              &
                        + time_since_reference_point )  * d_seconds_year       &
                        * 2.0_wp * pi
        
        etr = solar_constant * (1.00011_wp +                                   &
                          0.034221_wp * cos(year_angle) +                      &
                          0.001280_wp * sin(year_angle) +                      &
                          0.000719_wp * cos(2.0_wp * year_angle) +             &
                          0.000077_wp * sin(2.0_wp * year_angle))
        
!--    
!--     Under a very low angle, we keep extraterestrial radiation at
!--     the last small value, therefore the clearness index will be pushed
!--     towards 0 while keeping full continuity.
!--    
        IF ( zenith(0) <= lowest_solarUp )  THEN
            corrected_solarUp = lowest_solarUp
        ELSE
            corrected_solarUp = zenith(0)
        ENDIF
        
        horizontalETR = etr * corrected_solarUp
        
        DO i = nxl, nxr
            DO j = nys, nyn
                clearnessIndex = rad_sw_in(0,j,i) / horizontalETR
                diff_frac = 1.0_wp / (1.0_wp + exp(-5.0033_wp + 8.6025_wp * clearnessIndex))
                rad_sw_in_diff(j,i) = rad_sw_in(0,j,i) * diff_frac
                rad_sw_in_dir(j,i)  = rad_sw_in(0,j,i) * (1.0_wp - diff_frac)
                rad_lw_in_diff(j,i) = rad_lw_in(0,j,i)
            ENDDO
        ENDDO
        
    END SUBROUTINE calc_diffusion_radiation


 END SUBROUTINE radiation_interaction
    
!------------------------------------------------------------------------------!
! Description:
! ------------
!> This subroutine initializes structures needed for radiative transfer
!> model. This model calculates transformation processes of the
!> radiation inside urban and land canopy layer. The module includes also
!> the interaction of the radiation with the resolved plant canopy.
!>
!> For more info. see Resler et al. 2017
!>
!> The new version 2.0 was radically rewriten, the discretization scheme
!> has been changed. This new version significantly improves effectivity
!> of the paralelization and the scalability of the model.
!>
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_interaction_init

       USE control_parameters,                                                 &
           ONLY:  dz_stretch_level_start
           
       USE netcdf_data_input_mod,                                              &
           ONLY:  leaf_area_density_f

       USE plant_canopy_model_mod,                                             &
           ONLY:  pch_index, lad_s

       IMPLICIT NONE

       INTEGER(iwp) :: i, j, k, l, m, d
       INTEGER(iwp) :: k_topo     !< vertical index indicating topography top for given (j,i)
       INTEGER(iwp) :: nzptl, nzubl, nzutl, isurf, ipcgb, imrt
       REAL(wp)     :: mrl
#if defined( __parallel )
       INTEGER(iwp), DIMENSION(:), POINTER       ::  gridsurf_rma   !< fortran pointer, but lower bounds are 1
       TYPE(c_ptr)                               ::  gridsurf_rma_p !< allocated c pointer
       INTEGER(iwp)                              ::  minfo          !< MPI RMA window info handle
#endif

!
!--     precalculate face areas for different face directions using normal vector
        DO d = 0, nsurf_type
            facearea(d) = 1._wp
            IF ( idir(d) == 0 ) facearea(d) = facearea(d) * dx
            IF ( jdir(d) == 0 ) facearea(d) = facearea(d) * dy
            IF ( kdir(d) == 0 ) facearea(d) = facearea(d) * dz(1)
        ENDDO
!
!--    Find nzub, nzut, nzu via wall_flag_0 array (nzb_s_inner will be
!--    removed later). The following contruct finds the lowest / largest index
!--    for any upward-facing wall (see bit 12).
       nzubl = MINVAL( get_topography_top_index( 's' ) )
       nzutl = MAXVAL( get_topography_top_index( 's' ) )

       nzubl = MAX( nzubl, nzb )

       IF ( plant_canopy )  THEN
!--        allocate needed arrays
           ALLOCATE( pct(nys:nyn,nxl:nxr) )
           ALLOCATE( pch(nys:nyn,nxl:nxr) )

!--        calculate plant canopy height
           npcbl = 0
           pct   = 0
           pch   = 0
           DO i = nxl, nxr
               DO j = nys, nyn
!
!--                Find topography top index
                   k_topo = get_topography_top_index_ji( j, i, 's' )

                   DO k = nzt+1, 0, -1
                       IF ( lad_s(k,j,i) /= 0.0_wp )  THEN
!--                        we are at the top of the pcs
                           pct(j,i) = k + k_topo
                           pch(j,i) = k
                           npcbl = npcbl + pch(j,i)
                           EXIT
                       ENDIF
                   ENDDO
               ENDDO
           ENDDO

           nzutl = MAX( nzutl, MAXVAL( pct ) )
           nzptl = MAXVAL( pct )
!--        code of plant canopy model uses parameter pch_index
!--        we need to setup it here to right value
!--        (pch_index, lad_s and other arrays in PCM are defined flat)
           pch_index = MERGE( leaf_area_density_f%nz - 1, MAXVAL( pch ),       &
                              leaf_area_density_f%from_file )

           prototype_lad = MAXVAL( lad_s ) * .9_wp  !< better be *1.0 if lad is either 0 or maxval(lad) everywhere
           IF ( prototype_lad <= 0._wp ) prototype_lad = .3_wp
           !WRITE(message_string, '(a,f6.3)') 'Precomputing effective box optical ' &
           !    // 'depth using prototype leaf area density = ', prototype_lad
           !CALL message('usm_init_urban_surface', 'PA0520', 0, 0, -1, 6, 0)
       ENDIF

       nzutl = MIN( nzutl + nzut_free, nzt )

#if defined( __parallel )
       CALL MPI_AllReduce(nzubl, nzub, 1, MPI_INTEGER, MPI_MIN, comm2d, ierr )
       IF ( ierr /= 0 ) THEN
           WRITE(9,*) 'Error MPI_AllReduce11:', ierr, nzubl, nzub
           FLUSH(9)
       ENDIF
       CALL MPI_AllReduce(nzutl, nzut, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
       IF ( ierr /= 0 ) THEN
           WRITE(9,*) 'Error MPI_AllReduce12:', ierr, nzutl, nzut
           FLUSH(9)
       ENDIF
       CALL MPI_AllReduce(nzptl, nzpt, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
       IF ( ierr /= 0 ) THEN
           WRITE(9,*) 'Error MPI_AllReduce13:', ierr, nzptl, nzpt
           FLUSH(9)
       ENDIF
#else
       nzub = nzubl
       nzut = nzutl
       nzpt = nzptl
#endif
!
!--    Stretching (non-uniform grid spacing) is not considered in the radiation 
!--    model. Therefore, vertical stretching has to be applied above the area 
!--    where the parts of the radiation model which assume constant grid spacing
!--    are active. ABS (...) is required because the default value of 
!--    dz_stretch_level_start is -9999999.9_wp (negative). 
       IF ( ABS( dz_stretch_level_start(1) ) <= zw(nzut) ) THEN
          WRITE( message_string, * ) 'The lowest level where vertical ',       &
                                     'stretching is applied have to be ',      &
                                     'greater than ', zw(nzut)
          CALL message( 'radiation_interaction_init', 'PA0496', 1, 2, 0, 6, 0 )
       ENDIF 
!
!--    global number of urban and plant layers
       nzu = nzut - nzub + 1
       nzp = nzpt - nzub + 1
!
!--    check max_raytracing_dist relative to urban surface layer height
       mrl = 2.0_wp * nzu * dz(1)
!--    set max_raytracing_dist to double the urban surface layer height, if not set
       IF ( max_raytracing_dist == -999.0_wp ) THEN
          max_raytracing_dist = mrl
       ENDIF
!--    check if max_raytracing_dist set too low (here we only warn the user. Other
!      option is to correct the value again to double the urban surface layer height)
       IF ( max_raytracing_dist  <  mrl ) THEN
          WRITE(message_string, '(a,f6.1)') 'Max_raytracing_dist is set less than ', &
               'double the urban surface layer height, i.e. ', mrl
          CALL message('radiation_interaction_init', 'PA0521', 0, 0, -1, 6, 0)
       ENDIF
!        IF ( max_raytracing_dist <= mrl ) THEN
!           IF ( max_raytracing_dist /= -999.0_wp ) THEN
! !--          max_raytracing_dist too low
!              WRITE(message_string, '(a,f6.1)') 'Max_raytracing_dist too low, ' &
!                    // 'override to value ', mrl
!              CALL message('radiation_interaction_init', 'PA0521', 0, 0, -1, 6, 0)
!           ENDIF
!           max_raytracing_dist = mrl
!        ENDIF
!
!--    allocate urban surfaces grid
!--    calc number of surfaces in local proc
       CALL location_message( '    calculation of indices for surfaces', .TRUE. )
       nsurfl = 0
!
!--    Number of horizontal surfaces including land- and roof surfaces in both USM and LSM. Note that
!--    All horizontal surface elements are already counted in surface_mod.
       startland = 1
       nsurfl    = surf_usm_h%ns + surf_lsm_h%ns
       endland   = nsurfl
       nlands    = endland - startland + 1

!
!--    Number of vertical surfaces in both USM and LSM. Note that all vertical surface elements are
!--    already counted in surface_mod.
       startwall = nsurfl+1
       DO  i = 0,3
          nsurfl = nsurfl + surf_usm_v(i)%ns + surf_lsm_v(i)%ns
       ENDDO
       endwall = nsurfl
       nwalls  = endwall - startwall + 1
       dirstart = (/ startland, startwall, startwall, startwall, startwall /)
       dirend = (/ endland, endwall, endwall, endwall, endwall /)

!--    fill gridpcbl and pcbl
       IF ( npcbl > 0 )  THEN
           ALLOCATE( pcbl(iz:ix, 1:npcbl) )
           ALLOCATE( gridpcbl(nzub:nzpt,nys:nyn,nxl:nxr) )
           pcbl = -1
           gridpcbl(:,:,:) = 0
           ipcgb = 0
           DO i = nxl, nxr
               DO j = nys, nyn
!
!--                Find topography top index
                   k_topo = get_topography_top_index_ji( j, i, 's' )

                   DO k = k_topo + 1, pct(j,i)
                       ipcgb = ipcgb + 1
                       gridpcbl(k,j,i) = ipcgb
                       pcbl(:,ipcgb) = (/ k, j, i /)
                   ENDDO
               ENDDO
           ENDDO
           ALLOCATE( pcbinsw( 1:npcbl ) )
           ALLOCATE( pcbinswdir( 1:npcbl ) )
           ALLOCATE( pcbinswdif( 1:npcbl ) )
           ALLOCATE( pcbinlw( 1:npcbl ) )
       ENDIF

!--    fill surfl (the ordering of local surfaces given by the following
!--    cycles must not be altered, certain file input routines may depend
!--    on it)
       ALLOCATE(surfl_l(5*nsurfl))  ! is it necessary to allocate it with (5,nsurfl)?
       surfl(1:5,1:nsurfl) => surfl_l(1:5*nsurfl)
       isurf = 0
       IF ( rad_angular_discretization )  THEN
!
!--       Allocate and fill the reverse indexing array gridsurf
#if defined( __parallel )
!
!--       raytrace_mpi_rma is asserted

          CALL MPI_Info_create(minfo, ierr)
          IF ( ierr /= 0 ) THEN
              WRITE(9,*) 'Error MPI_Info_create1:', ierr
              FLUSH(9)
          ENDIF
          CALL MPI_Info_set(minfo, 'accumulate_ordering', '', ierr)
          IF ( ierr /= 0 ) THEN
              WRITE(9,*) 'Error MPI_Info_set1:', ierr
              FLUSH(9)
          ENDIF
          CALL MPI_Info_set(minfo, 'accumulate_ops', 'same_op', ierr)
          IF ( ierr /= 0 ) THEN
              WRITE(9,*) 'Error MPI_Info_set2:', ierr
              FLUSH(9)
          ENDIF
          CALL MPI_Info_set(minfo, 'same_size', 'true', ierr)
          IF ( ierr /= 0 ) THEN
              WRITE(9,*) 'Error MPI_Info_set3:', ierr
              FLUSH(9)
          ENDIF
          CALL MPI_Info_set(minfo, 'same_disp_unit', 'true', ierr)
          IF ( ierr /= 0 ) THEN
              WRITE(9,*) 'Error MPI_Info_set4:', ierr
              FLUSH(9)
          ENDIF

          CALL MPI_Win_allocate(INT(STORAGE_SIZE(1_iwp)/8*nsurf_type_u*nzu*nny*nnx, &
                                    kind=MPI_ADDRESS_KIND), STORAGE_SIZE(1_iwp)/8,  &
                                minfo, comm2d, gridsurf_rma_p, win_gridsurf, ierr)
          IF ( ierr /= 0 ) THEN
              WRITE(9,*) 'Error MPI_Win_allocate1:', ierr, &
                 INT(STORAGE_SIZE(1_iwp)/8*nsurf_type_u*nzu*nny*nnx,kind=MPI_ADDRESS_KIND), &
                 STORAGE_SIZE(1_iwp)/8, win_gridsurf
              FLUSH(9)
          ENDIF

          CALL MPI_Info_free(minfo, ierr)
          IF ( ierr /= 0 ) THEN
              WRITE(9,*) 'Error MPI_Info_free1:', ierr
              FLUSH(9)
          ENDIF

!
!--       On Intel compilers, calling c_f_pointer to transform a C pointer
!--       directly to a multi-dimensional Fotran pointer leads to strange
!--       errors on dimension boundaries. However, transforming to a 1D
!--       pointer and then redirecting a multidimensional pointer to it works
!--       fine.
          CALL c_f_pointer(gridsurf_rma_p, gridsurf_rma, (/ nsurf_type_u*nzu*nny*nnx /))
          gridsurf(0:nsurf_type_u-1, nzub:nzut, nys:nyn, nxl:nxr) =>                &
                     gridsurf_rma(1:nsurf_type_u*nzu*nny*nnx)
#else
          ALLOCATE(gridsurf(0:nsurf_type_u-1,nzub:nzut,nys:nyn,nxl:nxr) )
#endif
          gridsurf(:,:,:,:) = -999
       ENDIF

!--    add horizontal surface elements (land and urban surfaces)
!--    TODO: add urban overhanging surfaces (idown_u)
       DO i = nxl, nxr
           DO j = nys, nyn
              DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
                 k = surf_usm_h%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/iup_u,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(iup_u,k,j,i) = isurf
                 ENDIF
              ENDDO

              DO  m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
                 k = surf_lsm_h%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/iup_l,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(iup_u,k,j,i) = isurf
                 ENDIF
              ENDDO

           ENDDO
       ENDDO

!--    add vertical surface elements (land and urban surfaces)
!--    TODO: remove the hard coding of l = 0 to l = idirection
       DO i = nxl, nxr
           DO j = nys, nyn
              l = 0
              DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
                 k = surf_usm_v(l)%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/inorth_u,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(inorth_u,k,j,i) = isurf
                 ENDIF
              ENDDO
              DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
                 k = surf_lsm_v(l)%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/inorth_l,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(inorth_u,k,j,i) = isurf
                 ENDIF
              ENDDO

              l = 1
              DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
                 k = surf_usm_v(l)%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/isouth_u,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(isouth_u,k,j,i) = isurf
                 ENDIF
              ENDDO
              DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
                 k = surf_lsm_v(l)%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/isouth_l,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(isouth_u,k,j,i) = isurf
                 ENDIF
              ENDDO

              l = 2
              DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
                 k = surf_usm_v(l)%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/ieast_u,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(ieast_u,k,j,i) = isurf
                 ENDIF
              ENDDO
              DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
                 k = surf_lsm_v(l)%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/ieast_l,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(ieast_u,k,j,i) = isurf
                 ENDIF
              ENDDO

              l = 3
              DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
                 k = surf_usm_v(l)%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/iwest_u,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(iwest_u,k,j,i) = isurf
                 ENDIF
              ENDDO
              DO  m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i)
                 k = surf_lsm_v(l)%k(m)
                 isurf = isurf + 1
                 surfl(:,isurf) = (/iwest_l,k,j,i,m/)
                 IF ( rad_angular_discretization ) THEN
                    gridsurf(iwest_u,k,j,i) = isurf
                 ENDIF
              ENDDO
           ENDDO
       ENDDO
!
!--    Add local MRT boxes for specified number of levels
       nmrtbl = 0
       IF ( mrt_nlevels > 0 )  THEN
          DO  i = nxl, nxr
             DO  j = nys, nyn
                DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
!
!--                Skip roof if requested
                   IF ( mrt_skip_roof  .AND.  surf_usm_h%isroof_surf(m) )  CYCLE
!
!--                Cycle over specified no of levels
                   nmrtbl = nmrtbl + mrt_nlevels
                ENDDO
!
!--             Dtto for LSM
                DO  m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
                   nmrtbl = nmrtbl + mrt_nlevels
                ENDDO
             ENDDO
          ENDDO

          ALLOCATE( mrtbl(iz:ix,nmrtbl), mrtsky(nmrtbl), mrtskyt(nmrtbl), &
                    mrtinsw(nmrtbl), mrtinlw(nmrtbl), mrt(nmrtbl) )

          imrt = 0
          DO  i = nxl, nxr
             DO  j = nys, nyn
                DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
!
!--                Skip roof if requested
                   IF ( mrt_skip_roof  .AND.  surf_usm_h%isroof_surf(m) )  CYCLE
!
!--                Cycle over specified no of levels
                   l = surf_usm_h%k(m)
                   DO  k = l, l + mrt_nlevels - 1
                      imrt = imrt + 1
                      mrtbl(:,imrt) = (/k,j,i/)
                   ENDDO
                ENDDO
!
!--             Dtto for LSM
                DO  m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
                   l = surf_lsm_h%k(m)
                   DO  k = l, l + mrt_nlevels - 1
                      imrt = imrt + 1
                      mrtbl(:,imrt) = (/k,j,i/)
                   ENDDO
                ENDDO
             ENDDO
          ENDDO
       ENDIF

!
!--    broadband albedo of the land, roof and wall surface
!--    for domain border and sky set artifically to 1.0
!--    what allows us to calculate heat flux leaving over
!--    side and top borders of the domain
       ALLOCATE ( albedo_surf(nsurfl) )
       albedo_surf = 1.0_wp
!
!--    Also allocate further array for emissivity with identical order of
!--    surface elements as radiation arrays.
       ALLOCATE ( emiss_surf(nsurfl)  )


!
!--    global array surf of indices of surfaces and displacement index array surfstart
       ALLOCATE(nsurfs(0:numprocs-1))

#if defined( __parallel )
       CALL MPI_Allgather(nsurfl,1,MPI_INTEGER,nsurfs,1,MPI_INTEGER,comm2d,ierr)
       IF ( ierr /= 0 ) THEN
         WRITE(9,*) 'Error MPI_AllGather1:', ierr, nsurfl, nsurfs
         FLUSH(9)
     ENDIF

#else
       nsurfs(0) = nsurfl
#endif
       ALLOCATE(surfstart(0:numprocs))
       k = 0
       DO i=0,numprocs-1
           surfstart(i) = k
           k = k+nsurfs(i)
       ENDDO
       surfstart(numprocs) = k
       nsurf = k
       ALLOCATE(surf_l(5*nsurf))
       surf(1:5,1:nsurf) => surf_l(1:5*nsurf)

#if defined( __parallel )
       CALL MPI_AllGatherv(surfl_l, nsurfl*5, MPI_INTEGER, surf_l, nsurfs*5, &
           surfstart(0:numprocs-1)*5, MPI_INTEGER, comm2d, ierr)
       IF ( ierr /= 0 ) THEN
           WRITE(9,*) 'Error MPI_AllGatherv4:', ierr, SIZE(surfl_l), nsurfl*5, &
                      SIZE(surf_l), nsurfs*5, surfstart(0:numprocs-1)*5
           FLUSH(9)
       ENDIF
#else
       surf = surfl
#endif

!--
!--    allocation of the arrays for direct and diffusion radiation
       CALL location_message( '    allocation of radiation arrays', .TRUE. )
!--    rad_sw_in, rad_lw_in are computed in radiation model,
!--    splitting of direct and diffusion part is done
!--    in calc_diffusion_radiation for now

       ALLOCATE( rad_sw_in_dir(nysg:nyng,nxlg:nxrg) )
       ALLOCATE( rad_sw_in_diff(nysg:nyng,nxlg:nxrg) )
       ALLOCATE( rad_lw_in_diff(nysg:nyng,nxlg:nxrg) )
       rad_sw_in_dir  = 0.0_wp
       rad_sw_in_diff = 0.0_wp
       rad_lw_in_diff = 0.0_wp

!--    allocate radiation arrays
       ALLOCATE( surfins(nsurfl) )
       ALLOCATE( surfinl(nsurfl) )
       ALLOCATE( surfinsw(nsurfl) )
       ALLOCATE( surfinlw(nsurfl) )
       ALLOCATE( surfinswdir(nsurfl) )
       ALLOCATE( surfinswdif(nsurfl) )
       ALLOCATE( surfinlwdif(nsurfl) )
       ALLOCATE( surfoutsl(nsurfl) )
       ALLOCATE( surfoutll(nsurfl) )
       ALLOCATE( surfoutsw(nsurfl) )
       ALLOCATE( surfoutlw(nsurfl) )
       ALLOCATE( surfouts(nsurf) )
       ALLOCATE( surfoutl(nsurf) )
       ALLOCATE( surfinlg(nsurf) )
       ALLOCATE( skyvf(nsurfl) )
       ALLOCATE( skyvft(nsurfl) )
       ALLOCATE( surfemitlwl(nsurfl) )

!
!--    In case of average_radiation, aggregated surface albedo and emissivity,
!--    also set initial value for t_rad_urb.
!--    For now set an arbitrary initial value.
       IF ( average_radiation )  THEN
          albedo_urb = 0.1_wp
          emissivity_urb = 0.9_wp
          t_rad_urb = pt_surface
       ENDIF

    END SUBROUTINE radiation_interaction_init

!------------------------------------------------------------------------------!
! Description:
! ------------
!> Calculates shape view factors (SVF), plant sink canopy factors (PCSF),
!> sky-view factors, discretized path for direct solar radiation, MRT factors
!> and other preprocessed data needed for radiation_interaction.
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_calc_svf
    
        IMPLICIT NONE
        
        INTEGER(iwp)                                  :: i, j, k, d, ip, jp
        INTEGER(iwp)                                  :: isvf, ksvf, icsf, kcsf, npcsfl, isvf_surflt, imrt, imrtf, ipcgb
        INTEGER(iwp)                                  :: sd, td
        INTEGER(iwp)                                  :: iaz, izn      !< azimuth, zenith counters
        INTEGER(iwp)                                  :: naz, nzn      !< azimuth, zenith num of steps
        REAL(wp)                                      :: az0, zn0      !< starting azimuth/zenith
        REAL(wp)                                      :: azs, zns      !< azimuth/zenith cycle step
        REAL(wp)                                      :: az1, az2      !< relative azimuth of section borders
        REAL(wp)                                      :: azmid         !< ray (center) azimuth
        REAL(wp)                                      :: yxlen         !< |yxdir|
        REAL(wp), DIMENSION(2)                        :: yxdir         !< y,x *unit* vector of ray direction (in grid units)
        REAL(wp), DIMENSION(:), ALLOCATABLE           :: zdirs         !< directions in z (tangent of elevation)
        REAL(wp), DIMENSION(:), ALLOCATABLE           :: zcent         !< zenith angle centers
        REAL(wp), DIMENSION(:), ALLOCATABLE           :: zbdry         !< zenith angle boundaries
        REAL(wp), DIMENSION(:), ALLOCATABLE           :: vffrac        !< view factor fractions for individual rays
        REAL(wp), DIMENSION(:), ALLOCATABLE           :: vffrac0       !< dtto (original values)
        REAL(wp), DIMENSION(:), ALLOCATABLE           :: ztransp       !< array of transparency in z steps
        INTEGER(iwp)                                  :: lowest_free_ray !< index into zdirs
        INTEGER(iwp), DIMENSION(:), ALLOCATABLE       :: itarget       !< face indices of detected obstacles
        INTEGER(iwp)                                  :: itarg0, itarg1

        INTEGER(iwp)                                  :: udim
        INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET:: nzterrl_l
        INTEGER(iwp), DIMENSION(:,:), POINTER         :: nzterrl
        REAL(wp),     DIMENSION(:), ALLOCATABLE,TARGET:: csflt_l, pcsflt_l
        REAL(wp),     DIMENSION(:,:), POINTER         :: csflt, pcsflt
        INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET:: kcsflt_l,kpcsflt_l
        INTEGER(iwp), DIMENSION(:,:), POINTER         :: kcsflt,kpcsflt
        INTEGER(iwp), DIMENSION(:), ALLOCATABLE       :: icsflt,dcsflt,ipcsflt,dpcsflt
        REAL(wp), DIMENSION(3)                        :: uv
        LOGICAL                                       :: visible
        REAL(wp), DIMENSION(3)                        :: sa, ta          !< real coordinates z,y,x of source and target
        REAL(wp)                                      :: difvf           !< differential view factor
        REAL(wp)                                      :: transparency, rirrf, sqdist, svfsum
        INTEGER(iwp)                                  :: isurflt, isurfs, isurflt_prev
        INTEGER(idp)                                  :: ray_skip_maxdist, ray_skip_minval !< skipped raytracing counts
        INTEGER(iwp)                                  :: max_track_len !< maximum 2d track length
        INTEGER(iwp)                                  :: minfo
        REAL(wp), DIMENSION(:), POINTER               :: lad_s_rma       !< fortran 1D pointer
        TYPE(c_ptr)                                   :: lad_s_rma_p     !< allocated c pointer
#if defined( __parallel )
        INTEGER(kind=MPI_ADDRESS_KIND)                :: size_lad_rma
#endif
!    
        INTEGER(iwp), DIMENSION(0:svfnorm_report_num) :: svfnorm_counts
        CHARACTER(200)                                :: msg

!--     calculation of the SVF
        CALL location_message( '    calculation of SVF and CSF', .TRUE. )
        CALL radiation_write_debug_log('Start calculation of SVF and CSF')

!--     initialize variables and temporary arrays for calculation of svf and csf
        nsvfl  = 0
        ncsfl  = 0
        nsvfla = gasize
        msvf   = 1
        ALLOCATE( asvf1(nsvfla) )
        asvf => asvf1
        IF ( plant_canopy )  THEN
            ncsfla = gasize
            mcsf   = 1
            ALLOCATE( acsf1(ncsfla) )
            acsf => acsf1
        ENDIF
        nmrtf = 0
        IF ( mrt_nlevels > 0 )  THEN
           nmrtfa = gasize
           mmrtf = 1
           ALLOCATE ( amrtf1(nmrtfa) )
           amrtf => amrtf1
        ENDIF
        ray_skip_maxdist = 0
        ray_skip_minval = 0
        
!--     initialize temporary terrain and plant canopy height arrays (global 2D array!)
        ALLOCATE( nzterr(0:(nx+1)*(ny+1)-1) )
#if defined( __parallel )
        !ALLOCATE( nzterrl(nys:nyn,nxl:nxr) )
        ALLOCATE( nzterrl_l((nyn-nys+1)*(nxr-nxl+1)) )
        nzterrl(nys:nyn,nxl:nxr) => nzterrl_l(1:(nyn-nys+1)*(nxr-nxl+1))
        nzterrl = get_topography_top_index( 's' )
        CALL MPI_AllGather( nzterrl_l, nnx*nny, MPI_INTEGER, &
                            nzterr, nnx*nny, MPI_INTEGER, comm2d, ierr )
        IF ( ierr /= 0 ) THEN
            WRITE(9,*) 'Error MPI_AllGather1:', ierr, SIZE(nzterrl_l), nnx*nny, &
                       SIZE(nzterr), nnx*nny
            FLUSH(9)
        ENDIF
        DEALLOCATE(nzterrl_l)
#else
        nzterr = RESHAPE( get_topography_top_index( 's' ), (/(nx+1)*(ny+1)/) )
#endif
        IF ( plant_canopy )  THEN
            ALLOCATE( plantt(0:(nx+1)*(ny+1)-1) )
            maxboxesg = nx + ny + nzp + 1
            max_track_len = nx + ny + 1
!--         temporary arrays storing values for csf calculation during raytracing
            ALLOCATE( boxes(3, maxboxesg) )
            ALLOCATE( crlens(maxboxesg) )

#if defined( __parallel )
            CALL MPI_AllGather( pct, nnx*nny, MPI_INTEGER, &
                                plantt, nnx*nny, MPI_INTEGER, comm2d, ierr )
            IF ( ierr /= 0 ) THEN
                WRITE(9,*) 'Error MPI_AllGather2:', ierr, SIZE(pct), nnx*nny, &
                           SIZE(plantt), nnx*nny
                FLUSH(9)
            ENDIF

!--         temporary arrays storing values for csf calculation during raytracing
            ALLOCATE( lad_ip(maxboxesg) )
            ALLOCATE( lad_disp(maxboxesg) )

            IF ( raytrace_mpi_rma )  THEN
                ALLOCATE( lad_s_ray(maxboxesg) )
                
                ! set conditions for RMA communication
                CALL MPI_Info_create(minfo, ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Info_create2:', ierr
                    FLUSH(9)
                ENDIF
                CALL MPI_Info_set(minfo, 'accumulate_ordering', '', ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Info_set5:', ierr
                    FLUSH(9)
                ENDIF
                CALL MPI_Info_set(minfo, 'accumulate_ops', 'same_op', ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Info_set6:', ierr
                    FLUSH(9)
                ENDIF
                CALL MPI_Info_set(minfo, 'same_size', 'true', ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Info_set7:', ierr
                    FLUSH(9)
                ENDIF
                CALL MPI_Info_set(minfo, 'same_disp_unit', 'true', ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Info_set8:', ierr
                    FLUSH(9)
                ENDIF

!--             Allocate and initialize the MPI RMA window
!--             must be in accordance with allocation of lad_s in plant_canopy_model
!--             optimization of memory should be done
!--             Argument X of function STORAGE_SIZE(X) needs arbitrary REAL(wp) value, set to 1.0_wp for now
                size_lad_rma = STORAGE_SIZE(1.0_wp)/8*nnx*nny*nzp
                CALL MPI_Win_allocate(size_lad_rma, STORAGE_SIZE(1.0_wp)/8, minfo, comm2d, &
                                        lad_s_rma_p, win_lad, ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Win_allocate2:', ierr, size_lad_rma, &
                                STORAGE_SIZE(1.0_wp)/8, win_lad
                    FLUSH(9)
                ENDIF
                CALL c_f_pointer(lad_s_rma_p, lad_s_rma, (/ nzp*nny*nnx /))
                sub_lad(nzub:nzpt, nys:nyn, nxl:nxr) => lad_s_rma(1:nzp*nny*nnx)
            ELSE
                ALLOCATE(sub_lad(nzub:nzpt, nys:nyn, nxl:nxr))
            ENDIF
#else
            plantt = RESHAPE( pct(nys:nyn,nxl:nxr), (/(nx+1)*(ny+1)/) )
            ALLOCATE(sub_lad(nzub:nzpt, nys:nyn, nxl:nxr))
#endif
            plantt_max = MAXVAL(plantt)
            ALLOCATE( rt2_track(2, max_track_len), rt2_track_lad(nzub:plantt_max, max_track_len), &
                      rt2_track_dist(0:max_track_len), rt2_dist(plantt_max-nzub+2) )

            sub_lad(:,:,:) = 0._wp
            DO i = nxl, nxr
                DO j = nys, nyn
                    k = get_topography_top_index_ji( j, i, 's' )

                    sub_lad(k:nzpt, j, i) = lad_s(0:nzpt-k, j, i)
                ENDDO
            ENDDO

#if defined( __parallel )
            IF ( raytrace_mpi_rma )  THEN
                CALL MPI_Info_free(minfo, ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Info_free2:', ierr
                    FLUSH(9)
                ENDIF
                CALL MPI_Win_lock_all(0, win_lad, ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Win_lock_all1:', ierr, win_lad
                    FLUSH(9)
                ENDIF
                
            ELSE
                ALLOCATE( sub_lad_g(0:(nx+1)*(ny+1)*nzp-1) )
                CALL MPI_AllGather( sub_lad, nnx*nny*nzp, MPI_REAL, &
                                    sub_lad_g, nnx*nny*nzp, MPI_REAL, comm2d, ierr )
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_AllGather3:', ierr, SIZE(sub_lad), &
                                nnx*nny*nzp, SIZE(sub_lad_g), nnx*nny*nzp
                    FLUSH(9)
                ENDIF
            ENDIF
#endif
        ENDIF

!--     prepare the MPI_Win for collecting the surface indices
!--     from the reverse index arrays gridsurf from processors of target surfaces
#if defined( __parallel )
        IF ( rad_angular_discretization )  THEN
!
!--         raytrace_mpi_rma is asserted
            CALL MPI_Win_lock_all(0, win_gridsurf, ierr)
            IF ( ierr /= 0 ) THEN
                WRITE(9,*) 'Error MPI_Win_lock_all2:', ierr, win_gridsurf
                FLUSH(9)
            ENDIF
        ENDIF
#endif


        !--Directions opposite to face normals are not even calculated,
        !--they must be preset to 0
        !--
        dsitrans(:,:) = 0._wp
        
        DO isurflt = 1, nsurfl
!--         determine face centers
            td = surfl(id, isurflt)
            ta = (/ REAL(surfl(iz, isurflt), wp) - 0.5_wp * kdir(td),  &
                      REAL(surfl(iy, isurflt), wp) - 0.5_wp * jdir(td),  &
                      REAL(surfl(ix, isurflt), wp) - 0.5_wp * idir(td)  /)

            !--Calculate sky view factor and raytrace DSI paths
            skyvf(isurflt) = 0._wp
            skyvft(isurflt) = 0._wp

            !--Select a proper half-sphere for 2D raytracing
            SELECT CASE ( td )
               CASE ( iup_u, iup_l )
                  az0 = 0._wp
                  naz = raytrace_discrete_azims
                  azs = 2._wp * pi / REAL(naz, wp)
                  zn0 = 0._wp
                  nzn = raytrace_discrete_elevs / 2
                  zns = pi / 2._wp / REAL(nzn, wp)
               CASE ( isouth_u, isouth_l )
                  az0 = pi / 2._wp
                  naz = raytrace_discrete_azims / 2
                  azs = pi / REAL(naz, wp)
                  zn0 = 0._wp
                  nzn = raytrace_discrete_elevs
                  zns = pi / REAL(nzn, wp)
               CASE ( inorth_u, inorth_l )
                  az0 = - pi / 2._wp
                  naz = raytrace_discrete_azims / 2
                  azs = pi / REAL(naz, wp)
                  zn0 = 0._wp
                  nzn = raytrace_discrete_elevs
                  zns = pi / REAL(nzn, wp)
               CASE ( iwest_u, iwest_l )
                  az0 = pi
                  naz = raytrace_discrete_azims / 2
                  azs = pi / REAL(naz, wp)
                  zn0 = 0._wp
                  nzn = raytrace_discrete_elevs
                  zns = pi / REAL(nzn, wp)
               CASE ( ieast_u, ieast_l )
                  az0 = 0._wp
                  naz = raytrace_discrete_azims / 2
                  azs = pi / REAL(naz, wp)
                  zn0 = 0._wp
                  nzn = raytrace_discrete_elevs
                  zns = pi / REAL(nzn, wp)
               CASE DEFAULT
                  WRITE(message_string, *) 'ERROR: the surface type ', td,     &
                                           ' is not supported for calculating',&
                                           ' SVF'
                  CALL message( 'radiation_calc_svf', 'PA0488', 1, 2, 0, 6, 0 )
            END SELECT

            ALLOCATE ( zdirs(1:nzn), zcent(1:nzn), zbdry(0:nzn), vffrac(1:nzn*naz), &
                       ztransp(1:nzn*naz), itarget(1:nzn*naz) )   !FIXME allocate itarget only
                                                                  !in case of rad_angular_discretization

            itarg0 = 1
            itarg1 = nzn
            zcent(:) = (/( zn0+(REAL(izn,wp)-.5_wp)*zns, izn=1, nzn )/)
            zbdry(:) = (/( zn0+REAL(izn,wp)*zns, izn=0, nzn )/)
            IF ( td == iup_u  .OR.  td == iup_l )  THEN
               vffrac(1:nzn) = (COS(2 * zbdry(0:nzn-1)) - COS(2 * zbdry(1:nzn))) / 2._wp / REAL(naz, wp)
!
!--            For horizontal target, vf fractions are constant per azimuth
               DO iaz = 1, naz-1
                  vffrac(iaz*nzn+1:(iaz+1)*nzn) = vffrac(1:nzn)
               ENDDO
!--            sum of whole vffrac equals 1, verified
            ENDIF
!
!--         Calculate sky-view factor and direct solar visibility using 2D raytracing
            DO iaz = 1, naz
               azmid = az0 + (REAL(iaz, wp) - .5_wp) * azs
               IF ( td /= iup_u  .AND.  td /= iup_l )  THEN
                  az2 = REAL(iaz, wp) * azs - pi/2._wp
                  az1 = az2 - azs
                  !TODO precalculate after 1st line
                  vffrac(itarg0:itarg1) = (SIN(az2) - SIN(az1))               &
                              * (zbdry(1:nzn) - zbdry(0:nzn-1)                &
                                 + SIN(zbdry(0:nzn-1))*COS(zbdry(0:nzn-1))    &
                                 - SIN(zbdry(1:nzn))*COS(zbdry(1:nzn)))       &
                              / (2._wp * pi)
!--               sum of whole vffrac equals 1, verified
               ENDIF
               yxdir(:) = (/ COS(azmid) / dy, SIN(azmid) / dx /)
               yxlen = SQRT(SUM(yxdir(:)**2))
               zdirs(:) = COS(zcent(:)) / (dz(1) * yxlen * SIN(zcent(:)))
               yxdir(:) = yxdir(:) / yxlen

               CALL raytrace_2d(ta, yxdir, nzn, zdirs,                        &
                                    surfstart(myid) + isurflt, facearea(td),  &
                                    vffrac(itarg0:itarg1), .TRUE., .TRUE.,    &
                                    .FALSE., lowest_free_ray,                 &
                                    ztransp(itarg0:itarg1),                   &
                                    itarget(itarg0:itarg1))

               skyvf(isurflt) = skyvf(isurflt) + &
                                SUM(vffrac(itarg0:itarg0+lowest_free_ray-1))
               skyvft(isurflt) = skyvft(isurflt) + &
                                 SUM(ztransp(itarg0:itarg0+lowest_free_ray-1) &
                                             * vffrac(itarg0:itarg0+lowest_free_ray-1))
 
!--            Save direct solar transparency
               j = MODULO(NINT(azmid/                                          &
                               (2._wp*pi)*raytrace_discrete_azims-.5_wp, iwp), &
                          raytrace_discrete_azims)

               DO k = 1, raytrace_discrete_elevs/2
                  i = dsidir_rev(k-1, j)
                  IF ( i /= -1  .AND.  k <= lowest_free_ray )  &
                     dsitrans(isurflt, i) = ztransp(itarg0+k-1)
               ENDDO

!
!--            Advance itarget indices
               itarg0 = itarg1 + 1
               itarg1 = itarg1 + nzn
            ENDDO

            IF ( rad_angular_discretization )  THEN
!--            sort itarget by face id
               CALL quicksort_itarget(itarget,vffrac,ztransp,1,nzn*naz)
!
!--            find the first valid position
               itarg0 = 1
               DO WHILE ( itarg0 <= nzn*naz )
                  IF ( itarget(itarg0) /= -1 )  EXIT
                  itarg0 = itarg0 + 1
               ENDDO

               DO  i = itarg0, nzn*naz
!
!--               For duplicate values, only sum up vf fraction value
                  IF ( i < nzn*naz )  THEN
                     IF ( itarget(i+1) == itarget(i) )  THEN
                        vffrac(i+1) = vffrac(i+1) + vffrac(i)
                        CYCLE
                     ENDIF
                  ENDIF
!
!--               write to the svf array
                  nsvfl = nsvfl + 1
!--               check dimmension of asvf array and enlarge it if needed
                  IF ( nsvfla < nsvfl )  THEN
                     k = CEILING(REAL(nsvfla, kind=wp) * grow_factor)
                     IF ( msvf == 0 )  THEN
                        msvf = 1
                        ALLOCATE( asvf1(k) )
                        asvf => asvf1
                        asvf1(1:nsvfla) = asvf2
                        DEALLOCATE( asvf2 )
                     ELSE
                        msvf = 0
                        ALLOCATE( asvf2(k) )
                        asvf => asvf2
                        asvf2(1:nsvfla) = asvf1
                        DEALLOCATE( asvf1 )
                     ENDIF

                     WRITE (msg,'(A,3I12)') 'Grow asvf:',nsvfl,nsvfla,k
                     CALL radiation_write_debug_log( msg )
                     
                     nsvfla = k
                  ENDIF
!--               write svf values into the array
                  asvf(nsvfl)%isurflt = isurflt
                  asvf(nsvfl)%isurfs = itarget(i)
                  asvf(nsvfl)%rsvf = vffrac(i)
                  asvf(nsvfl)%rtransp = ztransp(i)
               END DO

            ENDIF ! rad_angular_discretization

            DEALLOCATE ( zdirs, zcent, zbdry, vffrac, ztransp, itarget ) !FIXME itarget shall be allocated only
                                                                  !in case of rad_angular_discretization
!
!--         Following calculations only required for surface_reflections
            IF ( surface_reflections  .AND.  .NOT. rad_angular_discretization )  THEN

               DO  isurfs = 1, nsurf
                  IF ( .NOT.  surface_facing(surfl(ix, isurflt), surfl(iy, isurflt), &
                     surfl(iz, isurflt), surfl(id, isurflt), &
                     surf(ix, isurfs), surf(iy, isurfs), &
                     surf(iz, isurfs), surf(id, isurfs)) )  THEN
                     CYCLE
                  ENDIF
                  
                  sd = surf(id, isurfs)
                  sa = (/ REAL(surf(iz, isurfs), wp) - 0.5_wp * kdir(sd),  &
                          REAL(surf(iy, isurfs), wp) - 0.5_wp * jdir(sd),  &
                          REAL(surf(ix, isurfs), wp) - 0.5_wp * idir(sd)  /)

!--               unit vector source -> target
                  uv = (/ (ta(1)-sa(1))*dz(1), (ta(2)-sa(2))*dy, (ta(3)-sa(3))*dx /)
                  sqdist = SUM(uv(:)**2)
                  uv = uv / SQRT(sqdist)

!--               reject raytracing above max distance
                  IF ( SQRT(sqdist) > max_raytracing_dist ) THEN
                     ray_skip_maxdist = ray_skip_maxdist + 1
                     CYCLE
                  ENDIF
                 
                  difvf = dot_product((/ kdir(sd), jdir(sd), idir(sd) /), uv) & ! cosine of source normal and direction
                      * dot_product((/ kdir(td), jdir(td), idir(td) /), -uv) &  ! cosine of target normal and reverse direction
                      / (pi * sqdist) ! square of distance between centers
!
!--               irradiance factor (our unshaded shape view factor) = view factor per differential target area * source area
                  rirrf = difvf * facearea(sd)

!--               reject raytracing for potentially too small view factor values
                  IF ( rirrf < min_irrf_value ) THEN
                      ray_skip_minval = ray_skip_minval + 1
                      CYCLE
                  ENDIF

!--               raytrace + process plant canopy sinks within
                  CALL raytrace(sa, ta, isurfs, difvf, facearea(td), .TRUE., &
                                visible, transparency)

                  IF ( .NOT.  visible ) CYCLE
                 ! rsvf = rirrf * transparency

!--               write to the svf array
                  nsvfl = nsvfl + 1
!--               check dimmension of asvf array and enlarge it if needed
                  IF ( nsvfla < nsvfl )  THEN
                     k = CEILING(REAL(nsvfla, kind=wp) * grow_factor)
                     IF ( msvf == 0 )  THEN
                        msvf = 1
                        ALLOCATE( asvf1(k) )
                        asvf => asvf1
                        asvf1(1:nsvfla) = asvf2
                        DEALLOCATE( asvf2 )
                     ELSE
                        msvf = 0
                        ALLOCATE( asvf2(k) )
                        asvf => asvf2
                        asvf2(1:nsvfla) = asvf1
                        DEALLOCATE( asvf1 )
                     ENDIF

                     WRITE(msg,'(A,3I12)') 'Grow asvf:',nsvfl,nsvfla,k
                     CALL radiation_write_debug_log( msg )
                     
                     nsvfla = k
                  ENDIF
!--               write svf values into the array
                  asvf(nsvfl)%isurflt = isurflt
                  asvf(nsvfl)%isurfs = isurfs
                  asvf(nsvfl)%rsvf = rirrf !we postopne multiplication by transparency
                  asvf(nsvfl)%rtransp = transparency !a.k.a. Direct Irradiance Factor
               ENDDO
            ENDIF
        ENDDO

!--
!--     Raytrace to canopy boxes to fill dsitransc TODO optimize
        dsitransc(:,:) = 0._wp
        az0 = 0._wp
        naz = raytrace_discrete_azims
        azs = 2._wp * pi / REAL(naz, wp)
        zn0 = 0._wp
        nzn = raytrace_discrete_elevs / 2
        zns = pi / 2._wp / REAL(nzn, wp)
        ALLOCATE ( zdirs(1:nzn), zcent(1:nzn), vffrac(1:nzn), ztransp(1:nzn), &
               itarget(1:nzn) )
        zcent(:) = (/( zn0+(REAL(izn,wp)-.5_wp)*zns, izn=1, nzn )/)
        vffrac(:) = 0._wp

        DO  ipcgb = 1, npcbl
           ta = (/ REAL(pcbl(iz, ipcgb), wp),  &
                   REAL(pcbl(iy, ipcgb), wp),  &
                   REAL(pcbl(ix, ipcgb), wp) /)
!--        Calculate direct solar visibility using 2D raytracing
           DO  iaz = 1, naz
              azmid = az0 + (REAL(iaz, wp) - .5_wp) * azs
              yxdir(:) = (/ COS(azmid) / dy, SIN(azmid) / dx /)
              yxlen = SQRT(SUM(yxdir(:)**2))
              zdirs(:) = COS(zcent(:)) / (dz(1) * yxlen * SIN(zcent(:)))
              yxdir(:) = yxdir(:) / yxlen
              CALL raytrace_2d(ta, yxdir, nzn, zdirs,                                &
                                   -999, -999._wp, vffrac, .FALSE., .FALSE., .TRUE., &
                                   lowest_free_ray, ztransp, itarget)

!--           Save direct solar transparency
              j = MODULO(NINT(azmid/                                         &
                             (2._wp*pi)*raytrace_discrete_azims-.5_wp, iwp), &
                         raytrace_discrete_azims)
              DO  k = 1, raytrace_discrete_elevs/2
                 i = dsidir_rev(k-1, j)
                 IF ( i /= -1  .AND.  k <= lowest_free_ray ) &
                    dsitransc(ipcgb, i) = ztransp(k)
              ENDDO
           ENDDO
        ENDDO
        DEALLOCATE ( zdirs, zcent, vffrac, ztransp, itarget )
!--
!--     Raytrace to MRT boxes
        IF ( nmrtbl > 0 )  THEN
           mrtdsit(:,:) = 0._wp
           mrtsky(:) = 0._wp
           mrtskyt(:) = 0._wp
           az0 = 0._wp
           naz = raytrace_discrete_azims
           azs = 2._wp * pi / REAL(naz, wp)
           zn0 = 0._wp
           nzn = raytrace_discrete_elevs
           zns = pi / REAL(nzn, wp)
           ALLOCATE ( zdirs(1:nzn), zcent(1:nzn), zbdry(0:nzn), vffrac(1:nzn*naz), vffrac0(1:nzn), &
                      ztransp(1:nzn*naz), itarget(1:nzn*naz) )   !FIXME allocate itarget only
                                                                 !in case of rad_angular_discretization

           zcent(:) = (/( zn0+(REAL(izn,wp)-.5_wp)*zns, izn=1, nzn )/)
           zbdry(:) = (/( zn0+REAL(izn,wp)*zns, izn=0, nzn )/)
           vffrac0(:) = (COS(zbdry(0:nzn-1)) - COS(zbdry(1:nzn))) / 2._wp / REAL(naz, wp)
           !
           !--Modify direction weights to simulate human body (lower weight for top-down)
           IF ( mrt_geom_human )  THEN
              vffrac0(:) = vffrac0(:) * MAX(0._wp, SIN(zcent(:))*0.88_wp + COS(zcent(:))*0.12_wp)
              vffrac0(:) = vffrac0(:) / (SUM(vffrac0) * REAL(naz, wp))
           ENDIF

           DO  imrt = 1, nmrtbl
              ta = (/ REAL(mrtbl(iz, imrt), wp),  &
                      REAL(mrtbl(iy, imrt), wp),  &
                      REAL(mrtbl(ix, imrt), wp) /)
!
!--           vf fractions are constant per azimuth
              DO iaz = 0, naz-1
                 vffrac(iaz*nzn+1:(iaz+1)*nzn) = vffrac0(:)
              ENDDO
!--           sum of whole vffrac equals 1, verified
              itarg0 = 1
              itarg1 = nzn
!
!--           Calculate sky-view factor and direct solar visibility using 2D raytracing
              DO  iaz = 1, naz
                 azmid = az0 + (REAL(iaz, wp) - .5_wp) * azs
                 yxdir(:) = (/ COS(azmid) / dy, SIN(azmid) / dx /)
                 yxlen = SQRT(SUM(yxdir(:)**2))
                 zdirs(:) = COS(zcent(:)) / (dz(1) * yxlen * SIN(zcent(:)))
                 yxdir(:) = yxdir(:) / yxlen

                 CALL raytrace_2d(ta, yxdir, nzn, zdirs,                         &
                                  -999, -999._wp, vffrac(itarg0:itarg1), .TRUE., &
                                  .FALSE., .TRUE., lowest_free_ray,              &
                                  ztransp(itarg0:itarg1),                        &
                                  itarget(itarg0:itarg1))

!--              Sky view factors for MRT
                 mrtsky(imrt) = mrtsky(imrt) + &
                                  SUM(vffrac(itarg0:itarg0+lowest_free_ray-1))
                 mrtskyt(imrt) = mrtskyt(imrt) + &
                                   SUM(ztransp(itarg0:itarg0+lowest_free_ray-1) &
                                               * vffrac(itarg0:itarg0+lowest_free_ray-1))
!--              Direct solar transparency for MRT
                 j = MODULO(NINT(azmid/                                         &
                                (2._wp*pi)*raytrace_discrete_azims-.5_wp, iwp), &
                            raytrace_discrete_azims)
                 DO  k = 1, raytrace_discrete_elevs/2
                    i = dsidir_rev(k-1, j)
                    IF ( i /= -1  .AND.  k <= lowest_free_ray ) &
                       mrtdsit(imrt, i) = ztransp(itarg0+k-1)
                 ENDDO
!
!--              Advance itarget indices
                 itarg0 = itarg1 + 1
                 itarg1 = itarg1 + nzn
              ENDDO

!--           sort itarget by face id
              CALL quicksort_itarget(itarget,vffrac,ztransp,1,nzn*naz)
!
!--           find the first valid position
              itarg0 = 1
              DO WHILE ( itarg0 <= nzn*naz )
                 IF ( itarget(itarg0) /= -1 )  EXIT
                 itarg0 = itarg0 + 1
              ENDDO

              DO  i = itarg0, nzn*naz
!
!--              For duplicate values, only sum up vf fraction value
                 IF ( i < nzn*naz )  THEN
                    IF ( itarget(i+1) == itarget(i) )  THEN
                       vffrac(i+1) = vffrac(i+1) + vffrac(i)
                       CYCLE
                    ENDIF
                 ENDIF
!
!--              write to the mrtf array
                 nmrtf = nmrtf + 1
!--              check dimmension of mrtf array and enlarge it if needed
                 IF ( nmrtfa < nmrtf )  THEN
                    k = CEILING(REAL(nmrtfa, kind=wp) * grow_factor)
                    IF ( mmrtf == 0 )  THEN
                       mmrtf = 1
                       ALLOCATE( amrtf1(k) )
                       amrtf => amrtf1
                       amrtf1(1:nmrtfa) = amrtf2
                       DEALLOCATE( amrtf2 )
                    ELSE
                       mmrtf = 0
                       ALLOCATE( amrtf2(k) )
                       amrtf => amrtf2
                       amrtf2(1:nmrtfa) = amrtf1
                       DEALLOCATE( amrtf1 )
                    ENDIF

                    WRITE (msg,'(A,3I12)') 'Grow amrtf:', nmrtf, nmrtfa, k
                    CALL radiation_write_debug_log( msg )

                    nmrtfa = k
                 ENDIF
!--              write mrtf values into the array
                 amrtf(nmrtf)%isurflt = imrt
                 amrtf(nmrtf)%isurfs = itarget(i)
                 amrtf(nmrtf)%rsvf = vffrac(i)
                 amrtf(nmrtf)%rtransp = ztransp(i)
              ENDDO ! itarg

           ENDDO ! imrt
           DEALLOCATE ( zdirs, zcent, zbdry, vffrac, vffrac0, ztransp, itarget )
!
!--        Move MRT factors to final arrays
           ALLOCATE ( mrtf(nmrtf), mrtft(nmrtf), mrtfsurf(2,nmrtf) )
           DO  imrtf = 1, nmrtf
              mrtf(imrtf) = amrtf(imrtf)%rsvf
              mrtft(imrtf) = amrtf(imrtf)%rsvf * amrtf(imrtf)%rtransp
              mrtfsurf(:,imrtf) = (/amrtf(imrtf)%isurflt, amrtf(imrtf)%isurfs /)
           ENDDO
           IF ( ALLOCATED(amrtf1) )  DEALLOCATE( amrtf1 )
           IF ( ALLOCATED(amrtf2) )  DEALLOCATE( amrtf2 )
        ENDIF ! nmrtbl > 0

        IF ( rad_angular_discretization )  THEN
#if defined( __parallel )
!--        finalize MPI_RMA communication established to get global index of the surface from grid indices
!--        flush all MPI window pending requests
           CALL MPI_Win_flush_all(win_gridsurf, ierr)
           IF ( ierr /= 0 ) THEN
               WRITE(9,*) 'Error MPI_Win_flush_all1:', ierr, win_gridsurf
               FLUSH(9)
           ENDIF
!--        unlock MPI window
           CALL MPI_Win_unlock_all(win_gridsurf, ierr)
           IF ( ierr /= 0 ) THEN
               WRITE(9,*) 'Error MPI_Win_unlock_all1:', ierr, win_gridsurf
               FLUSH(9)
           ENDIF
!--        free MPI window
           CALL MPI_Win_free(win_gridsurf, ierr)
           IF ( ierr /= 0 ) THEN
               WRITE(9,*) 'Error MPI_Win_free1:', ierr, win_gridsurf
               FLUSH(9)
           ENDIF
#else
           DEALLOCATE ( gridsurf )
#endif
        ENDIF

        CALL radiation_write_debug_log( 'End of calculation SVF' )
        WRITE(msg, *) 'Raytracing skipped for maximum distance of ', &
           max_raytracing_dist, ' m on ', ray_skip_maxdist, ' pairs.'
        CALL radiation_write_debug_log( msg )
        WRITE(msg, *) 'Raytracing skipped for minimum potential value of ', &
           min_irrf_value , ' on ', ray_skip_minval, ' pairs.'
        CALL radiation_write_debug_log( msg )

        CALL location_message( '    waiting for completion of SVF and CSF calculation in all processes', .TRUE. )
!--     deallocate temporary global arrays
        DEALLOCATE(nzterr)
        
        IF ( plant_canopy )  THEN
!--         finalize mpi_rma communication and deallocate temporary arrays
#if defined( __parallel )
            IF ( raytrace_mpi_rma )  THEN
                CALL MPI_Win_flush_all(win_lad, ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Win_flush_all2:', ierr, win_lad
                    FLUSH(9)
                ENDIF
!--             unlock MPI window
                CALL MPI_Win_unlock_all(win_lad, ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Win_unlock_all2:', ierr, win_lad
                    FLUSH(9)
                ENDIF
!--             free MPI window
                CALL MPI_Win_free(win_lad, ierr)
                IF ( ierr /= 0 ) THEN
                    WRITE(9,*) 'Error MPI_Win_free2:', ierr, win_lad
                    FLUSH(9)
                ENDIF
!--             deallocate temporary arrays storing values for csf calculation during raytracing
                DEALLOCATE( lad_s_ray )
!--             sub_lad is the pointer to lad_s_rma in case of raytrace_mpi_rma
!--             and must not be deallocated here
            ELSE
                DEALLOCATE(sub_lad)
                DEALLOCATE(sub_lad_g)
            ENDIF
#else
            DEALLOCATE(sub_lad)
#endif
            DEALLOCATE( boxes )
            DEALLOCATE( crlens )
            DEALLOCATE( plantt )
            DEALLOCATE( rt2_track, rt2_track_lad, rt2_track_dist, rt2_dist )
        ENDIF

        CALL location_message( '    calculation of the complete SVF array', .TRUE. )

        IF ( rad_angular_discretization )  THEN
           CALL radiation_write_debug_log( 'Load svf from the structure array to plain arrays' )
           ALLOCATE( svf(ndsvf,nsvfl) )
           ALLOCATE( svfsurf(idsvf,nsvfl) )

           DO isvf = 1, nsvfl
               svf(:, isvf) = (/ asvf(isvf)%rsvf, asvf(isvf)%rtransp /)
               svfsurf(:, isvf) = (/ asvf(isvf)%isurflt, asvf(isvf)%isurfs /)
           ENDDO
        ELSE
           CALL radiation_write_debug_log( 'Start SVF sort' )
!--        sort svf ( a version of quicksort )
           CALL quicksort_svf(asvf,1,nsvfl)

           !< load svf from the structure array to plain arrays
           CALL radiation_write_debug_log( 'Load svf from the structure array to plain arrays' )
           ALLOCATE( svf(ndsvf,nsvfl) )
           ALLOCATE( svfsurf(idsvf,nsvfl) )
           svfnorm_counts(:) = 0._wp
           isurflt_prev = -1
           ksvf = 1
           svfsum = 0._wp
           DO isvf = 1, nsvfl
!--            normalize svf per target face
               IF ( asvf(ksvf)%isurflt /= isurflt_prev )  THEN
                   IF ( isurflt_prev /= -1  .AND.  svfsum /= 0._wp )  THEN
                       !< update histogram of logged svf normalization values
                       i = searchsorted(svfnorm_report_thresh, svfsum / (1._wp-skyvf(isurflt_prev)))
                       svfnorm_counts(i) = svfnorm_counts(i) + 1

                       svf(1, isvf_surflt:isvf-1) = svf(1, isvf_surflt:isvf-1) / svfsum * (1._wp-skyvf(isurflt_prev))
                   ENDIF
                   isurflt_prev = asvf(ksvf)%isurflt
                   isvf_surflt = isvf
                   svfsum = asvf(ksvf)%rsvf !?? / asvf(ksvf)%rtransp
               ELSE
                   svfsum = svfsum + asvf(ksvf)%rsvf !?? / asvf(ksvf)%rtransp
               ENDIF

               svf(:, isvf) = (/ asvf(ksvf)%rsvf, asvf(ksvf)%rtransp /)
               svfsurf(:, isvf) = (/ asvf(ksvf)%isurflt, asvf(ksvf)%isurfs /)

!--            next element
               ksvf = ksvf + 1
           ENDDO

           IF ( isurflt_prev /= -1  .AND.  svfsum /= 0._wp )  THEN
               i = searchsorted(svfnorm_report_thresh, svfsum / (1._wp-skyvf(isurflt_prev)))
               svfnorm_counts(i) = svfnorm_counts(i) + 1

               svf(1, isvf_surflt:nsvfl) = svf(1, isvf_surflt:nsvfl) / svfsum * (1._wp-skyvf(isurflt_prev))
           ENDIF
           WRITE(9, *) 'SVF normalization histogram:', svfnorm_counts,  &
                       'on thresholds:', svfnorm_report_thresh(1:svfnorm_report_num), '(val < thresh <= val)'
           !TODO we should be able to deallocate skyvf, from now on we only need skyvft
        ENDIF ! rad_angular_discretization

!--     deallocate temporary asvf array
!--     DEALLOCATE(asvf) - ifort has a problem with deallocation of allocatable target
!--     via pointing pointer - we need to test original targets
        IF ( ALLOCATED(asvf1) )  THEN
            DEALLOCATE(asvf1)
        ENDIF
        IF ( ALLOCATED(asvf2) )  THEN
            DEALLOCATE(asvf2)
        ENDIF

        npcsfl = 0
        IF ( plant_canopy )  THEN

            CALL location_message( '    calculation of the complete CSF array', .TRUE. )
            CALL radiation_write_debug_log( 'Calculation of the complete CSF array' )
!--         sort and merge csf for the last time, keeping the array size to minimum
            CALL merge_and_grow_csf(-1)
            
!--         aggregate csb among processors
!--         allocate necessary arrays
            udim = max(ncsfl,1)
            ALLOCATE( csflt_l(ndcsf*udim) )
            csflt(1:ndcsf,1:udim) => csflt_l(1:ndcsf*udim)
            ALLOCATE( kcsflt_l(kdcsf*udim) )
            kcsflt(1:kdcsf,1:udim) => kcsflt_l(1:kdcsf*udim)
            ALLOCATE( icsflt(0:numprocs-1) )
            ALLOCATE( dcsflt(0:numprocs-1) )
            ALLOCATE( ipcsflt(0:numprocs-1) )
            ALLOCATE( dpcsflt(0:numprocs-1) )
            
!--         fill out arrays of csf values and 
!--         arrays of number of elements and displacements
!--         for particular precessors
            icsflt = 0
            dcsflt = 0
            ip = -1
            j = -1
            d = 0
            DO kcsf = 1, ncsfl
                j = j+1
                IF ( acsf(kcsf)%ip /= ip )  THEN
!--                 new block of the processor
!--                 number of elements of previous block
                    IF ( ip>=0) icsflt(ip) = j
                    d = d+j
!--                 blank blocks
                    DO jp = ip+1, acsf(kcsf)%ip-1
!--                     number of elements is zero, displacement is equal to previous
                        icsflt(jp) = 0
                        dcsflt(jp) = d
                    ENDDO
!--                 the actual block
                    ip = acsf(kcsf)%ip
                    dcsflt(ip) = d
                    j = 0
                ENDIF
                csflt(1,kcsf) = acsf(kcsf)%rcvf
!--             fill out integer values of itz,ity,itx,isurfs
                kcsflt(1,kcsf) = acsf(kcsf)%itz
                kcsflt(2,kcsf) = acsf(kcsf)%ity
                kcsflt(3,kcsf) = acsf(kcsf)%itx
                kcsflt(4,kcsf) = acsf(kcsf)%isurfs
            ENDDO
!--         last blank blocks at the end of array
            j = j+1
            IF ( ip>=0 ) icsflt(ip) = j
            d = d+j
            DO jp = ip+1, numprocs-1
!--             number of elements is zero, displacement is equal to previous
                icsflt(jp) = 0
                dcsflt(jp) = d
            ENDDO
            
!--         deallocate temporary acsf array
!--         DEALLOCATE(acsf) - ifort has a problem with deallocation of allocatable target
!--         via pointing pointer - we need to test original targets
            IF ( ALLOCATED(acsf1) )  THEN
                DEALLOCATE(acsf1)
            ENDIF
            IF ( ALLOCATED(acsf2) )  THEN
                DEALLOCATE(acsf2)
            ENDIF
                    
#if defined( __parallel )
!--         scatter and gather the number of elements to and from all processor
!--         and calculate displacements
            CALL radiation_write_debug_log( 'Scatter and gather the number of elements to and from all processor' )
            CALL MPI_AlltoAll(icsflt,1,MPI_INTEGER,ipcsflt,1,MPI_INTEGER,comm2d, ierr)
            IF ( ierr /= 0 ) THEN
                WRITE(9,*) 'Error MPI_AlltoAll1:', ierr, SIZE(icsflt), SIZE(ipcsflt)
                FLUSH(9)
            ENDIF

            npcsfl = SUM(ipcsflt)
            d = 0
            DO i = 0, numprocs-1
                dpcsflt(i) = d
                d = d + ipcsflt(i)
            ENDDO

!--         exchange csf fields between processors
            CALL radiation_write_debug_log( 'Exchange csf fields between processors' )
            udim = max(npcsfl,1)
            ALLOCATE( pcsflt_l(ndcsf*udim) )
            pcsflt(1:ndcsf,1:udim) => pcsflt_l(1:ndcsf*udim)
            ALLOCATE( kpcsflt_l(kdcsf*udim) )
            kpcsflt(1:kdcsf,1:udim) => kpcsflt_l(1:kdcsf*udim)
            CALL MPI_AlltoAllv(csflt_l, ndcsf*icsflt, ndcsf*dcsflt, MPI_REAL, &
                pcsflt_l, ndcsf*ipcsflt, ndcsf*dpcsflt, MPI_REAL, comm2d, ierr)
            IF ( ierr /= 0 ) THEN
                WRITE(9,*) 'Error MPI_AlltoAllv1:', ierr, SIZE(ipcsflt), ndcsf*icsflt, &
                            ndcsf*dcsflt, SIZE(pcsflt_l),ndcsf*ipcsflt, ndcsf*dpcsflt
                FLUSH(9)
            ENDIF

            CALL MPI_AlltoAllv(kcsflt_l, kdcsf*icsflt, kdcsf*dcsflt, MPI_INTEGER, &
                kpcsflt_l, kdcsf*ipcsflt, kdcsf*dpcsflt, MPI_INTEGER, comm2d, ierr)
            IF ( ierr /= 0 ) THEN
                WRITE(9,*) 'Error MPI_AlltoAllv2:', ierr, SIZE(kcsflt_l),kdcsf*icsflt, &
                           kdcsf*dcsflt, SIZE(kpcsflt_l), kdcsf*ipcsflt, kdcsf*dpcsflt
                FLUSH(9)
            ENDIF
            
#else
            npcsfl = ncsfl
            ALLOCATE( pcsflt(ndcsf,max(npcsfl,ndcsf)) )
            ALLOCATE( kpcsflt(kdcsf,max(npcsfl,kdcsf)) )
            pcsflt = csflt
            kpcsflt = kcsflt
#endif

!--         deallocate temporary arrays
            DEALLOCATE( csflt_l )
            DEALLOCATE( kcsflt_l )
            DEALLOCATE( icsflt )
            DEALLOCATE( dcsflt )
            DEALLOCATE( ipcsflt )
            DEALLOCATE( dpcsflt )

!--         sort csf ( a version of quicksort )
            CALL radiation_write_debug_log( 'Sort csf' )
            CALL quicksort_csf2(kpcsflt, pcsflt, 1, npcsfl)

!--         aggregate canopy sink factor records with identical box & source
!--         againg across all values from all processors
            CALL radiation_write_debug_log( 'Aggregate canopy sink factor records with identical box' )

            IF ( npcsfl > 0 )  THEN
                icsf = 1 !< reading index
                kcsf = 1 !< writing index
                DO while (icsf < npcsfl)
!--                 here kpcsf(kcsf) already has values from kpcsf(icsf)
                    IF ( kpcsflt(3,icsf) == kpcsflt(3,icsf+1)  .AND.  &
                         kpcsflt(2,icsf) == kpcsflt(2,icsf+1)  .AND.  &
                         kpcsflt(1,icsf) == kpcsflt(1,icsf+1)  .AND.  &
                         kpcsflt(4,icsf) == kpcsflt(4,icsf+1) )  THEN

                        pcsflt(1,kcsf) = pcsflt(1,kcsf) + pcsflt(1,icsf+1)

!--                     advance reading index, keep writing index
                        icsf = icsf + 1
                    ELSE
!--                     not identical, just advance and copy
                        icsf = icsf + 1
                        kcsf = kcsf + 1
                        kpcsflt(:,kcsf) = kpcsflt(:,icsf)
                        pcsflt(:,kcsf) = pcsflt(:,icsf)
                    ENDIF
                ENDDO
!--             last written item is now also the last item in valid part of array
                npcsfl = kcsf
            ENDIF

            ncsfl = npcsfl
            IF ( ncsfl > 0 )  THEN
                ALLOCATE( csf(ndcsf,ncsfl) )
                ALLOCATE( csfsurf(idcsf,ncsfl) )
                DO icsf = 1, ncsfl
                    csf(:,icsf) = pcsflt(:,icsf)
                    csfsurf(1,icsf) =  gridpcbl(kpcsflt(1,icsf),kpcsflt(2,icsf),kpcsflt(3,icsf))
                    csfsurf(2,icsf) =  kpcsflt(4,icsf)
                ENDDO
            ENDIF
            
!--         deallocation of temporary arrays
            IF ( npcbl > 0 )  DEALLOCATE( gridpcbl )
            DEALLOCATE( pcsflt_l )
            DEALLOCATE( kpcsflt_l )
            CALL radiation_write_debug_log( 'End of aggregate csf' )
            
        ENDIF

#if defined( __parallel )
        CALL MPI_BARRIER( comm2d, ierr )
#endif
        CALL radiation_write_debug_log( 'End of radiation_calc_svf (after mpi_barrier)' )

        RETURN
        
!        WRITE( message_string, * )  &
!            'I/O error when processing shape view factors / ',  &
!            'plant canopy sink factors / direct irradiance factors.'
!        CALL message( 'init_urban_surface', 'PA0502', 2, 2, 0, 6, 0 )
       
    END SUBROUTINE radiation_calc_svf

    
!------------------------------------------------------------------------------!
! Description:
! ------------
!> Raytracing for detecting obstacles and calculating compound canopy sink
!> factors. (A simple obstacle detection would only need to process faces in
!> 3 dimensions without any ordering.)
!> Assumtions:
!> -----------
!> 1. The ray always originates from a face midpoint (only one coordinate equals
!>    *.5, i.e. wall) and doesn't travel parallel to the surface (that would mean
!>    shape factor=0). Therefore, the ray may never travel exactly along a face
!>    or an edge.
!> 2. From grid bottom to urban surface top the grid has to be *equidistant*
!>    within each of the dimensions, including vertical (but the resolution
!>    doesn't need to be the same in all three dimensions).
!------------------------------------------------------------------------------!
    SUBROUTINE raytrace(src, targ, isrc, difvf, atarg, create_csf, visible, transparency)
        IMPLICIT NONE

        REAL(wp), DIMENSION(3), INTENT(in)     :: src, targ    !< real coordinates z,y,x
        INTEGER(iwp), INTENT(in)               :: isrc         !< index of source face for csf
        REAL(wp), INTENT(in)                   :: difvf        !< differential view factor for csf
        REAL(wp), INTENT(in)                   :: atarg        !< target surface area for csf
        LOGICAL, INTENT(in)                    :: create_csf   !< whether to generate new CSFs during raytracing
        LOGICAL, INTENT(out)                   :: visible
        REAL(wp), INTENT(out)                  :: transparency !< along whole path
        INTEGER(iwp)                           :: i, k, d
        INTEGER(iwp)                           :: seldim       !< dimension to be incremented
        INTEGER(iwp)                           :: ncsb         !< no of written plant canopy sinkboxes
        INTEGER(iwp)                           :: maxboxes     !< max no of gridboxes visited
        REAL(wp)                               :: distance     !< euclidean along path
        REAL(wp)                               :: crlen        !< length of gridbox crossing
        REAL(wp)                               :: lastdist     !< beginning of current crossing
        REAL(wp)                               :: nextdist     !< end of current crossing
        REAL(wp)                               :: realdist     !< distance in meters per unit distance
        REAL(wp)                               :: crmid        !< midpoint of crossing
        REAL(wp)                               :: cursink      !< sink factor for current canopy box
        REAL(wp), DIMENSION(3)                 :: delta        !< path vector
        REAL(wp), DIMENSION(3)                 :: uvect        !< unit vector
        REAL(wp), DIMENSION(3)                 :: dimnextdist  !< distance for each dimension increments
        INTEGER(iwp), DIMENSION(3)             :: box          !< gridbox being crossed
        INTEGER(iwp), DIMENSION(3)             :: dimnext      !< next dimension increments along path
        INTEGER(iwp), DIMENSION(3)             :: dimdelta     !< dimension direction = +- 1
        INTEGER(iwp)                           :: px, py       !< number of processors in x and y dir before 
                                                               !< the processor in the question
        INTEGER(iwp)                           :: ip           !< number of processor where gridbox reside
        INTEGER(iwp)                           :: ig           !< 1D index of gridbox in global 2D array
        
        REAL(wp)                               :: eps = 1E-10_wp !< epsilon for value comparison
        REAL(wp)                               :: lad_s_target   !< recieved lad_s of particular grid box

!
!--     Maximum number of gridboxes visited equals to maximum number of boundaries crossed in each dimension plus one. That's also
!--     the maximum number of plant canopy boxes written. We grow the acsf array accordingly using exponential factor.
        maxboxes = SUM(ABS(NINT(targ, iwp) - NINT(src, iwp))) + 1
        IF ( plant_canopy  .AND.  ncsfl + maxboxes > ncsfla )  THEN
!--         use this code for growing by fixed exponential increments (equivalent to case where ncsfl always increases by 1)
!--         k = CEILING(grow_factor ** real(CEILING(log(real(ncsfl + maxboxes, kind=wp)) &
!--                                                / log(grow_factor)), kind=wp))
!--         or use this code to simply always keep some extra space after growing
            k = CEILING(REAL(ncsfl + maxboxes, kind=wp) * grow_factor)

            CALL merge_and_grow_csf(k)
        ENDIF
        
        transparency = 1._wp
        ncsb = 0

        delta(:) = targ(:) - src(:)
        distance = SQRT(SUM(delta(:)**2))
        IF ( distance == 0._wp )  THEN
            visible = .TRUE.
            RETURN
        ENDIF
        uvect(:) = delta(:) / distance
        realdist = SQRT(SUM( (uvect(:)*(/dz(1),dy,dx/))**2 ))

        lastdist = 0._wp

!--     Since all face coordinates have values *.5 and we'd like to use
!--     integers, all these have .5 added
        DO d = 1, 3
            IF ( uvect(d) == 0._wp )  THEN
                dimnext(d) = 999999999
                dimdelta(d) = 999999999
                dimnextdist(d) = 1.0E20_wp
            ELSE IF ( uvect(d) > 0._wp )  THEN
                dimnext(d) = CEILING(src(d) + .5_wp)
                dimdelta(d) = 1
                dimnextdist(d) = (dimnext(d) - .5_wp - src(d)) / uvect(d)
            ELSE
                dimnext(d) = FLOOR(src(d) + .5_wp)
                dimdelta(d) = -1
                dimnextdist(d) = (dimnext(d) - .5_wp - src(d)) / uvect(d)
            ENDIF
        ENDDO

        DO
!--         along what dimension will the next wall crossing be?
            seldim = minloc(dimnextdist, 1)
            nextdist = dimnextdist(seldim)
            IF ( nextdist > distance ) nextdist = distance

            crlen = nextdist - lastdist
            IF ( crlen > .001_wp )  THEN
                crmid = (lastdist + nextdist) * .5_wp
                box = NINT(src(:) + uvect(:) * crmid, iwp)

!--             calculate index of the grid with global indices (box(2),box(3))
!--             in the array nzterr and plantt and id of the coresponding processor
                px = box(3)/nnx
                py = box(2)/nny
                ip = px*pdims(2)+py
                ig = ip*nnx*nny + (box(3)-px*nnx)*nny + box(2)-py*nny
                IF ( box(1) <= nzterr(ig) )  THEN
                    visible = .FALSE.
                    RETURN
                ENDIF

                IF ( plant_canopy )  THEN
                    IF ( box(1) <= plantt(ig) )  THEN
                        ncsb = ncsb + 1
                        boxes(:,ncsb) = box
                        crlens(ncsb) = crlen
#if defined( __parallel )
                        lad_ip(ncsb) = ip
                        lad_disp(ncsb) = (box(3)-px*nnx)*(nny*nzp) + (box(2)-py*nny)*nzp + box(1)-nzub
#endif
                    ENDIF
                ENDIF
            ENDIF

            IF ( ABS(distance - nextdist) < eps )  EXIT
            lastdist = nextdist
            dimnext(seldim) = dimnext(seldim) + dimdelta(seldim)
            dimnextdist(seldim) = (dimnext(seldim) - .5_wp - src(seldim)) / uvect(seldim)
        ENDDO
        
        IF ( plant_canopy )  THEN
#if defined( __parallel )
            IF ( raytrace_mpi_rma )  THEN
!--             send requests for lad_s to appropriate processor
                CALL cpu_log( log_point_s(77), 'rad_rma_lad', 'start' )
                DO i = 1, ncsb
                    CALL MPI_Get(lad_s_ray(i), 1, MPI_REAL, lad_ip(i), lad_disp(i), &
                                 1, MPI_REAL, win_lad, ierr)
                    IF ( ierr /= 0 )  THEN
                        WRITE(9,*) 'Error MPI_Get1:', ierr, lad_s_ray(i), &
                                   lad_ip(i), lad_disp(i), win_lad
                        FLUSH(9)
                    ENDIF
                ENDDO
                
!--             wait for all pending local requests complete
                CALL MPI_Win_flush_local_all(win_lad, ierr)
                IF ( ierr /= 0 )  THEN
                    WRITE(9,*) 'Error MPI_Win_flush_local_all1:', ierr, win_lad
                    FLUSH(9)
                ENDIF
                CALL cpu_log( log_point_s(77), 'rad_rma_lad', 'stop' )
                
            ENDIF
#endif

!--         calculate csf and transparency
            DO i = 1, ncsb
#if defined( __parallel )
                IF ( raytrace_mpi_rma )  THEN
                    lad_s_target = lad_s_ray(i)
                ELSE
                    lad_s_target = sub_lad_g(lad_ip(i)*nnx*nny*nzp + lad_disp(i))
                ENDIF
#else
                lad_s_target = sub_lad(boxes(1,i),boxes(2,i),boxes(3,i))
#endif
                cursink = 1._wp - exp(-ext_coef * lad_s_target * crlens(i)*realdist)

                IF ( create_csf )  THEN
!--                 write svf values into the array
                    ncsfl = ncsfl + 1
                    acsf(ncsfl)%ip = lad_ip(i)
                    acsf(ncsfl)%itx = boxes(3,i)
                    acsf(ncsfl)%ity = boxes(2,i)
                    acsf(ncsfl)%itz = boxes(1,i)
                    acsf(ncsfl)%isurfs = isrc
                    acsf(ncsfl)%rcvf = cursink*transparency*difvf*atarg
                ENDIF  !< create_csf

                transparency = transparency * (1._wp - cursink)
                
            ENDDO
        ENDIF
        
        visible = .TRUE.

    END SUBROUTINE raytrace
    
 
!------------------------------------------------------------------------------!
! Description:
! ------------
!> A new, more efficient version of ray tracing algorithm that processes a whole
!> arc instead of a single ray.
!>
!> In all comments, horizon means tangent of horizon angle, i.e.
!> vertical_delta / horizontal_distance
!------------------------------------------------------------------------------!
   SUBROUTINE raytrace_2d(origin, yxdir, nrays, zdirs, iorig, aorig, vffrac,  &
                              calc_svf, create_csf, skip_1st_pcb,             &
                              lowest_free_ray, transparency, itarget)
      IMPLICIT NONE

      REAL(wp), DIMENSION(3), INTENT(IN)     ::  origin        !< z,y,x coordinates of ray origin
      REAL(wp), DIMENSION(2), INTENT(IN)     ::  yxdir         !< y,x *unit* vector of ray direction (in grid units)
      INTEGER(iwp)                           ::  nrays         !< number of rays (z directions) to raytrace
      REAL(wp), DIMENSION(nrays), INTENT(IN) ::  zdirs         !< list of z directions to raytrace (z/hdist, grid, zenith->nadir)
      INTEGER(iwp), INTENT(in)               ::  iorig         !< index of origin face for csf
      REAL(wp), INTENT(in)                   ::  aorig         !< origin face area for csf
      REAL(wp), DIMENSION(nrays), INTENT(in) ::  vffrac        !< view factor fractions of each ray for csf
      LOGICAL, INTENT(in)                    ::  calc_svf      !< whether to calculate SFV (identify obstacle surfaces)
      LOGICAL, INTENT(in)                    ::  create_csf    !< whether to create canopy sink factors
      LOGICAL, INTENT(in)                    ::  skip_1st_pcb  !< whether to skip first plant canopy box during raytracing
      INTEGER(iwp), INTENT(out)              ::  lowest_free_ray !< index into zdirs
      REAL(wp), DIMENSION(nrays), INTENT(OUT) ::  transparency !< transparencies of zdirs paths
      INTEGER(iwp), DIMENSION(nrays), INTENT(OUT) ::  itarget  !< global indices of target faces for zdirs

      INTEGER(iwp), DIMENSION(nrays)         ::  target_procs
      REAL(wp)                               ::  horizon       !< highest horizon found after raytracing (z/hdist)
      INTEGER(iwp)                           ::  i, k, l, d
      INTEGER(iwp)                           ::  seldim       !< dimension to be incremented
      REAL(wp), DIMENSION(2)                 ::  yxorigin     !< horizontal copy of origin (y,x)
      REAL(wp)                               ::  distance     !< euclidean along path
      REAL(wp)                               ::  lastdist     !< beginning of current crossing
      REAL(wp)                               ::  nextdist     !< end of current crossing
      REAL(wp)                               ::  crmid        !< midpoint of crossing
      REAL(wp)                               ::  horz_entry   !< horizon at entry to column
      REAL(wp)                               ::  horz_exit    !< horizon at exit from column
      REAL(wp)                               ::  bdydim       !< boundary for current dimension
      REAL(wp), DIMENSION(2)                 ::  crossdist    !< distances to boundary for dimensions
      REAL(wp), DIMENSION(2)                 ::  dimnextdist  !< distance for each dimension increments
      INTEGER(iwp), DIMENSION(2)             ::  column       !< grid column being crossed
      INTEGER(iwp), DIMENSION(2)             ::  dimnext      !< next dimension increments along path
      INTEGER(iwp), DIMENSION(2)             ::  dimdelta     !< dimension direction = +- 1
      INTEGER(iwp)                           ::  px, py       !< number of processors in x and y dir before 
                                                              !< the processor in the question
      INTEGER(iwp)                           ::  ip           !< number of processor where gridbox reside
      INTEGER(iwp)                           ::  ig           !< 1D index of gridbox in global 2D array
      INTEGER(iwp)                           ::  wcount       !< RMA window item count
      INTEGER(iwp)                           ::  maxboxes     !< max no of CSF created
      INTEGER(iwp)                           ::  nly          !< maximum  plant canopy height 
      INTEGER(iwp)                           ::  ntrack
      
      INTEGER(iwp)                           ::  zb0
      INTEGER(iwp)                           ::  zb1
      INTEGER(iwp)                           ::  nz
      INTEGER(iwp)                           ::  iz
      INTEGER(iwp)                           ::  zsgn
      INTEGER(iwp)                           ::  lowest_lad   !< lowest column cell for which we need LAD
      INTEGER(iwp)                           ::  lastdir      !< wall direction before hitting this column
      INTEGER(iwp), DIMENSION(2)             ::  lastcolumn

#if defined( __parallel )
      INTEGER(MPI_ADDRESS_KIND)              ::  wdisp        !< RMA window displacement
#endif
      
      REAL(wp)                               ::  eps = 1E-10_wp !< epsilon for value comparison
      REAL(wp)                               ::  zbottom, ztop !< urban surface boundary in real numbers
      REAL(wp)                               ::  zorig         !< z coordinate of ray column entry
      REAL(wp)                               ::  zexit         !< z coordinate of ray column exit
      REAL(wp)                               ::  qdist         !< ratio of real distance to z coord difference
      REAL(wp)                               ::  dxxyy         !< square of real horizontal distance
      REAL(wp)                               ::  curtrans      !< transparency of current PC box crossing
      

      
      yxorigin(:) = origin(2:3)
      transparency(:) = 1._wp !-- Pre-set the all rays to transparent before reducing
      horizon = -HUGE(1._wp)
      lowest_free_ray = nrays
      IF ( rad_angular_discretization  .AND.  calc_svf )  THEN
         ALLOCATE(target_surfl(nrays))
         target_surfl(:) = -1
         lastdir = -999
         lastcolumn(:) = -999
      ENDIF

!--   Determine distance to boundary (in 2D xy)
      IF ( yxdir(1) > 0._wp )  THEN
         bdydim = ny + .5_wp !< north global boundary
         crossdist(1) = (bdydim - yxorigin(1)) / yxdir(1)
      ELSEIF ( yxdir(1) == 0._wp )  THEN
         crossdist(1) = HUGE(1._wp)
      ELSE
          bdydim = -.5_wp !< south global boundary
          crossdist(1) = (bdydim - yxorigin(1)) / yxdir(1)
      ENDIF

      IF ( yxdir(2) >= 0._wp )  THEN
          bdydim = nx + .5_wp !< east global boundary
          crossdist(2) = (bdydim - yxorigin(2)) / yxdir(2)
      ELSEIF ( yxdir(2) == 0._wp )  THEN
         crossdist(2) = HUGE(1._wp)
      ELSE
          bdydim = -.5_wp !< west global boundary
          crossdist(2) = (bdydim - yxorigin(2)) / yxdir(2)
      ENDIF
      distance = minval(crossdist, 1)

      IF ( plant_canopy )  THEN
         rt2_track_dist(0) = 0._wp
         rt2_track_lad(:,:) = 0._wp
         nly = plantt_max - nzub + 1
      ENDIF

      lastdist = 0._wp

!--   Since all face coordinates have values *.5 and we'd like to use
!--   integers, all these have .5 added
      DO  d = 1, 2
          IF ( yxdir(d) == 0._wp )  THEN
              dimnext(d) = HUGE(1_iwp)
              dimdelta(d) = HUGE(1_iwp)
              dimnextdist(d) = HUGE(1._wp)
          ELSE IF ( yxdir(d) > 0._wp )  THEN
              dimnext(d) = FLOOR(yxorigin(d) + .5_wp) + 1
              dimdelta(d) = 1
              dimnextdist(d) = (dimnext(d) - .5_wp - yxorigin(d)) / yxdir(d)
          ELSE
              dimnext(d) = CEILING(yxorigin(d) + .5_wp) - 1
              dimdelta(d) = -1
              dimnextdist(d) = (dimnext(d) - .5_wp - yxorigin(d)) / yxdir(d)
          ENDIF
      ENDDO

      ntrack = 0
      DO
!--      along what dimension will the next wall crossing be?
         seldim = minloc(dimnextdist, 1)
         nextdist = dimnextdist(seldim)
         IF ( nextdist > distance )  nextdist = distance

         IF ( nextdist > lastdist )  THEN
            ntrack = ntrack + 1
            crmid = (lastdist + nextdist) * .5_wp
            column = NINT(yxorigin(:) + yxdir(:) * crmid, iwp)

!--         calculate index of the grid with global indices (column(1),column(2))
!--         in the array nzterr and plantt and id of the coresponding processor
            px = column(2)/nnx
            py = column(1)/nny
            ip = px*pdims(2)+py
            ig = ip*nnx*nny + (column(2)-px*nnx)*nny + column(1)-py*nny

            IF ( lastdist == 0._wp )  THEN
               horz_entry = -HUGE(1._wp)
            ELSE
               horz_entry = (REAL(nzterr(ig), wp) + .5_wp - origin(1)) / lastdist
            ENDIF
            horz_exit = (REAL(nzterr(ig), wp) + .5_wp - origin(1)) / nextdist

            IF ( rad_angular_discretization  .AND.  calc_svf )  THEN
!
!--            Identify vertical obstacles hit by rays in current column
               DO WHILE ( lowest_free_ray > 0 )
                  IF ( zdirs(lowest_free_ray) > horz_entry )  EXIT
!
!--               This may only happen after 1st column, so lastdir and lastcolumn are valid
                  CALL request_itarget(lastdir,                                         &
                        CEILING(-0.5_wp + origin(1) + zdirs(lowest_free_ray)*lastdist), &
                        lastcolumn(1), lastcolumn(2),                                   &
                        target_surfl(lowest_free_ray), target_procs(lowest_free_ray))
                  lowest_free_ray = lowest_free_ray - 1
               ENDDO
!
!--            Identify horizontal obstacles hit by rays in current column
               DO WHILE ( lowest_free_ray > 0 )
                  IF ( zdirs(lowest_free_ray) > horz_exit )  EXIT
                  CALL request_itarget(iup_u, nzterr(ig)+1, column(1), column(2), &
                                       target_surfl(lowest_free_ray),           &
                                       target_procs(lowest_free_ray))
                  lowest_free_ray = lowest_free_ray - 1
               ENDDO
            ENDIF

            horizon = MAX(horizon, horz_entry, horz_exit)

            IF ( plant_canopy )  THEN
               rt2_track(:, ntrack) = column(:)
               rt2_track_dist(ntrack) = nextdist
            ENDIF
         ENDIF

         IF ( ABS(distance - nextdist) < eps )  EXIT

         IF ( rad_angular_discretization  .AND.  calc_svf )  THEN
!
!--         Save wall direction of coming building column (= this air column)
            IF ( seldim == 1 )  THEN
               IF ( dimdelta(seldim) == 1 )  THEN
                  lastdir = isouth_u
               ELSE
                  lastdir = inorth_u
               ENDIF
            ELSE
               IF ( dimdelta(seldim) == 1 )  THEN
                  lastdir = iwest_u
               ELSE
                  lastdir = ieast_u
               ENDIF
            ENDIF
            lastcolumn = column
         ENDIF
         lastdist = nextdist
         dimnext(seldim) = dimnext(seldim) + dimdelta(seldim)
         dimnextdist(seldim) = (dimnext(seldim) - .5_wp - yxorigin(seldim)) / yxdir(seldim)
      ENDDO

      IF ( plant_canopy )  THEN
!--      Request LAD WHERE applicable
!--      
#if defined( __parallel )
         IF ( raytrace_mpi_rma )  THEN
!--         send requests for lad_s to appropriate processor
            !CALL cpu_log( log_point_s(77), 'usm_init_rma', 'start' )
            DO  i = 1, ntrack
               px = rt2_track(2,i)/nnx
               py = rt2_track(1,i)/nny
               ip = px*pdims(2)+py
               ig = ip*nnx*nny + (rt2_track(2,i)-px*nnx)*nny + rt2_track(1,i)-py*nny

               IF ( rad_angular_discretization  .AND.  calc_svf )  THEN
!
!--               For fixed view resolution, we need plant canopy even for rays
!--               to opposing surfaces
                  lowest_lad = nzterr(ig) + 1
               ELSE
!
!--               We only need LAD for rays directed above horizon (to sky)
                  lowest_lad = CEILING( -0.5_wp + origin(1) +            &
                                    MIN( horizon * rt2_track_dist(i-1),  & ! entry
                                         horizon * rt2_track_dist(i)   ) ) ! exit
               ENDIF
!
!--            Skip asking for LAD where all plant canopy is under requested level
               IF ( plantt(ig) < lowest_lad )  CYCLE

               wdisp = (rt2_track(2,i)-px*nnx)*(nny*nzp) + (rt2_track(1,i)-py*nny)*nzp + lowest_lad-nzub
               wcount = plantt(ig)-lowest_lad+1
               ! TODO send request ASAP - even during raytracing
               CALL MPI_Get(rt2_track_lad(lowest_lad:plantt(ig), i), wcount, MPI_REAL, ip,    &
                            wdisp, wcount, MPI_REAL, win_lad, ierr)
               IF ( ierr /= 0 )  THEN
                  WRITE(9,*) 'Error MPI_Get2:', ierr, rt2_track_lad(lowest_lad:plantt(ig), i), &
                             wcount, ip, wdisp, win_lad
                  FLUSH(9)
               ENDIF
            ENDDO

!--         wait for all pending local requests complete
            ! TODO WAIT selectively for each column later when needed
            CALL MPI_Win_flush_local_all(win_lad, ierr)
            IF ( ierr /= 0 )  THEN
               WRITE(9,*) 'Error MPI_Win_flush_local_all2:', ierr, win_lad
               FLUSH(9)
            ENDIF
            !CALL cpu_log( log_point_s(77), 'usm_init_rma', 'stop' )

         ELSE ! raytrace_mpi_rma = .F.
            DO  i = 1, ntrack
               px = rt2_track(2,i)/nnx
               py = rt2_track(1,i)/nny
               ip = px*pdims(2)+py
               ig = ip*nnx*nny*nzp + (rt2_track(2,i)-px*nnx)*(nny*nzp) + (rt2_track(1,i)-py*nny)*nzp
               rt2_track_lad(nzub:plantt_max, i) = sub_lad_g(ig:ig+nly-1)
            ENDDO
         ENDIF
#else
         DO  i = 1, ntrack
            rt2_track_lad(nzub:plantt_max, i) = sub_lad(rt2_track(1,i), rt2_track(2,i), nzub:plantt_max)
         ENDDO
#endif
      ENDIF ! plant_canopy

      IF ( rad_angular_discretization  .AND.  calc_svf )  THEN
#if defined( __parallel )
!--      wait for all gridsurf requests to complete
         CALL MPI_Win_flush_local_all(win_gridsurf, ierr)
         IF ( ierr /= 0 )  THEN
            WRITE(9,*) 'Error MPI_Win_flush_local_all3:', ierr, win_gridsurf
            FLUSH(9)
         ENDIF
#endif
!
!--      recalculate local surf indices into global ones
         DO i = 1, nrays
            IF ( target_surfl(i) == -1 )  THEN
               itarget(i) = -1
            ELSE
               itarget(i) = target_surfl(i) + surfstart(target_procs(i))
            ENDIF
         ENDDO
         
         DEALLOCATE( target_surfl )
         
      ELSE
         itarget(:) = -1
      ENDIF ! rad_angular_discretization

      IF ( plant_canopy )  THEN
!--      Skip the PCB around origin if requested (for MRT, the PCB might not be there)
!--      
         IF ( skip_1st_pcb  .AND.  NINT(origin(1)) <= plantt_max )  THEN
            rt2_track_lad(NINT(origin(1), iwp), 1) = 0._wp
         ENDIF

!--      Assert that we have space allocated for CSFs
!--      
         maxboxes = (ntrack + MAX(CEILING(origin(1)-.5_wp) - nzub,          &
                                  nzut - CEILING(origin(1)-.5_wp))) * nrays
         IF ( ncsfl + maxboxes > ncsfla )  THEN
!--         use this code for growing by fixed exponential increments (equivalent to case where ncsfl always increases by 1)
!--         k = CEILING(grow_factor ** real(CEILING(log(real(ncsfl + maxboxes, kind=wp)) &
!--                                                / log(grow_factor)), kind=wp))
!--         or use this code to simply always keep some extra space after growing
            k = CEILING(REAL(ncsfl + maxboxes, kind=wp) * grow_factor)
            CALL merge_and_grow_csf(k)
         ENDIF

!--      Calculate transparencies and store new CSFs
!--      
         zbottom = REAL(nzub, wp) - .5_wp
         ztop = REAL(plantt_max, wp) + .5_wp

!--      Reverse direction of radiation (face->sky), only when calc_svf
!--      
         IF ( calc_svf )  THEN
            DO  i = 1, ntrack ! for each column
               dxxyy = ((dy*yxdir(1))**2 + (dx*yxdir(2))**2) * (rt2_track_dist(i)-rt2_track_dist(i-1))**2
               px = rt2_track(2,i)/nnx
               py = rt2_track(1,i)/nny
               ip = px*pdims(2)+py

               DO  k = 1, nrays ! for each ray
!
!--               NOTE 6778:
!--               With traditional svf discretization, CSFs under the horizon
!--               (i.e. for surface to surface radiation)  are created in
!--               raytrace(). With rad_angular_discretization, we must create
!--               CSFs under horizon only for one direction, otherwise we would
!--               have duplicate amount of energy. Although we could choose
!--               either of the two directions (they differ only by
!--               discretization error with no bias), we choose the the backward
!--               direction, because it tends to cumulate high canopy sink
!--               factors closer to raytrace origin, i.e. it should potentially
!--               cause less moiree.
                  IF ( .NOT. rad_angular_discretization )  THEN
                     IF ( zdirs(k) <= horizon )  CYCLE
                  ENDIF

                  zorig = origin(1) + zdirs(k) * rt2_track_dist(i-1)
                  IF ( zorig <= zbottom  .OR.  zorig >= ztop )  CYCLE

                  zsgn = INT(SIGN(1._wp, zdirs(k)), iwp)
                  rt2_dist(1) = 0._wp
                  IF ( zdirs(k) == 0._wp )  THEN ! ray is exactly horizontal
                     nz = 2
                     rt2_dist(nz) = SQRT(dxxyy)
                     iz = CEILING(-.5_wp + zorig, iwp)
                  ELSE
                     zexit = MIN(MAX(origin(1) + zdirs(k) * rt2_track_dist(i), zbottom), ztop)

                     zb0 = FLOOR(  zorig * zsgn - .5_wp) + 1  ! because it must be greater than orig
                     zb1 = CEILING(zexit * zsgn - .5_wp) - 1  ! because it must be smaller than exit
                     nz = MAX(zb1 - zb0 + 3, 2)
                     rt2_dist(nz) = SQRT(((zexit-zorig)*dz(1))**2 + dxxyy)
                     qdist = rt2_dist(nz) / (zexit-zorig)
                     rt2_dist(2:nz-1) = (/( ((REAL(l, wp) + .5_wp) * zsgn - zorig) * qdist , l = zb0, zb1 )/)
                     iz = zb0 * zsgn
                  ENDIF

                  DO  l = 2, nz
                     IF ( rt2_track_lad(iz, i) > 0._wp )  THEN
                        curtrans = exp(-ext_coef * rt2_track_lad(iz, i) * (rt2_dist(l)-rt2_dist(l-1)))

                        IF ( create_csf )  THEN
                           ncsfl = ncsfl + 1
                           acsf(ncsfl)%ip = ip
                           acsf(ncsfl)%itx = rt2_track(2,i)
                           acsf(ncsfl)%ity = rt2_track(1,i)
                           acsf(ncsfl)%itz = iz
                           acsf(ncsfl)%isurfs = iorig
                           acsf(ncsfl)%rcvf = (1._wp - curtrans)*transparency(k)*vffrac(k)
                        ENDIF

                        transparency(k) = transparency(k) * curtrans
                     ENDIF
                     iz = iz + zsgn
                  ENDDO ! l = 1, nz - 1
               ENDDO ! k = 1, nrays
            ENDDO ! i = 1, ntrack

            transparency(1:lowest_free_ray) = 1._wp !-- Reset rays above horizon to transparent (see NOTE 6778)
         ENDIF

!--      Forward direction of radiation (sky->face), always
!--      
         DO  i = ntrack, 1, -1 ! for each column backwards
            dxxyy = ((dy*yxdir(1))**2 + (dx*yxdir(2))**2) * (rt2_track_dist(i)-rt2_track_dist(i-1))**2
            px = rt2_track(2,i)/nnx
            py = rt2_track(1,i)/nny
            ip = px*pdims(2)+py

            DO  k = 1, nrays ! for each ray
!
!--            See NOTE 6778 above
               IF ( zdirs(k) <= horizon )  CYCLE

               zexit = origin(1) + zdirs(k) * rt2_track_dist(i-1)
               IF ( zexit <= zbottom  .OR.  zexit >= ztop )  CYCLE

               zsgn = -INT(SIGN(1._wp, zdirs(k)), iwp)
               rt2_dist(1) = 0._wp
               IF ( zdirs(k) == 0._wp )  THEN ! ray is exactly horizontal
                  nz = 2
                  rt2_dist(nz) = SQRT(dxxyy)
                  iz = NINT(zexit, iwp)
               ELSE
                  zorig = MIN(MAX(origin(1) + zdirs(k) * rt2_track_dist(i), zbottom), ztop)

                  zb0 = FLOOR(  zorig * zsgn - .5_wp) + 1  ! because it must be greater than orig
                  zb1 = CEILING(zexit * zsgn - .5_wp) - 1  ! because it must be smaller than exit
                  nz = MAX(zb1 - zb0 + 3, 2)
                  rt2_dist(nz) = SQRT(((zexit-zorig)*dz(1))**2 + dxxyy)
                  qdist = rt2_dist(nz) / (zexit-zorig)
                  rt2_dist(2:nz-1) = (/( ((REAL(l, wp) + .5_wp) * zsgn - zorig) * qdist , l = zb0, zb1 )/)
                  iz = zb0 * zsgn
               ENDIF

               DO  l = 2, nz
                  IF ( rt2_track_lad(iz, i) > 0._wp )  THEN
                     curtrans = exp(-ext_coef * rt2_track_lad(iz, i) * (rt2_dist(l)-rt2_dist(l-1)))

                     IF ( create_csf )  THEN
                        ncsfl = ncsfl + 1
                        acsf(ncsfl)%ip = ip
                        acsf(ncsfl)%itx = rt2_track(2,i)
                        acsf(ncsfl)%ity = rt2_track(1,i)
                        acsf(ncsfl)%itz = iz
                        IF ( itarget(k) /= -1 )  ERROR STOP !FIXME remove after test
                        acsf(ncsfl)%isurfs = -1
                        acsf(ncsfl)%rcvf = (1._wp - curtrans)*transparency(k)*aorig*vffrac(k)
                     ENDIF  ! create_csf

                     transparency(k) = transparency(k) * curtrans
                  ENDIF
                  iz = iz + zsgn
               ENDDO ! l = 1, nz - 1
            ENDDO ! k = 1, nrays
         ENDDO ! i = 1, ntrack
      ENDIF ! plant_canopy

      IF ( .NOT. (rad_angular_discretization  .AND.  calc_svf) )  THEN
!
!--      Just update lowest_free_ray according to horizon
         DO WHILE ( lowest_free_ray > 0 )
            IF ( zdirs(lowest_free_ray) > horizon )  EXIT
            lowest_free_ray = lowest_free_ray - 1
         ENDDO
      ENDIF

   CONTAINS

      SUBROUTINE request_itarget( d, z, y, x, isurfl, iproc )

         INTEGER(iwp), INTENT(in)            ::  d, z, y, x
         INTEGER(iwp), TARGET, INTENT(out)   ::  isurfl
         INTEGER(iwp), INTENT(out)           ::  iproc
#if defined( __parallel )
#else
         INTEGER(iwp)                        ::  target_displ  !< index of the grid in the local gridsurf array
#endif
         INTEGER(iwp)                        ::  px, py        !< number of processors in x and y direction
                                                               !< before the processor in the question
#if defined( __parallel )
         INTEGER(KIND=MPI_ADDRESS_KIND)      ::  target_displ  !< index of the grid in the local gridsurf array

!
!--      Calculate target processor and index in the remote local target gridsurf array
         px = x / nnx
         py = y / nny
         iproc = px * pdims(2) + py
         target_displ = ((x-px*nnx) * nny + y - py*nny ) * nzu * nsurf_type_u +&
                        ( z-nzub ) * nsurf_type_u + d
!
!--      Send MPI_Get request to obtain index target_surfl(i)
         CALL MPI_GET( isurfl, 1, MPI_INTEGER, iproc, target_displ,            &
                       1, MPI_INTEGER, win_gridsurf, ierr)
         IF ( ierr /= 0 )  THEN
            WRITE( 9,* ) 'Error MPI_Get3:', ierr, isurfl, iproc, target_displ, &
                         win_gridsurf
            FLUSH( 9 )
         ENDIF
#else
!--      set index target_surfl(i)
         isurfl = gridsurf(d,z,y,x)
#endif

      END SUBROUTINE request_itarget

   END SUBROUTINE raytrace_2d
 

!------------------------------------------------------------------------------!
!
! Description:
! ------------
!> Calculates apparent solar positions for all timesteps and stores discretized
!> positions.
!------------------------------------------------------------------------------!
   SUBROUTINE radiation_presimulate_solar_pos
      IMPLICIT NONE

      INTEGER(iwp)                              ::  it, i, j
      REAL(wp)                                  ::  tsrp_prev
      REAL(wp)                                  ::  simulated_time_prev
      REAL(wp), DIMENSION(:,:), ALLOCATABLE     ::  dsidir_tmp       !< dsidir_tmp[:,i] = unit vector of i-th
                                                                     !< appreant solar direction

      ALLOCATE ( dsidir_rev(0:raytrace_discrete_elevs/2-1,                 &
                            0:raytrace_discrete_azims-1) )
      dsidir_rev(:,:) = -1
      ALLOCATE ( dsidir_tmp(3,                                             &
                     raytrace_discrete_elevs/2*raytrace_discrete_azims) )
      ndsidir = 0

!
!--   We will artificialy update time_since_reference_point and return to
!--   true value later
      tsrp_prev = time_since_reference_point
      simulated_time_prev = simulated_time
      sun_direction = .TRUE.

!
!--   Process spinup time if configured
      IF ( spinup_time > 0._wp )  THEN
         DO  it = 0, CEILING(spinup_time / dt_spinup)
            time_since_reference_point = -spinup_time + REAL(it, wp) * dt_spinup
            simulated_time = simulated_time + dt_spinup
            CALL simulate_pos
         ENDDO
      ENDIF
!
!--   Process simulation time
      DO  it = 0, CEILING(( end_time - spinup_time ) / dt_radiation)
         time_since_reference_point = REAL(it, wp) * dt_radiation
         simulated_time = simulated_time + dt_spinup
         CALL simulate_pos
      ENDDO

      time_since_reference_point = tsrp_prev
      simulated_time = simulated_time_prev

!--   Allocate global vars which depend on ndsidir
      ALLOCATE ( dsidir ( 3, ndsidir ) )
      dsidir(:,:) = dsidir_tmp(:, 1:ndsidir)
      DEALLOCATE ( dsidir_tmp )

      ALLOCATE ( dsitrans(nsurfl, ndsidir) )
      ALLOCATE ( dsitransc(npcbl, ndsidir) )
      IF ( nmrtbl > 0 )  ALLOCATE ( mrtdsit(nmrtbl, ndsidir) )

      WRITE ( message_string, * ) 'Precalculated', ndsidir, ' solar positions', &
                                  'from', it, ' timesteps.'
      CALL message( 'radiation_presimulate_solar_pos', 'UI0013', 0, 0, 0, 6, 0 )

      CONTAINS

      !------------------------------------------------------------------------!
      ! Description:
      ! ------------
      !> Simuates a single position
      !------------------------------------------------------------------------!
      SUBROUTINE simulate_pos
         IMPLICIT NONE
!
!--      Update apparent solar position based on modified t_s_r_p
         CALL calc_zenith
         IF ( zenith(0) > 0 )  THEN
!--         
!--         Identify solar direction vector (discretized number) 1)
            i = MODULO(NINT(ATAN2(sun_dir_lon(0), sun_dir_lat(0))               &
                            / (2._wp*pi) * raytrace_discrete_azims-.5_wp, iwp), &
                       raytrace_discrete_azims)
            j = FLOOR(ACOS(zenith(0)) / pi * raytrace_discrete_elevs)
            IF ( dsidir_rev(j, i) == -1 )  THEN
               ndsidir = ndsidir + 1
               dsidir_tmp(:, ndsidir) =                                              &
                     (/ COS((REAL(j,wp)+.5_wp) * pi      / raytrace_discrete_elevs), &
                        SIN((REAL(j,wp)+.5_wp) * pi      / raytrace_discrete_elevs)  &
                      * COS((REAL(i,wp)+.5_wp) * 2_wp*pi / raytrace_discrete_azims), &
                        SIN((REAL(j,wp)+.5_wp) * pi      / raytrace_discrete_elevs)  &
                      * SIN((REAL(i,wp)+.5_wp) * 2_wp*pi / raytrace_discrete_azims) /)
               dsidir_rev(j, i) = ndsidir
            ENDIF
         ENDIF
      END SUBROUTINE simulate_pos

   END SUBROUTINE radiation_presimulate_solar_pos



!------------------------------------------------------------------------------!
! Description:
! ------------
!> Determines whether two faces are oriented towards each other. Since the
!> surfaces follow the gird box surfaces, it checks first whether the two surfaces
!> are directed in the same direction, then it checks if the two surfaces are
!> located in confronted direction but facing away from each other, e.g. <--| |-->
!------------------------------------------------------------------------------!
    PURE LOGICAL FUNCTION surface_facing(x, y, z, d, x2, y2, z2, d2)
        IMPLICIT NONE
        INTEGER(iwp),   INTENT(in)  :: x, y, z, d, x2, y2, z2, d2
      
        surface_facing = .FALSE.

!-- first check: are the two surfaces directed in the same direction
        IF ( (d==iup_u  .OR.  d==iup_l )                             &
             .AND. (d2==iup_u  .OR. d2==iup_l) ) RETURN
        IF ( (d==isouth_u  .OR.  d==isouth_l ) &
             .AND.  (d2==isouth_u  .OR.  d2==isouth_l) ) RETURN
        IF ( (d==inorth_u  .OR.  d==inorth_l ) &
             .AND.  (d2==inorth_u  .OR.  d2==inorth_l) ) RETURN
        IF ( (d==iwest_u  .OR.  d==iwest_l )     &
             .AND.  (d2==iwest_u  .OR.  d2==iwest_l ) ) RETURN
        IF ( (d==ieast_u  .OR.  d==ieast_l )     &
             .AND.  (d2==ieast_u  .OR.  d2==ieast_l ) ) RETURN

!-- second check: are surfaces facing away from each other
        SELECT CASE (d)
            CASE (iup_u, iup_l)                     !< upward facing surfaces
                IF ( z2 < z ) RETURN
            CASE (isouth_u, isouth_l)               !< southward facing surfaces
                IF ( y2 > y ) RETURN
            CASE (inorth_u, inorth_l)               !< northward facing surfaces
                IF ( y2 < y ) RETURN
            CASE (iwest_u, iwest_l)                 !< westward facing surfaces
                IF ( x2 > x ) RETURN
            CASE (ieast_u, ieast_l)                 !< eastward facing surfaces
                IF ( x2 < x ) RETURN
        END SELECT

        SELECT CASE (d2)
            CASE (iup_u)                            !< ground, roof
                IF ( z < z2 ) RETURN
            CASE (isouth_u, isouth_l)               !< south facing
                IF ( y > y2 ) RETURN
            CASE (inorth_u, inorth_l)               !< north facing
                IF ( y < y2 ) RETURN
            CASE (iwest_u, iwest_l)                 !< west facing
                IF ( x > x2 ) RETURN
            CASE (ieast_u, ieast_l)                 !< east facing
                IF ( x < x2 ) RETURN
            CASE (-1)
                CONTINUE
        END SELECT

        surface_facing = .TRUE.
        
    END FUNCTION surface_facing


!------------------------------------------------------------------------------!
!
! Description:
! ------------
!> Soubroutine reads svf and svfsurf data from saved file
!> SVF means sky view factors and CSF means canopy sink factors
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_read_svf

       IMPLICIT NONE
       
       CHARACTER(rad_version_len)   :: rad_version_field
       
       INTEGER(iwp)                 :: i
       INTEGER(iwp)                 :: ndsidir_from_file = 0
       INTEGER(iwp)                 :: npcbl_from_file = 0
       INTEGER(iwp)                 :: nsurfl_from_file = 0
       
       DO  i = 0, io_blocks-1
          IF ( i == io_group )  THEN

!
!--          numprocs_previous_run is only known in case of reading restart
!--          data. If a new initial run which reads svf data is started the
!--          following query will be skipped
             IF ( initializing_actions == 'read_restart_data' ) THEN

                IF ( numprocs_previous_run /= numprocs ) THEN
                   WRITE( message_string, * ) 'A different number of ',        &
                                              'processors between the run ',   &
                                              'that has written the svf data ',&
                                              'and the one that will read it ',&
                                              'is not allowed' 
                   CALL message( 'check_open', 'PA0491', 1, 2, 0, 6, 0 )
                ENDIF

             ENDIF
              
!
!--          Open binary file 
             CALL check_open( 88 )

!
!--          read and check version
             READ ( 88 ) rad_version_field
             IF ( TRIM(rad_version_field) /= TRIM(rad_version) )  THEN
                 WRITE( message_string, * ) 'Version of binary SVF file "',    &
                             TRIM(rad_version_field), '" does not match ',     &
                             'the version of model "', TRIM(rad_version), '"'
                 CALL message( 'radiation_read_svf', 'PA0482', 1, 2, 0, 6, 0 )
             ENDIF
              
!
!--          read nsvfl, ncsfl, nsurfl
             READ ( 88 ) nsvfl, ncsfl, nsurfl_from_file, npcbl_from_file,      &
                         ndsidir_from_file
             
             IF ( nsvfl < 0  .OR.  ncsfl < 0 )  THEN
                 WRITE( message_string, * ) 'Wrong number of SVF or CSF'
                 CALL message( 'radiation_read_svf', 'PA0483', 1, 2, 0, 6, 0 )
             ELSE
                 WRITE(message_string,*) '    Number of SVF, CSF, and nsurfl ',&
                                         'to read', nsvfl, ncsfl,              &
                                         nsurfl_from_file
                 CALL location_message( message_string, .TRUE. )
             ENDIF
             
             IF ( nsurfl_from_file /= nsurfl )  THEN
                 WRITE( message_string, * ) 'nsurfl from SVF file does not ',  &
                                            'match calculated nsurfl from ',   &
                                            'radiation_interaction_init'
                 CALL message( 'radiation_read_svf', 'PA0490', 1, 2, 0, 6, 0 )
             ENDIF
             
             IF ( npcbl_from_file /= npcbl )  THEN
                 WRITE( message_string, * ) 'npcbl from SVF file does not ',   &
                                            'match calculated npcbl from ',    &
                                            'radiation_interaction_init'
                 CALL message( 'radiation_read_svf', 'PA0493', 1, 2, 0, 6, 0 )
             ENDIF
             
             IF ( ndsidir_from_file /= ndsidir )  THEN
                 WRITE( message_string, * ) 'ndsidir from SVF file does not ', &
                                            'match calculated ndsidir from ',  &
                                            'radiation_presimulate_solar_pos'
                 CALL message( 'radiation_read_svf', 'PA0494', 1, 2, 0, 6, 0 )
             ENDIF
              
!
!--          Arrays skyvf, skyvft, dsitrans and dsitransc are allready 
!--          allocated in radiation_interaction_init and 
!--          radiation_presimulate_solar_pos
             IF ( nsurfl > 0 )  THEN
                READ(88) skyvf
                READ(88) skyvft
                READ(88) dsitrans  
             ENDIF
              
             IF ( plant_canopy  .AND.  npcbl > 0 ) THEN
                READ ( 88 )  dsitransc
             ENDIF
             
!
!--          The allocation of svf, svfsurf, csf and csfsurf happens in routine 
!--          radiation_calc_svf which is not called if the program enters 
!--          radiation_read_svf. Therefore these arrays has to allocate in the 
!--          following
             IF ( nsvfl > 0 )  THEN
                ALLOCATE( svf(ndsvf,nsvfl) )
                ALLOCATE( svfsurf(idsvf,nsvfl) )
                READ(88) svf
                READ(88) svfsurf
             ENDIF

             IF ( plant_canopy  .AND.  ncsfl > 0 )  THEN
                ALLOCATE( csf(ndcsf,ncsfl) )
                ALLOCATE( csfsurf(idcsf,ncsfl) )
                READ(88) csf
                READ(88) csfsurf
             ENDIF
              
!
!--          Close binary file                 
             CALL close_file( 88 )
                
          ENDIF
#if defined( __parallel )
          CALL MPI_BARRIER( comm2d, ierr )
#endif
       ENDDO

    END SUBROUTINE radiation_read_svf


!------------------------------------------------------------------------------!
!
! Description:
! ------------
!> Subroutine stores svf, svfsurf, csf and csfsurf data to a file.
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_write_svf

       IMPLICIT NONE
       
       INTEGER(iwp)        :: i

       DO  i = 0, io_blocks-1
          IF ( i == io_group )  THEN
!
!--          Open binary file 
             CALL check_open( 89 )

             WRITE ( 89 )  rad_version
             WRITE ( 89 )  nsvfl, ncsfl, nsurfl, npcbl, ndsidir
             IF ( nsurfl > 0 ) THEN
                WRITE ( 89 )  skyvf
                WRITE ( 89 )  skyvft
                WRITE ( 89 )  dsitrans
             ENDIF
             IF ( npcbl > 0 ) THEN
                WRITE ( 89 )  dsitransc
             ENDIF
             IF ( nsvfl > 0 ) THEN
                WRITE ( 89 )  svf
                WRITE ( 89 )  svfsurf
             ENDIF
             IF ( plant_canopy  .AND.  ncsfl > 0 )  THEN
                 WRITE ( 89 )  csf
                 WRITE ( 89 )  csfsurf
             ENDIF

!
!--          Close binary file                 
             CALL close_file( 89 )

          ENDIF
#if defined( __parallel )
          CALL MPI_BARRIER( comm2d, ierr )
#endif
       ENDDO
    END SUBROUTINE radiation_write_svf

!------------------------------------------------------------------------------!
!
! Description:
! ------------
!> Block of auxiliary subroutines:
!> 1. quicksort and corresponding comparison
!> 2. merge_and_grow_csf for implementation of "dynamical growing"
!>    array for csf
!------------------------------------------------------------------------------!
!-- quicksort.f -*-f90-*-
!-- Author: t-nissie, adaptation J.Resler
!-- License: GPLv3
!-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
    RECURSIVE SUBROUTINE quicksort_itarget(itarget, vffrac, ztransp, first, last)
        IMPLICIT NONE
        INTEGER(iwp), DIMENSION(:), INTENT(INOUT)   :: itarget
        REAL(wp), DIMENSION(:), INTENT(INOUT)       :: vffrac, ztransp
        INTEGER(iwp), INTENT(IN)                    :: first, last
        INTEGER(iwp)                                :: x, t
        INTEGER(iwp)                                :: i, j
        REAL(wp)                                    :: tr

        IF ( first>=last ) RETURN
        x = itarget((first+last)/2)
        i = first
        j = last
        DO
            DO WHILE ( itarget(i) < x )
               i=i+1
            ENDDO
            DO WHILE ( x < itarget(j) )
                j=j-1
            ENDDO
            IF ( i >= j ) EXIT
            t = itarget(i);  itarget(i) = itarget(j);  itarget(j) = t
            tr = vffrac(i);  vffrac(i) = vffrac(j);  vffrac(j) = tr
            tr = ztransp(i);  ztransp(i) = ztransp(j);  ztransp(j) = tr
            i=i+1
            j=j-1
        ENDDO
        IF ( first < i-1 ) CALL quicksort_itarget(itarget, vffrac, ztransp, first, i-1)
        IF ( j+1 < last )  CALL quicksort_itarget(itarget, vffrac, ztransp, j+1, last)
    END SUBROUTINE quicksort_itarget

    PURE FUNCTION svf_lt(svf1,svf2) result (res)
      TYPE (t_svf), INTENT(in) :: svf1,svf2
      LOGICAL                  :: res
      IF ( svf1%isurflt < svf2%isurflt  .OR.    &
          (svf1%isurflt == svf2%isurflt  .AND.  svf1%isurfs < svf2%isurfs) )  THEN
          res = .TRUE.
      ELSE
          res = .FALSE.
      ENDIF
    END FUNCTION svf_lt


!-- quicksort.f -*-f90-*-
!-- Author: t-nissie, adaptation J.Resler
!-- License: GPLv3
!-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
    RECURSIVE SUBROUTINE quicksort_svf(svfl, first, last)
        IMPLICIT NONE
        TYPE(t_svf), DIMENSION(:), INTENT(INOUT)  :: svfl
        INTEGER(iwp), INTENT(IN)                  :: first, last
        TYPE(t_svf)                               :: x, t
        INTEGER(iwp)                              :: i, j

        IF ( first>=last ) RETURN
        x = svfl( (first+last) / 2 )
        i = first
        j = last
        DO
            DO while ( svf_lt(svfl(i),x) )
               i=i+1
            ENDDO
            DO while ( svf_lt(x,svfl(j)) )
                j=j-1
            ENDDO
            IF ( i >= j ) EXIT
            t = svfl(i);  svfl(i) = svfl(j);  svfl(j) = t
            i=i+1
            j=j-1
        ENDDO
        IF ( first < i-1 ) CALL quicksort_svf(svfl, first, i-1)
        IF ( j+1 < last )  CALL quicksort_svf(svfl, j+1, last)
    END SUBROUTINE quicksort_svf

    PURE FUNCTION csf_lt(csf1,csf2) result (res)
      TYPE (t_csf), INTENT(in) :: csf1,csf2
      LOGICAL                  :: res
      IF ( csf1%ip < csf2%ip  .OR.    &
           (csf1%ip == csf2%ip  .AND.  csf1%itx < csf2%itx)  .OR.  &
           (csf1%ip == csf2%ip  .AND.  csf1%itx == csf2%itx  .AND.  csf1%ity < csf2%ity)  .OR.  &
           (csf1%ip == csf2%ip  .AND.  csf1%itx == csf2%itx  .AND.  csf1%ity == csf2%ity  .AND.   &
            csf1%itz < csf2%itz)  .OR.  &
           (csf1%ip == csf2%ip  .AND.  csf1%itx == csf2%itx  .AND.  csf1%ity == csf2%ity  .AND.   &
            csf1%itz == csf2%itz  .AND.  csf1%isurfs < csf2%isurfs) )  THEN
          res = .TRUE.
      ELSE
          res = .FALSE.
      ENDIF
    END FUNCTION csf_lt


!-- quicksort.f -*-f90-*-
!-- Author: t-nissie, adaptation J.Resler
!-- License: GPLv3
!-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
    RECURSIVE SUBROUTINE quicksort_csf(csfl, first, last)
        IMPLICIT NONE
        TYPE(t_csf), DIMENSION(:), INTENT(INOUT)  :: csfl
        INTEGER(iwp), INTENT(IN)                  :: first, last
        TYPE(t_csf)                               :: x, t
        INTEGER(iwp)                              :: i, j

        IF ( first>=last ) RETURN
        x = csfl( (first+last)/2 )
        i = first
        j = last
        DO
            DO while ( csf_lt(csfl(i),x) )
                i=i+1
            ENDDO
            DO while ( csf_lt(x,csfl(j)) )
                j=j-1
            ENDDO
            IF ( i >= j ) EXIT
            t = csfl(i);  csfl(i) = csfl(j);  csfl(j) = t
            i=i+1
            j=j-1
        ENDDO
        IF ( first < i-1 ) CALL quicksort_csf(csfl, first, i-1)
        IF ( j+1 < last )  CALL quicksort_csf(csfl, j+1, last)
    END SUBROUTINE quicksort_csf

    
    SUBROUTINE merge_and_grow_csf(newsize)
        INTEGER(iwp), INTENT(in)                :: newsize  !< new array size after grow, must be >= ncsfl
                                                            !< or -1 to shrink to minimum
        INTEGER(iwp)                            :: iread, iwrite
        TYPE(t_csf), DIMENSION(:), POINTER      :: acsfnew
        CHARACTER(100)                          :: msg

        IF ( newsize == -1 )  THEN
!--         merge in-place
            acsfnew => acsf
        ELSE
!--         allocate new array
            IF ( mcsf == 0 )  THEN
                ALLOCATE( acsf1(newsize) )
                acsfnew => acsf1
            ELSE
                ALLOCATE( acsf2(newsize) )
                acsfnew => acsf2
            ENDIF
        ENDIF

        IF ( ncsfl >= 1 )  THEN
!--         sort csf in place (quicksort)
            CALL quicksort_csf(acsf,1,ncsfl)

!--         while moving to a new array, aggregate canopy sink factor records with identical box & source
            acsfnew(1) = acsf(1)
            iwrite = 1
            DO iread = 2, ncsfl
!--             here acsf(kcsf) already has values from acsf(icsf)
                IF ( acsfnew(iwrite)%itx == acsf(iread)%itx &
                         .AND.  acsfnew(iwrite)%ity == acsf(iread)%ity &
                         .AND.  acsfnew(iwrite)%itz == acsf(iread)%itz &
                         .AND.  acsfnew(iwrite)%isurfs == acsf(iread)%isurfs )  THEN

                    acsfnew(iwrite)%rcvf = acsfnew(iwrite)%rcvf + acsf(iread)%rcvf
!--                 advance reading index, keep writing index
                ELSE
!--                 not identical, just advance and copy
                    iwrite = iwrite + 1
                    acsfnew(iwrite) = acsf(iread)
                ENDIF
            ENDDO
            ncsfl = iwrite
        ENDIF

        IF ( newsize == -1 )  THEN
!--         allocate new array and copy shrinked data
            IF ( mcsf == 0 )  THEN
                ALLOCATE( acsf1(ncsfl) )
                acsf1(1:ncsfl) = acsf2(1:ncsfl)
            ELSE
                ALLOCATE( acsf2(ncsfl) )
                acsf2(1:ncsfl) = acsf1(1:ncsfl)
            ENDIF
        ENDIF

!--     deallocate old array
        IF ( mcsf == 0 )  THEN
            mcsf = 1
            acsf => acsf1
            DEALLOCATE( acsf2 )
        ELSE
            mcsf = 0
            acsf => acsf2
            DEALLOCATE( acsf1 )
        ENDIF
        ncsfla = newsize

        WRITE(msg,'(A,2I12)') 'Grow acsf2:',ncsfl,ncsfla
        CALL radiation_write_debug_log( msg )

    END SUBROUTINE merge_and_grow_csf

    
!-- quicksort.f -*-f90-*-
!-- Author: t-nissie, adaptation J.Resler
!-- License: GPLv3
!-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
    RECURSIVE SUBROUTINE quicksort_csf2(kpcsflt, pcsflt, first, last)
        IMPLICIT NONE
        INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT)  :: kpcsflt
        REAL(wp), DIMENSION(:,:), INTENT(INOUT)      :: pcsflt
        INTEGER(iwp), INTENT(IN)                     :: first, last
        REAL(wp), DIMENSION(ndcsf)                   :: t2
        INTEGER(iwp), DIMENSION(kdcsf)               :: x, t1
        INTEGER(iwp)                                 :: i, j

        IF ( first>=last ) RETURN
        x = kpcsflt(:, (first+last)/2 )
        i = first
        j = last
        DO
            DO while ( csf_lt2(kpcsflt(:,i),x) )
                i=i+1
            ENDDO
            DO while ( csf_lt2(x,kpcsflt(:,j)) )
                j=j-1
            ENDDO
            IF ( i >= j ) EXIT
            t1 = kpcsflt(:,i);  kpcsflt(:,i) = kpcsflt(:,j);  kpcsflt(:,j) = t1
            t2 = pcsflt(:,i);  pcsflt(:,i) = pcsflt(:,j);  pcsflt(:,j) = t2
            i=i+1
            j=j-1
        ENDDO
        IF ( first < i-1 ) CALL quicksort_csf2(kpcsflt, pcsflt, first, i-1)
        IF ( j+1 < last )  CALL quicksort_csf2(kpcsflt, pcsflt, j+1, last)
    END SUBROUTINE quicksort_csf2
    

    PURE FUNCTION csf_lt2(item1, item2) result(res)
        INTEGER(iwp), DIMENSION(kdcsf), INTENT(in)  :: item1, item2
        LOGICAL                                     :: res
        res = ( (item1(3) < item2(3))                                                        &
             .OR.  (item1(3) == item2(3)  .AND.  item1(2) < item2(2))                            &
             .OR.  (item1(3) == item2(3)  .AND.  item1(2) == item2(2)  .AND.  item1(1) < item2(1)) &
             .OR.  (item1(3) == item2(3)  .AND.  item1(2) == item2(2)  .AND.  item1(1) == item2(1) &
                 .AND.  item1(4) < item2(4)) )
    END FUNCTION csf_lt2

    PURE FUNCTION searchsorted(athresh, val) result(ind)
        REAL(wp), DIMENSION(:), INTENT(IN)  :: athresh
        REAL(wp), INTENT(IN)                :: val
        INTEGER(iwp)                        :: ind
        INTEGER(iwp)                        :: i

        DO i = LBOUND(athresh, 1), UBOUND(athresh, 1)
            IF ( val < athresh(i) ) THEN
                ind = i - 1
                RETURN
            ENDIF
        ENDDO
        ind = UBOUND(athresh, 1)
    END FUNCTION searchsorted

!------------------------------------------------------------------------------!
! Description:
! ------------
!
!> radiation_radflux_gridbox subroutine gives the sw and lw radiation fluxes at the 
!> faces of a gridbox defined at i,j,k and located in the urban layer.
!> The total sw and the diffuse sw radiation as well as the lw radiation fluxes at
!> the gridbox 6 faces are stored in sw_gridbox, swd_gridbox, and lw_gridbox arrays, 
!> respectively, in the following order:
!>  up_face, down_face, north_face, south_face, east_face, west_face
!> 
!> The subroutine reports also how successful was the search process via the parameter
!> i_feedback as follow:
!> - i_feedback =  1 : successful
!> - i_feedback = -1 : unsuccessful; the requisted point is outside the urban domain
!> - i_feedback =  0 : uncomplete; some gridbox faces fluxes are missing
!> 
!> 
!> It is called outside from usm_urban_surface_mod whenever the radiation fluxes
!> are needed.
!>
!> This routine is not used so far. However, it may serve as an interface for radiation
!> fluxes of urban and land surfaces
!>
!> TODO:
!>    - Compare performance when using some combination of the Fortran intrinsic 
!>      functions, e.g. MINLOC, MAXLOC, ALL, ANY and COUNT functions, which search
!>      surfl array for elements meeting user-specified criterion, i.e. i,j,k
!>    - Report non-found or incomplete radiation fluxes arrays , if any, at the 
!>      gridbox faces in an error message form
!>
!------------------------------------------------------------------------------!
    SUBROUTINE radiation_radflux_gridbox(i,j,k,sw_gridbox,swd_gridbox,lw_gridbox,i_feedback)
        
        IMPLICIT NONE

        INTEGER(iwp),                 INTENT(in)  :: i,j,k                 !< gridbox indices at which fluxes are required
        INTEGER(iwp)                              :: ii,jj,kk,d            !< surface indices and type
        INTEGER(iwp)                              :: l                     !< surface id
        REAL(wp)    , DIMENSION(1:6), INTENT(out) :: sw_gridbox,lw_gridbox !< total sw and lw radiation fluxes of 6 faces of a gridbox, w/m2 
        REAL(wp)    , DIMENSION(1:6), INTENT(out) :: swd_gridbox           !< diffuse sw radiation from sky and model boundary of 6 faces of a gridbox, w/m2
        INTEGER(iwp),                 INTENT(out) :: i_feedback            !< feedback to report how the search was successful 


!-- initialize variables
        i_feedback  = -999999
        sw_gridbox  = -999999.9_wp
        lw_gridbox  = -999999.9_wp
        swd_gridbox = -999999.9_wp
        
!-- check the requisted grid indices
        IF ( k < nzb   .OR.  k > nzut  .OR.   &
             j < nysg  .OR.  j > nyng  .OR.   &
             i < nxlg  .OR.  i > nxrg         &
             ) THEN
           i_feedback = -1
           RETURN
        ENDIF

!-- search for the required grid and formulate the fluxes at the 6 gridbox faces
        DO l = 1, nsurfl
            ii = surfl(ix,l)
            jj = surfl(iy,l)
            kk = surfl(iz,l)

            IF ( ii == i  .AND.  jj == j  .AND.  kk == k ) THEN
               d = surfl(id,l)

               SELECT CASE ( d )

               CASE (iup_u,iup_l)                          !- gridbox up_facing face
                  sw_gridbox(1) = surfinsw(l)
                  lw_gridbox(1) = surfinlw(l)
                  swd_gridbox(1) = surfinswdif(l)

               CASE (inorth_u,inorth_l)                    !- gridbox north_facing face
                  sw_gridbox(3) = surfinsw(l)
                  lw_gridbox(3) = surfinlw(l)
                  swd_gridbox(3) = surfinswdif(l)

               CASE (isouth_u,isouth_l)                    !- gridbox south_facing face
                  sw_gridbox(4) = surfinsw(l)
                  lw_gridbox(4) = surfinlw(l)
                  swd_gridbox(4) = surfinswdif(l)

               CASE (ieast_u,ieast_l)                      !- gridbox east_facing face
                  sw_gridbox(5) = surfinsw(l)
                  lw_gridbox(5) = surfinlw(l)
                  swd_gridbox(5) = surfinswdif(l)

               CASE (iwest_u,iwest_l)                      !- gridbox west_facing face
                  sw_gridbox(6) = surfinsw(l)
                  lw_gridbox(6) = surfinlw(l)
                  swd_gridbox(6) = surfinswdif(l)

               END SELECT

            ENDIF

        IF ( ALL( sw_gridbox(:)  /= -999999.9_wp )  ) EXIT
        ENDDO

!-- check the completeness of the fluxes at all gidbox faces        
!-- TODO: report non-found or incomplete rad fluxes arrays in an error message form
        IF ( ANY( sw_gridbox(:)  <= -999999.9_wp )  .OR.   &
             ANY( swd_gridbox(:) <= -999999.9_wp )  .OR.   &
             ANY( lw_gridbox(:)  <= -999999.9_wp ) ) THEN
           i_feedback = 0
        ELSE
           i_feedback = 1
        ENDIF
        
        RETURN
        
    END SUBROUTINE radiation_radflux_gridbox

!------------------------------------------------------------------------------!
!
! Description:
! ------------
!> Subroutine for averaging 3D data
!------------------------------------------------------------------------------!
SUBROUTINE radiation_3d_data_averaging( mode, variable )
 

    USE control_parameters

    USE indices

    USE kinds

    IMPLICIT NONE

    CHARACTER (LEN=*) ::  mode    !< 
    CHARACTER (LEN=*) :: variable !< 

    LOGICAL      ::  match_lsm !< flag indicating natural-type surface
    LOGICAL      ::  match_usm !< flag indicating urban-type surface
    
    INTEGER(iwp) ::  i !< 
    INTEGER(iwp) ::  j !< 
    INTEGER(iwp) ::  k !< 
    INTEGER(iwp) ::  l, m !< index of current surface element

    INTEGER(iwp)                                       :: ids, idsint_u, idsint_l, isurf
    CHARACTER(LEN=varnamelength)                       :: var

!-- find the real name of the variable
    ids = -1
    l = -1
    var = TRIM(variable)
    DO i = 0, nd-1
        k = len(TRIM(var))
        j = len(TRIM(dirname(i)))
        IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) )  THEN
            ids = i
            idsint_u = dirint_u(ids)
            idsint_l = dirint_l(ids)
            var = var(:k-j)
            EXIT
        ENDIF
    ENDDO
    IF ( ids == -1 )  THEN
        var = TRIM(variable)
    ENDIF

    IF ( mode == 'allocate' )  THEN

       SELECT CASE ( TRIM( var ) )
!--          block of large scale (e.g. RRTMG) radiation output variables
             CASE ( 'rad_net*' )
                IF ( .NOT. ALLOCATED( rad_net_av ) )  THEN
                   ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_net_av = 0.0_wp
             
             CASE ( 'rad_lw_in*' )
                IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) )  THEN
                   ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_lw_in_xy_av = 0.0_wp
                
             CASE ( 'rad_lw_out*' )
                IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) )  THEN
                   ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_lw_out_xy_av = 0.0_wp
                
             CASE ( 'rad_sw_in*' )
                IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) )  THEN
                   ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_sw_in_xy_av = 0.0_wp
                
             CASE ( 'rad_sw_out*' )
                IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) )  THEN
                   ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_sw_out_xy_av = 0.0_wp                

             CASE ( 'rad_lw_in' )
                IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
                   ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_lw_in_av = 0.0_wp

             CASE ( 'rad_lw_out' )
                IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
                   ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_lw_out_av = 0.0_wp

             CASE ( 'rad_lw_cs_hr' )
                IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) )  THEN
                   ALLOCATE( rad_lw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_lw_cs_hr_av = 0.0_wp

             CASE ( 'rad_lw_hr' )
                IF ( .NOT. ALLOCATED( rad_lw_hr_av ) )  THEN
                   ALLOCATE( rad_lw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_lw_hr_av = 0.0_wp

             CASE ( 'rad_sw_in' )
                IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
                   ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_sw_in_av = 0.0_wp

             CASE ( 'rad_sw_out' )
                IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
                   ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_sw_out_av = 0.0_wp

             CASE ( 'rad_sw_cs_hr' )
                IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) )  THEN
                   ALLOCATE( rad_sw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_sw_cs_hr_av = 0.0_wp

             CASE ( 'rad_sw_hr' )
                IF ( .NOT. ALLOCATED( rad_sw_hr_av ) )  THEN
                   ALLOCATE( rad_sw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
                ENDIF
                rad_sw_hr_av = 0.0_wp

!--          block of RTM output variables
             CASE ( 'rtm_rad_net' )
!--              array of complete radiation balance
                 IF ( .NOT.  ALLOCATED(surfradnet_av) )  THEN
                     ALLOCATE( surfradnet_av(nsurfl) )
                     surfradnet_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_insw' )
!--                 array of sw radiation falling to surface after i-th reflection
                 IF ( .NOT.  ALLOCATED(surfinsw_av) )  THEN
                     ALLOCATE( surfinsw_av(nsurfl) )
                     surfinsw_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_inlw' )
!--                 array of lw radiation falling to surface after i-th reflection
                 IF ( .NOT.  ALLOCATED(surfinlw_av) )  THEN
                     ALLOCATE( surfinlw_av(nsurfl) )
                     surfinlw_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_inswdir' )
!--                 array of direct sw radiation falling to surface from sun
                 IF ( .NOT.  ALLOCATED(surfinswdir_av) )  THEN
                     ALLOCATE( surfinswdir_av(nsurfl) )
                     surfinswdir_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_inswdif' )
!--                 array of difusion sw radiation falling to surface from sky and borders of the domain
                 IF ( .NOT.  ALLOCATED(surfinswdif_av) )  THEN
                     ALLOCATE( surfinswdif_av(nsurfl) )
                     surfinswdif_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_inswref' )
!--                 array of sw radiation falling to surface from reflections
                 IF ( .NOT.  ALLOCATED(surfinswref_av) )  THEN
                     ALLOCATE( surfinswref_av(nsurfl) )
                     surfinswref_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_inlwdif' )
!--                 array of sw radiation falling to surface after i-th reflection
                IF ( .NOT.  ALLOCATED(surfinlwdif_av) )  THEN
                     ALLOCATE( surfinlwdif_av(nsurfl) )
                     surfinlwdif_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_inlwref' )
!--                 array of lw radiation falling to surface from reflections
                 IF ( .NOT.  ALLOCATED(surfinlwref_av) )  THEN
                     ALLOCATE( surfinlwref_av(nsurfl) )
                     surfinlwref_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_outsw' )
!--                 array of sw radiation emitted from surface after i-th reflection
                 IF ( .NOT.  ALLOCATED(surfoutsw_av) )  THEN
                     ALLOCATE( surfoutsw_av(nsurfl) )
                     surfoutsw_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_outlw' )
!--                 array of lw radiation emitted from surface after i-th reflection
                 IF ( .NOT.  ALLOCATED(surfoutlw_av) )  THEN
                     ALLOCATE( surfoutlw_av(nsurfl) )
                     surfoutlw_av = 0.0_wp
                 ENDIF
             CASE ( 'rtm_rad_ressw' )
!--                 array of residua of sw radiation absorbed in surface after last reflection
                 IF ( .NOT.  ALLOCATED(surfins_av) )  THEN
                     ALLOCATE( surfins_av(nsurfl) )
                     surfins_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_reslw' )
!--                 array of residua of lw radiation absorbed in surface after last reflection
                 IF ( .NOT.  ALLOCATED(surfinl_av) )  THEN
                     ALLOCATE( surfinl_av(nsurfl) )
                     surfinl_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_pc_inlw' )
!--                 array of of lw radiation absorbed in plant canopy
                 IF ( .NOT.  ALLOCATED(pcbinlw_av) )  THEN
                     ALLOCATE( pcbinlw_av(1:npcbl) )
                     pcbinlw_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_pc_insw' )
!--                 array of of sw radiation absorbed in plant canopy
                 IF ( .NOT.  ALLOCATED(pcbinsw_av) )  THEN
                     ALLOCATE( pcbinsw_av(1:npcbl) )
                     pcbinsw_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_pc_inswdir' )
!--                 array of of direct sw radiation absorbed in plant canopy
                 IF ( .NOT.  ALLOCATED(pcbinswdir_av) )  THEN
                     ALLOCATE( pcbinswdir_av(1:npcbl) )
                     pcbinswdir_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_pc_inswdif' )
!--                 array of of diffuse sw radiation absorbed in plant canopy
                 IF ( .NOT.  ALLOCATED(pcbinswdif_av) )  THEN
                     ALLOCATE( pcbinswdif_av(1:npcbl) )
                     pcbinswdif_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_rad_pc_inswref' )
!--                 array of of reflected sw radiation absorbed in plant canopy
                 IF ( .NOT.  ALLOCATED(pcbinswref_av) )  THEN
                     ALLOCATE( pcbinswref_av(1:npcbl) )
                     pcbinswref_av = 0.0_wp
                 ENDIF

             CASE ( 'rtm_mrt_sw' )
                IF ( .NOT. ALLOCATED( mrtinsw_av ) )  THEN
                   ALLOCATE( mrtinsw_av(nmrtbl) )
                ENDIF
                mrtinsw_av = 0.0_wp

             CASE ( 'rtm_mrt_lw' )
                IF ( .NOT. ALLOCATED( mrtinlw_av ) )  THEN
                   ALLOCATE( mrtinlw_av(nmrtbl) )
                ENDIF
                mrtinlw_av = 0.0_wp

             CASE ( 'rtm_mrt' )
                IF ( .NOT. ALLOCATED( mrt_av ) )  THEN
                   ALLOCATE( mrt_av(nmrtbl) )
                ENDIF
                mrt_av = 0.0_wp

          CASE DEFAULT
             CONTINUE

       END SELECT

    ELSEIF ( mode == 'sum' )  THEN

       SELECT CASE ( TRIM( var ) )
!--       block of large scale (e.g. RRTMG) radiation output variables
          CASE ( 'rad_net*' )
             IF ( ALLOCATED( rad_net_av ) ) THEN
                DO  i = nxl, nxr
                   DO  j = nys, nyn
                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
                                  surf_lsm_h%end_index(j,i)
                      match_usm = surf_usm_h%start_index(j,i) <=               &
                                  surf_usm_h%end_index(j,i)

                     IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
                         m = surf_lsm_h%end_index(j,i)
                         rad_net_av(j,i) = rad_net_av(j,i) +                   &
                                         surf_lsm_h%rad_net(m)
                      ELSEIF ( match_usm )  THEN
                         m = surf_usm_h%end_index(j,i)
                         rad_net_av(j,i) = rad_net_av(j,i) +                   &
                                         surf_usm_h%rad_net(m)
                      ENDIF
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_lw_in*' )
             IF ( ALLOCATED( rad_lw_in_xy_av ) ) THEN
                DO  i = nxl, nxr
                   DO  j = nys, nyn
                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
                                  surf_lsm_h%end_index(j,i)
                      match_usm = surf_usm_h%start_index(j,i) <=               &
                                  surf_usm_h%end_index(j,i)

                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
                         m = surf_lsm_h%end_index(j,i)
                         rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) +         &
                                         surf_lsm_h%rad_lw_in(m)
                      ELSEIF ( match_usm )  THEN
                         m = surf_usm_h%end_index(j,i)
                         rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) +         &
                                         surf_usm_h%rad_lw_in(m)
                      ENDIF
                   ENDDO
                ENDDO
             ENDIF
             
          CASE ( 'rad_lw_out*' )
             IF ( ALLOCATED( rad_lw_out_xy_av ) ) THEN
                DO  i = nxl, nxr
                   DO  j = nys, nyn
                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
                                  surf_lsm_h%end_index(j,i)
                      match_usm = surf_usm_h%start_index(j,i) <=               &
                                  surf_usm_h%end_index(j,i)

                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
                         m = surf_lsm_h%end_index(j,i)
                         rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) +       &
                                                 surf_lsm_h%rad_lw_out(m)
                      ELSEIF ( match_usm )  THEN
                         m = surf_usm_h%end_index(j,i)
                         rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) +       &
                                                 surf_usm_h%rad_lw_out(m)
                      ENDIF
                   ENDDO
                ENDDO
             ENDIF
             
          CASE ( 'rad_sw_in*' )
             IF ( ALLOCATED( rad_sw_in_xy_av ) ) THEN
                DO  i = nxl, nxr
                   DO  j = nys, nyn
                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
                                  surf_lsm_h%end_index(j,i)
                      match_usm = surf_usm_h%start_index(j,i) <=               &
                                  surf_usm_h%end_index(j,i)

                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
                         m = surf_lsm_h%end_index(j,i)
                         rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) +         &
                                                surf_lsm_h%rad_sw_in(m)
                      ELSEIF ( match_usm )  THEN
                         m = surf_usm_h%end_index(j,i)
                         rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) +         &
                                                surf_usm_h%rad_sw_in(m)
                      ENDIF
                   ENDDO
                ENDDO
             ENDIF
             
          CASE ( 'rad_sw_out*' )
             IF ( ALLOCATED( rad_sw_out_xy_av ) ) THEN
                DO  i = nxl, nxr
                   DO  j = nys, nyn
                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
                                  surf_lsm_h%end_index(j,i)
                      match_usm = surf_usm_h%start_index(j,i) <=               &
                                  surf_usm_h%end_index(j,i)

                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
                         m = surf_lsm_h%end_index(j,i)
                         rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) +       &
                                                 surf_lsm_h%rad_sw_out(m)
                      ELSEIF ( match_usm )  THEN
                         m = surf_usm_h%end_index(j,i)
                         rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) +       &
                                                 surf_usm_h%rad_sw_out(m)
                      ENDIF
                   ENDDO
                ENDDO
             ENDIF
             
          CASE ( 'rad_lw_in' )
             IF ( ALLOCATED( rad_lw_in_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i)             &
                                               + rad_lw_in(k,j,i)
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_lw_out' )
             IF ( ALLOCATED( rad_lw_out_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i)           &
                                                + rad_lw_out(k,j,i)
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_lw_cs_hr' )
             IF ( ALLOCATED( rad_lw_cs_hr_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_lw_cs_hr_av(k,j,i) = rad_lw_cs_hr_av(k,j,i)       &
                                                  + rad_lw_cs_hr(k,j,i)
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_lw_hr' )
             IF ( ALLOCATED( rad_lw_hr_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_lw_hr_av(k,j,i) = rad_lw_hr_av(k,j,i)             &
                                               + rad_lw_hr(k,j,i)
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_sw_in' )
             IF ( ALLOCATED( rad_sw_in_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i)             &
                                               + rad_sw_in(k,j,i)
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_sw_out' )
             IF ( ALLOCATED( rad_sw_out_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i)           &
                                                + rad_sw_out(k,j,i)
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_sw_cs_hr' )
             IF ( ALLOCATED( rad_sw_cs_hr_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_sw_cs_hr_av(k,j,i) = rad_sw_cs_hr_av(k,j,i)       &
                                                  + rad_sw_cs_hr(k,j,i)
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_sw_hr' )
             IF ( ALLOCATED( rad_sw_hr_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_sw_hr_av(k,j,i) = rad_sw_hr_av(k,j,i)             &
                                               + rad_sw_hr(k,j,i)
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

!--       block of RTM output variables
          CASE ( 'rtm_rad_net' )
!--           array of complete radiation balance
              DO isurf = dirstart(ids), dirend(ids)
                 IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                    surfradnet_av(isurf) = surfinsw(isurf) - surfoutsw(isurf) +  surfinlw(isurf) - surfoutlw(isurf)
                 ENDIF
              ENDDO

          CASE ( 'rtm_rad_insw' )
!--           array of sw radiation falling to surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinsw_av(isurf) = surfinsw_av(isurf) + surfinsw(isurf)
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inlw' )
!--           array of lw radiation falling to surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinlw_av(isurf) = surfinlw_av(isurf) + surfinlw(isurf)
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inswdir' )
!--           array of direct sw radiation falling to surface from sun
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinswdir_av(isurf) = surfinswdir_av(isurf) + surfinswdir(isurf)
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inswdif' )
!--           array of difusion sw radiation falling to surface from sky and borders of the domain
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinswdif_av(isurf) = surfinswdif_av(isurf) + surfinswdif(isurf)
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inswref' )
!--           array of sw radiation falling to surface from reflections
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinswref_av(isurf) = surfinswref_av(isurf) + surfinsw(isurf) - &
                                          surfinswdir(isurf) - surfinswdif(isurf)
                  ENDIF
              ENDDO


          CASE ( 'rtm_rad_inlwdif' )
!--           array of sw radiation falling to surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinlwdif_av(isurf) = surfinlwdif_av(isurf) + surfinlwdif(isurf)
                  ENDIF
              ENDDO
!
          CASE ( 'rtm_rad_inlwref' )
!--           array of lw radiation falling to surface from reflections
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinlwref_av(isurf) = surfinlwref_av(isurf) + &
                                          surfinlw(isurf) - surfinlwdif(isurf)
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_outsw' )
!--           array of sw radiation emitted from surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfoutsw_av(isurf) = surfoutsw_av(isurf) + surfoutsw(isurf)
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_outlw' )
!--           array of lw radiation emitted from surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfoutlw_av(isurf) = surfoutlw_av(isurf) + surfoutlw(isurf)
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_ressw' )
!--           array of residua of sw radiation absorbed in surface after last reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfins_av(isurf) = surfins_av(isurf) + surfins(isurf)
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_reslw' )
!--           array of residua of lw radiation absorbed in surface after last reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinl_av(isurf) = surfinl_av(isurf) + surfinl(isurf)
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_pc_inlw' )
              DO l = 1, npcbl
                 pcbinlw_av(l) = pcbinlw_av(l) + pcbinlw(l)
              ENDDO

          CASE ( 'rtm_rad_pc_insw' )
              DO l = 1, npcbl
                 pcbinsw_av(l) = pcbinsw_av(l) + pcbinsw(l)
              ENDDO

          CASE ( 'rtm_rad_pc_inswdir' )
              DO l = 1, npcbl
                 pcbinswdir_av(l) = pcbinswdir_av(l) + pcbinswdir(l)
              ENDDO

          CASE ( 'rtm_rad_pc_inswdif' )
              DO l = 1, npcbl
                 pcbinswdif_av(l) = pcbinswdif_av(l) + pcbinswdif(l)
              ENDDO

          CASE ( 'rtm_rad_pc_inswref' )
              DO l = 1, npcbl
                 pcbinswref_av(l) = pcbinswref_av(l) + pcbinsw(l) - pcbinswdir(l) - pcbinswdif(l)
              ENDDO

          CASE ( 'rad_mrt_sw' )
             IF ( ALLOCATED( mrtinsw_av ) )  THEN
                mrtinsw_av(:) = mrtinsw_av(:) + mrtinsw(:)
             ENDIF

          CASE ( 'rad_mrt_lw' )
             IF ( ALLOCATED( mrtinlw_av ) )  THEN
                mrtinlw_av(:) = mrtinlw_av(:) + mrtinlw(:)
             ENDIF

          CASE ( 'rad_mrt' )
             IF ( ALLOCATED( mrt_av ) )  THEN
                mrt_av(:) = mrt_av(:) + mrt(:)
             ENDIF

          CASE DEFAULT
             CONTINUE

       END SELECT

    ELSEIF ( mode == 'average' )  THEN

       SELECT CASE ( TRIM( var ) )
!--       block of large scale (e.g. RRTMG) radiation output variables
          CASE ( 'rad_net*' )
             IF ( ALLOCATED( rad_net_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      rad_net_av(j,i) = rad_net_av(j,i)                        &
                                        / REAL( average_count_3d, KIND=wp )
                   ENDDO
                ENDDO
             ENDIF
             
          CASE ( 'rad_lw_in*' )
             IF ( ALLOCATED( rad_lw_in_xy_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i)              &
                                        / REAL( average_count_3d, KIND=wp )
                   ENDDO
                ENDDO
             ENDIF
             
          CASE ( 'rad_lw_out*' )
             IF ( ALLOCATED( rad_lw_out_xy_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i)            &
                                        / REAL( average_count_3d, KIND=wp )
                   ENDDO
                ENDDO
             ENDIF
             
          CASE ( 'rad_sw_in*' )
             IF ( ALLOCATED( rad_sw_in_xy_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i)              &
                                        / REAL( average_count_3d, KIND=wp )
                   ENDDO
                ENDDO
             ENDIF
             
          CASE ( 'rad_sw_out*' )
             IF ( ALLOCATED( rad_sw_out_xy_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i)             &
                                        / REAL( average_count_3d, KIND=wp )
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_lw_in' )
             IF ( ALLOCATED( rad_lw_in_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i)             &
                                               / REAL( average_count_3d, KIND=wp )
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_lw_out' )
             IF ( ALLOCATED( rad_lw_out_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i)           &
                                                / REAL( average_count_3d, KIND=wp )
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_lw_cs_hr' )
             IF ( ALLOCATED( rad_lw_cs_hr_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_lw_cs_hr_av(k,j,i) = rad_lw_cs_hr_av(k,j,i)       &
                                                / REAL( average_count_3d, KIND=wp )
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_lw_hr' )
             IF ( ALLOCATED( rad_lw_hr_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_lw_hr_av(k,j,i) = rad_lw_hr_av(k,j,i)             &
                                               / REAL( average_count_3d, KIND=wp )
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_sw_in' )
             IF ( ALLOCATED( rad_sw_in_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i)             &
                                               / REAL( average_count_3d, KIND=wp )
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_sw_out' )
             IF ( ALLOCATED( rad_sw_out_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i)           &
                                                / REAL( average_count_3d, KIND=wp )
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_sw_cs_hr' )
             IF ( ALLOCATED( rad_sw_cs_hr_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_sw_cs_hr_av(k,j,i) = rad_sw_cs_hr_av(k,j,i)       &
                                                / REAL( average_count_3d, KIND=wp )
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

          CASE ( 'rad_sw_hr' )
             IF ( ALLOCATED( rad_sw_hr_av ) ) THEN
                DO  i = nxlg, nxrg
                   DO  j = nysg, nyng
                      DO  k = nzb, nzt+1
                         rad_sw_hr_av(k,j,i) = rad_sw_hr_av(k,j,i)             &
                                               / REAL( average_count_3d, KIND=wp )
                      ENDDO
                   ENDDO
                ENDDO
             ENDIF

!--       block of RTM output variables
          CASE ( 'rtm_rad_net' )
!--           array of complete radiation balance
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfradnet_av(isurf) = surfinsw_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_insw' )
!--           array of sw radiation falling to surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinsw_av(isurf) = surfinsw_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inlw' )
!--           array of lw radiation falling to surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinlw_av(isurf) = surfinlw_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inswdir' )
!--           array of direct sw radiation falling to surface from sun
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinswdir_av(isurf) = surfinswdir_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inswdif' )
!--           array of difusion sw radiation falling to surface from sky and borders of the domain
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinswdif_av(isurf) = surfinswdif_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inswref' )
!--           array of sw radiation falling to surface from reflections
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinswref_av(isurf) = surfinswref_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inlwdif' )
!--           array of sw radiation falling to surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinlwdif_av(isurf) = surfinlwdif_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_inlwref' )
!--           array of lw radiation falling to surface from reflections
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinlwref_av(isurf) = surfinlwref_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_outsw' )
!--           array of sw radiation emitted from surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfoutsw_av(isurf) = surfoutsw_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_outlw' )
!--           array of lw radiation emitted from surface after i-th reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfoutlw_av(isurf) = surfoutlw_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_ressw' )
!--           array of residua of sw radiation absorbed in surface after last reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfins_av(isurf) = surfins_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_reslw' )
!--           array of residua of lw radiation absorbed in surface after last reflection
              DO isurf = dirstart(ids), dirend(ids)
                  IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
                      surfinl_av(isurf) = surfinl_av(isurf) / REAL( average_count_3d, kind=wp )
                  ENDIF
              ENDDO

          CASE ( 'rtm_rad_pc_inlw' )
              DO l = 1, npcbl
                 pcbinlw_av(:) = pcbinlw_av(:) / REAL( average_count_3d, kind=wp )
              ENDDO

          CASE ( 'rtm_rad_pc_insw' )
              DO l = 1, npcbl
                 pcbinsw_av(:) = pcbinsw_av(:) / REAL( average_count_3d, kind=wp )
              ENDDO

          CASE ( 'rtm_rad_pc_inswdir' )
              DO l = 1, npcbl
                 pcbinswdir_av(:) = pcbinswdir_av(:) / REAL( average_count_3d, kind=wp )
              ENDDO

          CASE ( 'rtm_rad_pc_inswdif' )
              DO l = 1, npcbl
                 pcbinswdif_av(:) = pcbinswdif_av(:) / REAL( average_count_3d, kind=wp )
              ENDDO

          CASE ( 'rtm_rad_pc_inswref' )
              DO l = 1, npcbl
                 pcbinswref_av(:) = pcbinswref_av(:) / REAL( average_count_3d, kind=wp )
              ENDDO

          CASE ( 'rad_mrt_lw' )
             IF ( ALLOCATED( mrtinlw_av ) )  THEN
                mrtinlw_av(:) = mrtinlw_av(:) / REAL( average_count_3d, KIND=wp )
             ENDIF

          CASE ( 'rad_mrt' )
             IF ( ALLOCATED( mrt_av ) )  THEN
                mrt_av(:) = mrt_av(:) / REAL( average_count_3d, KIND=wp )
             ENDIF

       END SELECT

    ENDIF

END SUBROUTINE radiation_3d_data_averaging


!------------------------------------------------------------------------------!
!
! Description:
! ------------
!> Subroutine defining appropriate grid for netcdf variables.
!> It is called out from subroutine netcdf.
!------------------------------------------------------------------------------!
SUBROUTINE radiation_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
    
    IMPLICIT NONE

    CHARACTER (LEN=*), INTENT(IN)  ::  variable    !<
    LOGICAL, INTENT(OUT)           ::  found       !< 
    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x      !< 
    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y      !< 
    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z      !< 

    CHARACTER (len=varnamelength)  :: var

    found  = .TRUE.

!
!-- Check for the grid
    var = TRIM(variable)
!-- RTM directional variables
    IF ( var(1:12) == 'rtm_rad_net_'  .OR.  var(1:13) == 'rtm_rad_insw_'  .OR.          &
         var(1:13) == 'rtm_rad_inlw_'  .OR.  var(1:16) == 'rtm_rad_inswdir_'  .OR.      &
         var(1:16) == 'rtm_rad_inswdif_'  .OR.  var(1:16) == 'rtm_rad_inswref_'  .OR.   &
         var(1:16) == 'rtm_rad_inlwdif_'  .OR.  var(1:16) == 'rtm_rad_inlwref_'  .OR.   &
         var(1:14) == 'rtm_rad_outsw_'  .OR.  var(1:14) == 'rtm_rad_outlw_'  .OR.       &
         var(1:14) == 'rtm_rad_ressw_'  .OR.  var(1:14) == 'rtm_rad_reslw_'  .OR.       &
         var == 'rtm_rad_pc_inlw'  .OR.                                                 &
         var == 'rtm_rad_pc_insw'  .OR.  var == 'rtm_rad_pc_inswdir'  .OR.              &
         var == 'rtm_rad_pc_inswdif'  .OR.  var == 'rtm_rad_pc_inswref'  .OR.           &
         var(1:7) == 'rtm_svf'  .OR.  var(1:7) == 'rtm_dif'  .OR.                       &
         var(1:9) == 'rtm_skyvf' .OR. var(1:10) == 'rtm_skyvft'  .OR.                   &
         var == 'rtm_mrt'  .OR.  var ==  'rtm_mrt_sw'  .OR.  var == 'rtm_mrt_lw' )  THEN

         found = .TRUE.
         grid_x = 'x'
         grid_y = 'y'
         grid_z = 'zu'
    ELSE

       SELECT CASE ( TRIM( var ) )

          CASE ( 'rad_lw_cs_hr', 'rad_lw_hr', 'rad_sw_cs_hr', 'rad_sw_hr',        &
                 'rad_lw_cs_hr_xy', 'rad_lw_hr_xy', 'rad_sw_cs_hr_xy',            &
                 'rad_sw_hr_xy', 'rad_lw_cs_hr_xz', 'rad_lw_hr_xz',               &
                 'rad_sw_cs_hr_xz', 'rad_sw_hr_xz', 'rad_lw_cs_hr_yz',            &
                 'rad_lw_hr_yz', 'rad_sw_cs_hr_yz', 'rad_sw_hr_yz',               &
                 'rad_mrt', 'rad_mrt_sw', 'rad_mrt_lw' )
             grid_x = 'x'
             grid_y = 'y'
             grid_z = 'zu'

          CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_sw_in', 'rad_sw_out',            &
                 'rad_lw_in_xy', 'rad_lw_out_xy', 'rad_sw_in_xy','rad_sw_out_xy', &
                 'rad_lw_in_xz', 'rad_lw_out_xz', 'rad_sw_in_xz','rad_sw_out_xz', &
                 'rad_lw_in_yz', 'rad_lw_out_yz', 'rad_sw_in_yz','rad_sw_out_yz' )
             grid_x = 'x'
             grid_y = 'y'
             grid_z = 'zw'


          CASE DEFAULT
             found  = .FALSE.
             grid_x = 'none'
             grid_y = 'none'
             grid_z = 'none'

           END SELECT
       ENDIF

    END SUBROUTINE radiation_define_netcdf_grid

!------------------------------------------------------------------------------!
!
! Description:
! ------------
!> Subroutine defining 2D output variables
!------------------------------------------------------------------------------!
 SUBROUTINE radiation_data_output_2d( av, variable, found, grid, mode,         &
                                      local_pf, two_d, nzb_do, nzt_do )
 
    USE indices

    USE kinds


    IMPLICIT NONE

    CHARACTER (LEN=*) ::  grid     !< 
    CHARACTER (LEN=*) ::  mode     !< 
    CHARACTER (LEN=*) ::  variable !< 

    INTEGER(iwp) ::  av !< 
    INTEGER(iwp) ::  i  !< 
    INTEGER(iwp) ::  j  !< 
    INTEGER(iwp) ::  k  !< 
    INTEGER(iwp) ::  m  !< index of surface element at grid point (j,i)
    INTEGER(iwp) ::  nzb_do   !< 
    INTEGER(iwp) ::  nzt_do   !< 

    LOGICAL      ::  found !< 
    LOGICAL      ::  two_d !< flag parameter that indicates 2D variables (horizontal cross sections)

    REAL(wp) ::  fill_value = -999.0_wp    !< value for the _FillValue attribute

    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !< 

    found = .TRUE.

    SELECT CASE ( TRIM( variable ) )

       CASE ( 'rad_net*_xy' )        ! 2d-array
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
!
!--                Obtain rad_net from its respective surface type
!--                Natural-type surfaces
                   DO  m = surf_lsm_h%start_index(j,i),                        &
                           surf_lsm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_lsm_h%rad_net(m)
                   ENDDO
!
!--                Urban-type surfaces
                   DO  m = surf_usm_h%start_index(j,i),                        &
                           surf_usm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_usm_h%rad_net(m)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
             IF ( .NOT. ALLOCATED( rad_net_av ) ) THEN
                ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )
                rad_net_av = REAL( fill_value, KIND = wp )
             ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   local_pf(i,j,nzb+1) = rad_net_av(j,i)
                ENDDO
             ENDDO
          ENDIF
          two_d = .TRUE.
          grid = 'zu1'
          
       CASE ( 'rad_lw_in*_xy' )        ! 2d-array
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
!
!--                Obtain rad_net from its respective surface type
!--                Natural-type surfaces
                   DO  m = surf_lsm_h%start_index(j,i),                        &
                           surf_lsm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_lsm_h%rad_lw_in(m)
                   ENDDO
!
!--                Urban-type surfaces
                   DO  m = surf_usm_h%start_index(j,i),                        &
                           surf_usm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_usm_h%rad_lw_in(m)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
             IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) ) THEN
                ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) )
                rad_lw_in_xy_av = REAL( fill_value, KIND = wp )
             ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   local_pf(i,j,nzb+1) = rad_lw_in_xy_av(j,i)
                ENDDO
             ENDDO
          ENDIF
          two_d = .TRUE.
          grid = 'zu1'
          
       CASE ( 'rad_lw_out*_xy' )        ! 2d-array
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
!
!--                Obtain rad_net from its respective surface type
!--                Natural-type surfaces
                   DO  m = surf_lsm_h%start_index(j,i),                        &
                           surf_lsm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_lsm_h%rad_lw_out(m)
                   ENDDO
!
!--                Urban-type surfaces
                   DO  m = surf_usm_h%start_index(j,i),                        &
                           surf_usm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_usm_h%rad_lw_out(m)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
             IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) ) THEN
                ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) )
                rad_lw_out_xy_av = REAL( fill_value, KIND = wp )
             ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   local_pf(i,j,nzb+1) = rad_lw_out_xy_av(j,i)
                ENDDO
             ENDDO
          ENDIF
          two_d = .TRUE.
          grid = 'zu1'
          
       CASE ( 'rad_sw_in*_xy' )        ! 2d-array
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
!
!--                Obtain rad_net from its respective surface type
!--                Natural-type surfaces
                   DO  m = surf_lsm_h%start_index(j,i),                        &
                           surf_lsm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_lsm_h%rad_sw_in(m)
                   ENDDO
!
!--                Urban-type surfaces
                   DO  m = surf_usm_h%start_index(j,i),                        &
                           surf_usm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_usm_h%rad_sw_in(m)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
             IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) ) THEN
                ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) )
                rad_sw_in_xy_av = REAL( fill_value, KIND = wp )
             ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   local_pf(i,j,nzb+1) = rad_sw_in_xy_av(j,i)
                ENDDO
             ENDDO
          ENDIF
          two_d = .TRUE.
          grid = 'zu1'
          
       CASE ( 'rad_sw_out*_xy' )        ! 2d-array
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
!
!--                Obtain rad_net from its respective surface type
!--                Natural-type surfaces
                   DO  m = surf_lsm_h%start_index(j,i),                        &
                           surf_lsm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_lsm_h%rad_sw_out(m)
                   ENDDO
!
!--                Urban-type surfaces
                   DO  m = surf_usm_h%start_index(j,i),                        &
                           surf_usm_h%end_index(j,i)  
                      local_pf(i,j,nzb+1) = surf_usm_h%rad_sw_out(m)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
             IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) ) THEN
                ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) )
                rad_sw_out_xy_av = REAL( fill_value, KIND = wp )
             ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   local_pf(i,j,nzb+1) = rad_sw_out_xy_av(j,i)
                ENDDO
             ENDDO
          ENDIF
          two_d = .TRUE.
          grid = 'zu1'          
          
       CASE ( 'rad_lw_in_xy', 'rad_lw_in_xz', 'rad_lw_in_yz' )
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_lw_in(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
            IF ( .NOT. ALLOCATED( rad_lw_in_av ) ) THEN
               ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_lw_in_av = REAL( fill_value, KIND = wp )
            ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_lw_in_av(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ENDIF
          IF ( mode == 'xy' )  grid = 'zu'

       CASE ( 'rad_lw_out_xy', 'rad_lw_out_xz', 'rad_lw_out_yz' )
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_lw_out(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
            IF ( .NOT. ALLOCATED( rad_lw_out_av ) ) THEN
               ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_lw_out_av = REAL( fill_value, KIND = wp )
            ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_lw_out_av(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ENDIF   
          IF ( mode == 'xy' )  grid = 'zu'

       CASE ( 'rad_lw_cs_hr_xy', 'rad_lw_cs_hr_xz', 'rad_lw_cs_hr_yz' )
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_lw_cs_hr(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
            IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) ) THEN
               ALLOCATE( rad_lw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_lw_cs_hr_av = REAL( fill_value, KIND = wp )
            ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_lw_cs_hr_av(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ENDIF
          IF ( mode == 'xy' )  grid = 'zw'

       CASE ( 'rad_lw_hr_xy', 'rad_lw_hr_xz', 'rad_lw_hr_yz' )
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_lw_hr(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
            IF ( .NOT. ALLOCATED( rad_lw_hr_av ) ) THEN
               ALLOCATE( rad_lw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_lw_hr_av= REAL( fill_value, KIND = wp )
            ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_lw_hr_av(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ENDIF
          IF ( mode == 'xy' )  grid = 'zw'

       CASE ( 'rad_sw_in_xy', 'rad_sw_in_xz', 'rad_sw_in_yz' )
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_sw_in(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
            IF ( .NOT. ALLOCATED( rad_sw_in_av ) ) THEN
               ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_sw_in_av = REAL( fill_value, KIND = wp )
            ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_sw_in_av(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ENDIF
          IF ( mode == 'xy' )  grid = 'zu'

       CASE ( 'rad_sw_out_xy', 'rad_sw_out_xz', 'rad_sw_out_yz' )
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_sw_out(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
            IF ( .NOT. ALLOCATED( rad_sw_out_av ) ) THEN
               ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_sw_out_av = REAL( fill_value, KIND = wp )
            ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   DO  k = nzb, nzt+1
                      local_pf(i,j,k) = rad_sw_out_av(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ENDIF
          IF ( mode == 'xy' )  grid = 'zu'

       CASE ( 'rad_sw_cs_hr_xy', 'rad_sw_cs_hr_xz', 'rad_sw_cs_hr_yz' )
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_sw_cs_hr(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
            IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) ) THEN
               ALLOCATE( rad_sw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_sw_cs_hr_av = REAL( fill_value, KIND = wp )
            ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_sw_cs_hr_av(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ENDIF
          IF ( mode == 'xy' )  grid = 'zw'

       CASE ( 'rad_sw_hr_xy', 'rad_sw_hr_xz', 'rad_sw_hr_yz' )
          IF ( av == 0 ) THEN
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_sw_hr(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ELSE
            IF ( .NOT. ALLOCATED( rad_sw_hr_av ) ) THEN
               ALLOCATE( rad_sw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_sw_hr_av = REAL( fill_value, KIND = wp )
            ENDIF
             DO  i = nxl, nxr
                DO  j = nys, nyn 
                   DO  k = nzb_do, nzt_do
                      local_pf(i,j,k) = rad_sw_hr_av(k,j,i)
                   ENDDO
                ENDDO
             ENDDO
          ENDIF
          IF ( mode == 'xy' )  grid = 'zw'

       CASE DEFAULT
          found = .FALSE.
          grid  = 'none'

    END SELECT
 
 END SUBROUTINE radiation_data_output_2d


!------------------------------------------------------------------------------!
!
! Description:
! ------------
!> Subroutine defining 3D output variables
!------------------------------------------------------------------------------!
 SUBROUTINE radiation_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
 

    USE indices

    USE kinds


    IMPLICIT NONE

    CHARACTER (LEN=*) ::  variable !< 

    INTEGER(iwp) ::  av          !<
    INTEGER(iwp) ::  i, j, k, l  !<
    INTEGER(iwp) ::  nzb_do      !<
    INTEGER(iwp) ::  nzt_do      !<

    LOGICAL      ::  found       !<

    REAL(wp)     ::  fill_value = -999.0_wp    !< value for the _FillValue attribute

    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<

    CHARACTER (len=varnamelength)                   :: var, surfid
    INTEGER(iwp)                                    :: ids,idsint_u,idsint_l,isurf,isvf,isurfs,isurflt,ipcgb
    INTEGER(iwp)                                    :: is, js, ks, istat

    found = .TRUE.

    ids = -1
    var = TRIM(variable)
    DO i = 0, nd-1
        k = len(TRIM(var))
        j = len(TRIM(dirname(i)))
        IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) )  THEN
            ids = i
            idsint_u = dirint_u(ids)
            idsint_l = dirint_l(ids)
            var = var(:k-j)
            EXIT
        ENDIF
    ENDDO
    IF ( ids == -1 )  THEN
        var = TRIM(variable)
    ENDIF

    IF ( (var(1:8) == 'rtm_svf_'  .OR.  var(1:8) == 'rtm_dif_')  .AND.  len(TRIM(var)) >= 13 )  THEN
!--     svf values to particular surface
        surfid = var(9:)
        i = index(surfid,'_')
        j = index(surfid(i+1:),'_')
        READ(surfid(1:i-1),*, iostat=istat ) is
        IF ( istat == 0 )  THEN
            READ(surfid(i+1:i+j-1),*, iostat=istat ) js
        ENDIF
        IF ( istat == 0 )  THEN
            READ(surfid(i+j+1:),*, iostat=istat ) ks
        ENDIF
        IF ( istat == 0 )  THEN
            var = var(1:7)
        ENDIF
    ENDIF

    local_pf = fill_value

    SELECT CASE ( TRIM( var ) )
!--   block of large scale radiation model (e.g. RRTMG) output variables
      CASE ( 'rad_sw_in' )
         IF ( av == 0 )  THEN
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_sw_in(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ELSE
            IF ( .NOT. ALLOCATED( rad_sw_in_av ) ) THEN
               ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_sw_in_av = REAL( fill_value, KIND = wp )
            ENDIF
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_sw_in_av(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ENDIF

      CASE ( 'rad_sw_out' )
         IF ( av == 0 )  THEN
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_sw_out(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ELSE
            IF ( .NOT. ALLOCATED( rad_sw_out_av ) ) THEN
               ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_sw_out_av = REAL( fill_value, KIND = wp )
            ENDIF
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_sw_out_av(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ENDIF

      CASE ( 'rad_sw_cs_hr' )
         IF ( av == 0 )  THEN
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_sw_cs_hr(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ELSE
            IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) ) THEN
               ALLOCATE( rad_sw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_sw_cs_hr_av = REAL( fill_value, KIND = wp )
            ENDIF
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_sw_cs_hr_av(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ENDIF

      CASE ( 'rad_sw_hr' )
         IF ( av == 0 )  THEN
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_sw_hr(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ELSE
            IF ( .NOT. ALLOCATED( rad_sw_hr_av ) ) THEN
               ALLOCATE( rad_sw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_sw_hr_av = REAL( fill_value, KIND = wp )
            ENDIF
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_sw_hr_av(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ENDIF

      CASE ( 'rad_lw_in' )
         IF ( av == 0 )  THEN
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_lw_in(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ELSE
            IF ( .NOT. ALLOCATED( rad_lw_in_av ) ) THEN
               ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_lw_in_av = REAL( fill_value, KIND = wp )
            ENDIF
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_lw_in_av(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ENDIF

      CASE ( 'rad_lw_out' )
         IF ( av == 0 )  THEN
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_lw_out(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ELSE
            IF ( .NOT. ALLOCATED( rad_lw_out_av ) ) THEN
               ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_lw_out_av = REAL( fill_value, KIND = wp )
            ENDIF
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_lw_out_av(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ENDIF

      CASE ( 'rad_lw_cs_hr' )
         IF ( av == 0 )  THEN
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_lw_cs_hr(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ELSE
            IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) ) THEN
               ALLOCATE( rad_lw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
               rad_lw_cs_hr_av = REAL( fill_value, KIND = wp )
            ENDIF
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_lw_cs_hr_av(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ENDIF

      CASE ( 'rad_lw_hr' )
         IF ( av == 0 )  THEN
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_lw_hr(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ELSE
            IF ( .NOT. ALLOCATED( rad_lw_hr_av ) ) THEN
               ALLOCATE( rad_lw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
              rad_lw_hr_av = REAL( fill_value, KIND = wp )
            ENDIF
            DO  i = nxl, nxr
               DO  j = nys, nyn
                  DO  k = nzb_do, nzt_do
                     local_pf(i,j,k) = rad_lw_hr_av(k,j,i)
                  ENDDO
               ENDDO
            ENDDO
         ENDIF

!--   block of RTM output variables
!--   variables are intended mainly for debugging and detailed analyse purposes
      CASE ( 'rtm_skyvf' )
!--        sky view factor
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvf(isurf)
            ENDIF
         ENDDO

      CASE ( 'rtm_skyvft' )
!--      sky view factor
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == ids )  THEN
               local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvft(isurf)
            ENDIF
         ENDDO

      CASE ( 'rtm_svf', 'rtm_dif' )
!--      shape view factors or iradiance factors to selected surface
         IF ( TRIM(var)=='rtm_svf' )  THEN
             k = 1
         ELSE
             k = 2
         ENDIF
         DO isvf = 1, nsvfl
            isurflt = svfsurf(1, isvf)
            isurfs = svfsurf(2, isvf)

            IF ( surf(ix,isurfs) == is  .AND.  surf(iy,isurfs) == js  .AND. surf(iz,isurfs) == ks  .AND. &
                 (surf(id,isurfs) == idsint_u .OR. surfl(id,isurfs) == idsint_l ) ) THEN
!--            correct source surface
               local_pf(surfl(ix,isurflt),surfl(iy,isurflt),surfl(iz,isurflt)) = svf(k,isvf)
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_net' )
!--     array of complete radiation balance
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = &
                         surfinsw(isurf) - surfoutsw(isurf) +  surfinlw(isurf) - surfoutlw(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfradnet_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_insw' )
!--      array of sw radiation falling to surface after i-th reflection
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinsw(isurf)
               ELSE
                 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinsw_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_inlw' )
!--      array of lw radiation falling to surface after i-th reflection
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlw(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlw_av(isurf)
               ENDIF
             ENDIF
         ENDDO

      CASE ( 'rtm_rad_inswdir' )
!--      array of direct sw radiation falling to surface from sun
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdir(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdir_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_inswdif' )
!--      array of difusion sw radiation falling to surface from sky and borders of the domain
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdif(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdif_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_inswref' )
!--      array of sw radiation falling to surface from reflections
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = &
                    surfinsw(isurf) - surfinswdir(isurf) - surfinswdif(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswref_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_inlwdif' )
!--      array of difusion lw radiation falling to surface from sky and borders of the domain
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlwdif(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlwdif_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_inlwref' )
!--      array of lw radiation falling to surface from reflections
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlw(isurf) - surfinlwdif(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlwref_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_outsw' )
!--      array of sw radiation emitted from surface after i-th reflection
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutsw(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutsw_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_outlw' )
!--      array of lw radiation emitted from surface after i-th reflection
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutlw(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutlw_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_ressw' )
!--      average of array of residua of sw radiation absorbed in surface after last reflection
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfins(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfins_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_reslw' )
!--      average of array of residua of lw radiation absorbed in surface after last reflection
         DO isurf = dirstart(ids), dirend(ids)
            IF ( surfl(id,isurf) == idsint_u  .OR.  surfl(id,isurf) == idsint_l )  THEN
               IF ( av == 0 )  THEN
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinl(isurf)
               ELSE
                  local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinl_av(isurf)
               ENDIF
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_pc_inlw' )
!--      array of lw radiation absorbed by plant canopy
         DO ipcgb = 1, npcbl
            IF ( av == 0 )  THEN
               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinlw(ipcgb)
            ELSE
               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinlw_av(ipcgb)
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_pc_insw' )
!--      array of sw radiation absorbed by plant canopy
         DO ipcgb = 1, npcbl
            IF ( av == 0 )  THEN
              local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinsw(ipcgb)
            ELSE
              local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinsw_av(ipcgb)
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_pc_inswdir' )
!--      array of direct sw radiation absorbed by plant canopy
         DO ipcgb = 1, npcbl
            IF ( av == 0 )  THEN
               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdir(ipcgb)
            ELSE
               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdir_av(ipcgb)
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_pc_inswdif' )
!--      array of diffuse sw radiation absorbed by plant canopy
         DO ipcgb = 1, npcbl
            IF ( av == 0 )  THEN
               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdif(ipcgb)
            ELSE
               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdif_av(ipcgb)
            ENDIF
         ENDDO

      CASE ( 'rtm_rad_pc_inswref' )
!--      array of reflected sw radiation absorbed by plant canopy
         DO ipcgb = 1, npcbl
            IF ( av == 0 )  THEN
               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = &
                                    pcbinsw(ipcgb) - pcbinswdir(ipcgb) - pcbinswdif(ipcgb)
            ELSE
               local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswref_av(ipcgb)
            ENDIF
         ENDDO

      CASE ( 'rtm_mrt_sw' )
         local_pf = REAL( fill_value, KIND = wp )
         IF ( av == 0 )  THEN
            DO  l = 1, nmrtbl
               local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinsw(l)
            ENDDO
         ELSE
            IF ( ALLOCATED( mrtinsw_av ) ) THEN
               DO  l = 1, nmrtbl
                  local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinsw_av(l)
               ENDDO
            ENDIF
         ENDIF

      CASE ( 'rtm_mrt_lw' )
         local_pf = REAL( fill_value, KIND = wp )
         IF ( av == 0 )  THEN
            DO  l = 1, nmrtbl
               local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinlw(l)
            ENDDO
         ELSE
            IF ( ALLOCATED( mrtinlw_av ) ) THEN
               DO  l = 1, nmrtbl
                  local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinlw_av(l)
               ENDDO
            ENDIF
         ENDIF

      CASE ( 'rtm_mrt' )
         local_pf = REAL( fill_value, KIND = wp )
         IF ( av == 0 )  THEN
            DO  l = 1, nmrtbl
               local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrt(l)
            ENDDO
         ELSE
            IF ( ALLOCATED( mrt_av ) ) THEN
               DO  l = 1, nmrtbl
                  local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrt_av(l)
               ENDDO
            ENDIF
         ENDIF

       CASE DEFAULT
          found = .FALSE.

    END SELECT


 END SUBROUTINE radiation_data_output_3d

!------------------------------------------------------------------------------!
!
! Description:
! ------------
!> Subroutine defining masked data output
!------------------------------------------------------------------------------!
 SUBROUTINE radiation_data_output_mask( av, variable, found, local_pf )
 
    USE control_parameters
        
    USE indices
    
    USE kinds
    

    IMPLICIT NONE

    CHARACTER (LEN=*) ::  variable   !< 

    CHARACTER(LEN=5) ::  grid        !< flag to distinquish between staggered grids

    INTEGER(iwp) ::  av              !< 
    INTEGER(iwp) ::  i               !< 
    INTEGER(iwp) ::  j               !< 
    INTEGER(iwp) ::  k               !< 
    INTEGER(iwp) ::  topo_top_ind    !< k index of highest horizontal surface

    LOGICAL ::  found                !< true if output array was found
    LOGICAL ::  resorted             !< true if array is resorted


    REAL(wp),                                                                  &
       DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  &
          local_pf   !< 

    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to array which needs to be resorted for output


    found    = .TRUE.
    grid     = 's'
    resorted = .FALSE.

    SELECT CASE ( TRIM( variable ) )


       CASE ( 'rad_lw_in' )
          IF ( av == 0 )  THEN
             to_be_resorted => rad_lw_in
          ELSE
             to_be_resorted => rad_lw_in_av
          ENDIF

       CASE ( 'rad_lw_out' )
          IF ( av == 0 )  THEN
             to_be_resorted => rad_lw_out
          ELSE
             to_be_resorted => rad_lw_out_av
          ENDIF

       CASE ( 'rad_lw_cs_hr' )
          IF ( av == 0 )  THEN
             to_be_resorted => rad_lw_cs_hr
          ELSE
             to_be_resorted => rad_lw_cs_hr_av
          ENDIF

       CASE ( 'rad_lw_hr' )
          IF ( av == 0 )  THEN
             to_be_resorted => rad_lw_hr
          ELSE
             to_be_resorted => rad_lw_hr_av
          ENDIF

       CASE ( 'rad_sw_in' )
          IF ( av == 0 )  THEN
             to_be_resorted => rad_sw_in
          ELSE
             to_be_resorted => rad_sw_in_av
          ENDIF

       CASE ( 'rad_sw_out' )
          IF ( av == 0 )  THEN
             to_be_resorted => rad_sw_out
          ELSE
             to_be_resorted => rad_sw_out_av
          ENDIF

       CASE ( 'rad_sw_cs_hr' )
          IF ( av == 0 )  THEN
             to_be_resorted => rad_sw_cs_hr
          ELSE
             to_be_resorted => rad_sw_cs_hr_av
          ENDIF

       CASE ( 'rad_sw_hr' )
          IF ( av == 0 )  THEN
             to_be_resorted => rad_sw_hr
          ELSE
             to_be_resorted => rad_sw_hr_av
          ENDIF

       CASE DEFAULT
          found = .FALSE.

    END SELECT

!
!-- Resort the array to be output, if not done above
    IF ( .NOT. resorted )  THEN
       IF ( .NOT. mask_surface(mid) )  THEN
!
!--       Default masked output
          DO  i = 1, mask_size_l(mid,1)
             DO  j = 1, mask_size_l(mid,2)
                DO  k = 1, mask_size_l(mid,3)
                   local_pf(i,j,k) =  to_be_resorted(mask_k(mid,k), &
                                      mask_j(mid,j),mask_i(mid,i))
                ENDDO
             ENDDO
          ENDDO

       ELSE
!
!--       Terrain-following masked output
          DO  i = 1, mask_size_l(mid,1)
             DO  j = 1, mask_size_l(mid,2)
!
!--             Get k index of highest horizontal surface
                topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), &
                                                            mask_i(mid,i), &
                                                            grid )
!
!--             Save output array
                DO  k = 1, mask_size_l(mid,3)
                   local_pf(i,j,k) = to_be_resorted(                       &
                                          MIN( topo_top_ind+mask_k(mid,k), &
                                               nzt+1 ),                    &
                                          mask_j(mid,j),                   &
                                          mask_i(mid,i)                     )
                ENDDO
             ENDDO
          ENDDO

       ENDIF
    ENDIF



 END SUBROUTINE radiation_data_output_mask


!------------------------------------------------------------------------------!
! Description:
! ------------
!> Subroutine writes local (subdomain) restart data
!------------------------------------------------------------------------------!
 SUBROUTINE radiation_wrd_local


    IMPLICIT NONE


    IF ( ALLOCATED( rad_net_av ) )  THEN
       CALL wrd_write_string( 'rad_net_av' )
       WRITE ( 14 )  rad_net_av
    ENDIF
    
    IF ( ALLOCATED( rad_lw_in_xy_av ) )  THEN
       CALL wrd_write_string( 'rad_lw_in_xy_av' )
       WRITE ( 14 )  rad_lw_in_xy_av
    ENDIF
    
    IF ( ALLOCATED( rad_lw_out_xy_av ) )  THEN
       CALL wrd_write_string( 'rad_lw_out_xy_av' )
       WRITE ( 14 )  rad_lw_out_xy_av
    ENDIF
    
    IF ( ALLOCATED( rad_sw_in_xy_av ) )  THEN
       CALL wrd_write_string( 'rad_sw_in_xy_av' )
       WRITE ( 14 )  rad_sw_in_xy_av
    ENDIF
    
    IF ( ALLOCATED( rad_sw_out_xy_av ) )  THEN
       CALL wrd_write_string( 'rad_sw_out_xy_av' )
       WRITE ( 14 )  rad_sw_out_xy_av
    ENDIF

    IF ( ALLOCATED( rad_lw_in ) )  THEN
       CALL wrd_write_string( 'rad_lw_in' )
       WRITE ( 14 )  rad_lw_in
    ENDIF

    IF ( ALLOCATED( rad_lw_in_av ) )  THEN
       CALL wrd_write_string( 'rad_lw_in_av' )
       WRITE ( 14 )  rad_lw_in_av
    ENDIF

    IF ( ALLOCATED( rad_lw_out ) )  THEN
       CALL wrd_write_string( 'rad_lw_out' )
       WRITE ( 14 )  rad_lw_out
    ENDIF

    IF ( ALLOCATED( rad_lw_out_av) )  THEN
       CALL wrd_write_string( 'rad_lw_out_av' )
       WRITE ( 14 )  rad_lw_out_av
    ENDIF

    IF ( ALLOCATED( rad_lw_cs_hr) )  THEN
       CALL wrd_write_string( 'rad_lw_cs_hr' )
       WRITE ( 14 )  rad_lw_cs_hr
    ENDIF

    IF ( ALLOCATED( rad_lw_cs_hr_av) )  THEN
       CALL wrd_write_string( 'rad_lw_cs_hr_av' )
       WRITE ( 14 )  rad_lw_cs_hr_av
    ENDIF

    IF ( ALLOCATED( rad_lw_hr) )  THEN
       CALL wrd_write_string( 'rad_lw_hr' )
       WRITE ( 14 )  rad_lw_hr
    ENDIF

    IF ( ALLOCATED( rad_lw_hr_av) )  THEN
       CALL wrd_write_string( 'rad_lw_hr_av' )
       WRITE ( 14 )  rad_lw_hr_av
    ENDIF

    IF ( ALLOCATED( rad_sw_in) )  THEN
       CALL wrd_write_string( 'rad_sw_in' )
       WRITE ( 14 )  rad_sw_in
    ENDIF

    IF ( ALLOCATED( rad_sw_in_av) )  THEN
       CALL wrd_write_string( 'rad_sw_in_av' )
       WRITE ( 14 )  rad_sw_in_av
    ENDIF

    IF ( ALLOCATED( rad_sw_out) )  THEN
       CALL wrd_write_string( 'rad_sw_out' )
       WRITE ( 14 )  rad_sw_out
    ENDIF

    IF ( ALLOCATED( rad_sw_out_av) )  THEN
       CALL wrd_write_string( 'rad_sw_out_av' )
       WRITE ( 14 )  rad_sw_out_av
    ENDIF

    IF ( ALLOCATED( rad_sw_cs_hr) )  THEN
       CALL wrd_write_string( 'rad_sw_cs_hr' )
       WRITE ( 14 )  rad_sw_cs_hr
    ENDIF

    IF ( ALLOCATED( rad_sw_cs_hr_av) )  THEN
       CALL wrd_write_string( 'rad_sw_cs_hr_av' )
       WRITE ( 14 )  rad_sw_cs_hr_av
    ENDIF

    IF ( ALLOCATED( rad_sw_hr) )  THEN
       CALL wrd_write_string( 'rad_sw_hr' )
       WRITE ( 14 )  rad_sw_hr
    ENDIF

    IF ( ALLOCATED( rad_sw_hr_av) )  THEN
       CALL wrd_write_string( 'rad_sw_hr_av' )
       WRITE ( 14 )  rad_sw_hr_av
    ENDIF


 END SUBROUTINE radiation_wrd_local

!------------------------------------------------------------------------------!
! Description:
! ------------
!> Subroutine reads local (subdomain) restart data
!------------------------------------------------------------------------------!
 SUBROUTINE radiation_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,    &
                                nxr_on_file, nynf, nync, nyn_on_file, nysf,    &
                                nysc, nys_on_file, tmp_2d, tmp_3d, found )
 

    USE control_parameters
        
    USE indices
    
    USE kinds
    
    USE pegrid


    IMPLICIT NONE

    INTEGER(iwp) ::  i               !< 
    INTEGER(iwp) ::  k               !< 
    INTEGER(iwp) ::  nxlc            !< 
    INTEGER(iwp) ::  nxlf            !< 
    INTEGER(iwp) ::  nxl_on_file     !< 
    INTEGER(iwp) ::  nxrc            !< 
    INTEGER(iwp) ::  nxrf            !< 
    INTEGER(iwp) ::  nxr_on_file     !< 
    INTEGER(iwp) ::  nync            !< 
    INTEGER(iwp) ::  nynf            !< 
    INTEGER(iwp) ::  nyn_on_file     !< 
    INTEGER(iwp) ::  nysc            !< 
    INTEGER(iwp) ::  nysf            !< 
    INTEGER(iwp) ::  nys_on_file     !< 

    LOGICAL, INTENT(OUT)  :: found

    REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d   !< 

    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !< 

    REAL(wp), DIMENSION(0:0,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d2   !< 


    found = .TRUE.


    SELECT CASE ( restart_string(1:length) )

       CASE ( 'rad_net_av' )
          IF ( .NOT. ALLOCATED( rad_net_av ) )  THEN
             ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )
          ENDIF  
          IF ( k == 1 )  READ ( 13 )  tmp_2d
          rad_net_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =           &
                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
                        
       CASE ( 'rad_lw_in_xy_av' )
          IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) )  THEN
             ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) )
          ENDIF  
          IF ( k == 1 )  READ ( 13 )  tmp_2d
          rad_lw_in_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =      &
                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
                        
       CASE ( 'rad_lw_out_xy_av' )
          IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) )  THEN
             ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) )
          ENDIF  
          IF ( k == 1 )  READ ( 13 )  tmp_2d
          rad_lw_out_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =     &
                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
                        
       CASE ( 'rad_sw_in_xy_av' )
          IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) )  THEN
             ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) )
          ENDIF  
          IF ( k == 1 )  READ ( 13 )  tmp_2d
          rad_sw_in_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =      &
                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
                        
       CASE ( 'rad_sw_out_xy_av' )
          IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) )  THEN
             ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) )
          ENDIF  
          IF ( k == 1 )  READ ( 13 )  tmp_2d
          rad_sw_out_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =     &
                        tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
                        
       CASE ( 'rad_lw_in' )
          IF ( .NOT. ALLOCATED( rad_lw_in ) )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                ALLOCATE( rad_lw_in(0:0,nysg:nyng,nxlg:nxrg) )
             ELSE
                ALLOCATE( rad_lw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             ENDIF
          ENDIF  
          IF ( k == 1 )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                READ ( 13 )  tmp_3d2
                rad_lw_in(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =   &
                   tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ELSE
                READ ( 13 )  tmp_3d
                rad_lw_in(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =     &
                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ENDIF
          ENDIF

       CASE ( 'rad_lw_in_av' )
          IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                ALLOCATE( rad_lw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
             ELSE
                ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             ENDIF
          ENDIF  
          IF ( k == 1 )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                READ ( 13 )  tmp_3d2
                rad_lw_in_av(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =&
                    tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ELSE
                READ ( 13 )  tmp_3d
                rad_lw_in_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =  &
                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ENDIF
          ENDIF

       CASE ( 'rad_lw_out' )
          IF ( .NOT. ALLOCATED( rad_lw_out ) )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                ALLOCATE( rad_lw_out(0:0,nysg:nyng,nxlg:nxrg) )
             ELSE
                ALLOCATE( rad_lw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             ENDIF
          ENDIF  
          IF ( k == 1 )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                READ ( 13 )  tmp_3d2
                rad_lw_out(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =  &
                    tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ELSE
                READ ( 13 )  tmp_3d
                rad_lw_out(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =    &
                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ENDIF
          ENDIF

       CASE ( 'rad_lw_out_av' )
          IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                ALLOCATE( rad_lw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
             ELSE
                ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             ENDIF
          ENDIF  
          IF ( k == 1 )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                READ ( 13 )  tmp_3d2
                rad_lw_out_av(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) &
                   = tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ELSE
                READ ( 13 )  tmp_3d
                rad_lw_out_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ENDIF
          ENDIF

       CASE ( 'rad_lw_cs_hr' )
          IF ( .NOT. ALLOCATED( rad_lw_cs_hr ) )  THEN
             ALLOCATE( rad_lw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( k == 1 )  READ ( 13 )  tmp_3d
          rad_lw_cs_hr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =        &
                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)

       CASE ( 'rad_lw_cs_hr_av' )
          IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) )  THEN
             ALLOCATE( rad_lw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( k == 1 )  READ ( 13 )  tmp_3d
          rad_lw_cs_hr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =     &
                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)

       CASE ( 'rad_lw_hr' )
          IF ( .NOT. ALLOCATED( rad_lw_hr ) )  THEN
             ALLOCATE( rad_lw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( k == 1 )  READ ( 13 )  tmp_3d
          rad_lw_hr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =           &
                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)

       CASE ( 'rad_lw_hr_av' )
          IF ( .NOT. ALLOCATED( rad_lw_hr_av ) )  THEN
             ALLOCATE( rad_lw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( k == 1 )  READ ( 13 )  tmp_3d
          rad_lw_hr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =        &
                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)

       CASE ( 'rad_sw_in' )
          IF ( .NOT. ALLOCATED( rad_sw_in ) )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                ALLOCATE( rad_sw_in(0:0,nysg:nyng,nxlg:nxrg) )
             ELSE
                ALLOCATE( rad_sw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             ENDIF
          ENDIF  
          IF ( k == 1 )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                READ ( 13 )  tmp_3d2
                rad_sw_in(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =   &
                    tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ELSE
                READ ( 13 )  tmp_3d
                rad_sw_in(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =     &
                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ENDIF
          ENDIF

       CASE ( 'rad_sw_in_av' )
          IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                ALLOCATE( rad_sw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
             ELSE
                ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             ENDIF
          ENDIF  
          IF ( k == 1 )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                READ ( 13 )  tmp_3d2
                rad_sw_in_av(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =&
                    tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ELSE
                READ ( 13 )  tmp_3d
                rad_sw_in_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =  &
                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ENDIF
          ENDIF

       CASE ( 'rad_sw_out' )
          IF ( .NOT. ALLOCATED( rad_sw_out ) )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                ALLOCATE( rad_sw_out(0:0,nysg:nyng,nxlg:nxrg) )
             ELSE
                ALLOCATE( rad_sw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             ENDIF
          ENDIF  
          IF ( k == 1 )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                READ ( 13 )  tmp_3d2
                rad_sw_out(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =  &
                    tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ELSE
                READ ( 13 )  tmp_3d
                rad_sw_out(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =    &
                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ENDIF
          ENDIF

       CASE ( 'rad_sw_out_av' )
          IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                ALLOCATE( rad_sw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
             ELSE
                ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
             ENDIF
          ENDIF  
          IF ( k == 1 )  THEN
             IF ( radiation_scheme == 'clear-sky'  .OR.                    &
                  radiation_scheme == 'constant')  THEN
                READ ( 13 )  tmp_3d2
                rad_sw_out_av(0:0,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) &
                   = tmp_3d2(0:0,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ELSE
                READ ( 13 )  tmp_3d
                rad_sw_out_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
                    tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
             ENDIF
          ENDIF

       CASE ( 'rad_sw_cs_hr' )
          IF ( .NOT. ALLOCATED( rad_sw_cs_hr ) )  THEN
             ALLOCATE( rad_sw_cs_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( k == 1 )  READ ( 13 )  tmp_3d
          rad_sw_cs_hr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =        &
                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)

       CASE ( 'rad_sw_cs_hr_av' )
          IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) )  THEN
             ALLOCATE( rad_sw_cs_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( k == 1 )  READ ( 13 )  tmp_3d
          rad_sw_cs_hr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =     &
                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)

       CASE ( 'rad_sw_hr' )
          IF ( .NOT. ALLOCATED( rad_sw_hr ) )  THEN
             ALLOCATE( rad_sw_hr(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( k == 1 )  READ ( 13 )  tmp_3d
          rad_sw_hr(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =           &
                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)

       CASE ( 'rad_sw_hr_av' )
          IF ( .NOT. ALLOCATED( rad_sw_hr_av ) )  THEN
             ALLOCATE( rad_sw_hr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
          ENDIF
          IF ( k == 1 )  READ ( 13 )  tmp_3d
          rad_lw_hr_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =        &
                  tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)

       CASE DEFAULT

          found = .FALSE.

    END SELECT

 END SUBROUTINE radiation_rrd_local

!------------------------------------------------------------------------------!
! Description:
! ------------
!> Subroutine writes debug information
!------------------------------------------------------------------------------!
 SUBROUTINE radiation_write_debug_log ( message )
    !> it writes debug log with time stamp
    CHARACTER(*)  :: message
    CHARACTER(15) :: dtc
    CHARACTER(8)  :: date
    CHARACTER(10) :: time
    CHARACTER(5)  :: zone
    CALL date_and_time(date, time, zone)
    dtc = date(7:8)//','//time(1:2)//':'//time(3:4)//':'//time(5:10)
    WRITE(9,'(2A)') dtc, TRIM(message)
    FLUSH(9)
 END SUBROUTINE radiation_write_debug_log

 END MODULE radiation_model_mod