Ignore:
Timestamp:
Dec 14, 2017 5:12:51 PM (6 years ago)
Author:
kanani
Message:

Merge of branch palm4u into trunk

Location:
palm/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk

  • palm/trunk/SOURCE

  • palm/trunk/SOURCE/urban_surface_mod.f90

    r2583 r2696  
    11!> @file urban_surface_mod.f90
    2 !--------------------------------------------------------------------------------!
    3 ! This file is part of PALM.
     2!------------------------------------------------------------------------------!
     3! This file is part of the PALM model system.
    44!
    55! PALM is free software: you can redistribute it and/or modify it under the
     
    2626! -----------------
    2727! $Id$
     28! - Bugfix in calculation of pt_surface and related fluxes. (BM)
     29! - Do not write surface temperatures onto pt array as this might cause
     30!   problems with nesting. (MS)
     31! - Revised calculation of pt1 (now done in surface_layer_fluxes).
     32!   Bugfix, f_shf_window and f_shf_green were not set at vertical surface
     33!   elements. (MS)
     34! - merged with branch ebsolver
     35!   green building surfaces do not evaporate yet
     36!   properties of green wall layers and window layers are taken from wall layers
     37!   this input data is missing. (RvT)
     38! - Merged with branch radiation (developed by Mohamed Salim)
     39! - Revised initialization. (MS)
     40! - Rename emiss_surf into emissivity, roughness_wall into z0, albedo_surf into
     41!   albedo. (MS)
     42! - Move first call of usm_radiatin from usm_init to init_3d_model
     43! - fixed problem with near surface temperature
     44! - added near surface temperature t_surf_10cm_h(m), t_surf_10cm_v(l)%t(m)
     45! - does not work with temp profile including stability, ol
     46!   t_surf_10cm = pt1 now
     47! - merged with 2357 bugfix, error message for nopointer version
     48! - added indoor model coupling with wall heat flux
     49! - added green substrate/ dry vegetation layer for buildings
     50! - merged with 2232 new surface-type structure
     51! - added transmissivity of window tiles
     52! - added MOSAIK tile approach for 3 different surfaces (RvT)
     53!
     54! 2583 2017-10-26 13:58:38Z knoop
    2855! Date and time quantities are now read from date_and_time_mod. Solar constant is
    2956! read from radiation_model_mod
     
    142169!>    1.2 Km/s, which seem to be not realistic.
    143170!>
     171!> @todo Output of _av variables in case of restarts
    144172!> @todo Revise flux conversion in energy-balance solver
    145173!> @todo Bugfixing in nopointer branch
     
    148176!> @todo Check for load imbalances in CPU measures, e.g. for exchange_horiz_prog
    149177!>       factor 3 between min and max time
     178!> @todo Move setting of flag indoor_model to indoor_model_mod once available
     179!> @todo Check divisions in wtend (etc.) calculations for possible division
     180!>       by zero, e.g. in case fraq(0,m) + fraq(1,m) = 0?!
     181!> @todo Use unit 90 for OPEN/CLOSE of input files (FK)
    150182!------------------------------------------------------------------------------!
    151183 MODULE urban_surface_mod
     
    170202               g, pt_surface, large_scale_forcing, lsf_surf, spinup,           &
    171203               spinup_pt_mean, spinup_time, time_do3d, dt_do3d,                &
    172                average_count_3d, varnamelength, urban_surface
     204               average_count_3d, varnamelength, urban_surface, kappa
    173205
    174206    USE cpulog,                                                                &
    175207        ONLY:  cpu_log, log_point, log_point_s
    176      
     208
    177209    USE date_and_time_mod,                                                     &
    178210        ONLY:  d_seconds_year, day_of_year_init, time_utc_init
    179    
     211
    180212    USE grid_variables,                                                        &
    181213        ONLY:  dx, dy, ddx, ddy, ddx2, ddy2
    182    
     214
    183215    USE indices,                                                               &
    184216        ONLY:  nx, ny, nnx, nny, nnz, nxl, nxlg, nxr, nxrg, nyn, nyng, nys,    &
     
    192224   
    193225    USE plant_canopy_model_mod,                                                &
    194         ONLY:  plant_canopy, pch_index,                                        &
    195                pc_heating_rate, lad_s
     226        ONLY:  pc_heating_rate, plant_canopy, usm_lad_rma
    196227   
    197228    USE radiation_model_mod,                                                   &
    198         ONLY:  radiation, calc_zenith, zenith,                                 &
    199                rad_net, rad_sw_in, rad_lw_in, rad_sw_out, rad_lw_out,          &
     229        ONLY:  albedo_type, radiation, calc_zenith, zenith,                    &
     230               rad_sw_in, rad_lw_in, rad_sw_out, rad_lw_out,                   &
    200231               sigma_sb, solar_constant, sun_direction, sun_dir_lat,           &
    201                sun_dir_lon, force_radiation_call
     232               sun_dir_lon,                                                    &
     233               force_radiation_call, surfinsw, surfinlw, surfinswdir,          &
     234               surfinswdif, surfoutsw, surfoutlw, surfins,nsvfl, svf, svfsurf, &
     235               surfinl, surfinlwdif, energy_balance_surf_h,                    &
     236               energy_balance_surf_v, rad_sw_in_dir, rad_sw_in_diff,           &
     237               rad_lw_in_diff, surfouts, surfoutl, surfoutsl, surfoutll, surf, &
     238               surfl, nsurfl, nsurfs, surfstart, pcbinsw, pcbinlw, pcbl, npcbl, startenergy,      &
     239               endenergy, nenergy, iup_u, inorth_u, isouth_u, ieast_u, iwest_u, iup_l,  &
     240               inorth_l, isouth_l, ieast_l, iwest_l, startsky, endsky,id,      &
     241               iz, iy, ix, idir, jdir, kdir, startborder, endborder, nsurf_type, nzub, nzut,   &
     242               isky, inorth_b,idown_a, isouth_b, ieast_b, iwest_b, nzu, pch, nsurf,  &
     243               iup_a, inorth_a, isouth_a, ieast_a, iwest_a, idsvf, ndsvf,      &
     244               idcsf, ndcsf, kdcsf, pct, startland, endland, startwall, endwall
    202245
    203246    USE statistics,                                                            &
     
    206249    USE surface_mod
    207250
    208                
    209251
    210252    IMPLICIT NONE
    211253
     254
    212255!-- configuration parameters (they can be setup in PALM config)
    213     LOGICAL                                        ::  split_diffusion_radiation = .TRUE. !< split direct and diffusion dw radiation
    214                                                                                           !< (.F. in case the radiation model already does it)   
    215     LOGICAL                                        ::  usm_energy_balance_land = .TRUE.   !< flag parameter indicating wheather the energy balance is calculated for land and roofs
    216     LOGICAL                                        ::  usm_energy_balance_wall = .TRUE.   !< flag parameter indicating wheather the energy balance is calculated for land and roofs
    217256    LOGICAL                                        ::  usm_material_model = .TRUE.        !< flag parameter indicating wheather the  model of heat in materials is used
    218257    LOGICAL                                        ::  usm_anthropogenic_heat = .FALSE.   !< flag parameter indicating wheather the anthropogenic heat sources (e.g.transportation) are used
    219258    LOGICAL                                        ::  force_radiation_call_l = .FALSE.   !< flag parameter for unscheduled radiation model calls
    220     LOGICAL                                        ::  mrt_factors = .FALSE.              !< whether to generate MRT factor files during init
    221     LOGICAL                                        ::  write_svf_on_init = .FALSE.
    222     LOGICAL                                        ::  read_svf_on_init = .FALSE.
    223     LOGICAL                                        ::  usm_lad_rma = .TRUE.               !< use MPI RMA to access LAD for raytracing (instead of global array)
    224    
    225     INTEGER(iwp)                                   ::  nrefsteps = 0                      !< number of reflection steps to perform
    226    
     259    LOGICAL                                        ::  indoor_model = .FALSE.              !< whether to use the indoor model
     260
     261   
     262    INTEGER(iwp)                                   ::  building_type = 1                  !< default building type (preleminary setting)
    227263    INTEGER(iwp)                                   ::  land_category = 2                  !< default category for land surface
    228264    INTEGER(iwp)                                   ::  wall_category = 2                  !< default category for wall surface over pedestrian zone
    229265    INTEGER(iwp)                                   ::  pedestrant_category = 2            !< default category for wall surface in pedestrian zone
    230266    INTEGER(iwp)                                   ::  roof_category = 2                  !< default category for root surface
    231     REAL(wp)                                       ::  roof_height_limit = 4._wp          !< height for distinguish between land surfaces and roofs
    232 
    233     REAL(wp), PARAMETER                            ::  ext_coef = 0.6_wp                  !< extinction coefficient (a.k.a. alpha)
    234     REAL(wp)                                       ::  ra_horiz_coef = 5.0_wp             !< mysterious coefficient for correction of overestimation
     267
     268!
     269!-- Indices of input attributes for (above) ground floor level
     270    INTEGER(iwp) ::  ind_alb_wall          = 38 !< index in input list for albedo_type of wall fraction
     271    INTEGER(iwp) ::  ind_alb_green         = 39 !< index in input list for albedo_type of green fraction
     272    INTEGER(iwp) ::  ind_alb_win           = 40 !< index in input list for albedo_type of window fraction
     273    INTEGER(iwp) ::  ind_emis_wall_agfl    = 14 !< index in input list for wall emissivity, above ground floor level
     274    INTEGER(iwp) ::  ind_emis_wall_gfl     = 32 !< index in input list for wall emissivity, ground floor level
     275    INTEGER(iwp) ::  ind_emis_green_agfl   = 15 !< index in input list for green emissivity, above ground floor level
     276    INTEGER(iwp) ::  ind_emis_green_gfl    = 33 !< index in input list for green emissivity, ground floor level
     277    INTEGER(iwp) ::  ind_emis_win_agfl     = 16 !< index in input list for window emissivity, above ground floor level
     278    INTEGER(iwp) ::  ind_emis_win_gfl      = 34 !< index in input list for window emissivity, ground floor level
     279    INTEGER(iwp) ::  ind_green_frac_w_agfl = 2  !< index in input list for green fraction on wall, above ground floor level
     280    INTEGER(iwp) ::  ind_green_frac_w_gfl  = 23 !< index in input list for green fraction on wall, ground floor level
     281    INTEGER(iwp) ::  ind_green_frac_r_agfl = 3  !< index in input list for green fraction on roof, above ground floor level
     282    INTEGER(iwp) ::  ind_green_frac_r_gfl  = 24 !< index in input list for green fraction on roof, ground floor level
     283    INTEGER(iwp) ::  ind_hc1_agfl          =  6 !< index in input list for heat capacity at first wall layer, above ground floor level
     284    INTEGER(iwp) ::  ind_hc1_gfl           = 26 !< index in input list for heat capacity at first wall layer, ground floor level
     285    INTEGER(iwp) ::  ind_hc2_agfl          = 7  !< index in input list for heat capacity at second wall layer, above ground floor level
     286    INTEGER(iwp) ::  ind_hc2_gfl           = 27 !< index in input list for heat capacity at second wall layer, ground floor level
     287    INTEGER(iwp) ::  ind_hc3_agfl          = 8  !< index in input list for heat capacity at third wall layer, above ground floor level
     288    INTEGER(iwp) ::  ind_hc3_gfl           = 28 !< index in input list for heat capacity at third wall layer, ground floor level
     289    INTEGER(iwp) ::  ind_gflh              = 20 !< index in input list for ground floor level height
     290    INTEGER(iwp) ::  ind_lai_r_agfl        = 4  !< index in input list for LAI on roof, above ground floor level
     291    INTEGER(iwp) ::  ind_lai_r_gfl         = 4  !< index in input list for LAI on roof, ground floor level
     292    INTEGER(iwp) ::  ind_lai_w_agfl        = 5  !< index in input list for LAI on wall, above ground floor level
     293    INTEGER(iwp) ::  ind_lai_w_gfl         = 25 !< index in input list for LAI on wall, ground floor level
     294    INTEGER(iwp) ::  ind_tc1_agfl          = 9  !< index in input list for thermal conductivity at first wall layer, above ground floor level
     295    INTEGER(iwp) ::  ind_tc1_gfl           = 29 !< index in input list for thermal conductivity at first wall layer, ground floor level
     296    INTEGER(iwp) ::  ind_tc2_agfl          = 10 !< index in input list for thermal conductivity at second wall layer, above ground floor level
     297    INTEGER(iwp) ::  ind_tc2_gfl           = 30 !< index in input list for thermal conductivity at second wall layer, ground floor level
     298    INTEGER(iwp) ::  ind_tc3_agfl          = 11 !< index in input list for thermal conductivity at third wall layer, above ground floor level
     299    INTEGER(iwp) ::  ind_tc3_gfl           = 31 !< index in input list for thermal conductivity at third wall layer, ground floor level
     300    INTEGER(iwp) ::  ind_thick_1           = 41 !< index for wall layer thickness - 1st layer
     301    INTEGER(iwp) ::  ind_thick_2           = 42 !< index for wall layer thickness - 2nd layer
     302    INTEGER(iwp) ::  ind_thick_3           = 43 !< index for wall layer thickness - 3rd layer
     303    INTEGER(iwp) ::  ind_thick_4           = 44 !< index for wall layer thickness - 4th layer
     304    INTEGER(iwp) ::  ind_trans_agfl        = 17 !< index in input list for window transmissivity, above ground floor level
     305    INTEGER(iwp) ::  ind_trans_gfl         = 35 !< index in input list for window transmissivity, ground floor level
     306    INTEGER(iwp) ::  ind_wall_frac_agfl    = 0  !< index in input list for wall fraction, above ground floor level
     307    INTEGER(iwp) ::  ind_wall_frac_gfl     = 21 !< index in input list for wall fraction, ground floor level
     308    INTEGER(iwp) ::  ind_win_frac_agfl     = 1  !< index in input list for window fraction, above ground floor level
     309    INTEGER(iwp) ::  ind_win_frac_gfl      = 22 !< index in input list for window fraction, ground floor level
     310    INTEGER(iwp) ::  ind_z0_agfl           = 18 !< index in input list for z0, above ground floor level
     311    INTEGER(iwp) ::  ind_z0_gfl            = 36 !< index in input list for z0, ground floor level
     312    INTEGER(iwp) ::  ind_z0qh_agfl         = 19 !< index in input list for z0h / z0q, above ground floor level
     313    INTEGER(iwp) ::  ind_z0qh_gfl          = 37 !< index in input list for z0h / z0q, ground floor level
     314
     315
     316    REAL(wp)  ::  roof_height_limit = 4._wp          !< height for distinguish between land surfaces and roofs
     317    REAL(wp)  ::  ground_floor_level = 4.0_wp        !< default ground floor level
     318    REAL(wp)  ::  ra_horiz_coef = 5.0_wp             !< mysterious coefficient for correction of overestimation
    235319                                                                                          !< of r_a for horizontal surfaces -> TODO
    236    
    237 !-- parameters of urban surface model
    238     INTEGER(iwp), PARAMETER                        ::  usm_version_len = 10               !< length of identification string of usm version
    239     CHARACTER(usm_version_len), PARAMETER          ::  usm_version = 'USM v. 1.0'         !< identification of version of binary svf and restart files
    240     INTEGER(iwp), PARAMETER                        ::  svf_code_len = 15                  !< length of code for verification of the end of svf file
    241     CHARACTER(svf_code_len), PARAMETER             ::  svf_code = '*** end svf ***'       !< code for verification of the end of svf file
    242     INTEGER(iwp)                                   ::  nzu                                !< number of layers of urban surface (will be calculated)
    243     INTEGER(iwp)                                   ::  nzub,nzut                          !< bottom and top layer of urban surface (will be calculated)
    244     INTEGER(iwp), PARAMETER                        ::  nzut_free = 3                      !< number of free layers in urban surface layer above top of buildings
    245     INTEGER(iwp), PARAMETER                        ::  ndsvf = 2                          !< number of dimensions of real values in SVF
    246     INTEGER(iwp), PARAMETER                        ::  idsvf = 2                          !< number of dimensions of integer values in SVF
    247     INTEGER(iwp), PARAMETER                        ::  ndcsf = 2                          !< number of dimensions of real values in CSF
    248     INTEGER(iwp), PARAMETER                        ::  idcsf = 2                          !< number of dimensions of integer values in CSF
    249     INTEGER(iwp), PARAMETER                        ::  kdcsf = 4                          !< number of dimensions of integer values in CSF calculation array
    250     INTEGER(iwp), PARAMETER                        ::  id = 1                             !< position of d-index in surfl and surf
    251     INTEGER(iwp), PARAMETER                        ::  iz = 2                             !< position of k-index in surfl and surf
    252     INTEGER(iwp), PARAMETER                        ::  iy = 3                             !< position of j-index in surfl and surf
    253     INTEGER(iwp), PARAMETER                        ::  ix = 4                             !< position of i-index in surfl and surf
    254     INTEGER(iwp), PARAMETER                        ::  iroof = 0                          !< 0 - index of ground or roof
    255     INTEGER(iwp), PARAMETER                        ::  isouth = 1                         !< 1 - index of south facing wall
    256     INTEGER(iwp), PARAMETER                        ::  inorth = 2                         !< 2 - index of north facing wall
    257     INTEGER(iwp), PARAMETER                        ::  iwest  = 3                         !< 3 - index of west facing wall
    258     INTEGER(iwp), PARAMETER                        ::  ieast  = 4                         !< 4 - index of east facing wall
    259     INTEGER(iwp), PARAMETER                        ::  isky = 5                           !< 5 - index of top border of the urban surface layer ("urban sky")
    260     INTEGER(iwp), PARAMETER                        ::  inorthb = 6                        !< 6 - index of free north border of the domain (south facing)
    261     INTEGER(iwp), PARAMETER                        ::  isouthb = 7                        !< 7 - index of north south border of the domain (north facing)
    262     INTEGER(iwp), PARAMETER                        ::  ieastb  = 8                        !< 8 - index of east border of the domain (west facing)
    263     INTEGER(iwp), PARAMETER                        ::  iwestb  = 9                        !< 9 - index of wast border of the domain (east facing)
    264     INTEGER(iwp), DIMENSION(0:9), PARAMETER        ::  idir = (/0,0,0,-1,1,0,0,0,-1,1/)   !< surface normal direction x indices
    265     INTEGER(iwp), DIMENSION(0:9), PARAMETER        ::  jdir = (/0,-1,1,0,0,0,-1,1,0,0/)   !< surface normal direction y indices
    266     INTEGER(iwp), DIMENSION(0:9), PARAMETER        ::  kdir = (/1,0,0,0,0,-1,0,0,0,0/)    !< surface normal direction z indices
    267     REAL(wp), DIMENSION(1:4)                       ::  ddxy2                              !< 1/dx^2 or 1/dy^2 (in surface normal direction)
    268     INTEGER(iwp), DIMENSION(1:4,6:9)               ::  ijdb                               !< start and end of the local domain border coordinates (set in code)
    269     LOGICAL, DIMENSION(6:9)                        ::  isborder                           !< is PE on the border of the domain in four corresponding directions
    270                                                                                           !< parameter but set in the code
    271 
    272 !-- indices and sizes of urban surface model
    273     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  surfl            !< coordinates of i-th local surface in local grid - surfl[:,k] = [d, z, y, x]
    274     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  surf             !< coordinates of i-th surface in grid - surf[:,k] = [d, z, y, x]
    275     INTEGER(iwp)                                   ::  nsurfl           !< number of all surfaces in local processor
    276     INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  nsurfs           !< array of number of all surfaces in individual processors
    277     INTEGER(iwp)                                   ::  startsky         !< start index of block of sky
    278     INTEGER(iwp)                                   ::  endsky           !< end index of block of sky
    279     INTEGER(iwp)                                   ::  nskys            !< number of sky surfaces in local processor
    280     INTEGER(iwp)                                   ::  startland        !< start index of block of land and roof surfaces
    281     INTEGER(iwp)                                   ::  endland          !< end index of block of land and roof surfaces
    282     INTEGER(iwp)                                   ::  nlands           !< number of land and roof surfaces in local processor
    283     INTEGER(iwp)                                   ::  startwall        !< start index of block of wall surfaces
    284     INTEGER(iwp)                                   ::  endwall          !< end index of block of wall surfaces
    285     INTEGER(iwp)                                   ::  nwalls           !< number of wall surfaces in local processor
    286     INTEGER(iwp)                                   ::  startenergy      !< start index of block of real surfaces (land, walls and roofs)
    287     INTEGER(iwp)                                   ::  endenergy        !< end index of block of real surfaces (land, walls and roofs)
    288     INTEGER(iwp)                                   ::  nenergy          !< number of real surfaces in local processor
    289     INTEGER(iwp)                                   ::  nsurf            !< global number of surfaces in index array of surfaces (nsurf = Σproc nsurfs)
    290     INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  surfstart        !< starts of blocks of surfaces for individual processors in array surf
    291                                                                         !< respective block for particular processor is surfstart[iproc]+1 : surfstart[iproc+1]
    292     INTEGER(iwp)                                   ::  nsvfl            !< number of svf for local processor
    293     INTEGER(iwp)                                   ::  ncsfl            !< no. of csf in local processor
    294                                                                         !< needed only during calc_svf but must be here because it is
    295                                                                         !< shared between subroutines usm_calc_svf and usm_raytrace
    296 
    297 !-- type for calculation of svf
    298     TYPE t_svf
    299         INTEGER(iwp)                               :: isurflt           !<
    300         INTEGER(iwp)                               :: isurfs            !<
    301         REAL(wp)                                   :: rsvf              !<
    302         REAL(wp)                                   :: rtransp           !<
    303     END TYPE
    304 
    305 !-- type for calculation of csf
    306     TYPE t_csf
    307         INTEGER(iwp)                               :: ip                !<
    308         INTEGER(iwp)                               :: itx               !<
    309         INTEGER(iwp)                               :: ity               !<
    310         INTEGER(iwp)                               :: itz               !<
    311         INTEGER(iwp)                               :: isurfs            !<
    312         REAL(wp)                                   :: rsvf              !<
    313         REAL(wp)                                   :: rtransp           !<
    314     END TYPE
     320
     321    CHARACTER(37), DIMENSION(0:6), PARAMETER :: building_type_name = (/     &
     322                                   'user-defined                         ', & !  0
     323                                   'residential - 1950                   ', & !  1
     324                                   'residential 1951 - 2000              ', & !  2
     325                                   'residential 2001 -                   ', & !  3
     326                                   'office - 1950                        ', & !  4
     327                                   'office 1951 - 2000                   ', & !  5
     328                                   'office 2001 -                        '  & !  6
     329                                                                     /)
     330!
     331!-- building parameters, 4 different types
     332!-- 0 - wall fraction, 1- window fraction, 2 - green fraction on wall, 3- green fraction
     333!-- at roof, 4 - lai of green fraction at roof,  5 - lai of green fraction at wall,
     334!-- 6 - heat capacity of wall layer 1, 7 - heat capacity of wall layer 2,
     335!-- 8 - heat capacity of wall layer 3, 9 - thermal conductivity of wall layer 1,
     336!-- 10 - thermal conductivity of wall layer 2, 11 - thermal conductivity of wall layer 3, 
     337!-- 12 - indoor target summer temperature ( K ), 13 - indoor target winter temperature (K),
     338!-- 14 - emissivity of wall fraction, 15 - emissivity of green fraction, 16 - emissivity of window fraction,
     339!-- 17 - transmissivity of window fraction, 18 - z0, 19 - z0h/z0q, 20 - ground floor height,
     340!-- 21 - ground floor wall fraction, 22 - ground floor window fraction, 23 ground floor green fraction,
     341!-- 24 - ground floor green fraction on roof, 25 - ground floor lai of green fraction,
     342!-- 26 - ground floor heat capacity of wall layer 1, 27 - ground floor heat capacity of wall layer 1,
     343!-- 28 - ground floor heat capacity of wall layer 3, 29 - ground floor thermal conductivity of wall layer 1,
     344!-- 30 - ground floor thermal conductivity of wall layer 2, 31 - ground floor thermal conductivity of wall layer 3,
     345!-- 32 - ground floor emissivity of wall fraction, 33 - ground floor emissivity of green fraction,
     346!-- 34 - ground floor emissivity of window fraction, 35 - ground floor transmissivity of window fraction,
     347!-- 36 - ground floor z0, 37 - ground floor z0h/z0q, 38 - albedo type wall fraction
     348!-- 39 - albedo type green fraction, 40 - albedo type window fraction
     349!-- 41 - wall layer thickness - 1st layer, 42 - wall layer thickness - 2nd layer,
     350!-- 43 - wall layer thickness - 3rd layer, 44 - wall layer thickness - 4th layer,
     351!-- 45 - heat capacity of the wall surface, 46 - heat conductivity
     352!-- Please note, only preleminary dummy values so far!
     353    REAL(wp), DIMENSION(0:46,1:6), PARAMETER :: building_pars = RESHAPE( (/    &
     354        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
     355        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
     356        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
     357        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
     358        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
     359        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
     360        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
     361        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
     362        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
     363        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
     364        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 1
     365        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
     366        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
     367        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
     368        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
     369        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
     370        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
     371        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
     372        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
     373        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
     374        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
     375        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 2
     376        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
     377        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
     378        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
     379        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
     380        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
     381        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
     382        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
     383        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
     384        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
     385        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
     386        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 3
     387        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
     388        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
     389        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
     390        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
     391        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
     392        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
     393        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
     394        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
     395        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
     396        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
     397        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 4
     398        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
     399        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
     400        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
     401        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
     402        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
     403        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
     404        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
     405        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
     406        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
     407        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
     408        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 5
     409        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
     410        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
     411        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
     412        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
     413        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
     414        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
     415        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
     416        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
     417        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
     418        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
     419        20000.0_wp, 10.0_wp                                                    & !parameter 45-46 - end of type 6
     420                                                                          /),  &
     421                                                               (/47, 6/) )
     422
    315423!
    316424!-- Type for surface temperatures at vertical walls. Is not necessary for horizontal walls.
     
    324432    END TYPE t_wall_vertical
    325433
    326 !-- arrays for calculation of svf and csf
    327     TYPE(t_svf), DIMENSION(:), POINTER             ::  asvf             !< pointer to growing svc array
    328     TYPE(t_csf), DIMENSION(:), POINTER             ::  acsf             !< pointer to growing csf array
    329     TYPE(t_svf), DIMENSION(:), ALLOCATABLE, TARGET ::  asvf1, asvf2     !< realizations of svf array
    330     TYPE(t_csf), DIMENSION(:), ALLOCATABLE, TARGET ::  acsf1, acsf2     !< realizations of csf array
    331     INTEGER(iwp)                                   ::  nsvfla           !< dimmension of array allocated for storage of svf in local processor
    332     INTEGER(iwp)                                   ::  ncsfla           !< dimmension of array allocated for storage of csf in local processor
    333     INTEGER(iwp)                                   ::  msvf, mcsf       !< mod for swapping the growing array
    334     INTEGER(iwp), PARAMETER                        ::  gasize = 10000   !< initial size of growing arrays
    335 !-- temporary arrays for calculation of csf in raytracing
    336     INTEGER(iwp)                                   ::  maxboxesg        !< max number of boxes ray can cross in the domain
    337     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  boxes            !< coordinates of gridboxes being crossed by ray
    338     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  crlens           !< array of crossing lengths of ray for particular grid boxes
    339     INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  lad_ip           !< array of numbers of process where lad is stored
    340 #if defined( __parallel )
    341     INTEGER(kind=MPI_ADDRESS_KIND), &
    342                   DIMENSION(:), ALLOCATABLE        ::  lad_disp         !< array of displaycements of lad in local array of proc lad_ip
    343 #endif
    344     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  lad_s_ray        !< array of received lad_s for appropriate gridboxes crossed by ray
    345 
    346 !-- arrays storing the values of USM
    347     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  svfsurf          !< svfsurf[:,isvf] = index of source and target surface for svf[isvf]
    348     REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  svf              !< array of shape view factors+direct irradiation factors for local surfaces
    349     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfins          !< array of sw radiation falling to local surface after i-th reflection
    350     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinl          !< array of lw radiation for local surface after i-th reflection
    351    
    352                                                                         !< Inward radiation is also valid for virtual surfaces (radiation leaving domain)
    353     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinsw         !< array of sw radiation falling to local surface including radiation from reflections
    354     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinlw         !< array of lw radiation falling to local surface including radiation from reflections
    355     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinswdir      !< array of direct sw radiation falling to local surface
    356     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinswdif      !< array of diffuse sw radiation from sky and model boundary falling to local surface
    357     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinlwdif      !< array of diffuse lw radiation from sky and model boundary falling to local surface
    358    
    359                                                                         !< Outward radiation is only valid for nonvirtual surfaces
    360     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutsl        !< array of reflected sw radiation for local surface in i-th reflection
    361     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutll        !< array of reflected + emitted lw radiation for local surface in i-th reflection
    362     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfouts         !< array of reflected sw radiation for all surfaces in i-th reflection
    363     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutl         !< array of reflected + emitted lw radiation for all surfaces in i-th reflection
    364     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutsw        !< array of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection
    365     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutlw        !< array of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection
    366     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfhf           !< array of total radiation flux incoming to minus outgoing from local surface
    367     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  rad_net_l        !< local copy of rad_net (net radiation at surface)
    368434
    369435!-- arrays for time averages
     436!-- Attention: the variable rad_net_av is also used in the 3d field variable in radiation_model_mod.f90. It may be better to rename it
    370437    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  rad_net_av       !< average of rad_net_l
    371438    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinsw_av      !< average of sw radiation falling to local surface including radiation from reflections
     
    381448    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfinl_av       !< average of array of residua of lw radiation absorbed in surface after last reflection
    382449    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfhf_av        !< average of total radiation flux incoming to minus outgoing from local surface 
     450    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  wghf_eb_av       !< average of wghf_eb
     451    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  wshf_eb_av       !< average of wshf_eb
     452    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  t_wall_av        !< Average of t_wall
     453    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  wghf_eb_green_av !< average of wghf_eb_green
     454    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  t_green_av       !< Average of t_green
     455    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  wghf_eb_window_av !< average of wghf_eb_window
     456    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  t_window_av      !< Average of t_window   
    383457   
    384 !-- block variables needed for calculation of the plant canopy model inside the urban surface model
    385     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  csfsurf          !< csfsurf[:,icsf] = index of target surface and csf grid index for csf[icsf]
    386     REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  csf              !< array of plant canopy sink fators + direct irradiation factors (transparency)
    387                                                                         !< for local surfaces
    388     INTEGER(wp), DIMENSION(:,:), ALLOCATABLE       ::  pcbl             !< k,j,i coordinates of l-th local plant canopy box pcbl[:,l] = [k, j, i]
    389     INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE    ::  gridpcbl         !< index of local pcb[k,j,i]
    390     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinsw          !< array of absorbed sw radiation for local plant canopy box
    391     REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinlw          !< array of absorbed lw radiation for local plant canopy box
    392     INTEGER(iwp)                                   ::  npcbl            !< number of the plant canopy gridboxes in local processor
    393     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pch              !< heights of the plant canopy
    394     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pct              !< top layer of the plant canopy
    395     REAL(wp), DIMENSION(:,:,:), POINTER            ::  usm_lad          !< subset of lad_s within urban surface, transformed to plain Z coordinate
    396     REAL(wp), DIMENSION(:), POINTER                ::  usm_lad_g        !< usm_lad globalized (used to avoid MPI RMA calls in raytracing)
    397     REAL(wp)                                       ::  prototype_lad    !< prototype leaf area density for computing effective optical depth
    398     INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  nzterr, plantt   !< temporary global arrays for raytracing
    399    
    400 !-- radiation related arrays (it should be better in interface of radiation module of PALM
    401     REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  rad_sw_in_dir    !< direct sw radiation
    402     REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  rad_sw_in_diff   !< diffusion sw radiation
    403     REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  rad_lw_in_diff   !< diffusion lw radiation
    404458
    405459!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     
    419473    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
    420474                                                                         !< normalized soil, wall and roof layer depths (m/m)
     475!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default = (/0.33_wp, 0.66_wp, 1.0_wp /)
     476    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_window = (/0.25_wp, 0.5_wp, 0.75_wp, 1.0_wp /)
     477!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_window = (/0.33_wp, 0.66_wp, 1.0_wp /)
     478!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_window = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
     479                                                                         !< normalized window layer depths (m/m)
     480!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_green = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
     481                                                                         !< normalized green layer depths (m/m)
     482    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_green = (/0.25_wp, 0.5_wp, 0.75_wp, 1.0_wp /)
     483!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_green = (/0.33_wp, 0.66_wp, 1.0_wp /)
     484
    421485                                                                       
    422486    REAL(wp)                                       ::   wall_inner_temperature = 296.0_wp    !< temperature of the inner wall surface (~23 degrees C) (K)
    423487    REAL(wp)                                       ::   roof_inner_temperature = 296.0_wp    !< temperature of the inner roof surface (~23 degrees C) (K)
    424488    REAL(wp)                                       ::   soil_inner_temperature = 283.0_wp    !< temperature of the deep soil (~10 degrees C) (K)
     489    REAL(wp)                                       ::   window_inner_temperature = 296.0_wp  !< temperature of the inner window surface (~23 degrees C) (K)
    425490
    426491!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     
    428493!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    429494    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn                !< normalized wall layer depths (m)
     495    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn_window         !< normalized window layer depths (m)
     496    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn_green          !< normalized green layer depths (m)
    430497
    431498#if defined( __nopointer )
    432499    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_h           !< wall surface temperature (K) at horizontal walls
    433500    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_h_p         !< progn. wall surface temperature (K) at horizontal walls
    434 
     501    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h    !< window surface temperature (K) at horizontal walls
     502    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_p  !< progn. window surface temperature (K) at horizontal walls
     503    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h     !< green surface temperature (K) at horizontal walls
     504    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_p   !< progn. green surface temperature (K) at horizontal walls
     505    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_h     !< whole surface temperature (K) at horizontal walls
     506    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_h_p   !< progn. whole surface temperature (K) at horizontal walls
     507    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_h      !< near surface temperature (10cm) (K) at horizontal walls
     508    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_h_p    !< progn. near surface temperature (10cm) (K) at horizontal walls
    435509    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_v
    436510    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_v_p
     511    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_window_v
     512    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_window_v_p
     513    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_green_v
     514    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_green_v_p
     515    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_whole_v
     516    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_whole_v_p
     517    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_10cm_v
     518    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_10cm_v_p
    437519#else
    438520    REAL(wp), DIMENSION(:), POINTER                :: t_surf_h
    439521    REAL(wp), DIMENSION(:), POINTER                :: t_surf_h_p
     522    REAL(wp), DIMENSION(:), POINTER                :: t_surf_window_h
     523    REAL(wp), DIMENSION(:), POINTER                :: t_surf_window_h_p
     524    REAL(wp), DIMENSION(:), POINTER                :: t_surf_green_h
     525    REAL(wp), DIMENSION(:), POINTER                :: t_surf_green_h_p
     526    REAL(wp), DIMENSION(:), POINTER                :: t_surf_whole_h
     527    REAL(wp), DIMENSION(:), POINTER                :: t_surf_whole_h_p
     528    REAL(wp), DIMENSION(:), POINTER                :: t_surf_10cm_h
     529    REAL(wp), DIMENSION(:), POINTER                :: t_surf_10cm_h_p
    440530
    441531    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_h_1
    442532    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_h_2
     533    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_1
     534    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_2
     535    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_1
     536    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_2
     537    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_h_1
     538    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_h_2
     539    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_h_1
     540    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_h_2
    443541
    444542    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_v
    445543    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_v_p
     544    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_window_v
     545    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_window_v_p
     546    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_green_v
     547    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_green_v_p
     548    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_whole_v
     549    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_whole_v_p
     550    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_10cm_v
     551    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_10cm_v_p
    446552
    447553    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_v_1
    448554    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_v_2
     555    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_window_v_1
     556    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_window_v_2
     557    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_green_v_1
     558    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_green_v_2
     559    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_whole_v_1
     560    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_whole_v_2
     561    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_10cm_v_1
     562    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_10cm_v_2
     563   
    449564#endif
    450565    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_av          !< average of wall surface temperature (K)
     566    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_av   !< average of window surface temperature (K)
     567    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_av    !< average of green wall surface temperature (K)
     568    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_av    !< average of whole wall surface temperature (K)
     569    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_av    !< average of whole wall surface temperature (K)
    451570
    452571!-- Temporal tendencies for time stepping           
    453     REAL(wp), DIMENSION(:), ALLOCATABLE            :: tt_surface_m       !< surface temperature tendency (K)
     572    REAL(wp), DIMENSION(:), ALLOCATABLE            :: tt_surface_m       !< surface temperature tendency of wall (K)
     573    REAL(wp), DIMENSION(:), ALLOCATABLE            :: tt_surface_window_m !< surface temperature tendency of window (K)
     574    REAL(wp), DIMENSION(:), ALLOCATABLE            :: tt_surface_green_m !< surface temperature tendency of green wall (K)
    454575
    455576!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     
    457578!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    458579!-- parameters of the land, roof and wall surfaces
    459     REAL(wp), DIMENSION(:), ALLOCATABLE            :: albedo_surf        !< albedo of the surface
    460 !-- parameters of the wall surfaces
    461     REAL(wp), DIMENSION(:), ALLOCATABLE            :: emiss_surf         !< emissivity of the wall surface
    462580
    463581#if defined( __nopointer )
     
    465583    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_av          !< Average of t_wall
    466584    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_p           !< Prog. wall temperature (K)
     585    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h           !< Window temperature (K)
     586    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h_av        !< Average of t_window
     587    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h_p         !< Prog. window temperature (K)
     588    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h            !< Green temperature (K)
     589    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h_av         !< Average of t_green
     590    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h_p          !< Prog. green temperature (K)
    467591
    468592    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v             !< Wall temperature (K)
    469593    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v_av          !< Average of t_wall
    470594    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v_p           !< Prog. wall temperature (K)
     595    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v           !< Window temperature (K)
     596    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v_av        !< Average of t_window
     597    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v_p         !< Prog. window temperature (K)
     598    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v            !< Green temperature (K)
     599    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v_av         !< Average of t_green
     600    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v_p          !< Prog. green temperature (K)
    471601#else
    472602    REAL(wp), DIMENSION(:,:), POINTER                :: t_wall_h, t_wall_h_p
    473603    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_av, t_wall_h_1, t_wall_h_2
     604    REAL(wp), DIMENSION(:,:), POINTER                :: t_window_h, t_window_h_p
     605    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h_av, t_window_h_1, t_window_h_2
     606    REAL(wp), DIMENSION(:,:), POINTER                :: t_green_h, t_green_h_p
     607    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h_av, t_green_h_1, t_green_h_2
    474608
    475609    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_wall_v, t_wall_v_p
    476610    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v_av, t_wall_v_1, t_wall_v_2
     611    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_window_v, t_window_v_p
     612    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v_av, t_window_v_1, t_window_v_2
     613    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_green_v, t_green_v_p
     614    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v_av, t_green_v_1, t_green_v_2
    477615#endif
    478616
    479617!-- Wall temporal tendencies for time stepping
    480618    REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: tt_wall_m          !< t_wall prognostic array
     619    REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: tt_window_m        !< t_window prognostic array
     620    REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: tt_green_m         !< t_green prognostic array
    481621
    482622!-- Surface and material parameters classes (surface_type)
     
    495635    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        :: surface_type_codes   !< codes of wall types
    496636    REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: surface_params       !< parameters of wall types
    497    
    498     CHARACTER(len=*), PARAMETER                    :: svf_file_name='usm_svf'
     637
    499638   
    500639!-- interfaces of subroutines accessed from outside of this module
     640    INTERFACE usm_boundary_condition
     641       MODULE PROCEDURE usm_boundary_condition
     642    END INTERFACE usm_boundary_condition
     643
    501644    INTERFACE usm_check_data_output
    502645       MODULE PROCEDURE usm_check_data_output
     
    523666    END INTERFACE usm_material_heat_model
    524667   
     668    INTERFACE usm_green_heat_model
     669       MODULE PROCEDURE usm_green_heat_model
     670    END INTERFACE usm_green_heat_model
     671   
    525672    INTERFACE usm_parin
    526673       MODULE PROCEDURE usm_parin
    527674    END INTERFACE usm_parin
    528 
    529     INTERFACE usm_radiation
    530        MODULE PROCEDURE usm_radiation
    531     END INTERFACE usm_radiation
    532675   
     676    INTERFACE usm_temperature_near_surface
     677       MODULE PROCEDURE usm_temperature_near_surface
     678    END INTERFACE usm_temperature_near_surface
     679
    533680    INTERFACE usm_read_restart_data
    534681       MODULE PROCEDURE usm_read_restart_data
     
    546693       MODULE PROCEDURE usm_write_restart_data
    547694    END INTERFACE usm_write_restart_data
     695
     696    INTERFACE usm_allocate_surface
     697       MODULE PROCEDURE usm_allocate_surface
     698    END INTERFACE usm_allocate_surface
     699
     700    INTERFACE usm_average_3d_data
     701       MODULE PROCEDURE usm_average_3d_data
     702    END INTERFACE usm_average_3d_data
     703
    548704   
    549705    SAVE
     
    551707    PRIVATE
    552708   
     709!-- Public functions
     710    PUBLIC usm_boundary_condition, usm_check_parameters, usm_init_urban_surface,&
     711           usm_read_restart_data,                                               &
     712           usm_surface_energy_balance, usm_material_heat_model,                 &
     713           usm_swap_timelevel, usm_check_data_output, usm_average_3d_data,      &
     714           usm_data_output_3d, usm_define_netcdf_grid, usm_parin,               &
     715           usm_write_restart_data, usm_allocate_surface
     716
    553717!-- Public parameters, constants and initial values
    554     PUBLIC split_diffusion_radiation,                                          &
    555            usm_anthropogenic_heat, usm_material_model, mrt_factors,            &
    556            usm_check_parameters,                                               &
    557            usm_energy_balance_land, usm_energy_balance_wall, nrefsteps,        &
    558            usm_init_urban_surface, usm_radiation, usm_read_restart_data,       &
    559            usm_surface_energy_balance, usm_material_heat_model,                &
    560            usm_swap_timelevel, usm_check_data_output, usm_average_3d_data,     &
    561            usm_data_output_3d, usm_define_netcdf_grid, usm_parin,              &
    562            usm_write_restart_data,                                             &
    563            nzub, nzut, ra_horiz_coef, usm_lad_rma,                             &
    564            land_category, pedestrant_category, wall_category, roof_category,   &
    565            write_svf_on_init, read_svf_on_init
     718    PUBLIC usm_anthropogenic_heat, usm_material_model, ra_horiz_coef,           &
     719           usm_green_heat_model, usm_temperature_near_surface
     720
    566721
    567722
    568723 CONTAINS
    569724
    570  
    571725!------------------------------------------------------------------------------!
    572726! Description:
     
    575729!> and plant canopy and it allocates the needed arrays for USM
    576730!------------------------------------------------------------------------------!
    577     SUBROUTINE usm_allocate_urban_surface
     731    SUBROUTINE usm_allocate_surface
    578732   
    579733        IMPLICIT NONE
    580734       
    581         INTEGER(iwp) :: i, j, k, d, l, ir, jr, ids, m
    582         INTEGER(iwp) :: k_topo     !< vertical index indicating topography top for given (j,i)
    583         INTEGER(iwp) :: k_topo2    !< vertical index indicating topography top for given (j,i)
    584         INTEGER(iwp) :: nzubl, nzutl, isurf, ipcgb
    585         INTEGER(iwp) :: procid
    586 
    587        
    588 
    589        
    590 !--     auxiliary vars
    591         ddxy2 = (/ddy2,ddy2,ddx2,ddx2/)      !< 1/dx^2 or 1/dy^2 (in surface normal direction)
    592        
    593         CALL location_message( '', .TRUE. )
    594         CALL location_message( '    allocation of needed arrays', .TRUE. )
    595 !
    596 !--     Find nzub, nzut, nzu via wall_flag_0 array (nzb_s_inner will be
    597 !--     removed later). The following contruct finds the lowest / largest index
    598 !--     for any upward-facing wall (see bit 12).
    599         nzubl = MINVAL(                                                        &
    600                     MAXLOC(                                                    &
    601                           MERGE( 1, 0,                                         &
    602                                  BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), 12 )  &
    603                                ), DIM = 1                                      &
    604                           ) - 1                                                &
    605                             )
    606         nzutl = MAXVAL(                                                        &
    607                    MAXLOC(                                                     &
    608                           MERGE( 1, 0,                                         &
    609                                  BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), 12 )  &
    610                                ), DIM = 1                                      &
    611                           ) - 1                                                &
    612                             )
    613         nzubl = max(nzubl,nzb)
    614 
    615        
    616         IF ( plant_canopy )  THEN
    617 !--         allocate needed arrays
    618             ALLOCATE( pct(nys:nyn,nxl:nxr) )
    619             ALLOCATE( pch(nys:nyn,nxl:nxr) )
    620 
    621 !--         calculate plant canopy height
    622             npcbl = 0
    623             pct = 0.0_wp
    624             pch = 0.0_wp
    625             DO i = nxl, nxr
    626                 DO j = nys, nyn
    627 !
    628 !--                 Find topography top index
    629                     k_topo = get_topography_top_index( j, i, 's' )
    630 
    631                     DO k = nzt+1, 0, -1
    632                         IF ( lad_s(k,j,i) /= 0.0_wp )  THEN
    633 !--                         we are at the top of the pcs
    634                             pct(j,i) = k + k_topo
    635                             pch(j,i) = k
    636                             npcbl = npcbl + pch(j,i)
    637                             EXIT
    638                         ENDIF
    639                     ENDDO
    640                 ENDDO
    641             ENDDO
    642            
    643             nzutl = max(nzutl, maxval(pct))
    644 !--         code of plant canopy model uses parameter pch_index
    645 !--         we need to setup it here to right value
    646 !--         (pch_index, lad_s and other arrays in PCM are defined flat)
    647             pch_index = maxval(pch)
    648 
    649             prototype_lad = maxval(lad_s) * .9_wp  !< better be *1.0 if lad is either 0 or maxval(lad) everywhere
    650             IF ( prototype_lad <= 0._wp ) prototype_lad = .3_wp
    651             !WRITE(message_string, '(a,f6.3)') 'Precomputing effective box optical ' &
    652             !    // 'depth using prototype leaf area density = ', prototype_lad
    653             !CALL message('usm_init_urban_surface', 'PA0520', 0, 0, -1, 6, 0)
    654         ENDIF
    655        
    656         nzutl = min(nzutl+nzut_free, nzt)
    657                  
    658 #if defined( __parallel )
    659         CALL MPI_AllReduce(nzubl,nzub,1,MPI_INTEGER,MPI_MIN,comm2d,ierr);
    660         CALL MPI_AllReduce(nzutl,nzut,1,MPI_INTEGER,MPI_MAX,comm2d,ierr);
    661 #else
    662         nzub = nzubl
    663         nzut = nzutl
    664 #endif
    665 
    666 !--     global number of urban layers
    667         nzu = nzut - nzub + 1
    668        
    669 !--     allocate urban surfaces grid
    670 !--     calc number of surfaces in local proc
    671         CALL location_message( '    calculation of indices for surfaces', .TRUE. )
    672         nsurfl = 0
    673 !
    674 !--     Number of land- and roof surfaces. Note, since horizontal surface elements
    675 !--     are already counted in surface_mod, in case be simply reused here.
    676         startland = 1
    677         nsurfl    = surf_usm_h%ns
    678         endland   = nsurfl
    679         nlands    = endland-startland+1
    680 
    681 !
    682 !--     Number of vertical surfaces. As vertical surfaces are already
    683 !--     counted in surface mod, it can be reused here.
    684         startwall = nsurfl+1
    685         nsurfl = nsurfl + surf_usm_v(0)%ns + surf_usm_v(1)%ns +        &
    686                           surf_usm_v(2)%ns + surf_usm_v(3)%ns
    687         endwall = nsurfl
    688         nwalls = endwall-startwall+1
    689 
    690        
    691 !--     range of energy balance surfaces  ! will be treated separately by surf_usm_h and surf_usm_v
    692         nenergy = 0
    693         IF ( usm_energy_balance_land )  THEN
    694             startenergy = startland
    695             nenergy = nenergy + nlands
    696         ELSE
    697             startenergy = startwall
    698         ENDIF
    699         IF ( usm_energy_balance_wall )  THEN
    700             endenergy = endwall
    701             nenergy = nenergy + nwalls
    702         ELSE
    703             endenergy = endland
    704         ENDIF
    705 
    706 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    707 !--     block of virtual surfaces
    708 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    709 !--     calculate sky surfaces  ! not used so far!
    710         startsky = nsurfl+1
    711         nsurfl = nsurfl+(nxr-nxl+1)*(nyn-nys+1)
    712         endsky = nsurfl
    713         nskys = endsky-startsky+1
    714        
    715 !--     border flags
    716 #if defined( __parallel )
    717         isborder = (/ north_border_pe, south_border_pe, right_border_pe, left_border_pe /)
    718 #else
    719         isborder = (/.TRUE.,.TRUE.,.TRUE.,.TRUE./)
    720 #endif
    721 !--     fill array of the limits of the local domain borders
    722         ijdb = RESHAPE( (/ nxl,nxr,nyn,nyn,nxl,nxr,nys,nys,nxr,nxr,nys,nyn,nxl,nxl,nys,nyn /), (/4, 4/) )
    723 !--     calulation of the free borders of the domain
    724         DO  ids = 6,9
    725            IF ( isborder(ids) )  THEN
    726 !--           free border of the domain in direction ids
    727               DO  i = ijdb(1,ids), ijdb(2,ids)
    728                  DO  j = ijdb(3,ids), ijdb(4,ids)
    729 
    730                     k_topo  = get_topography_top_index( j, i, 's' )
    731                     k_topo2 = get_topography_top_index( j-jdir(ids), i-idir(ids), 's' )
    732 
    733                     k = nzut - MAX( k_topo, k_topo2 )
    734                     nsurfl = nsurfl + k
    735                  ENDDO
    736               ENDDO
    737            ENDIF
    738         ENDDO
    739        
    740 !--     fill gridpcbl and pcbl
    741         IF ( plant_canopy )  THEN
    742             ALLOCATE( pcbl(iz:ix, 1:npcbl) )
    743             ALLOCATE( gridpcbl(nzub:nzut,nys:nyn,nxl:nxr) )
    744             gridpcbl(:,:,:) = 0
    745             ipcgb = 0
    746             DO i = nxl, nxr
    747                 DO j = nys, nyn
    748 !
    749 !--                 Find topography top index
    750                     k_topo = get_topography_top_index( j, i, 's' )
    751 
    752                     DO k = k_topo + 1, pct(j,i)
    753                         ipcgb = ipcgb + 1
    754                         gridpcbl(k,j,i) = ipcgb
    755                         pcbl(:,ipcgb) = (/ k, j, i /)
    756                     ENDDO
    757                 ENDDO
    758             ENDDO
    759 
    760             ALLOCATE( pcbinsw( 1:npcbl ) )
    761             ALLOCATE( pcbinlw( 1:npcbl ) )
    762         ENDIF
    763 
    764 !--     fill surfl
    765         ALLOCATE(surfl(5,nsurfl))
    766         isurf = 0
    767        
    768 !--     add land surfaces or roofs
    769         DO i = nxl, nxr
    770             DO j = nys, nyn
    771                DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
    772                   k = surf_usm_h%k(m)
    773 
    774                   isurf = isurf + 1
    775                   surfl(:,isurf) = (/iroof,k,j,i,m/)
    776                ENDDO
    777             ENDDO
    778         ENDDO
    779 
    780 !--     add walls
    781         DO i = nxl, nxr
    782             DO j = nys, nyn
    783                l = 0
    784                DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
    785                   k = surf_usm_v(l)%k(m)
    786 
    787                   isurf          = isurf + 1
    788                   surfl(:,isurf) = (/2,k,j,i,m/)
    789                ENDDO
    790                l = 1
    791                DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
    792                   k = surf_usm_v(l)%k(m)
    793 
    794                   isurf          = isurf + 1
    795                   surfl(:,isurf) = (/1,k,j,i,m/)
    796                ENDDO
    797                l = 2
    798                DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
    799                   k = surf_usm_v(l)%k(m)
    800 
    801                   isurf          = isurf + 1
    802                   surfl(:,isurf) = (/4,k,j,i,m/)
    803                ENDDO
    804                l = 3
    805                DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
    806                   k = surf_usm_v(l)%k(m)
    807 
    808                   isurf          = isurf + 1
    809                   surfl(:,isurf) = (/3,k,j,i,m/)
    810                ENDDO
    811             ENDDO
    812         ENDDO
    813 
    814 !--     add sky
    815         DO i = nxl, nxr
    816             DO j = nys, nyn
    817                 isurf = isurf + 1
    818                 k = nzut
    819                 surfl(:,isurf) = (/isky,k,j,i,-1/)
    820             ENDDO
    821         ENDDO
    822        
    823 !--     calulation of the free borders of the domain
    824         DO ids = 6,9
    825             IF ( isborder(ids) )  THEN
    826 !--             free border of the domain in direction ids
    827                 DO i = ijdb(1,ids), ijdb(2,ids)
    828                     DO j = ijdb(3,ids), ijdb(4,ids)
    829                         k_topo  = get_topography_top_index( j, i, 's' )
    830                         k_topo2 = get_topography_top_index( j-jdir(ids), i-idir(ids), 's' )
    831 
    832                         DO k = MAX(k_topo,k_topo2)+1, nzut
    833                             isurf = isurf + 1
    834                             surfl(:,isurf) = (/ids,k,j,i,-1/)
    835                         ENDDO
    836                     ENDDO
    837                 ENDDO
    838             ENDIF
    839         ENDDO
    840        
    841 !--     global array surf of indices of surfaces and displacement index array surfstart
    842         ALLOCATE(nsurfs(0:numprocs-1))
    843        
    844 #if defined( __parallel )
    845         CALL MPI_Allgather(nsurfl,1,MPI_INTEGER,nsurfs,1,MPI_INTEGER,comm2d,ierr)
    846 #else
    847         nsurfs(0) = nsurfl
    848 #endif
    849         ALLOCATE(surfstart(0:numprocs))
    850         k = 0
    851         DO i=0,numprocs-1
    852             surfstart(i) = k
    853             k = k+nsurfs(i)
    854         ENDDO
    855         surfstart(numprocs) = k
    856         nsurf = k
    857         ALLOCATE(surf(5,nsurf))
    858        
    859 #if defined( __parallel )
    860         CALL MPI_AllGatherv(surfl, nsurfl*5, MPI_INTEGER, surf, nsurfs*5, surfstart*5, MPI_INTEGER, comm2d, ierr)
    861 #else
    862         surf = surfl
    863 #endif
    864        
    865 !--
    866 !--     allocation of the arrays for direct and diffusion radiation
    867         CALL location_message( '    allocation of radiation arrays', .TRUE. )
    868 !--     rad_sw_in, rad_lw_in are computed in radiation model,
    869 !--     splitting of direct and diffusion part is done
    870 !--     in usm_calc_diffusion_radiation for now
    871         ALLOCATE( rad_sw_in_dir(nysg:nyng,nxlg:nxrg) )
    872         ALLOCATE( rad_sw_in_diff(nysg:nyng,nxlg:nxrg) )
    873         ALLOCATE( rad_lw_in_diff(nysg:nyng,nxlg:nxrg) )
    874        
    875 !--     allocate radiation arrays
    876         ALLOCATE( surfins(nsurfl) )
    877         ALLOCATE( surfinl(nsurfl) )
    878         ALLOCATE( surfinsw(nsurfl) )
    879         ALLOCATE( surfinlw(nsurfl) )
    880         ALLOCATE( surfinswdir(nsurfl) )
    881         ALLOCATE( surfinswdif(nsurfl) )
    882         ALLOCATE( surfinlwdif(nsurfl) )
    883         ALLOCATE( surfoutsl(startenergy:endenergy) )
    884         ALLOCATE( surfoutll(startenergy:endenergy) )
    885         ALLOCATE( surfoutsw(startenergy:endenergy) )
    886         ALLOCATE( surfoutlw(startenergy:endenergy) )
    887         ALLOCATE( surfouts(nsurf) ) !TODO: global surfaces without virtual
    888         ALLOCATE( surfoutl(nsurf) ) !TODO: global surfaces without virtual
    889 
    890 
     735        INTEGER(iwp) ::  l
    891736
    892737!
     
    896741        ALLOCATE( surf_usm_h%rad_net_l(1:surf_usm_h%ns) )
    897742!
    898 !--  New
    899         ALLOCATE( surf_usm_h%rad_in_sw(1:surf_usm_h%ns)  )
    900         ALLOCATE( surf_usm_h%rad_out_sw(1:surf_usm_h%ns) )
    901         ALLOCATE( surf_usm_h%rad_in_lw(1:surf_usm_h%ns)  )
    902         ALLOCATE( surf_usm_h%rad_out_lw(1:surf_usm_h%ns) )
    903 !
    904743!--     For vertical surfaces
    905744        DO  l = 0, 3
    906745           ALLOCATE( surf_usm_v(l)%surfhf(1:surf_usm_v(l)%ns)    )
    907746           ALLOCATE( surf_usm_v(l)%rad_net_l(1:surf_usm_v(l)%ns) )
    908            ALLOCATE( surf_usm_v(l)%rad_in_sw(1:surf_usm_v(l)%ns)  )
    909            ALLOCATE( surf_usm_v(l)%rad_out_sw(1:surf_usm_v(l)%ns) )
    910            ALLOCATE( surf_usm_v(l)%rad_in_lw(1:surf_usm_v(l)%ns)  )
    911            ALLOCATE( surf_usm_v(l)%rad_out_lw(1:surf_usm_v(l)%ns) )
    912747        ENDDO
    913748
     
    920755           ALLOCATE( surf_usm_v(l)%surface_types(1:surf_usm_v(l)%ns) )
    921756        ENDDO
    922        
    923 !--     broadband albedo of the land, roof and wall surface
    924 !--     for domain border and sky set artifically to 1.0
    925 !--     what allows us to calculate heat flux leaving over
    926 !--     side and top borders of the domain
    927         ALLOCATE ( albedo_surf(nsurfl) )
    928         albedo_surf = 1.0_wp
    929         ALLOCATE ( surf_usm_h%albedo_surf(1:surf_usm_h%ns) )
     757!
     758!--     Allocate albedo_type and albedo. Each surface element
     759!--     has 3 values, 0: wall fraction, 1: green fraction, 2: window fraction.
     760        ALLOCATE( surf_usm_h%albedo_type(0:2,1:surf_usm_h%ns) )
     761        ALLOCATE( surf_usm_h%albedo(0:2,1:surf_usm_h%ns)      )
     762        surf_usm_h%albedo_type = albedo_type
    930763        DO  l = 0, 3
    931            ALLOCATE( surf_usm_v(l)%albedo_surf(1:surf_usm_v(l)%ns) )
    932         ENDDO
     764           ALLOCATE( surf_usm_v(l)%albedo_type(0:2,1:surf_usm_v(l)%ns) )
     765           ALLOCATE( surf_usm_v(l)%albedo(0:2,1:surf_usm_v(l)%ns)      )
     766           surf_usm_v(l)%albedo_type = albedo_type
     767        ENDDO       
     768
     769
     770!
     771!--     Allocate indoor target temperature for summer and winter
     772        ALLOCATE( surf_usm_h%target_temp_summer(1:surf_usm_h%ns) )
     773        ALLOCATE( surf_usm_h%target_temp_winter(1:surf_usm_h%ns) )
     774        DO  l = 0, 3
     775           ALLOCATE( surf_usm_v(l)%target_temp_summer(1:surf_usm_v(l)%ns) )
     776           ALLOCATE( surf_usm_v(l)%target_temp_winter(1:surf_usm_v(l)%ns) )
     777        ENDDO   
     778!
     779!--     Allocate flag indicating ground floor level surface elements
     780        ALLOCATE ( surf_usm_h%ground_level(1:surf_usm_h%ns) )
     781        DO  l = 0, 3
     782           ALLOCATE( surf_usm_v(l)%ground_level(1:surf_usm_v(l)%ns) )
     783        ENDDO   
     784!
     785!--      Allocate arrays for relative surface fraction.
     786!--      0 - wall fraction, 1 - green fraction, 2 - window fraction
     787         ALLOCATE( surf_usm_h%frac(0:2,1:surf_usm_h%ns) )
     788         surf_usm_h%frac = 0.0_wp
     789         DO  l = 0, 3
     790            ALLOCATE( surf_usm_v(l)%frac(0:2,1:surf_usm_v(l)%ns) )
     791            surf_usm_v(l)%frac = 0.0_wp
     792         ENDDO
    933793       
    934794!--     wall and roof surface parameters. First for horizontal surfaces
    935         ALLOCATE ( emiss_surf(startenergy:endenergy) )
    936 
    937         ALLOCATE ( surf_usm_h%isroof_surf(1:surf_usm_h%ns)    )
    938         ALLOCATE ( surf_usm_h%emiss_surf(1:surf_usm_h%ns)     )
    939         ALLOCATE ( surf_usm_h%lambda_surf(1:surf_usm_h%ns)    )
    940         ALLOCATE ( surf_usm_h%c_surface(1:surf_usm_h%ns)      )
    941         ALLOCATE ( surf_usm_h%roughness_wall(1:surf_usm_h%ns) )
     795        ALLOCATE ( surf_usm_h%isroof_surf(1:surf_usm_h%ns)     )
     796        ALLOCATE ( surf_usm_h%lambda_surf(1:surf_usm_h%ns)     )
     797        ALLOCATE ( surf_usm_h%lambda_surf_window(1:surf_usm_h%ns) )
     798        ALLOCATE ( surf_usm_h%lambda_surf_green(1:surf_usm_h%ns)  )
     799        ALLOCATE ( surf_usm_h%c_surface(1:surf_usm_h%ns)       )
     800        ALLOCATE ( surf_usm_h%c_surface_window(1:surf_usm_h%ns)   )
     801        ALLOCATE ( surf_usm_h%c_surface_green(1:surf_usm_h%ns)    )
     802        ALLOCATE ( surf_usm_h%transmissivity(1:surf_usm_h%ns)  )
     803        ALLOCATE ( surf_usm_h%lai(1:surf_usm_h%ns)             )
     804        ALLOCATE ( surf_usm_h%emissivity(0:2,1:surf_usm_h%ns)  )
     805
    942806!
    943807!--     For vertical surfaces.
    944808        DO  l = 0, 3
    945            ALLOCATE ( surf_usm_v(l)%emiss_surf(1:surf_usm_v(l)%ns)     )
    946            ALLOCATE ( surf_usm_v(l)%lambda_surf(1:surf_usm_v(l)%ns)    )
    947            ALLOCATE ( surf_usm_v(l)%c_surface(1:surf_usm_v(l)%ns)      )
    948            ALLOCATE ( surf_usm_v(l)%roughness_wall(1:surf_usm_v(l)%ns) )
     809           ALLOCATE ( surf_usm_v(l)%lambda_surf(1:surf_usm_v(l)%ns)     )
     810           ALLOCATE ( surf_usm_v(l)%c_surface(1:surf_usm_v(l)%ns)       )
     811           ALLOCATE ( surf_usm_v(l)%lambda_surf_window(1:surf_usm_v(l)%ns) )
     812           ALLOCATE ( surf_usm_v(l)%c_surface_window(1:surf_usm_v(l)%ns)   )
     813           ALLOCATE ( surf_usm_v(l)%lambda_surf_green(1:surf_usm_v(l)%ns)  )
     814           ALLOCATE ( surf_usm_v(l)%c_surface_green(1:surf_usm_v(l)%ns)    )
     815           ALLOCATE ( surf_usm_v(l)%transmissivity(1:surf_usm_v(l)%ns)  )
     816           ALLOCATE ( surf_usm_v(l)%lai(1:surf_usm_v(l)%ns)             )
     817
     818           ALLOCATE ( surf_usm_v(l)%emissivity(0:2,1:surf_usm_v(l)%ns)  )
    949819        ENDDO
    950        
     820
     821!       
    951822!--     allocate wall and roof material parameters. First for horizontal surfaces
    952823        ALLOCATE ( surf_usm_h%thickness_wall(1:surf_usm_h%ns)               )
     824        ALLOCATE ( surf_usm_h%thickness_window(1:surf_usm_h%ns)                  )
     825        ALLOCATE ( surf_usm_h%thickness_green(1:surf_usm_h%ns)                   )
    953826        ALLOCATE ( surf_usm_h%lambda_h(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
    954827        ALLOCATE ( surf_usm_h%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
     828        ALLOCATE ( surf_usm_h%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
     829        ALLOCATE ( surf_usm_h%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
     830        ALLOCATE ( surf_usm_h%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
     831        ALLOCATE ( surf_usm_h%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)     )
     832
    955833!
    956834!--     For vertical surfaces.
    957835        DO  l = 0, 3
    958836           ALLOCATE ( surf_usm_v(l)%thickness_wall(1:surf_usm_v(l)%ns)               )
     837           ALLOCATE ( surf_usm_v(l)%thickness_window(1:surf_usm_v(l)%ns)                  )
     838           ALLOCATE ( surf_usm_v(l)%thickness_green(1:surf_usm_v(l)%ns)                   )
    959839           ALLOCATE ( surf_usm_v(l)%lambda_h(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
    960840           ALLOCATE ( surf_usm_v(l)%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
     841           ALLOCATE ( surf_usm_v(l)%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
     842           ALLOCATE ( surf_usm_v(l)%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)    )
     843           ALLOCATE ( surf_usm_v(l)%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
     844           ALLOCATE ( surf_usm_v(l)%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)     )
    961845        ENDDO
    962846
     
    964848        ALLOCATE ( zwn(nzb_wall:nzt_wall) )
    965849        ALLOCATE ( surf_usm_h%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
     850        ALLOCATE ( zwn_window(nzb_wall:nzt_wall) )
     851        ALLOCATE ( surf_usm_h%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
     852        ALLOCATE ( zwn_green(nzb_wall:nzt_wall) )
     853        ALLOCATE ( surf_usm_h%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)      )
    966854        ALLOCATE ( surf_usm_h%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)    )
    967855        ALLOCATE ( surf_usm_h%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
    968856        ALLOCATE ( surf_usm_h%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
    969857        ALLOCATE ( surf_usm_h%zw(nzb_wall:nzt_wall,1:surf_usm_h%ns)            )
     858        ALLOCATE ( surf_usm_h%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)    )
     859        ALLOCATE ( surf_usm_h%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
     860        ALLOCATE ( surf_usm_h%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
     861        ALLOCATE ( surf_usm_h%zw_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)       )
     862        ALLOCATE ( surf_usm_h%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
     863        ALLOCATE ( surf_usm_h%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
     864        ALLOCATE ( surf_usm_h%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
     865        ALLOCATE ( surf_usm_h%zw_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
    970866!
    971867!--     For vertical surfaces.
    972868        DO  l = 0, 3
    973869           ALLOCATE ( surf_usm_v(l)%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
     870           ALLOCATE ( surf_usm_v(l)%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
     871           ALLOCATE ( surf_usm_v(l)%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)      )
    974872           ALLOCATE ( surf_usm_v(l)%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)    )
    975873           ALLOCATE ( surf_usm_v(l)%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
    976874           ALLOCATE ( surf_usm_v(l)%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
    977875           ALLOCATE ( surf_usm_v(l)%zw(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)            )
     876           ALLOCATE ( surf_usm_v(l)%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)    )
     877           ALLOCATE ( surf_usm_v(l)%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
     878           ALLOCATE ( surf_usm_v(l)%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
     879           ALLOCATE ( surf_usm_v(l)%zw_window(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)       )
     880           ALLOCATE ( surf_usm_v(l)%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)     )
     881           ALLOCATE ( surf_usm_v(l)%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)   )
     882           ALLOCATE ( surf_usm_v(l)%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)  )
     883           ALLOCATE ( surf_usm_v(l)%zw_green(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns)        )
    978884        ENDDO
    979885
     
    988894        IF ( .NOT. ALLOCATED( t_wall_h_p ) )                                   &           
    989895           ALLOCATE ( t_wall_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
     896        IF ( .NOT. ALLOCATED( t_surf_window_h ) )                              &
     897           ALLOCATE ( t_surf_window_h(1:surf_usm_h%ns) )
     898        IF ( .NOT. ALLOCATED( t_surf_window_h_p ) )                            &
     899           ALLOCATE ( t_surf_window_h_p(1:surf_usm_h%ns) )
     900        IF ( .NOT. ALLOCATED( t_window_h ) )                                   &           
     901           ALLOCATE ( t_window_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     902        IF ( .NOT. ALLOCATED( t_window_h_p ) )                                 &           
     903           ALLOCATE ( t_window_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
     904        IF ( .NOT. ALLOCATED( t_surf_green_h ) )                               &
     905           ALLOCATE ( t_surf_green_h(1:surf_usm_h%ns) )
     906        IF ( .NOT. ALLOCATED( t_surf_green_h_p ) )                             &
     907           ALLOCATE ( t_surf_green_h_p(1:surf_usm_h%ns) )           
     908        IF ( .NOT. ALLOCATED( t_green_h ) )                                    &           
     909           ALLOCATE ( t_green_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     910        IF ( .NOT. ALLOCATED( t_green_h_p ) )                                  &           
     911           ALLOCATE ( t_green_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
     912        IF ( .NOT. ALLOCATED( t_surf_whole_h ) )                               &
     913           ALLOCATE ( t_surf_whole_h(1:surf_usm_h%ns) )
     914        IF ( .NOT. ALLOCATED( t_surf_whole_h_p ) )                             &
     915           ALLOCATE ( t_surf_whole_h_p(1:surf_usm_h%ns) )           
     916        IF ( .NOT. ALLOCATED( t_surf_10cm_h ) )                                &
     917           ALLOCATE ( t_surf_10cm_h(1:surf_usm_h%ns) )
     918        IF ( .NOT. ALLOCATED( t_surf_10cm_h_p ) )                              &
     919           ALLOCATE ( t_surf_10cm_h_p(1:surf_usm_h%ns) )
    990920#else
    991921!
     
    1000930        IF ( .NOT. ALLOCATED( t_wall_h_2 ) )                                   &           
    1001931           ALLOCATE ( t_wall_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )         
     932        IF ( .NOT. ALLOCATED( t_surf_window_h_1 ) )                            &
     933           ALLOCATE ( t_surf_window_h_1(1:surf_usm_h%ns) )
     934        IF ( .NOT. ALLOCATED( t_surf_window_h_2 ) )                            &
     935           ALLOCATE ( t_surf_window_h_2(1:surf_usm_h%ns) )
     936        IF ( .NOT. ALLOCATED( t_window_h_1 ) )                                 &           
     937           ALLOCATE ( t_window_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     938        IF ( .NOT. ALLOCATED( t_window_h_2 ) )                                 &           
     939           ALLOCATE ( t_window_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )         
     940        IF ( .NOT. ALLOCATED( t_surf_green_h_1 ) )                             &
     941           ALLOCATE ( t_surf_green_h_1(1:surf_usm_h%ns) )
     942        IF ( .NOT. ALLOCATED( t_surf_green_h_2 ) )                             &
     943           ALLOCATE ( t_surf_green_h_2(1:surf_usm_h%ns) )
     944        IF ( .NOT. ALLOCATED( t_green_h_1 ) )                                  &           
     945           ALLOCATE ( t_green_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     946        IF ( .NOT. ALLOCATED( t_green_h_2 ) )                                  &           
     947           ALLOCATE ( t_green_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )         
     948        IF ( .NOT. ALLOCATED( t_surf_whole_h_1 ) )                             &
     949           ALLOCATE ( t_surf_whole_h_1(1:surf_usm_h%ns) )
     950        IF ( .NOT. ALLOCATED( t_surf_whole_h_2 ) )                             &
     951           ALLOCATE ( t_surf_whole_h_2(1:surf_usm_h%ns) )
     952        IF ( .NOT. ALLOCATED( t_surf_10cm_h_1 ) )                              &
     953           ALLOCATE ( t_surf_10cm_h_1(1:surf_usm_h%ns) )
     954        IF ( .NOT. ALLOCATED( t_surf_10cm_h_2 ) )                              &
     955           ALLOCATE ( t_surf_10cm_h_2(1:surf_usm_h%ns) )
    1002956!           
    1003957!--     initial assignment of the pointers
    1004958        t_wall_h    => t_wall_h_1;    t_wall_h_p    => t_wall_h_2
     959        t_window_h    => t_window_h_1;    t_window_h_p    => t_window_h_2
     960        t_green_h    => t_green_h_1;    t_green_h_p    => t_green_h_2
    1005961        t_surf_h => t_surf_h_1; t_surf_h_p => t_surf_h_2           
     962        t_surf_window_h => t_surf_window_h_1; t_surf_window_h_p => t_surf_window_h_2 
     963        t_surf_green_h => t_surf_green_h_1; t_surf_green_h_p => t_surf_green_h_2           
     964        t_surf_whole_h => t_surf_whole_h_1; t_surf_whole_h_p => t_surf_whole_h_2
     965        t_surf_10cm_h => t_surf_10cm_h_1; t_surf_10cm_h_p => t_surf_10cm_h_2 
     966 
    1006967#endif
    1007968
     
    1017978           IF ( .NOT. ALLOCATED( t_wall_v_p(l)%t ) )                           &                 
    1018979              ALLOCATE ( t_wall_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
     980           IF ( .NOT. ALLOCATED( t_surf_window_v(l)%t ) )                      &
     981              ALLOCATE ( t_surf_window_v(l)%t(1:surf_usm_v(l)%ns) )
     982           IF ( .NOT. ALLOCATED( t_surf_window_v_p(l)%t ) )                    &
     983              ALLOCATE ( t_surf_window_v_p(l)%t(1:surf_usm_v(l)%ns) )
     984           IF ( .NOT. ALLOCATED( t_window_v(l)%t ) )                           &
     985              ALLOCATE ( t_window_v(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
     986           IF ( .NOT. ALLOCATED( t_window_v_p(l)%t ) )                         &                 
     987              ALLOCATE ( t_window_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
     988           IF ( .NOT. ALLOCATED( t_green_v(l)%t ) )                            &
     989              ALLOCATE ( t_green_v(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
     990           IF ( .NOT. ALLOCATED( t_green_v_p(l)%t ) )                          &                 
     991              ALLOCATE ( t_green_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
     992           IF ( .NOT. ALLOCATED( t_surf_green_v(l)%t ) )                       &
     993              ALLOCATE ( t_surf_green_v(l)%t(1:surf_usm_v(l)%ns) )
     994           IF ( .NOT. ALLOCATED( t_surf_green_v_p(l)%t ) )                     &
     995              ALLOCATE ( t_surf_green_v_p(l)%t(1:surf_usm_v(l)%ns) )
     996           IF ( .NOT. ALLOCATED( t_surf_whole_v(l)%t ) )                       &
     997              ALLOCATE ( t_surf_whole_v(l)%t(1:surf_usm_v(l)%ns) )
     998           IF ( .NOT. ALLOCATED( t_surf_whole_v_p(l)%t ) )                     &
     999              ALLOCATE ( t_surf_whole_v_p(l)%t(1:surf_usm_v(l)%ns) )
     1000           IF ( .NOT. ALLOCATED( t_surf_10cm_v(l)%t ) )                        &
     1001              ALLOCATE ( t_surf_10cm_v(l)%t(1:surf_usm_v(l)%ns) )
     1002           IF ( .NOT. ALLOCATED( t_surf_10cm_v_p(l)%t ) )                        &
     1003              ALLOCATE ( t_surf_10cm_v_p(l)%t(1:surf_usm_v(l)%ns) )
    10191004        ENDDO
    10201005#else
     
    10311016           IF ( .NOT. ALLOCATED( t_wall_v_2(l)%t ) )                           &           
    10321017              ALLOCATE ( t_wall_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
     1018           IF ( .NOT. ALLOCATED( t_surf_window_v_1(l)%t ) )                    &
     1019              ALLOCATE ( t_surf_window_v_1(l)%t(1:surf_usm_v(l)%ns) )
     1020           IF ( .NOT. ALLOCATED( t_surf_window_v_2(l)%t ) )                    &
     1021              ALLOCATE ( t_surf_window_v_2(l)%t(1:surf_usm_v(l)%ns) )
     1022           IF ( .NOT. ALLOCATED( t_window_v_1(l)%t ) )                         &           
     1023              ALLOCATE ( t_window_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
     1024           IF ( .NOT. ALLOCATED( t_window_v_2(l)%t ) )                         &           
     1025              ALLOCATE ( t_window_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
     1026           IF ( .NOT. ALLOCATED( t_surf_green_v_1(l)%t ) )                     &
     1027              ALLOCATE ( t_surf_green_v_1(l)%t(1:surf_usm_v(l)%ns) )
     1028           IF ( .NOT. ALLOCATED( t_surf_green_v_2(l)%t ) )                     &
     1029              ALLOCATE ( t_surf_green_v_2(l)%t(1:surf_usm_v(l)%ns) )
     1030           IF ( .NOT. ALLOCATED( t_green_v_1(l)%t ) )                          &           
     1031              ALLOCATE ( t_green_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
     1032           IF ( .NOT. ALLOCATED( t_green_v_2(l)%t ) )                          &           
     1033              ALLOCATE ( t_green_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
     1034           IF ( .NOT. ALLOCATED( t_surf_whole_v_1(l)%t ) )                     &
     1035              ALLOCATE ( t_surf_whole_v_1(l)%t(1:surf_usm_v(l)%ns) )
     1036           IF ( .NOT. ALLOCATED( t_surf_whole_v_2(l)%t ) )                     &
     1037              ALLOCATE ( t_surf_whole_v_2(l)%t(1:surf_usm_v(l)%ns) )
     1038           IF ( .NOT. ALLOCATED( t_surf_10cm_v_1(l)%t ) )                     &
     1039              ALLOCATE ( t_surf_10cm_v_1(l)%t(1:surf_usm_v(l)%ns) )
     1040           IF ( .NOT. ALLOCATED( t_surf_10cm_v_2(l)%t ) )                     &
     1041              ALLOCATE ( t_surf_10cm_v_2(l)%t(1:surf_usm_v(l)%ns) )
    10331042        ENDDO
    10341043!
     
    10361045        t_wall_v    => t_wall_v_1;    t_wall_v_p    => t_wall_v_2
    10371046        t_surf_v => t_surf_v_1; t_surf_v_p => t_surf_v_2
     1047        t_window_v    => t_window_v_1;    t_window_v_p    => t_window_v_2
     1048        t_green_v    => t_green_v_1;    t_green_v_p    => t_green_v_2
     1049        t_surf_window_v => t_surf_window_v_1; t_surf_window_v_p => t_surf_window_v_2
     1050        t_surf_green_v => t_surf_green_v_1; t_surf_green_v_p => t_surf_green_v_2
     1051        t_surf_whole_v => t_surf_whole_v_1; t_surf_whole_v_p => t_surf_whole_v_2
     1052        t_surf_10cm_v => t_surf_10cm_v_1; t_surf_10cm_v_p => t_surf_10cm_v_2
     1053
    10381054#endif
    10391055!
     
    10411057        ALLOCATE ( surf_usm_h%tt_surface_m(1:surf_usm_h%ns)                  )
    10421058        ALLOCATE ( surf_usm_h%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     1059        ALLOCATE ( surf_usm_h%tt_surface_window_m(1:surf_usm_h%ns)             )
     1060        ALLOCATE ( surf_usm_h%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     1061        ALLOCATE ( surf_usm_h%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)  )
     1062        ALLOCATE ( surf_usm_h%tt_surface_green_m(1:surf_usm_h%ns)              )
     1063
    10431064!
    10441065!--     Set inital values for prognostic quantities
    10451066        IF ( ALLOCATED( surf_usm_h%tt_surface_m ) )  surf_usm_h%tt_surface_m = 0.0_wp
    10461067        IF ( ALLOCATED( surf_usm_h%tt_wall_m    ) )  surf_usm_h%tt_wall_m    = 0.0_wp
     1068        IF ( ALLOCATED( surf_usm_h%tt_surface_window_m ) )  surf_usm_h%tt_surface_window_m = 0.0_wp
     1069        IF ( ALLOCATED( surf_usm_h%tt_window_m    )      )  surf_usm_h%tt_window_m         = 0.0_wp
     1070        IF ( ALLOCATED( surf_usm_h%tt_green_m    )       )  surf_usm_h%tt_green_m          = 0.0_wp
     1071        IF ( ALLOCATED( surf_usm_h%tt_surface_green_m )  )  surf_usm_h%tt_surface_green_m  = 0.0_wp
    10471072!
    10481073!--     Now, for vertical surfaces
     
    10521077           IF ( ALLOCATED( surf_usm_v(l)%tt_surface_m ) )  surf_usm_v(l)%tt_surface_m = 0.0_wp
    10531078           IF ( ALLOCATED( surf_usm_v(l)%tt_wall_m    ) )  surf_usm_v(l)%tt_wall_m    = 0.0_wp
     1079           ALLOCATE ( surf_usm_v(l)%tt_surface_window_m(1:surf_usm_v(l)%ns)             )
     1080           ALLOCATE ( surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
     1081           IF ( ALLOCATED( surf_usm_v(l)%tt_surface_window_m ) )  surf_usm_v(l)%tt_surface_window_m = 0.0_wp
     1082           IF ( ALLOCATED( surf_usm_v(l)%tt_window_m  ) )  surf_usm_v(l)%tt_window_m    = 0.0_wp
     1083           ALLOCATE ( surf_usm_v(l)%tt_surface_green_m(1:surf_usm_v(l)%ns)              )
     1084           IF ( ALLOCATED( surf_usm_v(l)%tt_surface_green_m ) )  surf_usm_v(l)%tt_surface_green_m = 0.0_wp
     1085           ALLOCATE ( surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns)  )
     1086           IF ( ALLOCATED( surf_usm_v(l)%tt_green_m   ) )  surf_usm_v(l)%tt_green_m    = 0.0_wp
    10541087        ENDDO
    10551088
     
    10581091        ALLOCATE ( surf_usm_h%wshf_eb(1:surf_usm_h%ns) )
    10591092        ALLOCATE ( surf_usm_h%wghf_eb(1:surf_usm_h%ns) )
     1093        ALLOCATE ( surf_usm_h%wghf_eb_window(1:surf_usm_h%ns) )
     1094        ALLOCATE ( surf_usm_h%wghf_eb_green(1:surf_usm_h%ns) )
     1095        ALLOCATE ( surf_usm_h%iwghf_eb(1:surf_usm_h%ns) )
     1096        ALLOCATE ( surf_usm_h%iwghf_eb_window(1:surf_usm_h%ns) )
    10601097        IF ( ALLOCATED( surf_usm_h%wshf    ) )  surf_usm_h%wshf    = 0.0_wp
    10611098        IF ( ALLOCATED( surf_usm_h%wshf_eb ) )  surf_usm_h%wshf_eb = 0.0_wp
    10621099        IF ( ALLOCATED( surf_usm_h%wghf_eb ) )  surf_usm_h%wghf_eb = 0.0_wp
     1100        IF ( ALLOCATED( surf_usm_h%wghf_eb_window ) )  surf_usm_h%wghf_eb_window = 0.0_wp
     1101        IF ( ALLOCATED( surf_usm_h%wghf_eb_green ) )  surf_usm_h%wghf_eb_green = 0.0_wp
     1102        IF ( ALLOCATED( surf_usm_h%iwghf_eb ) )  surf_usm_h%iwghf_eb = 0.0_wp
     1103        IF ( ALLOCATED( surf_usm_h%iwghf_eb_window ) )  surf_usm_h%iwghf_eb_window = 0.0_wp
    10631104!
    10641105!--     Now, for vertical surfaces
     
    10671108           ALLOCATE ( surf_usm_v(l)%wshf_eb(1:surf_usm_v(l)%ns) )
    10681109           ALLOCATE ( surf_usm_v(l)%wghf_eb(1:surf_usm_v(l)%ns) )
     1110           ALLOCATE ( surf_usm_v(l)%wghf_eb_window(1:surf_usm_v(l)%ns) )
     1111           ALLOCATE ( surf_usm_v(l)%wghf_eb_green(1:surf_usm_v(l)%ns) )
     1112           ALLOCATE ( surf_usm_v(l)%iwghf_eb(1:surf_usm_v(l)%ns) )
     1113           ALLOCATE ( surf_usm_v(l)%iwghf_eb_window(1:surf_usm_v(l)%ns) )
    10691114           IF ( ALLOCATED( surf_usm_v(l)%wshf    ) )  surf_usm_v(l)%wshf    = 0.0_wp
    10701115           IF ( ALLOCATED( surf_usm_v(l)%wshf_eb ) )  surf_usm_v(l)%wshf_eb = 0.0_wp
    10711116           IF ( ALLOCATED( surf_usm_v(l)%wghf_eb ) )  surf_usm_v(l)%wghf_eb = 0.0_wp
     1117           IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_window ) )  surf_usm_v(l)%wghf_eb_window = 0.0_wp
     1118           IF ( ALLOCATED( surf_usm_v(l)%wghf_eb_green ) )  surf_usm_v(l)%wghf_eb_green = 0.0_wp
     1119           IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb ) )  surf_usm_v(l)%iwghf_eb = 0.0_wp
     1120           IF ( ALLOCATED( surf_usm_v(l)%iwghf_eb_window ) )  surf_usm_v(l)%iwghf_eb_window = 0.0_wp
    10721121        ENDDO
    10731122       
    1074     END SUBROUTINE usm_allocate_urban_surface
    1075 
     1123    END SUBROUTINE usm_allocate_surface
    10761124
    10771125
     
    11151163            ELSE
    11161164!--             wrong wall layer index
     1165                RETURN
     1166            ENDIF
     1167        ENDIF
     1168        IF ( var(1:13) == 'usm_t_window_'  .AND.  len(TRIM(var)) >= 14 )  THEN
     1169!--          wall layers
     1170            READ(var(14:14), '(I1)', iostat=istat ) iwl
     1171            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
     1172                var = var(1:12)
     1173            ELSE
     1174!--             wrong window layer index
     1175                RETURN
     1176            ENDIF
     1177        ENDIF
     1178        IF ( var(1:12) == 'usm_t_green_'  .AND.  len(TRIM(var)) >= 13 )  THEN
     1179!--          wall layers
     1180            READ(var(13:13), '(I1)', iostat=istat ) iwl
     1181            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
     1182                var = var(1:11)
     1183            ELSE
     1184!--             wrong green layer index
    11171185                RETURN
    11181186            ENDIF
     
    12641332                    ENDDO
    12651333
     1334                CASE ( 'usm_wghf_window' )
     1335!--                 array of heat flux from window ground (wall, roof, land)
     1336                    IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_window_av) )  THEN
     1337                        ALLOCATE( surf_usm_h%wghf_eb_window_av(1:surf_usm_h%ns) )
     1338                        surf_usm_h%wghf_eb_window_av = 0.0_wp
     1339                    ENDIF
     1340                    DO  l = 0, 3
     1341                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wghf_eb_window_av) )  THEN
     1342                           ALLOCATE( surf_usm_v(l)%wghf_eb_window_av(1:surf_usm_v(l)%ns) )
     1343                           surf_usm_v(l)%wghf_eb_window_av = 0.0_wp
     1344                       ENDIF
     1345                    ENDDO
     1346
     1347                CASE ( 'usm_wghf_green' )
     1348!--                 array of heat flux from green ground (wall, roof, land)
     1349                    IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_green_av) )  THEN
     1350                        ALLOCATE( surf_usm_h%wghf_eb_green_av(1:surf_usm_h%ns) )
     1351                        surf_usm_h%wghf_eb_green_av = 0.0_wp
     1352                    ENDIF
     1353                    DO  l = 0, 3
     1354                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%wghf_eb_green_av) )  THEN
     1355                           ALLOCATE( surf_usm_v(l)%wghf_eb_green_av(1:surf_usm_v(l)%ns) )
     1356                           surf_usm_v(l)%wghf_eb_green_av = 0.0_wp
     1357                       ENDIF
     1358                    ENDDO
     1359
     1360                CASE ( 'usm_iwghf' )
     1361!--                 array of heat flux from indoor ground (wall, roof, land)
     1362                    IF ( .NOT.  ALLOCATED(surf_usm_h%iwghf_eb_av) )  THEN
     1363                        ALLOCATE( surf_usm_h%iwghf_eb_av(1:surf_usm_h%ns) )
     1364                        surf_usm_h%iwghf_eb_av = 0.0_wp
     1365                    ENDIF
     1366                    DO  l = 0, 3
     1367                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%iwghf_eb_av) )  THEN
     1368                           ALLOCATE( surf_usm_v(l)%iwghf_eb_av(1:surf_usm_v(l)%ns) )
     1369                           surf_usm_v(l)%iwghf_eb_av = 0.0_wp
     1370                       ENDIF
     1371                    ENDDO
     1372
     1373                CASE ( 'usm_iwghf_window' )
     1374!--                 array of heat flux from indoor window ground (wall, roof, land)
     1375                    IF ( .NOT.  ALLOCATED(surf_usm_h%iwghf_eb_window_av) )  THEN
     1376                        ALLOCATE( surf_usm_h%iwghf_eb_window_av(1:surf_usm_h%ns) )
     1377                        surf_usm_h%iwghf_eb_window_av = 0.0_wp
     1378                    ENDIF
     1379                    DO  l = 0, 3
     1380                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%iwghf_eb_window_av) )  THEN
     1381                           ALLOCATE( surf_usm_v(l)%iwghf_eb_window_av(1:surf_usm_v(l)%ns) )
     1382                           surf_usm_v(l)%iwghf_eb_window_av = 0.0_wp
     1383                       ENDIF
     1384                    ENDDO
     1385                   
    12661386                CASE ( 'usm_t_surf' )
    12671387!--                 surface temperature for surfaces
     
    12771397                    ENDDO
    12781398
     1399                CASE ( 'usm_t_surf_window' )
     1400!--                 surface temperature for window surfaces
     1401                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_window_av) )  THEN
     1402                        ALLOCATE( surf_usm_h%t_surf_window_av(1:surf_usm_h%ns) )
     1403                        surf_usm_h%t_surf_window_av = 0.0_wp
     1404                    ENDIF
     1405                    DO  l = 0, 3
     1406                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_window_av) )  THEN
     1407                           ALLOCATE( surf_usm_v(l)%t_surf_window_av(1:surf_usm_v(l)%ns) )
     1408                           surf_usm_v(l)%t_surf_window_av = 0.0_wp
     1409                       ENDIF
     1410                    ENDDO
     1411                   
     1412                CASE ( 'usm_t_surf_green' )
     1413!--                 surface temperature for green surfaces
     1414                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_green_av) )  THEN
     1415                        ALLOCATE( surf_usm_h%t_surf_green_av(1:surf_usm_h%ns) )
     1416                        surf_usm_h%t_surf_green_av = 0.0_wp
     1417                    ENDIF
     1418                    DO  l = 0, 3
     1419                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_green_av) )  THEN
     1420                           ALLOCATE( surf_usm_v(l)%t_surf_green_av(1:surf_usm_v(l)%ns) )
     1421                           surf_usm_v(l)%t_surf_green_av = 0.0_wp
     1422                       ENDIF
     1423                    ENDDO
     1424               
     1425                CASE ( 'usm_t_surf_whole' )
     1426!--                 surface temperature for whole surfaces
     1427                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_whole_av) )  THEN
     1428                        ALLOCATE( surf_usm_h%t_surf_whole_av(1:surf_usm_h%ns) )
     1429                        surf_usm_h%t_surf_whole_av = 0.0_wp
     1430                    ENDIF
     1431                    DO  l = 0, 3
     1432                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_whole_av) )  THEN
     1433                           ALLOCATE( surf_usm_v(l)%t_surf_whole_av(1:surf_usm_v(l)%ns) )
     1434                           surf_usm_v(l)%t_surf_whole_av = 0.0_wp
     1435                       ENDIF
     1436                    ENDDO
     1437                   
     1438                CASE ( 'usm_t_surf_10cm' )
     1439!--                 near surface temperature for whole surfaces
     1440                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_10cm_av) )  THEN
     1441                        ALLOCATE( surf_usm_h%t_surf_10cm_av(1:surf_usm_h%ns) )
     1442                        surf_usm_h%t_surf_10cm_av = 0.0_wp
     1443                    ENDIF
     1444                    DO  l = 0, 3
     1445                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_10cm_av) )  THEN
     1446                           ALLOCATE( surf_usm_v(l)%t_surf_10cm_av(1:surf_usm_v(l)%ns) )
     1447                           surf_usm_v(l)%t_surf_10cm_av = 0.0_wp
     1448                       ENDIF
     1449                    ENDDO
     1450
    12791451                CASE ( 'usm_t_wall' )
    12801452!--                 wall temperature for iwl layer of walls and land
     
    12901462                    ENDDO
    12911463
     1464                CASE ( 'usm_t_window' )
     1465!--                 window temperature for iwl layer of walls and land
     1466                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_window_av) )  THEN
     1467                        ALLOCATE( surf_usm_h%t_window_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
     1468                        surf_usm_h%t_window_av = 0.0_wp
     1469                    ENDIF
     1470                    DO  l = 0, 3
     1471                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_window_av) )  THEN
     1472                           ALLOCATE( surf_usm_v(l)%t_window_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
     1473                           surf_usm_v(l)%t_window_av = 0.0_wp
     1474                       ENDIF
     1475                    ENDDO
     1476
     1477                CASE ( 'usm_t_green' )
     1478!--                 green temperature for iwl layer of walls and land
     1479                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_green_av) )  THEN
     1480                        ALLOCATE( surf_usm_h%t_green_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
     1481                        surf_usm_h%t_green_av = 0.0_wp
     1482                    ENDIF
     1483                    DO  l = 0, 3
     1484                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_green_av) )  THEN
     1485                           ALLOCATE( surf_usm_v(l)%t_green_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) )
     1486                           surf_usm_v(l)%t_green_av = 0.0_wp
     1487                       ENDIF
     1488                    ENDDO
     1489
    12921490               CASE DEFAULT
    12931491                   CONTINUE
     
    14511649                    ENDDO
    14521650                   
     1651                CASE ( 'usm_wghf_window' )
     1652!--                 array of heat flux from window ground (wall, roof, land)
     1653                    DO  m = 1, surf_usm_h%ns
     1654                       surf_usm_h%wghf_eb_window_av(m) =                              &
     1655                                          surf_usm_h%wghf_eb_window_av(m) +           &
     1656                                          surf_usm_h%wghf_eb_window(m)
     1657                    ENDDO
     1658                    DO  l = 0, 3
     1659                       DO  m = 1, surf_usm_v(l)%ns
     1660                          surf_usm_v(l)%wghf_eb_window_av(m) =                        &
     1661                                          surf_usm_v(l)%wghf_eb_window_av(m) +        &
     1662                                          surf_usm_v(l)%wghf_eb_window(m)
     1663                       ENDDO
     1664                    ENDDO
     1665
     1666                CASE ( 'usm_wghf_green' )
     1667!--                 array of heat flux from green ground (wall, roof, land)
     1668                    DO  m = 1, surf_usm_h%ns
     1669                       surf_usm_h%wghf_eb_green_av(m) =                              &
     1670                                          surf_usm_h%wghf_eb_green_av(m) +           &
     1671                                          surf_usm_h%wghf_eb_green(m)
     1672                    ENDDO
     1673                    DO  l = 0, 3
     1674                       DO  m = 1, surf_usm_v(l)%ns
     1675                          surf_usm_v(l)%wghf_eb_green_av(m) =                        &
     1676                                          surf_usm_v(l)%wghf_eb_green_av(m) +        &
     1677                                          surf_usm_v(l)%wghf_eb_green(m)
     1678                       ENDDO
     1679                    ENDDO
     1680                   
     1681                CASE ( 'usm_iwghf' )
     1682!--                 array of heat flux from indoor ground (wall, roof, land)
     1683                    DO  m = 1, surf_usm_h%ns
     1684                       surf_usm_h%iwghf_eb_av(m) =                              &
     1685                                          surf_usm_h%iwghf_eb_av(m) +           &
     1686                                          surf_usm_h%iwghf_eb(m)
     1687                    ENDDO
     1688                    DO  l = 0, 3
     1689                       DO  m = 1, surf_usm_v(l)%ns
     1690                          surf_usm_v(l)%iwghf_eb_av(m) =                        &
     1691                                          surf_usm_v(l)%iwghf_eb_av(m) +        &
     1692                                          surf_usm_v(l)%iwghf_eb(m)
     1693                       ENDDO
     1694                    ENDDO
     1695                   
     1696                CASE ( 'usm_iwghf_window' )
     1697!--                 array of heat flux from indoor window ground (wall, roof, land)
     1698                    DO  m = 1, surf_usm_h%ns
     1699                       surf_usm_h%iwghf_eb_window_av(m) =                              &
     1700                                          surf_usm_h%iwghf_eb_window_av(m) +           &
     1701                                          surf_usm_h%iwghf_eb_window(m)
     1702                    ENDDO
     1703                    DO  l = 0, 3
     1704                       DO  m = 1, surf_usm_v(l)%ns
     1705                          surf_usm_v(l)%iwghf_eb_window_av(m) =                        &
     1706                                          surf_usm_v(l)%iwghf_eb_window_av(m) +        &
     1707                                          surf_usm_v(l)%iwghf_eb_window(m)
     1708                       ENDDO
     1709                    ENDDO
     1710                   
    14531711                CASE ( 'usm_t_surf' )
    14541712!--                 surface temperature for surfaces
     
    14651723                       ENDDO
    14661724                    ENDDO
     1725                   
     1726                CASE ( 'usm_t_surf_window' )
     1727!--                 surface temperature for window surfaces
     1728                    DO  m = 1, surf_usm_h%ns
     1729                       surf_usm_h%t_surf_window_av(m) =                               &
     1730                                          surf_usm_h%t_surf_window_av(m) +            &
     1731                                          t_surf_window_h(m)
     1732                    ENDDO
     1733                    DO  l = 0, 3
     1734                       DO  m = 1, surf_usm_v(l)%ns
     1735                          surf_usm_v(l)%t_surf_window_av(m) =                         &
     1736                                          surf_usm_v(l)%t_surf_window_av(m) +         &
     1737                                          t_surf_window_v(l)%t(m)
     1738                       ENDDO
     1739                    ENDDO
     1740                   
     1741                CASE ( 'usm_t_surf_green' )
     1742!--                 surface temperature for green surfaces
     1743                    DO  m = 1, surf_usm_h%ns
     1744                       surf_usm_h%t_surf_green_av(m) =                               &
     1745                                          surf_usm_h%t_surf_green_av(m) +            &
     1746                                          t_surf_green_h(m)
     1747                    ENDDO
     1748                    DO  l = 0, 3
     1749                       DO  m = 1, surf_usm_v(l)%ns
     1750                          surf_usm_v(l)%t_surf_green_av(m) =                         &
     1751                                          surf_usm_v(l)%t_surf_green_av(m) +         &
     1752                                          t_surf_green_v(l)%t(m)
     1753                       ENDDO
     1754                    ENDDO
     1755               
     1756                CASE ( 'usm_t_surf_whole' )
     1757!--                 surface temperature for whole surfaces
     1758                    DO  m = 1, surf_usm_h%ns
     1759                       surf_usm_h%t_surf_whole_av(m) =                               &
     1760                                          surf_usm_h%t_surf_whole_av(m) +            &
     1761                                          t_surf_whole_h(m)
     1762                    ENDDO
     1763                    DO  l = 0, 3
     1764                       DO  m = 1, surf_usm_v(l)%ns
     1765                          surf_usm_v(l)%t_surf_whole_av(m) =                         &
     1766                                          surf_usm_v(l)%t_surf_whole_av(m) +         &
     1767                                          t_surf_whole_v(l)%t(m)
     1768                       ENDDO
     1769                    ENDDO
     1770                   
     1771                CASE ( 'usm_t_surf_10cm' )
     1772!--                 near surface temperature for whole surfaces
     1773                    DO  m = 1, surf_usm_h%ns
     1774                       surf_usm_h%t_surf_10cm_av(m) =                               &
     1775                                          surf_usm_h%t_surf_10cm_av(m) +            &
     1776                                          t_surf_10cm_h(m)
     1777                    ENDDO
     1778                    DO  l = 0, 3
     1779                       DO  m = 1, surf_usm_v(l)%ns
     1780                          surf_usm_v(l)%t_surf_10cm_av(m) =                         &
     1781                                          surf_usm_v(l)%t_surf_10cm_av(m) +         &
     1782                                          t_surf_10cm_v(l)%t(m)
     1783                       ENDDO
     1784                    ENDDO
     1785
    14671786                   
    14681787                CASE ( 'usm_t_wall' )
     
    14811800                    ENDDO
    14821801                   
     1802                CASE ( 'usm_t_window' )
     1803!--                 window temperature for  iwl layer of walls and land
     1804                    DO  m = 1, surf_usm_h%ns
     1805                       surf_usm_h%t_window_av(iwl,m) =                           &
     1806                                          surf_usm_h%t_window_av(iwl,m) +        &
     1807                                          t_window_h(iwl,m)
     1808                    ENDDO
     1809                    DO  l = 0, 3
     1810                       DO  m = 1, surf_usm_v(l)%ns
     1811                          surf_usm_v(l)%t_window_av(iwl,m) =                     &
     1812                                          surf_usm_v(l)%t_window_av(iwl,m) +     &
     1813                                          t_window_v(l)%t(iwl,m)
     1814                       ENDDO
     1815                    ENDDO
     1816
     1817                CASE ( 'usm_t_green' )
     1818!--                 green temperature for  iwl layer of walls and land
     1819                    DO  m = 1, surf_usm_h%ns
     1820                       surf_usm_h%t_green_av(iwl,m) =                           &
     1821                                          surf_usm_h%t_green_av(iwl,m) +        &
     1822                                          t_green_h(iwl,m)
     1823                    ENDDO
     1824                    DO  l = 0, 3
     1825                       DO  m = 1, surf_usm_v(l)%ns
     1826                          surf_usm_v(l)%t_green_av(iwl,m) =                     &
     1827                                          surf_usm_v(l)%t_green_av(iwl,m) +     &
     1828                                          t_green_v(l)%t(iwl,m)
     1829                       ENDDO
     1830                    ENDDO
     1831
    14831832                CASE DEFAULT
    14841833                    CONTINUE
     
    16381987                    ENDDO
    16391988                   
     1989                CASE ( 'usm_wghf_window' )
     1990!--                 array of heat flux from window ground (wall, roof, land)
     1991                    DO  m = 1, surf_usm_h%ns
     1992                       surf_usm_h%wghf_eb_window_av(m) =                              &
     1993                                          surf_usm_h%wghf_eb_window_av(m) /           &
     1994                                          REAL( average_count_3d, kind=wp )
     1995                    ENDDO
     1996                    DO  l = 0, 3
     1997                       DO  m = 1, surf_usm_v(l)%ns
     1998                          surf_usm_v(l)%wghf_eb_window_av(m) =                        &
     1999                                          surf_usm_v(l)%wghf_eb_window_av(m) /        &
     2000                                          REAL( average_count_3d, kind=wp )
     2001                       ENDDO
     2002                    ENDDO
     2003
     2004                CASE ( 'usm_wghf_green' )
     2005!--                 array of heat flux from green ground (wall, roof, land)
     2006                    DO  m = 1, surf_usm_h%ns
     2007                       surf_usm_h%wghf_eb_green_av(m) =                              &
     2008                                          surf_usm_h%wghf_eb_green_av(m) /           &
     2009                                          REAL( average_count_3d, kind=wp )
     2010                    ENDDO
     2011                    DO  l = 0, 3
     2012                       DO  m = 1, surf_usm_v(l)%ns
     2013                          surf_usm_v(l)%wghf_eb_green_av(m) =                        &
     2014                                          surf_usm_v(l)%wghf_eb_green_av(m) /        &
     2015                                          REAL( average_count_3d, kind=wp )
     2016                       ENDDO
     2017                    ENDDO
     2018
     2019                CASE ( 'usm_iwghf' )
     2020!--                 array of heat flux from indoor ground (wall, roof, land)
     2021                    DO  m = 1, surf_usm_h%ns
     2022                       surf_usm_h%iwghf_eb_av(m) =                              &
     2023                                          surf_usm_h%iwghf_eb_av(m) /           &
     2024                                          REAL( average_count_3d, kind=wp )
     2025                    ENDDO
     2026                    DO  l = 0, 3
     2027                       DO  m = 1, surf_usm_v(l)%ns
     2028                          surf_usm_v(l)%iwghf_eb_av(m) =                        &
     2029                                          surf_usm_v(l)%iwghf_eb_av(m) /        &
     2030                                          REAL( average_count_3d, kind=wp )
     2031                       ENDDO
     2032                    ENDDO
     2033                   
     2034                CASE ( 'usm_iwghf_window' )
     2035!--                 array of heat flux from indoor window ground (wall, roof, land)
     2036                    DO  m = 1, surf_usm_h%ns
     2037                       surf_usm_h%iwghf_eb_window_av(m) =                              &
     2038                                          surf_usm_h%iwghf_eb_window_av(m) /           &
     2039                                          REAL( average_count_3d, kind=wp )
     2040                    ENDDO
     2041                    DO  l = 0, 3
     2042                       DO  m = 1, surf_usm_v(l)%ns
     2043                          surf_usm_v(l)%iwghf_eb_window_av(m) =                        &
     2044                                          surf_usm_v(l)%iwghf_eb_window_av(m) /        &
     2045                                          REAL( average_count_3d, kind=wp )
     2046                       ENDDO
     2047                    ENDDO
     2048                   
    16402049                CASE ( 'usm_t_surf' )
    16412050!--                 surface temperature for surfaces
     
    16492058                          surf_usm_v(l)%t_surf_av(m) =                         &
    16502059                                          surf_usm_v(l)%t_surf_av(m) /         &
     2060                                          REAL( average_count_3d, kind=wp )
     2061                       ENDDO
     2062                    ENDDO
     2063                   
     2064                CASE ( 'usm_t_surf_window' )
     2065!--                 surface temperature for window surfaces
     2066                    DO  m = 1, surf_usm_h%ns
     2067                       surf_usm_h%t_surf_window_av(m) =                               &
     2068                                          surf_usm_h%t_surf_window_av(m) /            &
     2069                                          REAL( average_count_3d, kind=wp )
     2070                    ENDDO
     2071                    DO  l = 0, 3
     2072                       DO  m = 1, surf_usm_v(l)%ns
     2073                          surf_usm_v(l)%t_surf_window_av(m) =                         &
     2074                                          surf_usm_v(l)%t_surf_window_av(m) /         &
     2075                                          REAL( average_count_3d, kind=wp )
     2076                       ENDDO
     2077                    ENDDO
     2078                   
     2079                CASE ( 'usm_t_surf_green' )
     2080!--                 surface temperature for green surfaces
     2081                    DO  m = 1, surf_usm_h%ns
     2082                       surf_usm_h%t_surf_green_av(m) =                               &
     2083                                          surf_usm_h%t_surf_green_av(m) /            &
     2084                                          REAL( average_count_3d, kind=wp )
     2085                    ENDDO
     2086                    DO  l = 0, 3
     2087                       DO  m = 1, surf_usm_v(l)%ns
     2088                          surf_usm_v(l)%t_surf_green_av(m) =                         &
     2089                                          surf_usm_v(l)%t_surf_green_av(m) /         &
     2090                                          REAL( average_count_3d, kind=wp )
     2091                       ENDDO
     2092                    ENDDO
     2093                   
     2094                CASE ( 'usm_t_surf_whole' )
     2095!--                 surface temperature for whole surfaces
     2096                    DO  m = 1, surf_usm_h%ns
     2097                       surf_usm_h%t_surf_whole_av(m) =                               &
     2098                                          surf_usm_h%t_surf_whole_av(m) /            &
     2099                                          REAL( average_count_3d, kind=wp )
     2100                    ENDDO
     2101                    DO  l = 0, 3
     2102                       DO  m = 1, surf_usm_v(l)%ns
     2103                          surf_usm_v(l)%t_surf_whole_av(m) =                         &
     2104                                          surf_usm_v(l)%t_surf_whole_av(m) /         &
     2105                                          REAL( average_count_3d, kind=wp )
     2106                       ENDDO
     2107                    ENDDO
     2108                   
     2109                CASE ( 'usm_t_surf_10cm' )
     2110!--                 near surface temperature for whole surfaces
     2111                    DO  m = 1, surf_usm_h%ns
     2112                       surf_usm_h%t_surf_10cm_av(m) =                               &
     2113                                          surf_usm_h%t_surf_10cm_av(m) /            &
     2114                                          REAL( average_count_3d, kind=wp )
     2115                    ENDDO
     2116                    DO  l = 0, 3
     2117                       DO  m = 1, surf_usm_v(l)%ns
     2118                          surf_usm_v(l)%t_surf_10cm_av(m) =                         &
     2119                                          surf_usm_v(l)%t_surf_10cm_av(m) /         &
    16512120                                          REAL( average_count_3d, kind=wp )
    16522121                       ENDDO
     
    16682137                    ENDDO
    16692138
     2139                CASE ( 'usm_t_window' )
     2140!--                 window temperature for  iwl layer of walls and land
     2141                    DO  m = 1, surf_usm_h%ns
     2142                       surf_usm_h%t_window_av(iwl,m) =                           &
     2143                                          surf_usm_h%t_window_av(iwl,m) /        &
     2144                                          REAL( average_count_3d, kind=wp )
     2145                    ENDDO
     2146                    DO  l = 0, 3
     2147                       DO  m = 1, surf_usm_v(l)%ns
     2148                          surf_usm_v(l)%t_window_av(iwl,m) =                     &
     2149                                          surf_usm_v(l)%t_window_av(iwl,m) /     &
     2150                                          REAL( average_count_3d, kind=wp )
     2151                       ENDDO
     2152                    ENDDO
     2153
     2154                CASE ( 'usm_t_green' )
     2155!--                 green temperature for  iwl layer of walls and land
     2156                    DO  m = 1, surf_usm_h%ns
     2157                       surf_usm_h%t_green_av(iwl,m) =                           &
     2158                                          surf_usm_h%t_green_av(iwl,m) /        &
     2159                                          REAL( average_count_3d, kind=wp )
     2160                    ENDDO
     2161                    DO  l = 0, 3
     2162                       DO  m = 1, surf_usm_v(l)%ns
     2163                          surf_usm_v(l)%t_green_av(iwl,m) =                     &
     2164                                          surf_usm_v(l)%t_green_av(iwl,m) /     &
     2165                                          REAL( average_count_3d, kind=wp )
     2166                       ENDDO
     2167                    ENDDO
     2168
     2169
    16702170           END SELECT
    16712171
     
    16752175
    16762176
    1677 !------------------------------------------------------------------------------!
    1678 !> Calculates radiation absorbed by box with given size and LAD.
    1679 !>
    1680 !> Simulates resol**2 rays (by equally spacing a bounding horizontal square
    1681 !> conatining all possible rays that would cross the box) and calculates
    1682 !> average transparency per ray. Returns fraction of absorbed radiation flux
    1683 !> and area for which this fraction is effective.
    1684 !------------------------------------------------------------------------------!
    1685     PURE SUBROUTINE usm_box_absorb(boxsize, resol, dens, uvec, area, absorb)
    1686         IMPLICIT NONE
    1687 
    1688         REAL(wp), DIMENSION(3), INTENT(in) :: &
    1689             boxsize, &      !< z, y, x size of box in m
    1690             uvec            !< z, y, x unit vector of incoming flux
    1691         INTEGER(iwp), INTENT(in) :: &
    1692             resol           !< No. of rays in x and y dimensions
    1693         REAL(wp), INTENT(in) :: &
    1694             dens            !< box density (e.g. Leaf Area Density)
    1695         REAL(wp), INTENT(out) :: &
    1696             area, &         !< horizontal area for flux absorbtion
    1697             absorb          !< fraction of absorbed flux
    1698         REAL(wp) :: &
    1699             xshift, yshift, &
    1700             xmin, xmax, ymin, ymax, &
    1701             xorig, yorig, &
    1702             dx1, dy1, dz1, dx2, dy2, dz2, &
    1703             crdist, &
    1704             transp
    1705         INTEGER(iwp) :: &
    1706             i, j
    1707 
    1708         xshift = uvec(3) / uvec(1) * boxsize(1)
    1709         xmin = min(0._wp, -xshift)
    1710         xmax = boxsize(3) + max(0._wp, -xshift)
    1711         yshift = uvec(2) / uvec(1) * boxsize(1)
    1712         ymin = min(0._wp, -yshift)
    1713         ymax = boxsize(2) + max(0._wp, -yshift)
    1714 
    1715         transp = 0._wp
    1716         DO i = 1, resol
    1717             xorig = xmin + (xmax-xmin) * (i-.5_wp) / resol
    1718             DO j = 1, resol
    1719                 yorig = ymin + (ymax-ymin) * (j-.5_wp) / resol
    1720 
    1721                 dz1 = 0._wp
    1722                 dz2 = boxsize(1)/uvec(1)
    1723 
    1724                 IF ( uvec(2) > 0._wp )  THEN
    1725                     dy1 = -yorig             / uvec(2) !< crossing with y=0
    1726                     dy2 = (boxsize(2)-yorig) / uvec(2) !< crossing with y=boxsize(2)
    1727                 ELSE IF ( uvec(2) < 0._wp )  THEN
    1728                     dy1 = (boxsize(2)-yorig) / uvec(2) !< crossing with y=boxsize(2)
    1729                     dy2 = -yorig             / uvec(2) !< crossing with y=0
    1730                 ELSE !uvec(2)==0
    1731                     dy1 = -huge(1._wp)
    1732                     dy2 = huge(1._wp)
    1733                 ENDIF
    1734 
    1735                 IF ( uvec(3) > 0._wp )  THEN
    1736                     dx1 = -xorig             / uvec(3) !< crossing with x=0
    1737                     dx2 = (boxsize(3)-xorig) / uvec(3) !< crossing with x=boxsize(3)
    1738                 ELSE IF ( uvec(3) < 0._wp )  THEN
    1739                     dx1 = (boxsize(3)-xorig) / uvec(3) !< crossing with x=boxsize(3)
    1740                     dx2 = -xorig             / uvec(3) !< crossing with x=0
    1741                 ELSE !uvec(1)==0
    1742                     dx1 = -huge(1._wp)
    1743                     dx2 = huge(1._wp)
    1744                 ENDIF
    1745 
    1746                 crdist = max(0._wp, (min(dz2, dy2, dx2) - max(dz1, dy1, dx1)))
    1747                 transp = transp + exp(-ext_coef * dens * crdist)
    1748             ENDDO
    1749         ENDDO
    1750         transp = transp / resol**2
    1751         area = (boxsize(3)+xshift)*(boxsize(2)+yshift)
    1752         absorb = 1._wp - transp
    1753        
    1754     END SUBROUTINE usm_box_absorb
    1755    
    1756    
     2177
    17572178!------------------------------------------------------------------------------!
    17582179! Description:
    17592180! ------------
    1760 !> This subroutine splits direct and diffusion dw radiation
    1761 !> It sould not be called in case the radiation model already does it
    1762 !> It follows <CITATION>
     2181!> Set internal Neumann boundary condition at outer soil grid points
     2182!> for temperature and humidity.
    17632183!------------------------------------------------------------------------------!
    1764     SUBROUTINE usm_calc_diffusion_radiation
    1765    
    1766         REAL(wp), PARAMETER                          :: lowest_solarUp = 0.1_wp  !< limit the sun elevation to protect stability of the calculation
    1767         INTEGER(iwp)                                 :: i, j
    1768         REAL(wp)                                     ::  year_angle              !< angle
    1769         REAL(wp)                                     ::  etr                     !< extraterestrial radiation
    1770         REAL(wp)                                     ::  corrected_solarUp       !< corrected solar up radiation
    1771         REAL(wp)                                     ::  horizontalETR           !< horizontal extraterestrial radiation
    1772         REAL(wp)                                     ::  clearnessIndex          !< clearness index
    1773         REAL(wp)                                     ::  diff_frac               !< diffusion fraction of the radiation
    1774 
    1775        
    1776 !--     Calculate current day and time based on the initial values and simulation time
    1777         year_angle = ( (day_of_year_init * 86400) + time_utc_init              &
    1778                         + time_since_reference_point )  * d_seconds_year       &
    1779                         * 2.0_wp * pi
    1780        
    1781         etr = solar_constant * (1.00011_wp +                                   &
    1782                           0.034221_wp * cos(year_angle) +                      &
    1783                           0.001280_wp * sin(year_angle) +                      &
    1784                           0.000719_wp * cos(2.0_wp * year_angle) +             &
    1785                           0.000077_wp * sin(2.0_wp * year_angle))
    1786        
    1787 !--   
    1788 !--     Under a very low angle, we keep extraterestrial radiation at
    1789 !--     the last small value, therefore the clearness index will be pushed
    1790 !--     towards 0 while keeping full continuity.
    1791 !--   
    1792         IF ( zenith(0) <= lowest_solarUp )  THEN
    1793             corrected_solarUp = lowest_solarUp
    1794         ELSE
    1795             corrected_solarUp = zenith(0)
    1796         ENDIF
    1797        
    1798         horizontalETR = etr * corrected_solarUp
    1799        
    1800         DO i = nxlg, nxrg
    1801             DO j = nysg, nyng
    1802                 clearnessIndex = rad_sw_in(0,j,i) / horizontalETR
    1803                 diff_frac = 1.0_wp / (1.0_wp + exp(-5.0033_wp + 8.6025_wp * clearnessIndex))
    1804                 rad_sw_in_diff(j,i) = rad_sw_in(0,j,i) * diff_frac
    1805                 rad_sw_in_dir(j,i)  = rad_sw_in(0,j,i) * (1.0_wp - diff_frac)
    1806                 rad_lw_in_diff(j,i) = rad_lw_in(0,j,i)
    1807             ENDDO
    1808         ENDDO
    1809        
    1810     END SUBROUTINE usm_calc_diffusion_radiation
    1811    
    1812 
    1813 !------------------------------------------------------------------------------!
    1814 ! Description:
    1815 ! ------------
    1816 !> Calculates shape view factors SVF and plant sink canopy factors PSCF
    1817 !> !!!!!DESCRIPTION!!!!!!!!!!
    1818 !------------------------------------------------------------------------------!
    1819     SUBROUTINE usm_calc_svf
    1820    
    1821         IMPLICIT NONE
    1822        
    1823         INTEGER(iwp)                                :: i, j, k, l, d, ip, jp
    1824         INTEGER(iwp)                                :: isvf, ksvf, icsf, kcsf, npcsfl, isvf_surflt, imrtt, imrtf
    1825         INTEGER(iwp)                                :: sd, td, ioln, iproc
    1826         REAL(wp),     DIMENSION(0:9)                :: facearea
    1827         INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   :: nzterrl, planthl
    1828         REAL(wp),     DIMENSION(:,:), ALLOCATABLE   :: csflt, pcsflt
    1829         INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   :: kcsflt,kpcsflt
    1830         INTEGER(iwp), DIMENSION(:), ALLOCATABLE     :: icsflt,dcsflt,ipcsflt,dpcsflt
    1831         REAL(wp), DIMENSION(3)                      :: uv
    1832         LOGICAL                                     :: visible
    1833         REAL(wp), DIMENSION(3)                      :: sa, ta          !< real coordinates z,y,x of source and target
    1834         REAL(wp)                                    :: transparency, rirrf, sqdist, svfsum
    1835         INTEGER(iwp)                                :: isurflt, isurfs, isurflt_prev
    1836         INTEGER(iwp)                                :: itx, ity, itz
    1837         CHARACTER(len=7)                            :: pid_char = ''
    1838         INTEGER(iwp)                                :: win_lad, minfo
    1839         REAL(wp), DIMENSION(:,:,:), POINTER         :: lad_s_rma       !< fortran pointer, but lower bounds are 1
    1840         TYPE(c_ptr)                                 :: lad_s_rma_p     !< allocated c pointer
    1841 #if defined( __parallel )
    1842         INTEGER(kind=MPI_ADDRESS_KIND)              :: size_lad_rma
    1843 #endif
    1844 !   
    1845 !--     calculation of the SVF
    1846         CALL location_message( '    calculation of SVF and CSF', .TRUE. )
    1847 !
    1848 !--     precalculate face areas for different face directions using normal vector
    1849         DO d = 0, 9
    1850             facearea(d) = 1._wp
    1851             IF ( idir(d) == 0 ) facearea(d) = facearea(d) * dx
    1852             IF ( jdir(d) == 0 ) facearea(d) = facearea(d) * dy
    1853             IF ( kdir(d) == 0 ) facearea(d) = facearea(d) * dz
    1854         ENDDO
    1855 
    1856 !--     initialize variables and temporary arrays for calculation of svf and csf
    1857         nsvfl  = 0
    1858         ncsfl  = 0
    1859         nsvfla = gasize
    1860         msvf   = 1
    1861         ALLOCATE( asvf1(nsvfla) )
    1862         asvf => asvf1
    1863         IF ( plant_canopy )  THEN
    1864             ncsfla = gasize
    1865             mcsf   = 1
    1866             ALLOCATE( acsf1(ncsfla) )
    1867             acsf => acsf1
    1868         ENDIF
    1869        
    1870 !--     initialize temporary terrain and plant canopy height arrays (global 2D array!)
    1871         ALLOCATE( nzterr(0:(nx+1)*(ny+1)-1) )
    1872 #if defined( __parallel )
    1873         ALLOCATE( nzterrl(nys:nyn,nxl:nxr) )
    1874         nzterrl = MAXLOC(                                                      &
    1875                           MERGE( 1, 0,                                         &
    1876                                  BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), 12 )  &
    1877                                ), DIM = 1                                      &
    1878                         ) - 1  ! = nzb_s_inner(nys:nyn,nxl:nxr)
    1879         CALL MPI_AllGather( nzterrl, nnx*nny, MPI_INTEGER, &
    1880                             nzterr, nnx*nny, MPI_INTEGER, comm2d, ierr )
    1881         DEALLOCATE(nzterrl)
    1882 #else
    1883         nzterr = RESHAPE( MAXLOC(                                              &
    1884                           MERGE( 1, 0,                                         &
    1885                                  BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), 12 )  &
    1886                                ), DIM = 1                                      &
    1887                                 ) - 1,                                         &
    1888                           (/(nx+1)*(ny+1)/)                                    &
    1889                         )
    1890 #endif
    1891         IF ( plant_canopy )  THEN
    1892             ALLOCATE( plantt(0:(nx+1)*(ny+1)-1) )
    1893             maxboxesg = nx + ny + nzu + 1
    1894 !--         temporary arrays storing values for csf calculation during raytracing
    1895             ALLOCATE( boxes(3, maxboxesg) )
    1896             ALLOCATE( crlens(maxboxesg) )
    1897 
    1898 #if defined( __parallel )
    1899             ALLOCATE( planthl(nys:nyn,nxl:nxr) )
    1900             planthl = pch(nys:nyn,nxl:nxr)
    1901        
    1902             CALL MPI_AllGather( planthl, nnx*nny, MPI_INTEGER, &
    1903                                 plantt, nnx*nny, MPI_INTEGER, comm2d, ierr )
    1904             DEALLOCATE( planthl )
    1905            
    1906 !--         temporary arrays storing values for csf calculation during raytracing
    1907             ALLOCATE( lad_ip(maxboxesg) )
    1908             ALLOCATE( lad_disp(maxboxesg) )
    1909 
    1910             IF ( usm_lad_rma )  THEN
    1911                 ALLOCATE( lad_s_ray(maxboxesg) )
    1912                
    1913                 ! set conditions for RMA communication
    1914                 CALL MPI_Info_create(minfo, ierr)
    1915                 CALL MPI_Info_set(minfo, 'accumulate_ordering', '', ierr)
    1916                 CALL MPI_Info_set(minfo, 'accumulate_ops', 'same_op', ierr)
    1917                 CALL MPI_Info_set(minfo, 'same_size', 'true', ierr)
    1918                 CALL MPI_Info_set(minfo, 'same_disp_unit', 'true', ierr)
    1919 
    1920 !--             Allocate and initialize the MPI RMA window
    1921 !--             must be in accordance with allocation of lad_s in plant_canopy_model
    1922 !--             optimization of memory should be done
    1923 !--             Argument X of function c_sizeof(X) needs arbitrary REAL(wp) value, set to 1.0_wp for now
    1924                 size_lad_rma = c_sizeof(1.0_wp)*nnx*nny*nzu
    1925                 CALL MPI_Win_allocate(size_lad_rma, c_sizeof(1.0_wp), minfo, comm2d, &
    1926                                         lad_s_rma_p, win_lad, ierr)
    1927                 CALL c_f_pointer(lad_s_rma_p, lad_s_rma, (/ nzu, nny, nnx /))
    1928                 usm_lad(nzub:, nys:, nxl:) => lad_s_rma(:,:,:)
    1929             ELSE
    1930                 ALLOCATE(usm_lad(nzub:nzut, nys:nyn, nxl:nxr))
    1931             ENDIF
    1932 #else
    1933             plantt = RESHAPE( pct(nys:nyn,nxl:nxr), (/(nx+1)*(ny+1)/) )
    1934             ALLOCATE(usm_lad(nzub:nzut, nys:nyn, nxl:nxr))
    1935 #endif
    1936             usm_lad(:,:,:) = 0._wp
    1937             DO i = nxl, nxr
    1938                 DO j = nys, nyn
    1939                     k = get_topography_top_index( j, i, 's' )
    1940 
    1941                     usm_lad(k:nzut, j, i) = lad_s(0:nzut-k, j, i)
    1942                 ENDDO
    1943             ENDDO
    1944 
    1945 #if defined( __parallel )
    1946             IF ( usm_lad_rma )  THEN
    1947                 CALL MPI_Info_free(minfo, ierr)
    1948                 CALL MPI_Win_lock_all(0, win_lad, ierr)
    1949             ELSE
    1950                 ALLOCATE( usm_lad_g(0:(nx+1)*(ny+1)*nzu-1) )
    1951                 CALL MPI_AllGather( usm_lad, nnx*nny*nzu, MPI_REAL, &
    1952                                     usm_lad_g, nnx*nny*nzu, MPI_REAL, comm2d, ierr )
    1953             ENDIF
    1954 #endif
    1955         ENDIF
    1956 
    1957         IF ( mrt_factors )  THEN
    1958             OPEN(153, file='MRT_TARGETS', access='SEQUENTIAL', &
    1959                     action='READ', status='OLD', form='FORMATTED', err=524)
    1960             OPEN(154, file='MRT_FACTORS'//myid_char, access='DIRECT', recl=(5*4+2*8), &
    1961                     action='WRITE', status='REPLACE', form='UNFORMATTED', err=525)
    1962             imrtf = 1
    1963             DO
    1964                 READ(153, *, end=526, err=524) imrtt, i, j, k
    1965                 IF ( i < nxl  .OR.  i > nxr &
    1966                      .OR.  j < nys  .OR.  j > nyn ) CYCLE
    1967                 ta = (/ REAL(k), REAL(j), REAL(i) /)
    1968 
    1969                 DO isurfs = 1, nsurf
    1970                     IF ( .NOT.  usm_facing(i, j, k, -1, &
    1971                         surf(ix, isurfs), surf(iy, isurfs), &
    1972                         surf(iz, isurfs), surf(id, isurfs)) )  THEN
    1973                         CYCLE
    1974                     ENDIF
    1975                      
    1976                     sd = surf(id, isurfs)
    1977                     sa = (/ REAL(surf(iz, isurfs), wp) - 0.5_wp * kdir(sd), &
    1978                             REAL(surf(iy, isurfs), wp) - 0.5_wp * jdir(sd), &
    1979                             REAL(surf(ix, isurfs), wp) - 0.5_wp * idir(sd) /)
    1980 
    1981 !--                 unit vector source -> target
    1982                     uv = (/ (ta(1)-sa(1))*dz, (ta(2)-sa(2))*dy, (ta(3)-sa(3))*dx /)
    1983                     sqdist = SUM(uv(:)**2)
    1984                     uv = uv / SQRT(sqdist)
    1985 
    1986 !--                 irradiance factor - see svf. Here we consider that target face is always normal,
    1987 !--                 i.e. the second dot product equals 1
    1988                     rirrf = dot_product((/ kdir(sd), jdir(sd), idir(sd) /), uv) &
    1989                         / (pi * sqdist) * facearea(sd)
    1990 
    1991 !--                 raytrace while not creating any canopy sink factors
    1992                     CALL usm_raytrace(sa, ta, isurfs, rirrf, 1._wp, .FALSE., &
    1993                             visible, transparency, win_lad)
    1994                     IF ( .NOT.  visible ) CYCLE
    1995 
    1996                     !rsvf = rirrf * transparency
    1997                     WRITE(154, rec=imrtf, err=525) INT(imrtt, kind=4), &
    1998                         INT(surf(id, isurfs), kind=4), &
    1999                         INT(surf(iz, isurfs), kind=4), &
    2000                         INT(surf(iy, isurfs), kind=4), &
    2001                         INT(surf(ix, isurfs), kind=4), &
    2002                         REAL(rirrf, kind=8), REAL(transparency, kind=8)
    2003                     imrtf = imrtf + 1
    2004 
    2005                 ENDDO !< isurfs
    2006             ENDDO !< MRT_TARGETS record
    2007 
    2008 524         message_string = 'error reading file MRT_TARGETS'
    2009             CALL message( 'usm_calc_svf', 'PA0524', 1, 2, 0, 6, 0 )
    2010 
    2011 525         message_string = 'error writing file MRT_FACTORS'//myid_char
    2012             CALL message( 'usm_calc_svf', 'PA0525', 1, 2, 0, 6, 0 )
    2013 
    2014 526         CLOSE(153)
    2015             CLOSE(154)
    2016         ENDIF  !< mrt_factors
    2017 
    2018        
    2019         DO isurflt = 1, nsurfl
    2020 !--         determine face centers
    2021             td = surfl(id, isurflt)
    2022             IF ( td >= isky  .AND.  .NOT.  plant_canopy ) CYCLE
    2023             ta = (/ REAL(surfl(iz, isurflt), wp) - 0.5_wp * kdir(td),  &
    2024                       REAL(surfl(iy, isurflt), wp) - 0.5_wp * jdir(td),  &
    2025                       REAL(surfl(ix, isurflt), wp) - 0.5_wp * idir(td)  /)
    2026             DO isurfs = 1, nsurf
    2027                 IF ( .NOT.  usm_facing(surfl(ix, isurflt), surfl(iy, isurflt), &
    2028                     surfl(iz, isurflt), surfl(id, isurflt), &
    2029                     surf(ix, isurfs), surf(iy, isurfs), &
    2030                     surf(iz, isurfs), surf(id, isurfs)) )  THEN
    2031                     CYCLE
    2032                 ENDIF
    2033                  
    2034                 sd = surf(id, isurfs)
    2035                 sa = (/ REAL(surf(iz, isurfs), wp) - 0.5_wp * kdir(sd),  &
    2036                         REAL(surf(iy, isurfs), wp) - 0.5_wp * jdir(sd),  &
    2037                         REAL(surf(ix, isurfs), wp) - 0.5_wp * idir(sd)  /)
    2038 
    2039 !--             unit vector source -> target
    2040                 uv = (/ (ta(1)-sa(1))*dz, (ta(2)-sa(2))*dy, (ta(3)-sa(3))*dx /)
    2041                 sqdist = SUM(uv(:)**2)
    2042                 uv = uv / SQRT(sqdist)
    2043                
    2044 !--             irradiance factor (our unshaded shape view factor) = view factor per differential target area * source area
    2045                 rirrf = dot_product((/ kdir(sd), jdir(sd), idir(sd) /), uv) & ! cosine of source normal and direction
    2046                     * dot_product((/ kdir(td), jdir(td), idir(td) /), -uv) &  ! cosine of target normal and reverse direction
    2047                     / (pi * sqdist) & ! square of distance between centers
    2048                     * facearea(sd)
    2049 
    2050 !--             raytrace + process plant canopy sinks within
    2051                 CALL usm_raytrace(sa, ta, isurfs, rirrf, facearea(td), .TRUE., &
    2052                         visible, transparency, win_lad)
    2053                
    2054                 IF ( .NOT.  visible ) CYCLE
    2055                 IF ( td >= isky ) CYCLE !< we calculated these only for raytracing
    2056                                         !< to find plant canopy sinks, we don't need svf for them
    2057                 ! rsvf = rirrf * transparency
    2058 
    2059 !--             write to the svf array
    2060                 nsvfl = nsvfl + 1
    2061 !--             check dimmension of asvf array and enlarge it if needed
    2062                 IF ( nsvfla < nsvfl )  THEN
    2063                     k = nsvfla * 2
    2064                     IF ( msvf == 0 )  THEN
    2065                         msvf = 1
    2066                         ALLOCATE( asvf1(k) )
    2067                         asvf => asvf1
    2068                         asvf1(1:nsvfla) = asvf2
    2069                         DEALLOCATE( asvf2 )
    2070                     ELSE
    2071                         msvf = 0
    2072                         ALLOCATE( asvf2(k) )
    2073                         asvf => asvf2
    2074                         asvf2(1:nsvfla) = asvf1
    2075                         DEALLOCATE( asvf1 )
    2076                     ENDIF
    2077                     nsvfla = k
    2078                 ENDIF
    2079 !--             write svf values into the array
    2080                 asvf(nsvfl)%isurflt = isurflt
    2081                 asvf(nsvfl)%isurfs = isurfs
    2082                 asvf(nsvfl)%rsvf = rirrf !we postopne multiplication by transparency
    2083                 asvf(nsvfl)%rtransp = transparency !a.k.a. Direct Irradiance Factor
    2084             ENDDO
    2085         ENDDO
    2086 
    2087         CALL location_message( '    waiting for completion of SVF and CSF calculation in all processes', .TRUE. )
    2088 !--     deallocate temporary global arrays
    2089         DEALLOCATE(nzterr)
    2090        
    2091         IF ( plant_canopy )  THEN
    2092 !--         finalize mpi_rma communication and deallocate temporary arrays
    2093 #if defined( __parallel )
    2094             IF ( usm_lad_rma )  THEN
    2095                 CALL MPI_Win_flush_all(win_lad, ierr)
    2096 !--             unlock MPI window
    2097                 CALL MPI_Win_unlock_all(win_lad, ierr)
    2098 !--             free MPI window
    2099                 CALL MPI_Win_free(win_lad, ierr)
    2100                
    2101 !--             deallocate temporary arrays storing values for csf calculation during raytracing
    2102                 DEALLOCATE( lad_s_ray )
    2103 !--             usm_lad is the pointer to lad_s_rma in case of usm_lad_rma
    2104 !--             and must not be deallocated here
    2105             ELSE
    2106                 DEALLOCATE(usm_lad)
    2107                 DEALLOCATE(usm_lad_g)
    2108             ENDIF
    2109 #else
    2110             DEALLOCATE(usm_lad)
    2111 #endif
    2112             DEALLOCATE( boxes )
    2113             DEALLOCATE( crlens )
    2114             DEALLOCATE( plantt )
    2115         ENDIF
    2116 
    2117         CALL location_message( '    calculation of the complete SVF array', .TRUE. )
    2118 
    2119 !--     sort svf ( a version of quicksort )
    2120         CALL quicksort_svf(asvf,1,nsvfl)
    2121 
    2122         ALLOCATE( svf(ndsvf,nsvfl) )
    2123         ALLOCATE( svfsurf(idsvf,nsvfl) )
    2124 
    2125         !< load svf from the structure array to plain arrays
    2126         isurflt_prev = -1
    2127         ksvf = 1
    2128         svfsum = 0._wp
    2129         DO isvf = 1, nsvfl
    2130 !--         normalize svf per target face
    2131             IF ( asvf(ksvf)%isurflt /= isurflt_prev )  THEN
    2132                 IF ( isurflt_prev /= -1  .AND.  svfsum /= 0._wp )  THEN
    2133 !--                 TODO detect and log when normalization differs too much from 1
    2134                     svf(1, isvf_surflt:isvf-1) = svf(1, isvf_surflt:isvf-1) / svfsum
    2135                 ENDIF
    2136                 isurflt_prev = asvf(ksvf)%isurflt
    2137                 isvf_surflt = isvf
    2138                 svfsum = asvf(ksvf)%rsvf !?? / asvf(ksvf)%rtransp
    2139             ELSE
    2140                 svfsum = svfsum + asvf(ksvf)%rsvf !?? / asvf(ksvf)%rtransp
    2141             ENDIF
    2142 
    2143             svf(:, isvf) = (/ asvf(ksvf)%rsvf, asvf(ksvf)%rtransp /)
    2144             svfsurf(:, isvf) = (/ asvf(ksvf)%isurflt, asvf(ksvf)%isurfs /)
    2145 
    2146 !--         next element
    2147             ksvf = ksvf + 1
    2148         ENDDO
    2149 
    2150         IF ( isurflt_prev /= -1  .AND.  svfsum /= 0._wp )  THEN
    2151 !--         TODO detect and log when normalization differs too much from 1
    2152             svf(1, isvf_surflt:nsvfl) = svf(1, isvf_surflt:nsvfl) / svfsum
    2153         ENDIF
    2154 
    2155 !--     deallocate temporary asvf array
    2156 !--     DEALLOCATE(asvf) - ifort has a problem with deallocation of allocatable target
    2157 !--     via pointing pointer - we need to test original targets
    2158         IF ( ALLOCATED(asvf1) )  THEN
    2159             DEALLOCATE(asvf1)
    2160         ENDIF
    2161         IF ( ALLOCATED(asvf2) )  THEN
    2162             DEALLOCATE(asvf2)
    2163         ENDIF
    2164 
    2165         npcsfl = 0
    2166         IF ( plant_canopy )  THEN
    2167 
    2168             CALL location_message( '    calculation of the complete CSF array', .TRUE. )
    2169 
    2170 !--         sort and merge csf for the last time, keeping the array size to minimum
    2171             CALL usm_merge_and_grow_csf(-1)
    2172            
    2173 !--         aggregate csb among processors
    2174 !--         allocate necessary arrays
    2175             ALLOCATE( csflt(ndcsf,max(ncsfl,ndcsf)) )
    2176             ALLOCATE( kcsflt(kdcsf,max(ncsfl,kdcsf)) )
    2177             ALLOCATE( icsflt(0:numprocs-1) )
    2178             ALLOCATE( dcsflt(0:numprocs-1) )
    2179             ALLOCATE( ipcsflt(0:numprocs-1) )
    2180             ALLOCATE( dpcsflt(0:numprocs-1) )
    2181            
    2182 !--         fill out arrays of csf values and
    2183 !--         arrays of number of elements and displacements
    2184 !--         for particular precessors
    2185             icsflt = 0
    2186             dcsflt = 0
    2187             ip = -1
    2188             j = -1
    2189             d = 0
    2190             DO kcsf = 1, ncsfl
    2191                 j = j+1
    2192                 IF ( acsf(kcsf)%ip /= ip )  THEN
    2193 !--                 new block of the processor
    2194 !--                 number of elements of previous block
    2195                     IF ( ip>=0) icsflt(ip) = j
    2196                     d = d+j
    2197 !--                 blank blocks
    2198                     DO jp = ip+1, acsf(kcsf)%ip-1
    2199 !--                     number of elements is zero, displacement is equal to previous
    2200                         icsflt(jp) = 0
    2201                         dcsflt(jp) = d
    2202                     ENDDO
    2203 !--                 the actual block
    2204                     ip = acsf(kcsf)%ip
    2205                     dcsflt(ip) = d
    2206                     j = 0
    2207                 ENDIF
    2208 !--             fill out real values of rsvf, rtransp
    2209                 csflt(1,kcsf) = acsf(kcsf)%rsvf
    2210                 csflt(2,kcsf) = acsf(kcsf)%rtransp
    2211 !--             fill out integer values of itz,ity,itx,isurfs
    2212                 kcsflt(1,kcsf) = acsf(kcsf)%itz
    2213                 kcsflt(2,kcsf) = acsf(kcsf)%ity
    2214                 kcsflt(3,kcsf) = acsf(kcsf)%itx
    2215                 kcsflt(4,kcsf) = acsf(kcsf)%isurfs
    2216             ENDDO
    2217 !--         last blank blocks at the end of array
    2218             j = j+1
    2219             IF ( ip>=0 ) icsflt(ip) = j
    2220             d = d+j
    2221             DO jp = ip+1, numprocs-1
    2222 !--             number of elements is zero, displacement is equal to previous
    2223                 icsflt(jp) = 0
    2224                 dcsflt(jp) = d
    2225             ENDDO
    2226            
    2227 !--         deallocate temporary acsf array
    2228 !--         DEALLOCATE(acsf) - ifort has a problem with deallocation of allocatable target
    2229 !--         via pointing pointer - we need to test original targets
    2230             IF ( ALLOCATED(acsf1) )  THEN
    2231                 DEALLOCATE(acsf1)
    2232             ENDIF
    2233             IF ( ALLOCATED(acsf2) )  THEN
    2234                 DEALLOCATE(acsf2)
    2235             ENDIF
    2236                    
    2237 #if defined( __parallel )
    2238 !--         scatter and gather the number of elements to and from all processor
    2239 !--         and calculate displacements
    2240             CALL MPI_AlltoAll(icsflt,1,MPI_INTEGER,ipcsflt,1,MPI_INTEGER,comm2d, ierr)
    2241            
    2242             npcsfl = SUM(ipcsflt)
    2243             d = 0
    2244             DO i = 0, numprocs-1
    2245                 dpcsflt(i) = d
    2246                 d = d + ipcsflt(i)
    2247             ENDDO
    2248        
    2249 !--         exchange csf fields between processors
    2250             ALLOCATE( pcsflt(ndcsf,max(npcsfl,ndcsf)) )
    2251             ALLOCATE( kpcsflt(kdcsf,max(npcsfl,kdcsf)) )
    2252             CALL MPI_AlltoAllv(csflt, ndcsf*icsflt, ndcsf*dcsflt, MPI_REAL, &
    2253                 pcsflt, ndcsf*ipcsflt, ndcsf*dpcsflt, MPI_REAL, comm2d, ierr)
    2254             CALL MPI_AlltoAllv(kcsflt, kdcsf*icsflt, kdcsf*dcsflt, MPI_INTEGER, &
    2255                 kpcsflt, kdcsf*ipcsflt, kdcsf*dpcsflt, MPI_INTEGER, comm2d, ierr)
    2256            
    2257 #else
    2258             npcsfl = ncsfl
    2259             ALLOCATE( pcsflt(ndcsf,max(npcsfl,ndcsf)) )
    2260             ALLOCATE( kpcsflt(kdcsf,max(npcsfl,kdcsf)) )
    2261             pcsflt = csflt
    2262             kpcsflt = kcsflt
    2263 #endif
    2264 
    2265 !--         deallocate temporary arrays
    2266             DEALLOCATE( csflt )
    2267             DEALLOCATE( kcsflt )
    2268             DEALLOCATE( icsflt )
    2269             DEALLOCATE( dcsflt )
    2270             DEALLOCATE( ipcsflt )
    2271             DEALLOCATE( dpcsflt )
    2272 
    2273 !--         sort csf ( a version of quicksort )
    2274             CALL quicksort_csf2(kpcsflt, pcsflt, 1, npcsfl)
    2275 
    2276 !--         aggregate canopy sink factor records with identical box & source
    2277 !--         againg across all values from all processors
    2278             IF ( npcsfl > 0 )  THEN
    2279                 icsf = 1 !< reading index
    2280                 kcsf = 1 !< writing index
    2281                 DO while (icsf < npcsfl)
    2282 !--                 here kpcsf(kcsf) already has values from kpcsf(icsf)
    2283                     IF ( kpcsflt(3,icsf) == kpcsflt(3,icsf+1)  .AND.  &
    2284                          kpcsflt(2,icsf) == kpcsflt(2,icsf+1)  .AND.  &
    2285                          kpcsflt(1,icsf) == kpcsflt(1,icsf+1)  .AND.  &
    2286                          kpcsflt(4,icsf) == kpcsflt(4,icsf+1) )  THEN
    2287 !--                     We could simply take either first or second rtransp, both are valid. As a very simple heuristic about which ray
    2288 !--                     probably passes nearer the center of the target box, we choose DIF from the entry with greater CSF, since that
    2289 !--                     might mean that the traced beam passes longer through the canopy box.
    2290                         IF ( pcsflt(1,kcsf) < pcsflt(1,icsf+1) )  THEN
    2291                             pcsflt(2,kcsf) = pcsflt(2,icsf+1)
    2292                         ENDIF
    2293                         pcsflt(1,kcsf) = pcsflt(1,kcsf) + pcsflt(1,icsf+1)
    2294 
    2295 !--                     advance reading index, keep writing index
    2296                         icsf = icsf + 1
    2297                     ELSE
    2298 !--                     not identical, just advance and copy
    2299                         icsf = icsf + 1
    2300                         kcsf = kcsf + 1
    2301                         kpcsflt(:,kcsf) = kpcsflt(:,icsf)
    2302                         pcsflt(:,kcsf) = pcsflt(:,icsf)
    2303                     ENDIF
    2304                 ENDDO
    2305 !--             last written item is now also the last item in valid part of array
    2306                 npcsfl = kcsf
    2307             ENDIF
    2308 
    2309             ncsfl = npcsfl
    2310             IF ( ncsfl > 0 )  THEN
    2311                 ALLOCATE( csf(ndcsf,ncsfl) )
    2312                 ALLOCATE( csfsurf(idcsf,ncsfl) )
    2313                 DO icsf = 1, ncsfl
    2314                     csf(:,icsf) = pcsflt(:,icsf)
    2315                     csfsurf(1,icsf) =  gridpcbl(kpcsflt(1,icsf),kpcsflt(2,icsf),kpcsflt(3,icsf))
    2316                     csfsurf(2,icsf) =  kpcsflt(4,icsf)
    2317                 ENDDO
    2318             ENDIF
    2319            
    2320 !--         deallocation of temporary arrays
    2321             DEALLOCATE( pcsflt )
    2322             DEALLOCATE( kpcsflt )
    2323            
    2324         ENDIF
    2325        
    2326         RETURN
    2327        
    2328 301     WRITE( message_string, * )  &
    2329             'I/O error when processing shape view factors / ',  &
    2330             'plant canopy sink factors / direct irradiance factors.'
    2331         CALL message( 'init_urban_surface', 'PA0502', 2, 2, 0, 6, 0 )
    2332        
    2333     END SUBROUTINE usm_calc_svf
     2184 SUBROUTINE usm_boundary_condition
     2185 
     2186    IMPLICIT NONE
     2187
     2188    INTEGER(iwp) :: i      !< grid index x-direction
     2189    INTEGER(iwp) :: ioff   !< offset index x-direction indicating location of soil grid point
     2190    INTEGER(iwp) :: j      !< grid index y-direction
     2191    INTEGER(iwp) :: joff   !< offset index x-direction indicating location of soil grid point
     2192    INTEGER(iwp) :: k      !< grid index z-direction
     2193    INTEGER(iwp) :: koff   !< offset index x-direction indicating location of soil grid point
     2194    INTEGER(iwp) :: l      !< running index surface-orientation
     2195    INTEGER(iwp) :: m      !< running index surface elements
     2196
     2197    koff = surf_usm_h%koff
     2198    DO  m = 1, surf_usm_h%ns
     2199       i = surf_usm_h%i(m)
     2200       j = surf_usm_h%j(m)
     2201       k = surf_usm_h%k(m)
     2202       pt(k+koff,j,i) = pt(k,j,i)
     2203    ENDDO
     2204
     2205    DO  l = 0, 3
     2206       ioff = surf_usm_v(l)%ioff
     2207       joff = surf_usm_v(l)%joff
     2208       DO  m = 1, surf_usm_v(l)%ns
     2209          i = surf_usm_v(l)%i(m)
     2210          j = surf_usm_v(l)%j(m)
     2211          k = surf_usm_v(l)%k(m)
     2212          pt(k,j+joff,i+ioff) = pt(k,j,i)
     2213       ENDDO
     2214    ENDDO
     2215
     2216 END SUBROUTINE usm_boundary_condition
    23342217
    23352218
     
    23392222! ------------
    23402223!> Subroutine checks variables and assigns units.
    2341 !> It is caaled out from subroutine check_parameters.
     2224!> It is called out from subroutine check_parameters.
    23422225!------------------------------------------------------------------------------!
    23432226    SUBROUTINE usm_check_data_output( variable, unit )
     
    23582241             var(1:14) == 'usm_rad_ressw_'  .OR.  var(1:14) == 'usm_rad_reslw_'  .OR.     &
    23592242             var(1:11) == 'usm_rad_hf_'  .OR.                                             &
    2360              var(1:9)  == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_' )  THEN
     2243             var(1:9)  == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_' .OR.                 &
     2244             var(1:16) == 'usm_wghf_window_' .OR. var(1:15) == 'usm_wghf_green_' .OR.     &
     2245             var(1:10) == 'usm_iwghf_' .OR. var(1:17) == 'usm_iwghf_window_' )  THEN
    23612246            unit = 'W/m2'
    2362         ELSE IF ( var(1:10) == 'usm_t_surf'  .OR.  var(1:10) == 'usm_t_wall' )  THEN
     2247        ELSE IF ( var(1:10) == 'usm_t_surf'  .OR.  var(1:10) == 'usm_t_wall' .OR.         &
     2248                  var(1:12) == 'usm_t_window' .OR. var(1:17) == 'usm_t_surf_window' .OR.  &
     2249                  var(1:16) == 'usm_t_surf_green'  .OR.                                   &
     2250                  var(1:16) == 'usm_t_surf_whole' .OR. var(1:11) == 'usm_t_green' .OR.    &
     2251                  var(1:15) == 'usm_t_surf_10cm')  THEN
    23632252            unit = 'K'
    23642253        ELSE IF ( var(1:9) == 'usm_surfz'  .OR.  var(1:7) == 'usm_svf'  .OR.              &
     
    24142303       ENDIF
    24152304
    2416 
    24172305    END SUBROUTINE usm_check_parameters
    24182306
     
    24432331        INTEGER(iwp), PARAMETER                                :: nd = 5
    24442332        CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER         :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
    2445         INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER             :: dirint = (/ iroof, isouth, inorth, iwest, ieast /)
     2333        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER             :: dirint = (/ iup_u, isouth_u, inorth_u, iwest_u, ieast_u /)
    24462334        INTEGER(iwp), DIMENSION(0:nd-1)                        :: dirstart
    24472335        INTEGER(iwp), DIMENSION(0:nd-1)                        :: dirend
     
    24772365            ENDIF
    24782366        ENDIF
     2367        IF ( var(1:13) == 'usm_t_window_'  .AND.  len(TRIM(var)) >= 14 )  THEN
     2368!--         window layers
     2369            READ(var(14:14), '(I1)', iostat=istat ) iwl
     2370            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
     2371                var = var(1:12)
     2372            ENDIF
     2373        ENDIF
     2374        IF ( var(1:12) == 'usm_t_green_'  .AND.  len(TRIM(var)) >= 13 )  THEN
     2375!--         green layers
     2376            READ(var(13:13), '(I1)', iostat=istat ) iwl
     2377            IF ( istat == 0  .AND.  iwl >= nzb_wall  .AND.  iwl <= nzt_wall )  THEN
     2378                var = var(1:11)
     2379            ENDIF
     2380        ENDIF
    24792381        IF ( (var(1:8) == 'usm_svf_'  .OR.  var(1:8) == 'usm_dif_')  .AND.  len(TRIM(var)) >= 13 )  THEN
    24802382!--         svf values to particular surface
     
    25312433             
    25322434          CASE ( 'usm_surfalb' )
    2533 !--           surface albedo
     2435!--           surface albedo, weighted average
    25342436              DO  m = 1, surf_usm_h%ns
    25352437                 i = surf_usm_h%i(m)
    25362438                 j = surf_usm_h%j(m)
    25372439                 k = surf_usm_h%k(m)
    2538                  temp_pf(k,j,i) = surf_usm_h%albedo_surf(m)
     2440                 temp_pf(k,j,i) = surf_usm_h%frac(0,m)     *                   &
     2441                                  surf_usm_h%albedo(0,m) +                     &
     2442                                  surf_usm_h%frac(1,m)     *                   &
     2443                                  surf_usm_h%albedo(1,m) +                     &
     2444                                  surf_usm_h%frac(2,m)     *                   &
     2445                                  surf_usm_h%albedo(2,m)
    25392446              ENDDO
    25402447              DO  l = 0, 3
     
    25432450                    j = surf_usm_v(l)%j(m)
    25442451                    k = surf_usm_v(l)%k(m)
    2545                     temp_pf(k,j,i) = surf_usm_v(l)%albedo_surf(m)
     2452                    temp_pf(k,j,i) = surf_usm_v(l)%frac(0,m)     *             &
     2453                                     surf_usm_v(l)%albedo(0,m) +               &
     2454                                     surf_usm_v(l)%frac(1,m)     *             &
     2455                                     surf_usm_v(l)%albedo(1,m) +               &
     2456                                     surf_usm_v(l)%frac(2,m)     *             &
     2457                                     surf_usm_v(l)%albedo(2,m)
    25462458                 ENDDO
    25472459              ENDDO
    25482460             
    25492461          CASE ( 'usm_surfemis' )
    2550 !--           surface albedo
     2462!--           surface emissivity, weighted average
    25512463              DO  m = 1, surf_usm_h%ns
    25522464                 i = surf_usm_h%i(m)
    25532465                 j = surf_usm_h%j(m)
    25542466                 k = surf_usm_h%k(m)
    2555                  temp_pf(k,j,i) = surf_usm_h%emiss_surf(m)
     2467                 temp_pf(k,j,i) =  surf_usm_h%frac(0,m)     *                  &
     2468                                   surf_usm_h%emissivity(0,m) +                &
     2469                                   surf_usm_h%frac(1,m)     *                  &
     2470                                   surf_usm_h%emissivity(1,m) +                &
     2471                                   surf_usm_h%frac(2,m)     *                  &
     2472                                   surf_usm_h%emissivity(2,m)
    25562473              ENDDO
    25572474              DO  l = 0, 3
     
    25602477                    j = surf_usm_v(l)%j(m)
    25612478                    k = surf_usm_v(l)%k(m)
    2562                     temp_pf(k,j,i) = surf_usm_v(l)%emiss_surf(m)
     2479                    temp_pf(k,j,i) = surf_usm_v(l)%frac(0,m)       *           &
     2480                                     surf_usm_v(l)%emissivity(0,m) +           &
     2481                                     surf_usm_v(l)%frac(1,m) *                 &
     2482                                     surf_usm_v(l)%emissivity(1,m) +           &
     2483                                     surf_usm_v(l)%frac(2,m)     *             &
     2484                                     surf_usm_v(l)%emissivity(2,m)
    25632485                 ENDDO
    25642486              ENDDO
     2487
     2488          CASE ( 'usm_surfwintrans' )
     2489!--           transmissivity window tiles
     2490              DO  m = 1, surf_usm_h%ns
     2491                 i = surf_usm_h%i(m)
     2492                 j = surf_usm_h%j(m)
     2493                 k = surf_usm_h%k(m)
     2494                 temp_pf(k,j,i) = surf_usm_h%transmissivity(m)
     2495              ENDDO
     2496              DO  l = 0, 3
     2497                 DO  m = 1, surf_usm_v(l)%ns
     2498                    i = surf_usm_v(l)%i(m)
     2499                    j = surf_usm_v(l)%j(m)
     2500                    k = surf_usm_v(l)%k(m)
     2501                    temp_pf(k,j,i) = surf_usm_v(l)%transmissivity(m)
     2502                 ENDDO
     2503
     2504              ENDDO
     2505
    25652506!
    25662507!-- Not adjusted so far             
     
    28412782              ENDIF
    28422783
     2784          CASE ( 'usm_wghf_window' )
     2785!--           array of heat flux from window ground (land, wall, roof)
     2786
     2787              IF ( av == 0 )  THEN
     2788                 DO  m = 1, surf_usm_h%ns
     2789                    i = surf_usm_h%i(m)
     2790                    j = surf_usm_h%j(m)
     2791                    k = surf_usm_h%k(m)
     2792                    temp_pf(k,j,i) = surf_usm_h%wghf_eb_window(m)
     2793                 ENDDO
     2794                 DO  l = 0, 3
     2795                    DO  m = 1, surf_usm_v(l)%ns
     2796                       i = surf_usm_v(l)%i(m)
     2797                       j = surf_usm_v(l)%j(m)
     2798                       k = surf_usm_v(l)%k(m)
     2799                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window(m)
     2800                    ENDDO
     2801                 ENDDO
     2802              ELSE
     2803                 DO  m = 1, surf_usm_h%ns
     2804                    i = surf_usm_h%i(m)
     2805                    j = surf_usm_h%j(m)
     2806                    k = surf_usm_h%k(m)
     2807                    temp_pf(k,j,i) = surf_usm_h%wghf_eb_window_av(m)
     2808                 ENDDO
     2809                 DO  l = 0, 3
     2810                    DO  m = 1, surf_usm_v(l)%ns
     2811                       i = surf_usm_v(l)%i(m)
     2812                       j = surf_usm_v(l)%j(m)
     2813                       k = surf_usm_v(l)%k(m)
     2814                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window_av(m)
     2815                    ENDDO
     2816                 ENDDO
     2817              ENDIF
     2818
     2819          CASE ( 'usm_wghf_green' )
     2820!--           array of heat flux from green ground (land, wall, roof)
     2821
     2822              IF ( av == 0 )  THEN
     2823                 DO  m = 1, surf_usm_h%ns
     2824                    i = surf_usm_h%i(m)
     2825                    j = surf_usm_h%j(m)
     2826                    k = surf_usm_h%k(m)
     2827                    temp_pf(k,j,i) = surf_usm_h%wghf_eb_green(m)
     2828                 ENDDO
     2829                 DO  l = 0, 3
     2830                    DO  m = 1, surf_usm_v(l)%ns
     2831                       i = surf_usm_v(l)%i(m)
     2832                       j = surf_usm_v(l)%j(m)
     2833                       k = surf_usm_v(l)%k(m)
     2834                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green(m)
     2835                    ENDDO
     2836                 ENDDO
     2837              ELSE
     2838                 DO  m = 1, surf_usm_h%ns
     2839                    i = surf_usm_h%i(m)
     2840                    j = surf_usm_h%j(m)
     2841                    k = surf_usm_h%k(m)
     2842                    temp_pf(k,j,i) = surf_usm_h%wghf_eb_green_av(m)
     2843                 ENDDO
     2844                 DO  l = 0, 3
     2845                    DO  m = 1, surf_usm_v(l)%ns
     2846                       i = surf_usm_v(l)%i(m)
     2847                       j = surf_usm_v(l)%j(m)
     2848                       k = surf_usm_v(l)%k(m)
     2849                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green_av(m)
     2850                    ENDDO
     2851                 ENDDO
     2852              ENDIF
     2853
     2854          CASE ( 'usm_iwghf' )
     2855!--           array of heat flux from indoor ground (land, wall, roof)
     2856              IF ( av == 0 )  THEN
     2857                 DO  m = 1, surf_usm_h%ns
     2858                    i = surf_usm_h%i(m)
     2859                    j = surf_usm_h%j(m)
     2860                    k = surf_usm_h%k(m)
     2861                    temp_pf(k,j,i) = surf_usm_h%iwghf_eb(m)
     2862                 ENDDO
     2863                 DO  l = 0, 3
     2864                    DO  m = 1, surf_usm_v(l)%ns
     2865                       i = surf_usm_v(l)%i(m)
     2866                       j = surf_usm_v(l)%j(m)
     2867                       k = surf_usm_v(l)%k(m)
     2868                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb(m)
     2869                    ENDDO
     2870                 ENDDO
     2871              ELSE
     2872                 DO  m = 1, surf_usm_h%ns
     2873                    i = surf_usm_h%i(m)
     2874                    j = surf_usm_h%j(m)
     2875                    k = surf_usm_h%k(m)
     2876                    temp_pf(k,j,i) = surf_usm_h%iwghf_eb_av(m)
     2877                 ENDDO
     2878                 DO  l = 0, 3
     2879                    DO  m = 1, surf_usm_v(l)%ns
     2880                       i = surf_usm_v(l)%i(m)
     2881                       j = surf_usm_v(l)%j(m)
     2882                       k = surf_usm_v(l)%k(m)
     2883                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_av(m)
     2884                    ENDDO
     2885                 ENDDO
     2886              ENDIF
     2887
     2888          CASE ( 'usm_iwghf_window' )
     2889!--           array of heat flux from indoor window ground (land, wall, roof)
     2890
     2891              IF ( av == 0 )  THEN
     2892                 DO  m = 1, surf_usm_h%ns
     2893                    i = surf_usm_h%i(m)
     2894                    j = surf_usm_h%j(m)
     2895                    k = surf_usm_h%k(m)
     2896                    temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window(m)
     2897                 ENDDO
     2898                 DO  l = 0, 3
     2899                    DO  m = 1, surf_usm_v(l)%ns
     2900                       i = surf_usm_v(l)%i(m)
     2901                       j = surf_usm_v(l)%j(m)
     2902                       k = surf_usm_v(l)%k(m)
     2903                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window(m)
     2904                    ENDDO
     2905                 ENDDO
     2906              ELSE
     2907                 DO  m = 1, surf_usm_h%ns
     2908                    i = surf_usm_h%i(m)
     2909                    j = surf_usm_h%j(m)
     2910                    k = surf_usm_h%k(m)
     2911                    temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window_av(m)
     2912                 ENDDO
     2913                 DO  l = 0, 3
     2914                    DO  m = 1, surf_usm_v(l)%ns
     2915                       i = surf_usm_v(l)%i(m)
     2916                       j = surf_usm_v(l)%j(m)
     2917                       k = surf_usm_v(l)%k(m)
     2918                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window_av(m)
     2919                    ENDDO
     2920                 ENDDO
     2921              ENDIF
     2922             
    28432923          CASE ( 'usm_t_surf' )
    28442924!--           surface temperature for surfaces
     
    28742954                 ENDDO
    28752955              ENDIF
     2956             
     2957          CASE ( 'usm_t_surf_window' )
     2958!--           surface temperature for window surfaces
     2959
     2960              IF ( av == 0 )  THEN
     2961                 DO  m = 1, surf_usm_h%ns
     2962                    i = surf_usm_h%i(m)
     2963                    j = surf_usm_h%j(m)
     2964                    k = surf_usm_h%k(m)
     2965                    temp_pf(k,j,i) = t_surf_window_h(m)
     2966                 ENDDO
     2967                 DO  l = 0, 3
     2968                    DO  m = 1, surf_usm_v(l)%ns
     2969                       i = surf_usm_v(l)%i(m)
     2970                       j = surf_usm_v(l)%j(m)
     2971                       k = surf_usm_v(l)%k(m)
     2972                       temp_pf(k,j,i) = t_surf_window_v(l)%t(m)
     2973                    ENDDO
     2974                 ENDDO
     2975
     2976              ELSE
     2977                 DO  m = 1, surf_usm_h%ns
     2978                    i = surf_usm_h%i(m)
     2979                    j = surf_usm_h%j(m)
     2980                    k = surf_usm_h%k(m)
     2981                    temp_pf(k,j,i) = surf_usm_h%t_surf_window_av(m)
     2982                 ENDDO
     2983                 DO  l = 0, 3
     2984                    DO  m = 1, surf_usm_v(l)%ns
     2985                       i = surf_usm_v(l)%i(m)
     2986                       j = surf_usm_v(l)%j(m)
     2987                       k = surf_usm_v(l)%k(m)
     2988                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_window_av(m)
     2989                    ENDDO
     2990
     2991                 ENDDO
     2992
     2993              ENDIF
     2994
     2995          CASE ( 'usm_t_surf_green' )
     2996!--           surface temperature for green surfaces
     2997
     2998              IF ( av == 0 )  THEN
     2999                 DO  m = 1, surf_usm_h%ns
     3000                    i = surf_usm_h%i(m)
     3001                    j = surf_usm_h%j(m)
     3002                    k = surf_usm_h%k(m)
     3003                    temp_pf(k,j,i) = t_surf_green_h(m)
     3004                 ENDDO
     3005                 DO  l = 0, 3
     3006                    DO  m = 1, surf_usm_v(l)%ns
     3007                       i = surf_usm_v(l)%i(m)
     3008                       j = surf_usm_v(l)%j(m)
     3009                       k = surf_usm_v(l)%k(m)
     3010                       temp_pf(k,j,i) = t_surf_green_v(l)%t(m)
     3011                    ENDDO
     3012                 ENDDO
     3013
     3014              ELSE
     3015                 DO  m = 1, surf_usm_h%ns
     3016                    i = surf_usm_h%i(m)
     3017                    j = surf_usm_h%j(m)
     3018                    k = surf_usm_h%k(m)
     3019                    temp_pf(k,j,i) = surf_usm_h%t_surf_green_av(m)
     3020                 ENDDO
     3021                 DO  l = 0, 3
     3022                    DO  m = 1, surf_usm_v(l)%ns
     3023                       i = surf_usm_v(l)%i(m)
     3024                       j = surf_usm_v(l)%j(m)
     3025                       k = surf_usm_v(l)%k(m)
     3026                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_green_av(m)
     3027                    ENDDO
     3028
     3029                 ENDDO
     3030
     3031              ENDIF
     3032
     3033          CASE ( 'usm_t_surf_whole' )
     3034!--           surface temperature for whole surfaces
     3035
     3036              IF ( av == 0 )  THEN
     3037                 DO  m = 1, surf_usm_h%ns
     3038                    i = surf_usm_h%i(m)
     3039                    j = surf_usm_h%j(m)
     3040                    k = surf_usm_h%k(m)
     3041                    temp_pf(k,j,i) = t_surf_whole_h(m)
     3042                 ENDDO
     3043                 DO  l = 0, 3
     3044                    DO  m = 1, surf_usm_v(l)%ns
     3045                       i = surf_usm_v(l)%i(m)
     3046                       j = surf_usm_v(l)%j(m)
     3047                       k = surf_usm_v(l)%k(m)
     3048                       temp_pf(k,j,i) = t_surf_whole_v(l)%t(m)
     3049                    ENDDO
     3050                 ENDDO
     3051
     3052              ELSE
     3053                 DO  m = 1, surf_usm_h%ns
     3054                    i = surf_usm_h%i(m)
     3055                    j = surf_usm_h%j(m)
     3056                    k = surf_usm_h%k(m)
     3057                    temp_pf(k,j,i) = surf_usm_h%t_surf_whole_av(m)
     3058                 ENDDO
     3059                 DO  l = 0, 3
     3060                    DO  m = 1, surf_usm_v(l)%ns
     3061                       i = surf_usm_v(l)%i(m)
     3062                       j = surf_usm_v(l)%j(m)
     3063                       k = surf_usm_v(l)%k(m)
     3064                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_whole_av(m)
     3065                    ENDDO
     3066
     3067                 ENDDO
     3068
     3069              ENDIF
     3070             
     3071          CASE ( 'usm_t_surf_10cm' )
     3072!--           near surface temperature for whole surfaces
     3073
     3074              IF ( av == 0 )  THEN
     3075                 DO  m = 1, surf_usm_h%ns
     3076                    i = surf_usm_h%i(m)
     3077                    j = surf_usm_h%j(m)
     3078                    k = surf_usm_h%k(m)
     3079                    temp_pf(k,j,i) = t_surf_10cm_h(m)
     3080                 ENDDO
     3081                 DO  l = 0, 3
     3082                    DO  m = 1, surf_usm_v(l)%ns
     3083                       i = surf_usm_v(l)%i(m)
     3084                       j = surf_usm_v(l)%j(m)
     3085                       k = surf_usm_v(l)%k(m)
     3086                       temp_pf(k,j,i) = t_surf_10cm_v(l)%t(m)
     3087                    ENDDO
     3088                 ENDDO
     3089
     3090              ELSE
     3091                 DO  m = 1, surf_usm_h%ns
     3092                    i = surf_usm_h%i(m)
     3093                    j = surf_usm_h%j(m)
     3094                    k = surf_usm_h%k(m)
     3095                    temp_pf(k,j,i) = surf_usm_h%t_surf_10cm_av(m)
     3096                 ENDDO
     3097                 DO  l = 0, 3
     3098                    DO  m = 1, surf_usm_v(l)%ns
     3099                       i = surf_usm_v(l)%i(m)
     3100                       j = surf_usm_v(l)%j(m)
     3101                       k = surf_usm_v(l)%k(m)
     3102                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_10cm_av(m)
     3103                    ENDDO
     3104
     3105                 ENDDO
     3106
     3107              ENDIF
     3108
    28763109             
    28773110          CASE ( 'usm_t_wall' )
     
    29093142              ENDIF
    29103143             
     3144          CASE ( 'usm_t_window' )
     3145!--           window temperature for iwl layer of walls and land
     3146              IF ( av == 0 )  THEN
     3147                 DO  m = 1, surf_usm_h%ns
     3148                    i = surf_usm_h%i(m)
     3149                    j = surf_usm_h%j(m)
     3150                    k = surf_usm_h%k(m)
     3151                    temp_pf(k,j,i) = t_window_h(iwl,m)
     3152                 ENDDO
     3153                 DO  l = 0, 3
     3154                    DO  m = 1, surf_usm_v(l)%ns
     3155                       i = surf_usm_v(l)%i(m)
     3156                       j = surf_usm_v(l)%j(m)
     3157                       k = surf_usm_v(l)%k(m)
     3158                       temp_pf(k,j,i) = t_window_v(l)%t(iwl,m)
     3159                    ENDDO
     3160                 ENDDO
     3161              ELSE
     3162                 DO  m = 1, surf_usm_h%ns
     3163                    i = surf_usm_h%i(m)
     3164                    j = surf_usm_h%j(m)
     3165                    k = surf_usm_h%k(m)
     3166                    temp_pf(k,j,i) = surf_usm_h%t_window_av(iwl,m)
     3167                 ENDDO
     3168                 DO  l = 0, 3
     3169                    DO  m = 1, surf_usm_v(l)%ns
     3170                       i = surf_usm_v(l)%i(m)
     3171                       j = surf_usm_v(l)%j(m)
     3172                       k = surf_usm_v(l)%k(m)
     3173                       temp_pf(k,j,i) = surf_usm_v(l)%t_window_av(iwl,m)
     3174                    ENDDO
     3175                 ENDDO
     3176              ENDIF
     3177
     3178          CASE ( 'usm_t_green' )
     3179!--           green temperature for  iwl layer of walls and land
     3180              IF ( av == 0 )  THEN
     3181                 DO  m = 1, surf_usm_h%ns
     3182                    i = surf_usm_h%i(m)
     3183                    j = surf_usm_h%j(m)
     3184                    k = surf_usm_h%k(m)
     3185                    temp_pf(k,j,i) = t_green_h(iwl,m)
     3186                 ENDDO
     3187                 DO  l = 0, 3
     3188                    DO  m = 1, surf_usm_v(l)%ns
     3189                       i = surf_usm_v(l)%i(m)
     3190                       j = surf_usm_v(l)%j(m)
     3191                       k = surf_usm_v(l)%k(m)
     3192                       temp_pf(k,j,i) = t_green_v(l)%t(iwl,m)
     3193                    ENDDO
     3194                 ENDDO
     3195              ELSE
     3196                 DO  m = 1, surf_usm_h%ns
     3197                    i = surf_usm_h%i(m)
     3198                    j = surf_usm_h%j(m)
     3199                    k = surf_usm_h%k(m)
     3200                    temp_pf(k,j,i) = surf_usm_h%t_green_av(iwl,m)
     3201                 ENDDO
     3202                 DO  l = 0, 3
     3203                    DO  m = 1, surf_usm_v(l)%ns
     3204                       i = surf_usm_v(l)%i(m)
     3205                       j = surf_usm_v(l)%j(m)
     3206                       k = surf_usm_v(l)%k(m)
     3207                       temp_pf(k,j,i) = surf_usm_v(l)%t_green_av(iwl,m)
     3208                    ENDDO
     3209                 ENDDO
     3210              ENDIF
     3211
     3212             
    29113213          CASE DEFAULT
    29123214              found = .FALSE.
    29133215             
    29143216        END SELECT
     3217
    29153218!
    29163219!--     Rearrange dimensions for NetCDF output
     
    29543257             var(1:11) == 'usm_rad_hf_'  .OR.                                               &
    29553258             var(1:9) == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_'  .OR.                   &
     3259             var(1:16) == 'usm_wghf_window_'  .OR. var(1:15) == 'usm_wghf_green_' .OR.      &
     3260             var(1:10) == 'usm_iwghf_'  .OR. var(1:17) == 'usm_iwghf_window_' .OR.          &
    29563261             var(1:10) == 'usm_t_surf'  .OR.  var(1:10) == 'usm_t_wall'  .OR.               &
     3262             var(1:17) == 'usm_t_surf_window'  .OR.  var(1:12) == 'usm_t_window'  .OR.      &
     3263             var(1:16) == 'usm_t_surf_green'  .OR.  var(1:16) == 'usm_t_surf_whole' .OR.    &
     3264             var(1:15) == 'usm_t_surf_10cm' .OR.                                            &
    29573265             var(1:9) == 'usm_surfz'  .OR.  var(1:7) == 'usm_svf'  .OR.                     &
    29583266             var(1:7) == 'usm_dif'  .OR.  var(1:11) == 'usm_surfcat'  .OR.                  &
    2959              var(1:11) == 'usm_surfalb'  .OR.  var(1:12) == 'usm_surfemis' )  THEN
     3267             var(1:11) == 'usm_surfalb'  .OR.  var(1:12) == 'usm_surfemis'  .OR.            &
     3268             var(1:16) == 'usm_surfwintrans' )  THEN
    29603269
    29613270            found = .TRUE.
     
    29723281    END SUBROUTINE usm_define_netcdf_grid
    29733282   
    2974    
    2975 !------------------------------------------------------------------------------!
    2976 !> Finds first model boundary crossed by a ray
    2977 !------------------------------------------------------------------------------!
    2978     PURE SUBROUTINE usm_find_boundary_face(origin, uvect, bdycross)
    2979    
    2980        IMPLICIT NONE
    2981        
    2982        INTEGER(iwp) ::  d       !<
    2983        INTEGER(iwp) ::  seldim  !< found fist crossing index
    2984 
    2985        INTEGER(iwp), DIMENSION(3)              ::  bdyd      !< boundary direction       
    2986        INTEGER(iwp), DIMENSION(4), INTENT(out) ::  bdycross  !< found boundary crossing (d, z, y, x)
    2987        
    2988        REAL(wp)                                ::  bdydim  !<
    2989        REAL(wp)                                ::  dist    !<
    2990        
    2991        REAL(wp), DIMENSION(3)             ::  crossdist  !< crossing distance
    2992        REAL(wp), DIMENSION(3), INTENT(in) ::  origin     !< ray origin
    2993        REAL(wp), DIMENSION(3), INTENT(in) ::  uvect      !< ray unit vector
    2994  
    2995 
    2996        bdydim       = nzut + .5_wp  !< top boundary
    2997        bdyd(1)      = isky
    2998        crossdist(1) = ( bdydim - origin(1) ) / uvect(1)  !< subroutine called only when uvect(1)>0
    2999 
    3000        IF ( uvect(2) == 0._wp )  THEN
    3001           crossdist(2) = huge(1._wp)
    3002        ELSE
    3003           IF ( uvect(2) >= 0._wp )  THEN
    3004              bdydim  = ny + .5_wp  !< north global boundary
    3005              bdyd(2) = inorthb
    3006           ELSE
    3007              bdydim  = -.5_wp  !< south global boundary
    3008              bdyd(2) = isouthb
    3009           ENDIF
    3010           crossdist(2) = ( bdydim - origin(2) ) / uvect(2)
    3011        ENDIF
    3012 
    3013        IF ( uvect(3) == 0._wp )  THEN
    3014           crossdist(3) = huge(1._wp)
    3015        ELSE
    3016           IF ( uvect(3) >= 0._wp )  THEN
    3017              bdydim  = nx + .5_wp  !< east global boundary
    3018              bdyd(3) = ieastb
    3019           ELSE
    3020              bdydim  = -.5_wp  !< west global boundary
    3021              bdyd(3) = iwestb
    3022           ENDIF
    3023           crossdist(3) = ( bdydim - origin(3) ) / uvect(3)
    3024        ENDIF
    3025 
    3026        seldim = minloc(crossdist, 1)
    3027        dist   = crossdist(seldim)
    3028        d      = bdyd(seldim)
    3029 
    3030        bdycross(1)   = d
    3031        bdycross(2:4) = NINT( origin(:) + uvect(:) * dist &
    3032                                        + .5_wp * (/ kdir(d), jdir(d), idir(d) /) )
    3033                        
    3034     END SUBROUTINE
    3035 
    3036 
    3037 !------------------------------------------------------------------------------!
    3038 !> Determines whether two faces are oriented towards each other
    3039 !------------------------------------------------------------------------------!
    3040     PURE LOGICAL FUNCTION usm_facing(x, y, z, d, x2, y2, z2, d2)
    3041         IMPLICIT NONE
    3042         INTEGER(iwp),   INTENT(in)  :: x, y, z, d, x2, y2, z2, d2
    3043      
    3044         usm_facing = .FALSE.
    3045         IF ( d==iroof  .AND.  d2==iroof ) RETURN
    3046         IF ( d==isky  .AND.  d2==isky ) RETURN
    3047         IF ( (d==isouth  .OR.  d==inorthb)  .AND.  (d2==isouth.OR.d2==inorthb) ) RETURN
    3048         IF ( (d==inorth  .OR.  d==isouthb)  .AND.  (d2==inorth.OR.d2==isouthb) ) RETURN
    3049         IF ( (d==iwest  .OR.  d==ieastb)  .AND.  (d2==iwest.OR.d2==ieastb) ) RETURN
    3050         IF ( (d==ieast  .OR.  d==iwestb)  .AND.  (d2==ieast.OR.d2==iwestb) ) RETURN
    3051 
    3052         SELECT CASE (d)
    3053             CASE (iroof)                   !< ground, roof
    3054                 IF ( z2 < z ) RETURN
    3055             CASE (isky)                    !< sky
    3056                 IF ( z2 > z ) RETURN
    3057             CASE (isouth, inorthb)         !< south facing
    3058                 IF ( y2 > y ) RETURN
    3059             CASE (inorth, isouthb)         !< north facing
    3060                 IF ( y2 < y ) RETURN
    3061             CASE (iwest, ieastb)           !< west facing
    3062                 IF ( x2 > x ) RETURN
    3063             CASE (ieast, iwestb)           !< east facing
    3064                 IF ( x2 < x ) RETURN
    3065         END SELECT
    3066 
    3067         SELECT CASE (d2)
    3068             CASE (iroof)                   !< ground, roof
    3069                 IF ( z < z2 ) RETURN
    3070             CASE (isky)                    !< sky
    3071                 IF ( z > z2 ) RETURN
    3072             CASE (isouth, inorthb)         !< south facing
    3073                 IF ( y > y2 ) RETURN
    3074             CASE (inorth, isouthb)         !< north facing
    3075                 IF ( y < y2 ) RETURN
    3076             CASE (iwest, ieastb)           !< west facing
    3077                 IF ( x > x2 ) RETURN
    3078             CASE (ieast, iwestb)           !< east facing
    3079                 IF ( x < x2 ) RETURN
    3080             CASE (-1)
    3081                 CONTINUE
    3082         END SELECT
    3083 
    3084         usm_facing = .TRUE.
    3085        
    3086     END FUNCTION usm_facing
    3087    
    30883283
    30893284!------------------------------------------------------------------------------!
     
    31023297!--     Calculate wall grid spacings.
    31033298!--     Temperature is defined at the center of the wall layers,
    3104 !--     whereas gradients/fluxes are defined at the edges (_stag)
    3105         DO k = nzb_wall, nzt_wall
    3106            zwn(k) = zwn_default(k)
    3107         ENDDO
    3108 !       
     3299!--     whereas gradients/fluxes are defined at the edges (_stag)     
    31093300!--     apply for all particular surface grids. First for horizontal surfaces
    31103301        DO  m = 1, surf_usm_h%ns
    3111            surf_usm_h%zw(:,m)             = zwn(:) *                           &
    3112                                             surf_usm_h%thickness_wall(m)
     3302
    31133303           surf_usm_h%dz_wall(nzb_wall,m) = surf_usm_h%zw(nzb_wall,m)
    31143304           DO k = nzb_wall+1, nzt_wall
     
    31163306                                         surf_usm_h%zw(k-1,m)
    31173307           ENDDO
     3308           surf_usm_h%dz_window(nzb_wall,m) = surf_usm_h%zw_window(nzb_wall,m)
     3309           DO k = nzb_wall+1, nzt_wall
     3310               surf_usm_h%dz_window(k,m) = surf_usm_h%zw_window(k,m) -         &
     3311                                         surf_usm_h%zw_window(k-1,m)
     3312           ENDDO
     3313           surf_usm_h%dz_green(nzb_wall,m) = surf_usm_h%zw_green(nzb_wall,m)
     3314           DO k = nzb_wall+1, nzt_wall
     3315               surf_usm_h%dz_green(k,m) = surf_usm_h%zw_green(k,m) -           &
     3316                                         surf_usm_h%zw_green(k-1,m)
     3317           ENDDO
    31183318           
    31193319           surf_usm_h%dz_wall(nzt_wall+1,m) = surf_usm_h%dz_wall(nzt_wall,m)
     
    31243324           ENDDO
    31253325           surf_usm_h%dz_wall_stag(nzt_wall,m) = surf_usm_h%dz_wall(nzt_wall,m)
     3326           
     3327           surf_usm_h%dz_window(nzt_wall+1,m) = surf_usm_h%dz_window(nzt_wall,m)
     3328
     3329           DO k = nzb_wall, nzt_wall-1
     3330               surf_usm_h%dz_window_stag(k,m) = 0.5 * (                        &
     3331                           surf_usm_h%dz_window(k+1,m) + surf_usm_h%dz_window(k,m) )
     3332           ENDDO
     3333           surf_usm_h%dz_window_stag(nzt_wall,m) = surf_usm_h%dz_window(nzt_wall,m)
     3334
     3335           surf_usm_h%dz_green(nzt_wall+1,m) = surf_usm_h%dz_green(nzt_wall,m)
     3336
     3337           DO k = nzb_wall, nzt_wall-1
     3338               surf_usm_h%dz_green_stag(k,m) = 0.5 * (                         &
     3339                           surf_usm_h%dz_green(k+1,m) + surf_usm_h%dz_green(k,m) )
     3340           ENDDO
     3341           surf_usm_h%dz_green_stag(nzt_wall,m) = surf_usm_h%dz_green(nzt_wall,m)
    31263342        ENDDO
    3127         surf_usm_h%ddz_wall      = 1.0_wp / surf_usm_h%dz_wall
    3128         surf_usm_h%ddz_wall_stag = 1.0_wp / surf_usm_h%dz_wall_stag
     3343        surf_usm_h%ddz_wall        = 1.0_wp / surf_usm_h%dz_wall
     3344        surf_usm_h%ddz_wall_stag   = 1.0_wp / surf_usm_h%dz_wall_stag
     3345        surf_usm_h%ddz_window      = 1.0_wp / surf_usm_h%dz_window
     3346        surf_usm_h%ddz_window_stag = 1.0_wp / surf_usm_h%dz_window_stag
     3347        surf_usm_h%ddz_green       = 1.0_wp / surf_usm_h%dz_green
     3348        surf_usm_h%ddz_green_stag  = 1.0_wp / surf_usm_h%dz_green_stag
    31293349!       
    31303350!--     For vertical surfaces
    31313351        DO  l = 0, 3
    31323352           DO  m = 1, surf_usm_v(l)%ns
    3133               surf_usm_v(l)%zw(:,m)             = zwn(:) *                     &
    3134                                                   surf_usm_v(l)%thickness_wall(m)
    31353353              surf_usm_v(l)%dz_wall(nzb_wall,m) = surf_usm_v(l)%zw(nzb_wall,m)
    31363354              DO k = nzb_wall+1, nzt_wall
    31373355                  surf_usm_v(l)%dz_wall(k,m) = surf_usm_v(l)%zw(k,m) -         &
    31383356                                               surf_usm_v(l)%zw(k-1,m)
     3357              ENDDO
     3358              surf_usm_v(l)%dz_window(nzb_wall,m) = surf_usm_v(l)%zw_window(nzb_wall,m)
     3359              DO k = nzb_wall+1, nzt_wall
     3360                  surf_usm_v(l)%dz_window(k,m) = surf_usm_v(l)%zw_window(k,m) - &
     3361                                               surf_usm_v(l)%zw_window(k-1,m)
     3362              ENDDO
     3363              surf_usm_v(l)%dz_green(nzb_wall,m) = surf_usm_v(l)%zw_green(nzb_wall,m)
     3364              DO k = nzb_wall+1, nzt_wall
     3365                  surf_usm_v(l)%dz_green(k,m) = surf_usm_v(l)%zw_green(k,m) - &
     3366                                               surf_usm_v(l)%zw_green(k-1,m)
    31393367              ENDDO
    31403368           
     
    31493377              surf_usm_v(l)%dz_wall_stag(nzt_wall,m) =                         &
    31503378                                              surf_usm_v(l)%dz_wall(nzt_wall,m)
     3379              surf_usm_v(l)%dz_window(nzt_wall+1,m) =                            &
     3380                                              surf_usm_v(l)%dz_window(nzt_wall,m)
     3381
     3382              DO k = nzb_wall, nzt_wall-1
     3383                  surf_usm_v(l)%dz_window_stag(k,m) = 0.5 * (                    &
     3384                                                surf_usm_v(l)%dz_window(k+1,m) + &
     3385                                                surf_usm_v(l)%dz_window(k,m) )
     3386              ENDDO
     3387              surf_usm_v(l)%dz_window_stag(nzt_wall,m) =                         &
     3388                                              surf_usm_v(l)%dz_window(nzt_wall,m)
     3389              surf_usm_v(l)%dz_green(nzt_wall+1,m) =                            &
     3390                                              surf_usm_v(l)%dz_green(nzt_wall,m)
     3391
     3392              DO k = nzb_wall, nzt_wall-1
     3393                  surf_usm_v(l)%dz_green_stag(k,m) = 0.5 * (                    &
     3394                                                surf_usm_v(l)%dz_green(k+1,m) + &
     3395                                                surf_usm_v(l)%dz_green(k,m) )
     3396              ENDDO
     3397              surf_usm_v(l)%dz_green_stag(nzt_wall,m) =                         &
     3398                                              surf_usm_v(l)%dz_green(nzt_wall,m)
    31513399           ENDDO
    3152            surf_usm_v(l)%ddz_wall      = 1.0_wp / surf_usm_v(l)%dz_wall
    3153            surf_usm_v(l)%ddz_wall_stag = 1.0_wp / surf_usm_v(l)%dz_wall_stag
     3400           surf_usm_v(l)%ddz_wall        = 1.0_wp / surf_usm_v(l)%dz_wall
     3401           surf_usm_v(l)%ddz_wall_stag   = 1.0_wp / surf_usm_v(l)%dz_wall_stag
     3402           surf_usm_v(l)%ddz_window      = 1.0_wp / surf_usm_v(l)%dz_window
     3403           surf_usm_v(l)%ddz_window_stag = 1.0_wp / surf_usm_v(l)%dz_window_stag
     3404           surf_usm_v(l)%ddz_green       = 1.0_wp / surf_usm_v(l)%dz_green
     3405           surf_usm_v(l)%ddz_green_stag  = 1.0_wp / surf_usm_v(l)%dz_green_stag
    31543406        ENDDO     
    31553407
     
    31683420!------------------------------------------------------------------------------!
    31693421    SUBROUTINE usm_init_urban_surface
     3422
     3423        USE arrays_3d,                                                         &
     3424            ONLY:  zw
     3425
     3426        USE netcdf_data_input_mod,                                             &
     3427            ONLY:  building_pars_f, building_type_f, terrain_height_f
    31703428   
    31713429        IMPLICIT NONE
    31723430
    3173         INTEGER(iwp) ::  i, j, k, l, m            !< running indices
    3174         REAL(wp)     ::  c, d, tin, exn
     3431        INTEGER(iwp) ::  i                   !< loop index x-dirction
     3432        INTEGER(iwp) ::  ind_emis_wall       !< index in input list for wall emissivity
     3433        INTEGER(iwp) ::  ind_emis_green      !< index in input list for green emissivity
     3434        INTEGER(iwp) ::  ind_emis_win        !< index in input list for window emissivity
     3435        INTEGER(iwp) ::  ind_green_frac_w    !< index in input list for green fraction on wall
     3436        INTEGER(iwp) ::  ind_green_frac_r    !< index in input list for green fraction on roof
     3437        INTEGER(iwp) ::  ind_hc1             !< index in input list for heat capacity at first wall layer
     3438        INTEGER(iwp) ::  ind_hc2             !< index in input list for heat capacity at second wall layer
     3439        INTEGER(iwp) ::  ind_hc3             !< index in input list for heat capacity at third wall layer
     3440        INTEGER(iwp) ::  ind_lai_r           !< index in input list for LAI on roof
     3441        INTEGER(iwp) ::  ind_lai_w           !< index in input list for LAI on wall
     3442        INTEGER(iwp) ::  ind_tc1             !< index in input list for thermal conductivity at first wall layer
     3443        INTEGER(iwp) ::  ind_tc2             !< index in input list for thermal conductivity at second wall layer
     3444        INTEGER(iwp) ::  ind_tc3             !< index in input list for thermal conductivity at third wall layer
     3445        INTEGER(iwp) ::  ind_trans           !< index in input list for window transmissivity
     3446        INTEGER(iwp) ::  ind_wall_frac       !< index in input list for wall fraction
     3447        INTEGER(iwp) ::  ind_win_frac        !< index in input list for window fraction
     3448        INTEGER(iwp) ::  ind_z0              !< index in input list for z0
     3449        INTEGER(iwp) ::  ind_z0qh            !< index in input list for z0h / z0q
     3450        INTEGER(iwp) ::  j                   !< loop index y-dirction
     3451        INTEGER(iwp) ::  k                   !< loop index z-dirction
     3452        INTEGER(iwp) ::  l                   !< loop index surface orientation
     3453        INTEGER(iwp) ::  m                   !< loop index surface element
     3454        INTEGER(iwp) ::  st                  !< dummy 
     3455
     3456        REAL(wp)     ::  c, d, tin, twin, exn
     3457        REAL(wp)     ::  ground_floor_level_l         !< local height of ground floor level
     3458        REAL(wp)     ::  z_agl                        !< height above ground
    31753459
    31763460!
     
    31873471            lsf_surf = .FALSE.
    31883472        ENDIF
    3189        
    3190 !--     init anthropogenic sources of heat
    3191         CALL usm_allocate_urban_surface()
    3192        
    3193 !--     read the surface_types array somewhere
     3473
     3474!
     3475!--     Flag surface elements belonging to the ground floor level. Therefore,
     3476!--     use terrain height array from file, if available. This flag is later used
     3477!--     to control initialization of surface attributes.
     3478        surf_usm_h%ground_level = .FALSE.
     3479        DO  m = 1, surf_usm_h%ns
     3480           i = surf_usm_h%i(m)
     3481           j = surf_usm_h%j(m)
     3482           k = surf_usm_h%k(m)
     3483!
     3484!--        Get local ground level. If no ground level is given in input file,
     3485!--        use default value.
     3486           ground_floor_level_l = ground_floor_level
     3487           IF ( building_pars_f%from_file )  THEN
     3488              IF ( building_pars_f%pars_xy(ind_gflh,j,i) /=                    &
     3489                   building_pars_f%fill )  &
     3490                 ground_floor_level_l = building_pars_f%pars_xy(ind_gflh,j,i)         
     3491           ENDIF
     3492!
     3493!--        Determine height of surface element above ground level
     3494           IF (  terrain_height_f%from_file )  THEN
     3495              z_agl = zw(k) - terrain_height_f%var(j,i)
     3496           ELSE
     3497              z_agl = zw(k)
     3498           ENDIF
     3499!
     3500!--        Set flag for ground level
     3501           IF ( z_agl <= ground_floor_level_l )                                &
     3502              surf_usm_h%ground_level(m) = .TRUE.
     3503        ENDDO
     3504
     3505        DO  l = 0, 3
     3506           surf_usm_v(l)%ground_level = .FALSE.
     3507           DO  m = 1, surf_usm_v(l)%ns
     3508              i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
     3509              j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
     3510              k = surf_usm_v(l)%k(m)
     3511!
     3512!--           Get local ground level. If no ground level is given in input file,
     3513!--           use default value.
     3514              ground_floor_level_l = ground_floor_level
     3515              IF ( building_pars_f%from_file )  THEN
     3516                 IF ( building_pars_f%pars_xy(ind_gflh,j,i) /=                 &
     3517                      building_pars_f%fill ) &
     3518                    ground_floor_level_l = building_pars_f%pars_xy(ind_gflh,j,i)
     3519              ENDIF
     3520!
     3521!--           Determine height of surface element above ground level. Please
     3522!--           note, height of surface element is determined with respect to
     3523!--           its height of the adjoing atmospheric grid point.
     3524              IF (  terrain_height_f%from_file )  THEN
     3525                 z_agl = zw(k) - terrain_height_f%var(j-surf_usm_v(l)%joff,    &
     3526                                                      i-surf_usm_v(l)%ioff)
     3527              ELSE
     3528                 z_agl = zw(k)
     3529              ENDIF
     3530!
     3531!--           Set flag for ground level
     3532              IF ( z_agl <= ground_floor_level_l )                                &
     3533                 surf_usm_v(l)%ground_level(m) = .TRUE.
     3534
     3535           ENDDO
     3536        ENDDO
     3537!
     3538!--     Initialize urban-type surface attribute. According to initialization in
     3539!--     land-surface model, follow a 3-level approach.
     3540!--     Level 1 - initialization via default attributes
     3541        DO  m = 1, surf_usm_h%ns
     3542!
     3543!--        Now, all horizontal surfaces are roof surfaces (?)
     3544           surf_usm_h%isroof_surf(m)   = .TRUE.
     3545           surf_usm_h%surface_types(m) = roof_category         !< default category for root surface
     3546!
     3547!--        In order to distinguish between ground floor level and
     3548!--        above-ground-floor level surfaces, set input indices.
     3549           ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
     3550                                     surf_usm_h%ground_level(m) )
     3551           ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
     3552                                     surf_usm_h%ground_level(m) )
     3553           ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
     3554                                     surf_usm_h%ground_level(m) )
     3555           ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
     3556                                     surf_usm_h%ground_level(m) )
     3557           ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
     3558                                     surf_usm_h%ground_level(m) )
     3559           ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
     3560                                     surf_usm_h%ground_level(m) )
     3561           ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
     3562                                     surf_usm_h%ground_level(m) )
     3563           ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
     3564                                     surf_usm_h%ground_level(m) )
     3565           ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
     3566                                     surf_usm_h%ground_level(m) )
     3567           ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
     3568                                     surf_usm_h%ground_level(m) )
     3569           ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
     3570                                     surf_usm_h%ground_level(m) )
     3571           ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
     3572                                     surf_usm_h%ground_level(m) )
     3573           ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
     3574                                     surf_usm_h%ground_level(m) )
     3575           ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
     3576                                     surf_usm_h%ground_level(m) )
     3577           ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
     3578                                     surf_usm_h%ground_level(m) )
     3579           ind_trans        = MERGE( ind_trans_gfl,        ind_trans_agfl,        &
     3580                                     surf_usm_h%ground_level(m) )
     3581           ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
     3582                                     surf_usm_h%ground_level(m) )
     3583           ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
     3584                                     surf_usm_h%ground_level(m) )
     3585!
     3586!--        Initialize relatvie wall- (0), green- (1) and window (2) fractions
     3587           surf_usm_h%frac(0,m)  = building_pars(ind_wall_frac,building_type)   
     3588           surf_usm_h%frac(1,m)  = building_pars(ind_green_frac_r,building_type) 
     3589           surf_usm_h%frac(2,m)  = building_pars(ind_win_frac,building_type) 
     3590           surf_usm_h%lai(m)     = building_pars(ind_green_frac_r,building_type) 
     3591
     3592           surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,building_type) 
     3593           surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
     3594           surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
     3595           surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,building_type)   
     3596           surf_usm_h%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,building_type) 
     3597           surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
     3598           surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
     3599           surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,building_type)   
     3600           surf_usm_h%rho_c_green(nzb_wall,m)   = building_pars(ind_hc1,building_type) 
     3601           surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
     3602           surf_usm_h%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
     3603           surf_usm_h%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,building_type)   
     3604           surf_usm_h%lambda_h_green(nzb_wall,m)   = building_pars(ind_tc1,building_type) 
     3605           surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
     3606           surf_usm_h%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
     3607           surf_usm_h%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,building_type)
     3608           surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1,building_type) 
     3609           surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
     3610           surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
     3611           surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,building_type)   
     3612           surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1,building_type) 
     3613           surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
     3614           surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
     3615           surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,building_type)   
     3616
     3617           surf_usm_h%target_temp_summer(m)  = building_pars(12,building_type)   
     3618           surf_usm_h%target_temp_winter(m)  = building_pars(13,building_type)   
     3619!
     3620!--        emissivity of wall-, green- and window fraction
     3621           surf_usm_h%emissivity(0,m)        = building_pars(ind_emis_wall,building_type)
     3622           surf_usm_h%emissivity(1,m)        = building_pars(ind_emis_green,building_type)
     3623           surf_usm_h%emissivity(2,m)        = building_pars(ind_emis_win,building_type)
     3624
     3625           surf_usm_h%transmissivity(m)      = building_pars(ind_trans,building_type)
     3626
     3627           surf_usm_h%z0(m)                  = building_pars(ind_z0,building_type)
     3628           surf_usm_h%z0h(m)                 = building_pars(ind_z0qh,building_type)
     3629           surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,building_type)
     3630!
     3631!--        albedo type for wall fraction, green fraction, window fraction
     3632           surf_usm_h%albedo_type(0,m)       = INT( building_pars(ind_alb_wall,building_type)  )
     3633           surf_usm_h%albedo_type(1,m)       = INT( building_pars(ind_alb_green,building_type) )
     3634           surf_usm_h%albedo_type(2,m)       = INT( building_pars(ind_alb_win,building_type)   )
     3635
     3636           surf_usm_h%zw(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
     3637           surf_usm_h%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
     3638           surf_usm_h%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
     3639           surf_usm_h%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
     3640           
     3641           surf_usm_h%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
     3642           surf_usm_h%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
     3643           surf_usm_h%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
     3644           surf_usm_h%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
     3645           
     3646           surf_usm_h%zw_window(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
     3647           surf_usm_h%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
     3648           surf_usm_h%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
     3649           surf_usm_h%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
     3650
     3651           surf_usm_h%c_surface(m)           = building_pars(45,building_type) 
     3652           surf_usm_h%lambda_surf(m)         = building_pars(46,building_type) 
     3653           surf_usm_h%c_surface_green(m)     = building_pars(45,building_type) 
     3654           surf_usm_h%lambda_surf_green(m)   = building_pars(46,building_type) 
     3655           surf_usm_h%c_surface_window(m)    = building_pars(45,building_type) 
     3656           surf_usm_h%lambda_surf_window(m)  = building_pars(46,building_type) 
     3657
     3658        ENDDO
     3659
     3660        DO  l = 0, 3
     3661           DO  m = 1, surf_usm_v(l)%ns
     3662
     3663              surf_usm_v(l)%surface_types(m) = wall_category         !< default category for root surface
     3664!
     3665!--           In order to distinguish between ground floor level and
     3666!--           above-ground-floor level surfaces, set input indices.
     3667              ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
     3668                                        surf_usm_v(l)%ground_level(m) )
     3669              ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
     3670                                        surf_usm_v(l)%ground_level(m) )
     3671              ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
     3672                                        surf_usm_v(l)%ground_level(m) )
     3673              ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
     3674                                        surf_usm_v(l)%ground_level(m) )
     3675              ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
     3676                                        surf_usm_v(l)%ground_level(m) )
     3677              ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
     3678                                        surf_usm_v(l)%ground_level(m) )
     3679              ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
     3680                                        surf_usm_v(l)%ground_level(m) )
     3681              ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
     3682                                        surf_usm_v(l)%ground_level(m) )
     3683              ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
     3684                                        surf_usm_v(l)%ground_level(m) )
     3685              ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
     3686                                        surf_usm_v(l)%ground_level(m) )
     3687              ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
     3688                                        surf_usm_v(l)%ground_level(m) )
     3689              ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
     3690                                        surf_usm_v(l)%ground_level(m) )
     3691              ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
     3692                                        surf_usm_v(l)%ground_level(m) )
     3693              ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
     3694                                        surf_usm_v(l)%ground_level(m) )
     3695              ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
     3696                                        surf_usm_v(l)%ground_level(m) )
     3697              ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,         &
     3698                                        surf_usm_v(l)%ground_level(m) )
     3699              ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
     3700                                        surf_usm_v(l)%ground_level(m) )
     3701              ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
     3702                                        surf_usm_v(l)%ground_level(m) )
     3703
     3704!
     3705!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
     3706              surf_usm_v(l)%frac(0,m)              = building_pars(ind_wall_frac,building_type)   
     3707              surf_usm_v(l)%frac(1,m)              = building_pars(ind_green_frac_w,building_type)
     3708              surf_usm_v(l)%frac(2,m)              = building_pars(ind_win_frac,building_type) 
     3709              surf_usm_v(l)%lai(m)                 = building_pars(ind_lai_w,building_type) 
     3710
     3711              surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,building_type) 
     3712              surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
     3713              surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
     3714              surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,building_type)   
     3715             
     3716              surf_usm_v(l)%rho_c_green(nzb_wall,m)   = building_pars(ind_hc1,building_type) 
     3717              surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
     3718              surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
     3719              surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,building_type)   
     3720             
     3721              surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1,building_type) 
     3722              surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
     3723              surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
     3724              surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,building_type)   
     3725
     3726              surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,building_type) 
     3727              surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
     3728              surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
     3729              surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,building_type)   
     3730             
     3731              surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = building_pars(ind_tc1,building_type) 
     3732              surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
     3733              surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
     3734              surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,building_type)   
     3735
     3736              surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1,building_type) 
     3737              surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,building_type)
     3738              surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
     3739              surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,building_type)   
     3740
     3741              surf_usm_v(l)%target_temp_summer(m)  = building_pars(12,building_type)   
     3742              surf_usm_v(l)%target_temp_winter(m)  = building_pars(13,building_type)   
     3743!
     3744!--           emissivity of wall-, green- and window fraction
     3745              surf_usm_v(l)%emissivity(0,m)        = building_pars(ind_emis_wall,building_type)
     3746              surf_usm_v(l)%emissivity(1,m)        = building_pars(ind_emis_green,building_type)
     3747              surf_usm_v(l)%emissivity(2,m)        = building_pars(ind_emis_win,building_type)
     3748
     3749              surf_usm_v(l)%transmissivity(m)      = building_pars(ind_trans,building_type)
     3750
     3751              surf_usm_v(l)%z0(m)                  = building_pars(ind_z0,building_type)
     3752              surf_usm_v(l)%z0h(m)                 = building_pars(ind_z0qh,building_type)
     3753              surf_usm_v(l)%z0q(m)                 = building_pars(ind_z0qh,building_type)
     3754
     3755              surf_usm_v(l)%albedo_type(0,m)       = INT( building_pars(ind_alb_wall,building_type) )
     3756              surf_usm_v(l)%albedo_type(1,m)       = INT( building_pars(ind_alb_green,building_type) )
     3757              surf_usm_v(l)%albedo_type(2,m)       = INT( building_pars(ind_alb_win,building_type) )
     3758
     3759              surf_usm_v(l)%zw(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
     3760              surf_usm_v(l)%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
     3761              surf_usm_v(l)%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
     3762              surf_usm_v(l)%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
     3763             
     3764              surf_usm_v(l)%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
     3765              surf_usm_v(l)%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
     3766              surf_usm_v(l)%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
     3767              surf_usm_v(l)%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
     3768
     3769              surf_usm_v(l)%zw_window(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
     3770              surf_usm_v(l)%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
     3771              surf_usm_v(l)%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
     3772              surf_usm_v(l)%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
     3773
     3774              surf_usm_v(l)%c_surface(m)           = building_pars(45,building_type) 
     3775              surf_usm_v(l)%lambda_surf(m)         = building_pars(46,building_type)
     3776              surf_usm_v(l)%c_surface_green(m)     = building_pars(45,building_type) 
     3777              surf_usm_v(l)%lambda_surf_green(m)   = building_pars(46,building_type)
     3778              surf_usm_v(l)%c_surface_window(m)    = building_pars(45,building_type) 
     3779              surf_usm_v(l)%lambda_surf_window(m)  = building_pars(46,building_type)
     3780
     3781           ENDDO
     3782        ENDDO
     3783!
     3784!--     Level 2 - initialization via building type read from file
     3785        IF ( building_type_f%from_file )  THEN
     3786           DO  m = 1, surf_usm_h%ns
     3787              i = surf_usm_h%i(m)
     3788              j = surf_usm_h%j(m)
     3789!
     3790!--           For the moment, limit building type to 6 (to overcome errors in input file).
     3791              st = building_type_f%var(j,i)
     3792              IF ( st /= building_type_f%fill )  THEN
     3793
     3794!
     3795!--              In order to distinguish between ground floor level and
     3796!--              above-ground-floor level surfaces, set input indices.
     3797                 ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
     3798                                           surf_usm_h%ground_level(m) )
     3799                 ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
     3800                                           surf_usm_h%ground_level(m) )
     3801                 ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
     3802                                           surf_usm_h%ground_level(m) )
     3803                 ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
     3804                                           surf_usm_h%ground_level(m) )
     3805                 ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
     3806                                           surf_usm_h%ground_level(m) )
     3807                 ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
     3808                                           surf_usm_h%ground_level(m) )
     3809                 ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
     3810                                           surf_usm_h%ground_level(m) )
     3811                 ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
     3812                                           surf_usm_h%ground_level(m) )
     3813                 ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
     3814                                           surf_usm_h%ground_level(m) )
     3815                 ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
     3816                                           surf_usm_h%ground_level(m) )
     3817                 ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
     3818                                           surf_usm_h%ground_level(m) )
     3819                 ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
     3820                                           surf_usm_h%ground_level(m) )
     3821                 ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
     3822                                           surf_usm_h%ground_level(m) )
     3823                 ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
     3824                                           surf_usm_h%ground_level(m) )
     3825                 ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
     3826                                           surf_usm_h%ground_level(m) )
     3827                 ind_trans        = MERGE( ind_trans_gfl,        ind_trans_agfl,        &
     3828                                           surf_usm_h%ground_level(m) )
     3829                 ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
     3830                                           surf_usm_h%ground_level(m) )
     3831                 ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
     3832                                           surf_usm_h%ground_level(m) )
     3833
     3834!
     3835!--              Initialize relatvie wall- (0), green- (1) and window (2) fractions
     3836                 surf_usm_h%frac(0,m)   = building_pars(ind_wall_frac,st)   
     3837                 surf_usm_h%frac(1,m)   = building_pars(ind_green_frac_r,st) 
     3838                 surf_usm_h%frac(2,m)   = building_pars(ind_win_frac,st) 
     3839                 surf_usm_h%lai(m)      = building_pars(ind_green_frac_r,st) 
     3840
     3841                 surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,st) 
     3842                 surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,st)
     3843                 surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,st)
     3844                 surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,st)   
     3845                 surf_usm_h%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,st) 
     3846                 surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,st)
     3847                 surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,st)
     3848                 surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,st)   
     3849                 
     3850                 surf_usm_h%rho_c_green(nzb_wall,m)   = building_pars(ind_hc1,st) 
     3851                 surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,st)
     3852                 surf_usm_h%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,st)
     3853                 surf_usm_h%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,st)   
     3854                 surf_usm_h%lambda_h_green(nzb_wall,m)   = building_pars(ind_tc1,st) 
     3855                 surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,st)
     3856                 surf_usm_h%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,st)
     3857                 surf_usm_h%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,st)   
     3858               
     3859                 surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1,st) 
     3860                 surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,st)
     3861                 surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,st)
     3862                 surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,st)   
     3863                 surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1,st) 
     3864                 surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,st)
     3865                 surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,st)
     3866                 surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,st)   
     3867
     3868                 surf_usm_h%target_temp_summer(m)  = building_pars(12,st)   
     3869                 surf_usm_h%target_temp_winter(m)  = building_pars(13,st)   
     3870!
     3871!--              emissivity of wall-, green- and window fraction
     3872                 surf_usm_h%emissivity(0,m)        = building_pars(ind_emis_wall,st)
     3873                 surf_usm_h%emissivity(1,m)        = building_pars(ind_emis_green,st)
     3874                 surf_usm_h%emissivity(2,m)        = building_pars(ind_emis_win,st)
     3875
     3876                 surf_usm_h%transmissivity(m)      = building_pars(ind_trans,st)
     3877
     3878                 surf_usm_h%z0(m)                  = building_pars(ind_z0,st)
     3879                 surf_usm_h%z0h(m)                 = building_pars(ind_z0qh,st)
     3880                 surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,st)
     3881!
     3882!--              albedo type for wall fraction, green fraction, window fraction
     3883                 surf_usm_h%albedo_type(0,m)       = INT( building_pars(ind_alb_wall,st) )
     3884                 surf_usm_h%albedo_type(1,m)       = INT( building_pars(ind_alb_green,st) )
     3885                 surf_usm_h%albedo_type(2,m)       = INT( building_pars(ind_alb_win,st) )
     3886
     3887                 surf_usm_h%zw(nzb_wall,m)         = building_pars(ind_thick_1,st)
     3888                 surf_usm_h%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
     3889                 surf_usm_h%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
     3890                 surf_usm_h%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
     3891                 
     3892                 surf_usm_h%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,st)
     3893                 surf_usm_h%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
     3894                 surf_usm_h%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
     3895                 surf_usm_h%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
     3896
     3897                 surf_usm_h%zw_window(nzb_wall,m)         = building_pars(ind_thick_1,st)
     3898                 surf_usm_h%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
     3899                 surf_usm_h%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
     3900                 surf_usm_h%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
     3901
     3902                 surf_usm_h%c_surface(m)           = building_pars(45,st) 
     3903                 surf_usm_h%lambda_surf(m)         = building_pars(46,st)
     3904                 surf_usm_h%c_surface_green(m)     = building_pars(45,st) 
     3905                 surf_usm_h%lambda_surf_green(m)   = building_pars(46,st)
     3906                 surf_usm_h%c_surface_window(m)    = building_pars(45,st) 
     3907                 surf_usm_h%lambda_surf_window(m)  = building_pars(46,st)
     3908
     3909              ENDIF
     3910           ENDDO
     3911
     3912           DO  l = 0, 3
     3913              DO  m = 1, surf_usm_v(l)%ns
     3914                 i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
     3915                 j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
     3916!
     3917!--              For the moment, limit building type to 6 (to overcome errors in input file).
     3918
     3919                 st = building_type_f%var(j,i)
     3920                 IF ( st /= building_type_f%fill )  THEN
     3921
     3922!
     3923!--                 In order to distinguish between ground floor level and
     3924!--                 above-ground-floor level surfaces, set input indices.
     3925                    ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
     3926                                              surf_usm_v(l)%ground_level(m) )
     3927                    ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
     3928                                              surf_usm_v(l)%ground_level(m) )
     3929                    ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
     3930                                              surf_usm_v(l)%ground_level(m) )
     3931                    ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
     3932                                              surf_usm_v(l)%ground_level(m) )
     3933                    ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
     3934                                              surf_usm_v(l)%ground_level(m) )
     3935                    ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
     3936                                              surf_usm_v(l)%ground_level(m) )
     3937                    ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
     3938                                              surf_usm_v(l)%ground_level(m) )
     3939                    ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
     3940                                              surf_usm_v(l)%ground_level(m) )
     3941                    ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
     3942                                              surf_usm_v(l)%ground_level(m) )
     3943                    ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
     3944                                              surf_usm_v(l)%ground_level(m) )
     3945                    ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
     3946                                              surf_usm_v(l)%ground_level(m) )
     3947                    ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
     3948                                              surf_usm_v(l)%ground_level(m) )
     3949                    ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
     3950                                              surf_usm_v(l)%ground_level(m) )
     3951                    ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
     3952                                              surf_usm_v(l)%ground_level(m) )
     3953                    ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
     3954                                              surf_usm_v(l)%ground_level(m) )
     3955                    ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,         &
     3956                                        surf_usm_v(l)%ground_level(m) )
     3957                    ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
     3958                                              surf_usm_v(l)%ground_level(m) )
     3959                    ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
     3960                                              surf_usm_v(l)%ground_level(m) )
     3961
     3962!
     3963!--                 Initialize relatvie wall- (0), green- (1) and window (2) fractions
     3964                    surf_usm_v(l)%frac(0,m) = building_pars(ind_wall_frac,st)   
     3965                    surf_usm_v(l)%frac(1,m) = building_pars(ind_green_frac_w,st) 
     3966                    surf_usm_v(l)%frac(2,m) = building_pars(ind_win_frac,st)   
     3967                    surf_usm_v(l)%lai(m)    = building_pars(ind_lai_w,st) 
     3968
     3969                    surf_usm_v(l)%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,st) 
     3970                    surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,st)
     3971                    surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,st)
     3972                    surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,st)
     3973                   
     3974                    surf_usm_v(l)%rho_c_green(nzb_wall,m)   = building_pars(ind_hc1,st) 
     3975                    surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,st)
     3976                    surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,st)
     3977                    surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,st)
     3978                   
     3979                    surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1,st) 
     3980                    surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,st)
     3981                    surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,st)
     3982                    surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,st)
     3983
     3984                    surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,st) 
     3985                    surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,st)
     3986                    surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,st)
     3987                    surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,st)
     3988                   
     3989                    surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = building_pars(ind_tc1,st) 
     3990                    surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,st)
     3991                    surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,st)
     3992                    surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,st)
     3993                   
     3994                    surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1,st) 
     3995                    surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,st)
     3996                    surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,st)
     3997                    surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,st)
     3998
     3999                    surf_usm_v(l)%target_temp_summer(m)  = building_pars(12,st)   
     4000                    surf_usm_v(l)%target_temp_winter(m)  = building_pars(13,st)   
     4001!
     4002!--                 emissivity of wall-, green- and window fraction
     4003                    surf_usm_v(l)%emissivity(0,m)        = building_pars(ind_emis_wall,st)
     4004                    surf_usm_v(l)%emissivity(1,m)        = building_pars(ind_emis_green,st)
     4005                    surf_usm_v(l)%emissivity(2,m)        = building_pars(ind_emis_win,st)
     4006
     4007                    surf_usm_v(l)%transmissivity(m)      = building_pars(ind_trans,st)
     4008
     4009                    surf_usm_v(l)%z0(m)                  = building_pars(ind_z0,st)
     4010                    surf_usm_v(l)%z0h(m)                 = building_pars(ind_z0qh,st)
     4011                    surf_usm_v(l)%z0q(m)                 = building_pars(ind_z0qh,st)
     4012
     4013                    surf_usm_v(l)%albedo_type(0,m)       = INT( building_pars(ind_alb_wall,st) )
     4014                    surf_usm_v(l)%albedo_type(1,m)       = INT( building_pars(ind_alb_green,st) )
     4015                    surf_usm_v(l)%albedo_type(2,m)       = INT( building_pars(ind_alb_win,st) )
     4016
     4017                    surf_usm_v(l)%zw(nzb_wall,m)         = building_pars(ind_thick_1,st)
     4018                    surf_usm_v(l)%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
     4019                    surf_usm_v(l)%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
     4020                    surf_usm_v(l)%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
     4021                   
     4022                    surf_usm_v(l)%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,st)
     4023                    surf_usm_v(l)%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
     4024                    surf_usm_v(l)%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
     4025                    surf_usm_v(l)%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
     4026                   
     4027                    surf_usm_v(l)%zw_window(nzb_wall,m)         = building_pars(ind_thick_1,st)
     4028                    surf_usm_v(l)%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
     4029                    surf_usm_v(l)%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
     4030                    surf_usm_v(l)%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
     4031
     4032                    surf_usm_v(l)%c_surface(m)           = building_pars(45,st) 
     4033                    surf_usm_v(l)%lambda_surf(m)         = building_pars(46,st)
     4034                    surf_usm_v(l)%c_surface_green(m)     = building_pars(45,st) 
     4035                    surf_usm_v(l)%lambda_surf_green(m)   = building_pars(46,st)
     4036                    surf_usm_v(l)%c_surface_window(m)    = building_pars(45,st) 
     4037                    surf_usm_v(l)%lambda_surf_window(m)  = building_pars(46,st)
     4038
     4039
     4040                 ENDIF
     4041              ENDDO
     4042           ENDDO
     4043        ENDIF
     4044
     4045!
     4046!--     Level 3 - initialization via building_pars read from file
     4047        IF ( building_pars_f%from_file )  THEN
     4048           DO  m = 1, surf_usm_h%ns
     4049              i = surf_usm_h%i(m)
     4050              j = surf_usm_h%j(m)
     4051
     4052!
     4053!--           In order to distinguish between ground floor level and
     4054!--           above-ground-floor level surfaces, set input indices.
     4055              ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
     4056                                        surf_usm_h%ground_level(m) )
     4057              ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
     4058                                        surf_usm_h%ground_level(m) )
     4059              ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
     4060                                        surf_usm_h%ground_level(m) )
     4061              ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
     4062                                        surf_usm_h%ground_level(m) )
     4063              ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
     4064                                        surf_usm_h%ground_level(m) )
     4065              ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
     4066                                        surf_usm_h%ground_level(m) )
     4067              ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
     4068                                        surf_usm_h%ground_level(m) )
     4069              ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
     4070                                        surf_usm_h%ground_level(m) )
     4071              ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
     4072                                        surf_usm_h%ground_level(m) )
     4073              ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
     4074                                        surf_usm_h%ground_level(m) )
     4075              ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
     4076                                        surf_usm_h%ground_level(m) )
     4077              ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
     4078                                        surf_usm_h%ground_level(m) )
     4079              ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
     4080                                        surf_usm_h%ground_level(m) )
     4081              ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
     4082                                        surf_usm_h%ground_level(m) )
     4083              ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
     4084                                        surf_usm_h%ground_level(m) )
     4085              ind_trans        = MERGE( ind_trans_gfl,        ind_trans_agfl,        &
     4086                                        surf_usm_h%ground_level(m) )
     4087              ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
     4088                                        surf_usm_h%ground_level(m) )
     4089              ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
     4090                                        surf_usm_h%ground_level(m) )
     4091
     4092!
     4093!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
     4094              IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /= building_pars_f%fill )    &
     4095                 surf_usm_h%frac(0,m)  = building_pars_f%pars_xy(ind_wall_frac,j,i)   
     4096              IF ( building_pars_f%pars_xy(ind_green_frac_r,j,i) /= building_pars_f%fill ) &
     4097                 surf_usm_h%frac(1,m)  = building_pars_f%pars_xy(ind_green_frac_r,j,i)
     4098              IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /= building_pars_f%fill )     &
     4099                 surf_usm_h%frac(2,m)  = building_pars_f%pars_xy(ind_win_frac,j,i)
     4100
     4101 
     4102              IF ( building_pars_f%pars_xy(ind_lai_r,j,i) /= building_pars_f%fill )        &
     4103                 surf_usm_h%lai(m)             = building_pars_f%pars_xy(ind_lai_r,j,i)
     4104
     4105              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
     4106                 surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars_f%pars_xy(ind_hc1,j,i) 
     4107                 surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
     4108              ENDIF
     4109              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
     4110                 surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
     4111              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )    &
     4112                 surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
     4113              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
     4114                 surf_usm_h%rho_c_green(nzb_wall,m)   = building_pars_f%pars_xy(ind_hc1,j,i) 
     4115                 surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
     4116              ENDIF
     4117              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
     4118                 surf_usm_h%rho_c_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
     4119              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )    &
     4120                 surf_usm_h%rho_c_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
     4121              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
     4122                 surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars_f%pars_xy(ind_hc1,j,i) 
     4123                 surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
     4124              ENDIF
     4125              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
     4126                 surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
     4127              IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )    &
     4128                 surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
     4129
     4130              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
     4131                 surf_usm_h%lambda_h(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
     4132                 surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)       
     4133              ENDIF
     4134              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
     4135                 surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
     4136              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )    &
     4137                 surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)   
     4138              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
     4139                 surf_usm_h%lambda_h_green(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
     4140                 surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)       
     4141              ENDIF
     4142              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
     4143                 surf_usm_h%lambda_h_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
     4144              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )    &
     4145                 surf_usm_h%lambda_h_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)   
     4146              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
     4147                 surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
     4148                 surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)       
     4149              ENDIF
     4150              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
     4151                 surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
     4152              IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )    &
     4153                 surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)   
     4154
     4155              IF ( building_pars_f%pars_xy(12,j,i) /= building_pars_f%fill )         &
     4156                 surf_usm_h%target_temp_summer(m)  = building_pars_f%pars_xy(12,j,i)   
     4157              IF ( building_pars_f%pars_xy(13,j,i) /= building_pars_f%fill )         &
     4158                 surf_usm_h%target_temp_winter(m)  = building_pars_f%pars_xy(13,j,i)   
     4159
     4160              IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill ) &
     4161                 surf_usm_h%emissivity(0,m)        = building_pars_f%pars_xy(ind_emis_wall,j,i)
     4162              IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= building_pars_f%fill )&
     4163                 surf_usm_h%emissivity(1,m)        = building_pars_f%pars_xy(ind_emis_green,j,i)
     4164              IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= building_pars_f%fill )  &
     4165                 surf_usm_h%emissivity(2,m)        = building_pars_f%pars_xy(ind_emis_win,j,i)
     4166
     4167              IF ( building_pars_f%pars_xy(ind_trans,j,i) /= building_pars_f%fill )    &
     4168                 surf_usm_h%transmissivity(m)      = building_pars_f%pars_xy(ind_trans,j,i)
     4169
     4170              IF ( building_pars_f%pars_xy(ind_z0,j,i) /= building_pars_f%fill )    &
     4171                 surf_usm_h%z0(m)                  = building_pars_f%pars_xy(ind_z0,j,i)
     4172              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )  &
     4173                 surf_usm_h%z0h(m)                 = building_pars_f%pars_xy(ind_z0qh,j,i)
     4174              IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )  &
     4175                 surf_usm_h%z0q(m)                 = building_pars_f%pars_xy(ind_z0qh,j,i)
     4176
     4177              IF ( building_pars_f%pars_xy(ind_alb_wall,j,i) /= building_pars_f%fill )    &
     4178                 surf_usm_h%albedo_type(0,m)       = building_pars_f%pars_xy(ind_alb_wall,j,i)
     4179              IF ( building_pars_f%pars_xy(ind_alb_green,j,i) /= building_pars_f%fill )    &
     4180                 surf_usm_h%albedo_type(1,m)       = building_pars_f%pars_xy(ind_alb_green,j,i)
     4181              IF ( building_pars_f%pars_xy(ind_alb_win,j,i) /= building_pars_f%fill )    &
     4182                 surf_usm_h%albedo_type(2,m)       = building_pars_f%pars_xy(ind_alb_win,j,i)
     4183
     4184              IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    &
     4185                 surf_usm_h%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
     4186              IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    &
     4187                 surf_usm_h%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
     4188              IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    &
     4189                 surf_usm_h%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
     4190              IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    &
     4191                 surf_usm_h%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
     4192              IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    &
     4193                 surf_usm_h%zw_green(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
     4194              IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    &
     4195                 surf_usm_h%zw_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
     4196              IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    &
     4197                 surf_usm_h%zw_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
     4198              IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    &
     4199                 surf_usm_h%zw_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
     4200              IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    &
     4201                 surf_usm_h%zw_window(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
     4202              IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    &
     4203                 surf_usm_h%zw_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
     4204              IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    &
     4205                 surf_usm_h%zw_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
     4206              IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    &
     4207                 surf_usm_h%zw_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
     4208
     4209              IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    &
     4210                 surf_usm_h%c_surface(m)           = building_pars_f%pars_xy(45,j,i)
     4211              IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    &
     4212                 surf_usm_h%lambda_surf(m)         = building_pars_f%pars_xy(46,j,i)
     4213              IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    &
     4214                 surf_usm_h%c_surface_green(m)           = building_pars_f%pars_xy(45,j,i)
     4215              IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    &
     4216                 surf_usm_h%lambda_surf_green(m)         = building_pars_f%pars_xy(46,j,i)
     4217              IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    &
     4218                 surf_usm_h%c_surface_window(m)           = building_pars_f%pars_xy(45,j,i)
     4219              IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    &
     4220                 surf_usm_h%lambda_surf_window(m)         = building_pars_f%pars_xy(46,j,i)
     4221           ENDDO
     4222
     4223
     4224
     4225           DO  l = 0, 3
     4226              DO  m = 1, surf_usm_v(l)%ns
     4227                 i = surf_usm_v(l)%i(m) + surf_usm_v(l)%ioff
     4228                 j = surf_usm_v(l)%j(m) + surf_usm_v(l)%joff
     4229               
     4230!
     4231!--              In order to distinguish between ground floor level and
     4232!--              above-ground-floor level surfaces, set input indices.
     4233                 ind_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,     &
     4234                                           surf_usm_v(l)%ground_level(m) )
     4235                 ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
     4236                                           surf_usm_v(l)%ground_level(m) )
     4237                 ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
     4238                                           surf_usm_v(l)%ground_level(m) )
     4239                 ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
     4240                                           surf_usm_v(l)%ground_level(m) )
     4241                 ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
     4242                                           surf_usm_v(l)%ground_level(m) )
     4243                 ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
     4244                                           surf_usm_v(l)%ground_level(m) )
     4245                 ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
     4246                                           surf_usm_v(l)%ground_level(m) )
     4247                 ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
     4248                                           surf_usm_v(l)%ground_level(m) )
     4249                 ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
     4250                                           surf_usm_v(l)%ground_level(m) )
     4251                 ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
     4252                                           surf_usm_v(l)%ground_level(m) )
     4253                 ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
     4254                                           surf_usm_v(l)%ground_level(m) )
     4255                 ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
     4256                                           surf_usm_v(l)%ground_level(m) )
     4257                 ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
     4258                                           surf_usm_v(l)%ground_level(m) )
     4259                 ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
     4260                                           surf_usm_v(l)%ground_level(m) )
     4261                 ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
     4262                                           surf_usm_v(l)%ground_level(m) )
     4263                 ind_trans        = MERGE( ind_trans_gfl,       ind_trans_agfl,         &
     4264                                           surf_usm_v(l)%ground_level(m) )
     4265                 ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
     4266                                           surf_usm_v(l)%ground_level(m) )
     4267                 ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
     4268                                              surf_usm_v(l)%ground_level(m) )
     4269
     4270!
     4271!--              Initialize relatvie wall- (0), green- (1) and window (2) fractions
     4272                 IF ( building_pars_f%pars_xy(ind_wall_frac,j,i) /=                     &
     4273                      building_pars_f%fill )                                            &
     4274                    surf_usm_v(l)%frac(0,m)  = building_pars_f%pars_xy(ind_wall_frac,j,i)   
     4275                 IF ( building_pars_f%pars_xy(ind_green_frac_w,j,i) /=                  &
     4276                      building_pars_f%fill )                                            &
     4277                    surf_usm_v(l)%frac(1,m)  = building_pars_f%pars_xy(ind_green_frac_w,j,i)
     4278                 IF ( building_pars_f%pars_xy(ind_win_frac,j,i) /=                      &
     4279                      building_pars_f%fill )                                            &
     4280                    surf_usm_v(l)%frac(2,m)  = building_pars_f%pars_xy(ind_win_frac,j,i)
     4281 
     4282                 IF ( building_pars_f%pars_xy(ind_lai_w,j,i) /= building_pars_f%fill )  &
     4283                    surf_usm_v(l)%lai(m) = building_pars_f%pars_xy(ind_lai_w,j,i)
     4284
     4285                 IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )    &
     4286                 THEN
     4287                    surf_usm_v(l)%rho_c_wall(nzb_wall,m)   =                            &
     4288                                                    building_pars_f%pars_xy(ind_hc1,j,i) 
     4289                    surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) =                            &
     4290                                                    building_pars_f%pars_xy(ind_hc1,j,i)
     4291                 ENDIF
     4292                 IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
     4293                    surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) =                            &                           
     4294                                                    building_pars_f%pars_xy(ind_hc2,j,i)
     4295                 IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )    &
     4296                    surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) =                            &
     4297                                                    building_pars_f%pars_xy(ind_hc3,j,i)
     4298                 IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
     4299                    surf_usm_v(l)%rho_c_green(nzb_wall,m)   =                           &
     4300                                                    building_pars_f%pars_xy(ind_hc1,j,i) 
     4301                    surf_usm_v(l)%rho_c_green(nzb_wall+1,m) =                           &
     4302                                                    building_pars_f%pars_xy(ind_hc1,j,i)
     4303                 ENDIF
     4304                 IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
     4305                    surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
     4306                 IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )    &
     4307                    surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)   
     4308                 IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN
     4309                    surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars_f%pars_xy(ind_hc1,j,i) 
     4310                    surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
     4311                 ENDIF
     4312                 IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
     4313                    surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_hc2,j,i)
     4314                 IF ( building_pars_f%pars_xy(ind_hc3,j,i) /= building_pars_f%fill )    &
     4315                    surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
     4316
     4317                 IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
     4318                    surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
     4319                    surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)       
     4320                 ENDIF
     4321                 IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
     4322                    surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
     4323                 IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )    &
     4324                    surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)   
     4325                 IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
     4326                    surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
     4327                    surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)       
     4328                 ENDIF
     4329                 IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
     4330                    surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
     4331                 IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )    &
     4332                    surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)   
     4333                 IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
     4334                    surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
     4335                    surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)       
     4336                 ENDIF
     4337                 IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
     4338                    surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_tc2,j,i)
     4339                 IF ( building_pars_f%pars_xy(ind_tc3,j,i) /= building_pars_f%fill )    &
     4340                    surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
     4341
     4342                 IF ( building_pars_f%pars_xy(12,j,i) /= building_pars_f%fill )         &
     4343                    surf_usm_v(l)%target_temp_summer(m)  = building_pars_f%pars_xy(12,j,i)   
     4344                 IF ( building_pars_f%pars_xy(13,j,i) /= building_pars_f%fill )         &
     4345                    surf_usm_v(l)%target_temp_winter(m)  = building_pars_f%pars_xy(13,j,i)   
     4346
     4347                 IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill ) &
     4348                    surf_usm_v(l)%emissivity(0,m)        = building_pars_f%pars_xy(ind_emis_wall,j,i)
     4349                 IF ( building_pars_f%pars_xy(ind_emis_green,j,i) /= building_pars_f%fill )&
     4350                    surf_usm_v(l)%emissivity(1,m)        = building_pars_f%pars_xy(ind_emis_green,j,i)
     4351                 IF ( building_pars_f%pars_xy(ind_emis_win,j,i) /= building_pars_f%fill )  &
     4352                    surf_usm_v(l)%emissivity(2,m)        = building_pars_f%pars_xy(ind_emis_win,j,i)
     4353
     4354                 IF ( building_pars_f%pars_xy(ind_trans,j,i) /= building_pars_f%fill )    &
     4355                    surf_usm_v(l)%transmissivity(m)      = building_pars_f%pars_xy(ind_trans,j,i)
     4356
     4357                 IF ( building_pars_f%pars_xy(ind_z0,j,i) /= building_pars_f%fill )    &
     4358                    surf_usm_v(l)%z0(m)                  = building_pars_f%pars_xy(ind_z0,j,i)
     4359                 IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )  &
     4360                    surf_usm_v(l)%z0h(m)                 = building_pars_f%pars_xy(ind_z0qh,j,i)
     4361                 IF ( building_pars_f%pars_xy(ind_z0qh,j,i) /= building_pars_f%fill )  &
     4362                    surf_usm_v(l)%z0q(m)                 = building_pars_f%pars_xy(ind_z0qh,j,i)
     4363
     4364                 IF ( building_pars_f%pars_xy(ind_alb_wall,j,i) /= building_pars_f%fill )    &
     4365                    surf_usm_v(l)%albedo_type(0,m)       = building_pars_f%pars_xy(ind_alb_wall,j,i)
     4366                 IF ( building_pars_f%pars_xy(ind_alb_green,j,i) /= building_pars_f%fill )    &
     4367                    surf_usm_v(l)%albedo_type(1,m)       = building_pars_f%pars_xy(ind_alb_green,j,i)
     4368                 IF ( building_pars_f%pars_xy(ind_alb_win,j,i) /= building_pars_f%fill )    &
     4369                    surf_usm_v(l)%albedo_type(2,m)       = building_pars_f%pars_xy(ind_alb_win,j,i)
     4370
     4371                 IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    &
     4372                    surf_usm_v(l)%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
     4373                 IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    &
     4374                    surf_usm_v(l)%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
     4375                 IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    &
     4376                    surf_usm_v(l)%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
     4377                 IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    &
     4378                    surf_usm_v(l)%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
     4379                 IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    &
     4380                    surf_usm_v(l)%zw_green(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
     4381                 IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    &
     4382                    surf_usm_v(l)%zw_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
     4383                 IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    &
     4384                    surf_usm_v(l)%zw_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
     4385                 IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    &
     4386                    surf_usm_v(l)%zw_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
     4387                 IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    &
     4388                    surf_usm_v(l)%zw_window(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
     4389                 IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    &
     4390                    surf_usm_v(l)%zw_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
     4391                 IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    &
     4392                    surf_usm_v(l)%zw_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
     4393                 IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    &
     4394                    surf_usm_v(l)%zw_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
     4395
     4396                 IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    &
     4397                    surf_usm_v(l)%c_surface(m)           = building_pars_f%pars_xy(45,j,i)
     4398                 IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    &
     4399                    surf_usm_v(l)%lambda_surf(m)         = building_pars_f%pars_xy(46,j,i)
     4400                 IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    &
     4401                    surf_usm_v(l)%c_surface_green(m)     = building_pars_f%pars_xy(45,j,i)
     4402                 IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    &
     4403                    surf_usm_v(l)%lambda_surf_green(m)   = building_pars_f%pars_xy(46,j,i)
     4404                 IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    &
     4405                    surf_usm_v(l)%c_surface_window(m)    = building_pars_f%pars_xy(45,j,i)
     4406                 IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    &
     4407                    surf_usm_v(l)%lambda_surf_window(m)  = building_pars_f%pars_xy(46,j,i)
     4408
     4409              ENDDO
     4410           ENDDO
     4411        ENDIF
     4412!       
     4413!--     Read the surface_types array.
     4414!--     Please note, here also initialization of surface attributes is done as
     4415!--     long as _urbsurf and _surfpar files are available. Values from above
     4416!--     will be overwritten. This might be removed later, but is still in the
     4417!--     code to enable compatibility with older model version.
    31944418        CALL usm_read_urban_surface_types()
    31954419       
     
    31974421        CALL usm_init_material_model()
    31984422       
     4423!--     init anthropogenic sources of heat
    31994424        IF ( usm_anthropogenic_heat )  THEN
    32004425!--         init anthropogenic sources of heat (from transportation for now)
    32014426            CALL usm_read_anthropogenic_heat()
    32024427        ENDIF
    3203        
    3204         IF ( read_svf_on_init )  THEN
    3205 !--         read svf, csf, svfsurf and csfsurf data from file
    3206             CALL location_message( '    Start reading SVF from file', .TRUE. )
    3207             CALL usm_read_svf_from_file()
    3208             CALL location_message( '    Reading SVF from file has finished', .TRUE. )
    3209         ELSE
    3210 !--         calculate SFV and CSF
    3211             CALL location_message( '    Start calculation of SVF', .TRUE. )
    3212             CALL cpu_log( log_point_s(79), 'usm_calc_svf', 'start' )
    3213             CALL usm_calc_svf()
    3214             CALL cpu_log( log_point_s(79), 'usm_calc_svf', 'stop' )
    3215             CALL location_message( '    Calculation of SVF has finished', .TRUE. )
    3216         ENDIF
    3217 
    3218         IF ( write_svf_on_init )  THEN
    3219 !--         write svf, csf svfsurf and csfsurf data to file
    3220             CALL location_message( '    Store SVF and CSF to file', .TRUE. )
    3221             CALL usm_write_svf_to_file()
    3222         ENDIF
    3223        
     4428               
    32244429        IF ( plant_canopy )  THEN
    3225 !--         gridpcbl was only necessary for initialization
    3226             DEALLOCATE( gridpcbl )
    3227             IF ( .NOT.  ALLOCATED(pc_heating_rate) )  THEN
     4430           
     4431            IF ( .NOT.  ALLOCATED( pc_heating_rate) )  THEN
    32284432!--             then pc_heating_rate is allocated in init_plant_canopy
    32294433!--             in case of cthf /= 0 => we need to allocate it for our use here
     
    32514455
    32524456               t_surf_h(m) = pt(k,j,i) * exn
     4457               t_surf_window_h(m) = pt(k,j,i) * exn
     4458               t_surf_green_h(m) = pt(k,j,i) * exn
     4459               t_surf_whole_h(m) = pt(k,j,i) * exn
    32534460            ENDDO
    32544461!
     
    32614468
    32624469                  t_surf_v(l)%t(m) = pt(k,j,i) * exn
     4470                  t_surf_window_v(l)%t(m) = pt(k,j,i) * exn
     4471                  t_surf_green_v(l)%t(m) = pt(k,j,i) * exn
     4472                  t_surf_whole_v(l)%t(m) = pt(k,j,i) * exn
    32634473               ENDDO
    32644474            ENDDO
     
    32754485               IF ( surf_usm_h%isroof_surf(m) )  THEN
    32764486                   tin = roof_inner_temperature
     4487                   twin = window_inner_temperature
    32774488!
    32784489!--            Normal land surface
    32794490               ELSE
    32804491                   tin = soil_inner_temperature
     4492                   twin = window_inner_temperature
    32814493               ENDIF
    32824494
     
    32864498
    32874499                   t_wall_h(k,m) = ( 1.0_wp - c ) * t_surf_h(m) + c * tin
     4500                   t_window_h(k,m) = ( 1.0_wp - c ) * t_surf_window_h(m) + c * twin
     4501                   t_green_h(k,m) = t_surf_h(m)
    32884502               ENDDO
    32894503            ENDDO
     
    32954509!--               Inner wall
    32964510                  tin = wall_inner_temperature
     4511                  twin = window_inner_temperature
    32974512
    32984513                  DO k = nzb_wall, nzt_wall+1
    32994514                     c = REAL( k - nzb_wall, wp ) /                            &
    33004515                         REAL( nzt_wall + 1 - nzb_wall , wp )
    3301 
    3302                      t_wall_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_v(l)%t(m) +  &
    3303                                           c * tin
     4516                     t_wall_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_v(l)%t(m) + c * tin
     4517                     t_window_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_window_v(l)%t(m) + c * twin
     4518                     t_green_v(l)%t(k,m) = t_surf_v(l)%t(m)
    33044519                  ENDDO
    33054520               ENDDO
     
    33154530        t_surf_h_p = t_surf_h
    33164531        t_surf_v_p = t_surf_v
     4532        t_surf_window_h_p = t_surf_window_h
     4533        t_surf_window_v_p = t_surf_window_v
     4534        t_surf_whole_h_p = t_surf_whole_h
     4535        t_surf_whole_v_p = t_surf_whole_v
     4536        t_surf_green_h_p = t_surf_green_h
     4537        t_surf_green_v_p = t_surf_green_v
     4538        t_surf_10cm_h_p = t_surf_10cm_h
     4539        t_surf_10cm_v_p = t_surf_10cm_v
    33174540
    33184541        t_wall_h_p = t_wall_h
    33194542        t_wall_v_p = t_wall_v
    3320        
    3321 !--     Adjust radiative fluxes for urban surface at model start
    3322         CALL usm_radiation
     4543        t_window_h_p = t_window_h
     4544        t_window_v_p = t_window_v
     4545        t_green_h_p = t_green_h
     4546        t_green_v_p = t_green_v
    33234547       
    33244548        CALL cpu_log( log_point_s(78), 'usm_init', 'stop' )
    33254549
    3326        
    33274550    END SUBROUTINE usm_init_urban_surface
    33284551
     
    33424565        INTEGER(iwp) ::  i,j,k,l,kw, m                      !< running indices
    33434566
    3344         REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: wtend  !< tendency
     4567        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: wtend, wintend  !< tendency
    33454568
    33464569!
     
    33554578!--        prognostic equation for ground/roof temperature t_wall_h
    33564579           wtend(:) = 0.0_wp
    3357            wtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzb_wall,m)) *    &
    3358                                       ( surf_usm_h%lambda_h(nzb_wall,m) *      &
    3359                                         ( t_wall_h(nzb_wall+1,m)               &
    3360                                         - t_wall_h(nzb_wall,m) ) *             &
    3361                                         surf_usm_h%ddz_wall(nzb_wall+1,m)      &
    3362                                       + surf_usm_h%wghf_eb(m) ) *              &
    3363                                         surf_usm_h%ddz_wall_stag(nzb_wall,m)
    3364            
    3365            DO  kw = nzb_wall+1, nzt_wall
    3366                wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
    3367                               * (   surf_usm_h%lambda_h(kw,m)                  &
    3368                                  * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
    3369                                  * surf_usm_h%ddz_wall(kw+1,m)                 &
    3370                               - surf_usm_h%lambda_h(kw-1,m)                    &
    3371                                  * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
    3372                                  * surf_usm_h%ddz_wall(kw,m)                   &
    3373                               ) * surf_usm_h%ddz_wall_stag(kw,m)
    3374             ENDDO
     4580           wtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzb_wall,m)) *        &
     4581                                       ( surf_usm_h%lambda_h(nzb_wall,m) *         &
     4582                                         ( t_wall_h(nzb_wall+1,m)                  &
     4583                                         - t_wall_h(nzb_wall,m) ) *                &
     4584                                         surf_usm_h%ddz_wall(nzb_wall+1,m)         &
     4585                                       + surf_usm_h%frac(0,m)                      &
     4586                                         / (surf_usm_h%frac(0,m)                   &
     4587                                           + surf_usm_h%frac(1,m) )                &
     4588                                         * surf_usm_h%wghf_eb(m)                   &
     4589                                       - surf_usm_h%frac(1,m)                      &
     4590                                          / (surf_usm_h%frac(0,m)                  &
     4591                                            + surf_usm_h%frac(1,m) )               &
     4592                                         * ( surf_usm_h%lambda_h_green(nzt_wall,m) &
     4593                                           * surf_usm_h%ddz_green(nzt_wall,m)      &
     4594                                           + surf_usm_h%lambda_h(nzb_wall,m)       &
     4595                                           * surf_usm_h%ddz_wall(nzb_wall,m) )     &
     4596                                         / ( surf_usm_h%ddz_green(nzt_wall,m)      &
     4597                                           + surf_usm_h%ddz_wall(nzb_wall,m) )     &
     4598                                         * ( t_wall_h(nzb_wall,m)                  &
     4599                                           - t_green_h(nzt_wall,m) ) ) *           &
     4600                                       surf_usm_h%ddz_wall_stag(nzb_wall,m)
     4601
     4602!dummy value for testing
     4603surf_usm_h%iwghf_eb(m) = 0.
     4604
     4605           IF ( indoor_model ) then
     4606              DO  kw = nzb_wall+1, nzt_wall-1
     4607                  wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
     4608                                 * (   surf_usm_h%lambda_h(kw,m)                  &
     4609                                    * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
     4610                                    * surf_usm_h%ddz_wall(kw+1,m)                 &
     4611                                 - surf_usm_h%lambda_h(kw-1,m)                    &
     4612                                    * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
     4613                                    * surf_usm_h%ddz_wall(kw,m)                   &
     4614                                   ) * surf_usm_h%ddz_wall_stag(kw,m)
     4615              ENDDO
     4616              wtend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzt_wall,m)) *    &
     4617                                         ( surf_usm_h%lambda_h(nzt_wall-1,m) *    &
     4618                                           ( t_wall_h(nzt_wall,m)                 &
     4619                                           - t_wall_h(nzt_wall-1,m) ) *           &
     4620                                           surf_usm_h%ddz_wall(nzt_wall,m)        &
     4621                                         + surf_usm_h%iwghf_eb(m) ) *             &
     4622                                           surf_usm_h%ddz_wall_stag(nzt_wall,m)
     4623           ELSE
     4624              DO  kw = nzb_wall+1, nzt_wall
     4625                  wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
     4626                                 * (   surf_usm_h%lambda_h(kw,m)                  &
     4627                                    * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
     4628                                    * surf_usm_h%ddz_wall(kw+1,m)                 &
     4629                                 - surf_usm_h%lambda_h(kw-1,m)                    &
     4630                                    * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
     4631                                    * surf_usm_h%ddz_wall(kw,m)                   &
     4632                                   ) * surf_usm_h%ddz_wall_stag(kw,m)
     4633              ENDDO
     4634           ENDIF
    33754635
    33764636           t_wall_h_p(nzb_wall:nzt_wall,m) = t_wall_h(nzb_wall:nzt_wall,m)     &
     
    33784638                                 * wtend(nzb_wall:nzt_wall) + tsc(3)           &
    33794639                                 * surf_usm_h%tt_wall_m(nzb_wall:nzt_wall,m) )   
    3380            
     4640
     4641!--        prognostic equation for ground/roof window temperature t_window_h
     4642           wintend(:) = 0.0_wp
     4643           wintend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzb_wall,m)) *   &
     4644                                      ( surf_usm_h%lambda_h_window(nzb_wall,m) *  &
     4645                                        ( t_window_h(nzb_wall+1,m)                &
     4646                                        - t_window_h(nzb_wall,m) ) *              &
     4647                                        surf_usm_h%ddz_window(nzb_wall+1,m)       &
     4648                                      + surf_usm_h%wghf_eb_window(m)              &
     4649                                      + surf_usm_h%rad_sw_in(m)                   &
     4650                                        * (1.0_wp - exp(-surf_usm_h%transmissivity(m) &
     4651                                        * surf_usm_h%zw_window(nzb_wall,m) ) )    &
     4652                                      ) * surf_usm_h%ddz_window_stag(nzb_wall,m)
     4653
     4654           IF ( indoor_model ) then
     4655              DO  kw = nzb_wall+1, nzt_wall-1
     4656                  wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m))          &
     4657                                 * (   surf_usm_h%lambda_h_window(kw,m)           &
     4658                                    * ( t_window_h(kw+1,m) - t_window_h(kw,m) )   &
     4659                                    * surf_usm_h%ddz_window(kw+1,m)               &
     4660                                 - surf_usm_h%lambda_h_window(kw-1,m)             &
     4661                                    * ( t_window_h(kw,m) - t_window_h(kw-1,m) )   &
     4662                                    * surf_usm_h%ddz_window(kw,m)                 &
     4663                                 + surf_usm_h%rad_sw_in(m)                        &
     4664                                    * (exp(-surf_usm_h%transmissivity(m)       &
     4665                                        * surf_usm_h%zw_window(kw-1,m) )          &
     4666                                        - exp(-surf_usm_h%transmissivity(m)    &
     4667                                        * surf_usm_h%zw_window(kw,m) ) )          &
     4668                                   ) * surf_usm_h%ddz_window_stag(kw,m)
     4669
     4670              ENDDO
     4671              wintend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzt_wall,m)) *     &
     4672                                         ( surf_usm_h%lambda_h_window(nzt_wall-1,m) *  &
     4673                                           ( t_window_h(nzt_wall,m)                    &
     4674                                           - t_window_h(nzt_wall-1,m) ) *              &
     4675                                           surf_usm_h%ddz_window(nzt_wall,m)           &
     4676                                         + surf_usm_h%iwghf_eb_window(m)               &
     4677                                         + surf_usm_h%rad_sw_in(m)                     &
     4678                                           * (1.0_wp - exp(-surf_usm_h%transmissivity(m) &
     4679                                           * surf_usm_h%zw_window(nzt_wall,m) ) )      &
     4680                                         ) * surf_usm_h%ddz_window_stag(nzt_wall,m)
     4681           ELSE
     4682              DO  kw = nzb_wall+1, nzt_wall
     4683                  wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m))          &
     4684                                 * (   surf_usm_h%lambda_h_window(kw,m)           &
     4685                                    * ( t_window_h(kw+1,m) - t_window_h(kw,m) )   &
     4686                                    * surf_usm_h%ddz_window(kw+1,m)               &
     4687                                 - surf_usm_h%lambda_h_window(kw-1,m)             &
     4688                                    * ( t_window_h(kw,m) - t_window_h(kw-1,m) )   &
     4689                                    * surf_usm_h%ddz_window(kw,m)                 &
     4690                                 + surf_usm_h%rad_sw_in(m)                        &
     4691                                    * (exp(-surf_usm_h%transmissivity(m)       &
     4692                                        * surf_usm_h%zw_window(kw-1,m) )          &
     4693                                        - exp(-surf_usm_h%transmissivity(m)    &
     4694                                        * surf_usm_h%zw_window(kw,m) ) )          &
     4695                                   ) * surf_usm_h%ddz_window_stag(kw,m)
     4696
     4697              ENDDO
     4698           ENDIF
     4699
     4700           t_window_h_p(nzb_wall:nzt_wall,m) = t_window_h(nzb_wall:nzt_wall,m)    &
     4701                                 + dt_3d * ( tsc(2)                               &
     4702                                 * wintend(nzb_wall:nzt_wall) + tsc(3)            &
     4703                                 * surf_usm_h%tt_window_m(nzb_wall:nzt_wall,m) )   
     4704           
    33814705!
    33824706!--        calculate t_wall tendencies for the next Runge-Kutta step
     
    33944718               ENDIF
    33954719           ENDIF
     4720
     4721!--        calculate t_window tendencies for the next Runge-Kutta step
     4722           IF ( timestep_scheme(1:5) == 'runge' )  THEN
     4723               IF ( intermediate_timestep_count == 1 )  THEN
     4724                  DO  kw = nzb_wall, nzt_wall
     4725                     surf_usm_h%tt_window_m(kw,m) = wintend(kw)
     4726                  ENDDO
     4727               ELSEIF ( intermediate_timestep_count <                          &
     4728                        intermediate_timestep_count_max )  THEN
     4729                   DO  kw = nzb_wall, nzt_wall
     4730                      surf_usm_h%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) +    &
     4731                                         5.3125_wp * surf_usm_h%tt_window_m(kw,m)
     4732                   ENDDO
     4733               ENDIF
     4734           ENDIF
    33964735        ENDDO
     4736
    33974737!
    33984738!--     For vertical surfaces     
     
    34074747!--           prognostic equation for wall temperature t_wall_v
    34084748              wtend(:) = 0.0_wp
    3409               wtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzb_wall,m)) * &
    3410                                       ( surf_usm_v(l)%lambda_h(nzb_wall,m) *   &
    3411                                         ( t_wall_v(l)%t(nzb_wall+1,m)          &
    3412                                         - t_wall_v(l)%t(nzb_wall,m) ) *        &
    3413                                         surf_usm_v(l)%ddz_wall(nzb_wall+1,m)   &
    3414                                       + surf_usm_v(l)%wghf_eb(m) ) *           &
    3415                                         surf_usm_v(l)%ddz_wall_stag(nzb_wall,m)
    3416            
    3417               DO  kw = nzb_wall+1, nzt_wall
    3418                   wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
    3419                            * (   surf_usm_v(l)%lambda_h(kw,m)                  &
    3420                               * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
    3421                               * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
    3422                            - surf_usm_v(l)%lambda_h(kw-1,m)                    &
    3423                               * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
    3424                               * surf_usm_v(l)%ddz_wall(kw,m)                   &
    3425                               ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
    3426                ENDDO
     4749
     4750               wtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzb_wall,m)) *    &
     4751                                       ( surf_usm_v(l)%lambda_h(nzb_wall,m) *         &
     4752                                         ( t_wall_v(l)%t(nzb_wall+1,m)                &
     4753                                         - t_wall_v(l)%t(nzb_wall,m) ) *              &
     4754                                         surf_usm_v(l)%ddz_wall(nzb_wall+1,m)         &
     4755                                       + surf_usm_v(l)%frac(0,m)                      &
     4756                                         / (surf_usm_v(l)%frac(0,m)                   &
     4757                                           + surf_usm_v(l)%frac(1,m) )                &
     4758                                         * surf_usm_v(l)%wghf_eb(m)                   &
     4759                                       - surf_usm_v(l)%frac(1,m)                      &
     4760                                         / (surf_usm_v(l)%frac(0,m)                    &
     4761                                           + surf_usm_v(l)%frac(1,m) )                &
     4762                                         * ( surf_usm_v(l)%lambda_h_green(nzt_wall,m) &
     4763                                           * surf_usm_v(l)%ddz_green(nzt_wall,m)      &
     4764                                           + surf_usm_v(l)%lambda_h(nzb_wall,m)       &
     4765                                           * surf_usm_v(l)%ddz_wall(nzb_wall,m) )     &
     4766                                         / ( surf_usm_v(l)%ddz_green(nzt_wall,m)      &
     4767                                           + surf_usm_v(l)%ddz_wall(nzb_wall,m) )     &
     4768                                         * ( t_wall_v(l)%t(nzb_wall,m)                &
     4769                                           - t_green_v(l)%t(nzt_wall,m) ) ) *         &
     4770                                         surf_usm_v(l)%ddz_wall_stag(nzb_wall,m)
     4771
     4772!dummy value for testing
     4773surf_usm_v(l)%iwghf_eb(m) = 0.
     4774
     4775              IF ( indoor_model ) then
     4776                 DO  kw = nzb_wall+1, nzt_wall-1
     4777                     wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
     4778                              * (   surf_usm_v(l)%lambda_h(kw,m)                  &
     4779                                 * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
     4780                                 * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
     4781                              - surf_usm_v(l)%lambda_h(kw-1,m)                    &
     4782                                 * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
     4783                                 * surf_usm_v(l)%ddz_wall(kw,m)                   &
     4784                                 ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
     4785                 ENDDO
     4786                 wtend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzt_wall,m)) * &
     4787                                         ( surf_usm_v(l)%lambda_h(nzt_wall-1,m) *    &
     4788                                           ( t_wall_v(l)%t(nzt_wall,m)               &
     4789                                           - t_wall_v(l)%t(nzt_wall-1,m) ) *         &
     4790                                           surf_usm_v(l)%ddz_wall(nzt_wall,m)        &
     4791                                         + surf_usm_v(l)%iwghf_eb(m) ) *             &
     4792                                           surf_usm_v(l)%ddz_wall_stag(nzt_wall,m)
     4793              ELSE
     4794                 DO  kw = nzb_wall+1, nzt_wall
     4795                     wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
     4796                              * (   surf_usm_v(l)%lambda_h(kw,m)                  &
     4797                                 * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
     4798                                 * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
     4799                              - surf_usm_v(l)%lambda_h(kw-1,m)                    &
     4800                                 * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
     4801                                 * surf_usm_v(l)%ddz_wall(kw,m)                   &
     4802                                 ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
     4803                 ENDDO
     4804              ENDIF
    34274805
    34284806              t_wall_v_p(l)%t(nzb_wall:nzt_wall,m) =                           &
     
    34314809                                 * wtend(nzb_wall:nzt_wall) + tsc(3)           &
    34324810                                 * surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall,m) )   
    3433            
     4811
     4812!--           prognostic equation for window temperature t_window_v
     4813              wintend(:) = 0.0_wp
     4814              wintend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzb_wall,m)) * &
     4815                                      ( surf_usm_v(l)%lambda_h_window(nzb_wall,m) *   &
     4816                                        ( t_window_v(l)%t(nzb_wall+1,m)               &
     4817                                        - t_window_v(l)%t(nzb_wall,m) ) *             &
     4818                                        surf_usm_v(l)%ddz_window(nzb_wall+1,m)        &
     4819                                      + surf_usm_v(l)%wghf_eb_window(m)               &
     4820                                      + surf_usm_v(l)%rad_sw_in(m)                    &
     4821                                        * (1.0_wp - exp(-surf_usm_v(l)%transmissivity(m) &
     4822                                        * surf_usm_v(l)%zw_window(nzb_wall,m) ) )     &
     4823                                      ) * surf_usm_v(l)%ddz_window_stag(nzb_wall,m)
     4824
     4825              IF ( indoor_model ) then
     4826                 DO  kw = nzb_wall+1, nzt_wall -1
     4827                     wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m))         &
     4828                              * (   surf_usm_v(l)%lambda_h_window(kw,m)                &
     4829                                 * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
     4830                                 * surf_usm_v(l)%ddz_window(kw+1,m)                    &
     4831                              - surf_usm_v(l)%lambda_h_window(kw-1,m)                  &
     4832                                 * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
     4833                                 * surf_usm_v(l)%ddz_window(kw,m)                      &
     4834                              + surf_usm_v(l)%rad_sw_in(m)                             &
     4835                                 * (exp(-surf_usm_v(l)%transmissivity(m)            &
     4836                                    * surf_usm_v(l)%zw_window(kw-1,m)       )          &
     4837                                        - exp(-surf_usm_v(l)%transmissivity(m)      &
     4838                                        * surf_usm_v(l)%zw_window(kw,m) ) )            &
     4839                                 ) * surf_usm_v(l)%ddz_window_stag(kw,m)
     4840                  ENDDO
     4841                  wintend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzt_wall,m)) * &
     4842                                          ( surf_usm_v(l)%lambda_h_window(nzt_wall-1,m) * &
     4843                                            ( t_window_v(l)%t(nzt_wall,m)                 &
     4844                                            - t_window_v(l)%t(nzt_wall-1,m) ) *           &
     4845                                            surf_usm_v(l)%ddz_window(nzt_wall,m)          &
     4846                                          + surf_usm_v(l)%iwghf_eb_window(m)              &
     4847                                          + surf_usm_v(l)%rad_sw_in(m)                    &
     4848                                            * (1.0_wp - exp(-surf_usm_v(l)%transmissivity(m) &
     4849                                            * surf_usm_v(l)%zw_window(nzt_wall,m) ) )     &
     4850                                          ) * surf_usm_v(l)%ddz_window_stag(nzt_wall,m)
     4851              ELSE
     4852                 DO  kw = nzb_wall+1, nzt_wall
     4853                     wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m))         &
     4854                              * (   surf_usm_v(l)%lambda_h_window(kw,m)                &
     4855                                 * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
     4856                                 * surf_usm_v(l)%ddz_window(kw+1,m)                    &
     4857                              - surf_usm_v(l)%lambda_h_window(kw-1,m)                  &
     4858                                 * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
     4859                                 * surf_usm_v(l)%ddz_window(kw,m)                      &
     4860                              + surf_usm_v(l)%rad_sw_in(m)                             &
     4861                                 * (exp(-surf_usm_v(l)%transmissivity(m)            &
     4862                                    * surf_usm_v(l)%zw_window(kw-1,m)       )          &
     4863                                        - exp(-surf_usm_v(l)%transmissivity(m)      &
     4864                                        * surf_usm_v(l)%zw_window(kw,m) ) )            &
     4865                                 ) * surf_usm_v(l)%ddz_window_stag(kw,m)
     4866                 ENDDO
     4867              ENDIF
     4868
     4869              t_window_v_p(l)%t(nzb_wall:nzt_wall,m) =                           &
     4870                                   t_window_v(l)%t(nzb_wall:nzt_wall,m)          &
     4871                                 + dt_3d * ( tsc(2)                              &
     4872                                 * wintend(nzb_wall:nzt_wall) + tsc(3)           &
     4873                                 * surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall,m) )   
     4874
    34344875!
    34354876!--           calculate t_wall tendencies for the next Runge-Kutta step
     
    34484889                  ENDIF
    34494890              ENDIF
     4891!--           calculate t_window tendencies for the next Runge-Kutta step
     4892              IF ( timestep_scheme(1:5) == 'runge' )  THEN
     4893                  IF ( intermediate_timestep_count == 1 )  THEN
     4894                     DO  kw = nzb_wall, nzt_wall
     4895                        surf_usm_v(l)%tt_window_m(kw,m) = wintend(kw)
     4896                     ENDDO
     4897                  ELSEIF ( intermediate_timestep_count <                       &
     4898                           intermediate_timestep_count_max )  THEN
     4899                      DO  kw = nzb_wall, nzt_wall
     4900                         surf_usm_v(l)%tt_window_m(kw,m) =                     &
     4901                                     - 9.5625_wp * wintend(kw) +               &
     4902                                       5.3125_wp * surf_usm_v(l)%tt_window_m(kw,m)
     4903                      ENDDO
     4904                  ENDIF
     4905              ENDIF
    34504906           ENDDO
    34514907        ENDDO
     
    34534909    END SUBROUTINE usm_material_heat_model
    34544910
     4911!------------------------------------------------------------------------------!
     4912! Description:
     4913! ------------
     4914!
     4915!> Green and substrate model as part of the urban surface model. The model predicts ground
     4916!> temperatures.
     4917!------------------------------------------------------------------------------!
     4918    SUBROUTINE usm_green_heat_model
     4919
     4920
     4921        IMPLICIT NONE
     4922
     4923        INTEGER(iwp) ::  i,j,k,l,kw, m                      !< running indices
     4924
     4925        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: gtend  !< tendency
     4926
     4927!
     4928!--     For horizontal surfaces                                   
     4929        DO  m = 1, surf_usm_h%ns
     4930!
     4931!--        Obtain indices
     4932           i = surf_usm_h%i(m)           
     4933           j = surf_usm_h%j(m)
     4934           k = surf_usm_h%k(m)
     4935
     4936           t_green_h(nzt_wall+1,m) = t_wall_h(nzb_wall,m)
     4937!
     4938!--        prognostic equation for ground/roof temperature t_green_h
     4939           gtend(:) = 0.0_wp
     4940           gtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_green(nzb_wall,m)) *    &
     4941                                      ( surf_usm_h%lambda_h_green(nzb_wall,m) * &
     4942                                        ( t_green_h(nzb_wall+1,m)               &
     4943                                        - t_green_h(nzb_wall,m) ) *             &
     4944                                        surf_usm_h%ddz_green(nzb_wall+1,m)      &
     4945                                      + surf_usm_h%wghf_eb_green(m) ) *         &
     4946                                        surf_usm_h%ddz_green_stag(nzb_wall,m)
     4947           
     4948            DO  kw = nzb_wall+1, nzt_wall
     4949                gtend(kw) = (1.0_wp / surf_usm_h%rho_c_green(kw,m))             &
     4950                               * (   surf_usm_h%lambda_h_green(kw,m)            &
     4951                                  * ( t_green_h(kw+1,m) - t_green_h(kw,m) )     &
     4952                                  * surf_usm_h%ddz_green(kw+1,m)                &
     4953                               - surf_usm_h%lambda_h_green(kw-1,m)              &
     4954                                  * ( t_green_h(kw,m) - t_green_h(kw-1,m) )     &
     4955                                  * surf_usm_h%ddz_green(kw,m)                  &
     4956                                 ) * surf_usm_h%ddz_green_stag(kw,m)
     4957            ENDDO
     4958
     4959           t_green_h_p(nzb_wall:nzt_wall,m) = t_green_h(nzb_wall:nzt_wall,m)    &
     4960                                 + dt_3d * ( tsc(2)                             &
     4961                                 * gtend(nzb_wall:nzt_wall) + tsc(3)            &
     4962                                 * surf_usm_h%tt_green_m(nzb_wall:nzt_wall,m) )   
     4963
     4964         
     4965!
     4966!--        calculate t_green tendencies for the next Runge-Kutta step
     4967           IF ( timestep_scheme(1:5) == 'runge' )  THEN
     4968               IF ( intermediate_timestep_count == 1 )  THEN
     4969                  DO  kw = nzb_wall, nzt_wall
     4970                     surf_usm_h%tt_green_m(kw,m) = gtend(kw)
     4971                  ENDDO
     4972               ELSEIF ( intermediate_timestep_count <                           &
     4973                        intermediate_timestep_count_max )  THEN
     4974                   DO  kw = nzb_wall, nzt_wall
     4975                      surf_usm_h%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) +    &
     4976                                         5.3125_wp * surf_usm_h%tt_green_m(kw,m)
     4977                   ENDDO
     4978               ENDIF
     4979           ENDIF
     4980        ENDDO
     4981
     4982!
     4983!--     For vertical surfaces     
     4984        DO  l = 0, 3                             
     4985           DO  m = 1, surf_usm_v(l)%ns
     4986!
     4987!--           Obtain indices
     4988              i = surf_usm_v(l)%i(m)           
     4989              j = surf_usm_v(l)%j(m)
     4990              k = surf_usm_v(l)%k(m)
     4991
     4992              t_green_v(l)%t(nzt_wall+1,m) = t_wall_v(l)%t(nzb_wall,m)
     4993!
     4994!--           prognostic equation for green temperature t_green_v
     4995              gtend(:) = 0.0_wp
     4996              gtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_green(nzb_wall,m)) * &
     4997                                      ( surf_usm_v(l)%lambda_h_green(nzb_wall,m) * &
     4998                                        ( t_green_v(l)%t(nzb_wall+1,m)             &
     4999                                        - t_green_v(l)%t(nzb_wall,m) ) *           &
     5000                                        surf_usm_v(l)%ddz_green(nzb_wall+1,m)      &
     5001                                      + surf_usm_v(l)%wghf_eb(m) ) *               &
     5002                                        surf_usm_v(l)%ddz_green_stag(nzb_wall,m)
     5003           
     5004              DO  kw = nzb_wall+1, nzt_wall
     5005                 gtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_green(kw,m))          &
     5006                           * (   surf_usm_v(l)%lambda_h_green(kw,m)              &
     5007                             * ( t_green_v(l)%t(kw+1,m) - t_green_v(l)%t(kw,m) ) &
     5008                             * surf_usm_v(l)%ddz_green(kw+1,m)                   &
     5009                           - surf_usm_v(l)%lambda_h(kw-1,m)                      &
     5010                             * ( t_green_v(l)%t(kw,m) - t_green_v(l)%t(kw-1,m) ) &
     5011                             * surf_usm_v(l)%ddz_green(kw,m) )                   &
     5012                           * surf_usm_v(l)%ddz_green_stag(kw,m)
     5013              ENDDO
     5014
     5015              t_green_v_p(l)%t(nzb_wall:nzt_wall,m) =                              &
     5016                                   t_green_v(l)%t(nzb_wall:nzt_wall,m)             &
     5017                                 + dt_3d * ( tsc(2)                                &
     5018                                 * gtend(nzb_wall:nzt_wall) + tsc(3)               &
     5019                                 * surf_usm_v(l)%tt_green_m(nzb_wall:nzt_wall,m) )   
     5020
     5021!
     5022!--           calculate t_green tendencies for the next Runge-Kutta step
     5023              IF ( timestep_scheme(1:5) == 'runge' )  THEN
     5024                  IF ( intermediate_timestep_count == 1 )  THEN
     5025                     DO  kw = nzb_wall, nzt_wall
     5026                        surf_usm_v(l)%tt_green_m(kw,m) = gtend(kw)
     5027                     ENDDO
     5028                  ELSEIF ( intermediate_timestep_count <                           &
     5029                           intermediate_timestep_count_max )  THEN
     5030                      DO  kw = nzb_wall, nzt_wall
     5031                         surf_usm_v(l)%tt_green_m(kw,m) =                          &
     5032                                     - 9.5625_wp * gtend(kw) +                     &
     5033                                       5.3125_wp * surf_usm_v(l)%tt_green_m(kw,m)
     5034                      ENDDO
     5035                  ENDIF
     5036              ENDIF
     5037
     5038           ENDDO
     5039        ENDDO
     5040
     5041    END SUBROUTINE usm_green_heat_model
    34555042
    34565043!------------------------------------------------------------------------------!
     
    34665053
    34675054       NAMELIST /urban_surface_par/                                            &
     5055                           building_type,                                      &
    34685056                           land_category,                                      &
    3469                            mrt_factors,                                        &
    3470                            nrefsteps,                                          &
    34715057                           pedestrant_category,                                &
    34725058                           ra_horiz_coef,                                      &
    3473                            read_svf_on_init,                                   &
    34745059                           roof_category,                                      &
    3475                            split_diffusion_radiation,                          &
    34765060                           urban_surface,                                      &
    34775061                           usm_anthropogenic_heat,                             &
    3478                            usm_energy_balance_land,                            &
    3479                            usm_energy_balance_wall,                            &
    34805062                           usm_material_model,                                 &
    34815063                           usm_lad_rma,                                        &
    34825064                           wall_category,                                      &
    3483                            write_svf_on_init
     5065                           indoor_model
    34845066
    34855067       line = ' '
     
    35165098    END SUBROUTINE usm_parin
    35175099
    3518 
    35195100!------------------------------------------------------------------------------!
    35205101! Description:
    35215102! ------------
    3522 !> This subroutine calculates interaction of the solar radiation
    3523 !> with urban surface and updates surface, roofs and walls heatfluxes.
    3524 !> It also updates rad_sw_out and rad_lw_out.
     5103!> Calculates temperature near surface (10 cm) for indoor model
    35255104!------------------------------------------------------------------------------!
    3526     SUBROUTINE usm_radiation
    3527    
    3528         IMPLICIT NONE
    3529        
    3530         INTEGER(iwp)               :: i, j, k, kk, is, js, d, ku, refstep, m, mm, l, ll
    3531         INTEGER(iwp)               :: nzubl, nzutl, isurf, isurfsrc, isurf1, isvf, icsf, ipcgb
    3532         INTEGER(iwp), DIMENSION(4) :: bdycross
    3533         REAL(wp), DIMENSION(3,3)   :: mrot            !< grid rotation matrix (xyz)
    3534         REAL(wp), DIMENSION(3,0:9) :: vnorm           !< face direction normal vectors (xyz)
    3535         REAL(wp), DIMENSION(3)     :: sunorig         !< grid rotated solar direction unit vector (xyz)
    3536         REAL(wp), DIMENSION(3)     :: sunorig_grid    !< grid squashed solar direction unit vector (zyx)
    3537         REAL(wp), DIMENSION(0:9)   :: costheta        !< direct irradiance factor of solar angle
    3538         REAL(wp), DIMENSION(nzub:nzut) :: pchf_prep   !< precalculated factor for canopy temp tendency
    3539         REAL(wp), PARAMETER        :: alpha = 0._wp   !< grid rotation (TODO: add to namelist or remove)
    3540         REAL(wp)                   :: rx, ry, rz
    3541         REAL(wp)                   :: pc_box_area, pc_abs_frac, pc_abs_eff
    3542         INTEGER(iwp)               :: pc_box_dimshift !< transform for best accuracy
    3543         INTEGER(iwp), DIMENSION(0:3) :: reorder = (/ 1, 0, 3, 2 /)
    3544        
    3545 #if ! defined( __nopointer )
    3546         IF ( plant_canopy )  THEN
    3547             pchf_prep(:) = r_d * (hyp(nzub:nzut) / 100000.0_wp)**0.286_wp &
    3548                         / (cp * hyp(nzub:nzut) * dx*dy*dz) !< equals to 1 / (rho * c_p * Vbox * T)
    3549         ENDIF
    3550 #endif
    3551         sun_direction = .TRUE.
    3552         CALL calc_zenith  !< required also for diffusion radiation
    3553 
    3554 !--     prepare rotated normal vectors and irradiance factor
    3555         vnorm(1,:) = idir(:)
    3556         vnorm(2,:) = jdir(:)
    3557         vnorm(3,:) = kdir(:)
    3558         mrot(1, :) = (/ cos(alpha), -sin(alpha), 0._wp /)
    3559         mrot(2, :) = (/ sin(alpha),  cos(alpha), 0._wp /)
    3560         mrot(3, :) = (/ 0._wp,       0._wp,      1._wp /)
    3561         sunorig = (/ sun_dir_lon, sun_dir_lat, zenith(0) /)
    3562         sunorig = matmul(mrot, sunorig)
    3563         DO d = 0, 9
    3564             costheta(d) = dot_product(sunorig, vnorm(:,d))
    3565         ENDDO
    3566        
    3567         IF ( zenith(0) > 0 )  THEN
    3568 !--         now we will "squash" the sunorig vector by grid box size in
    3569 !--         each dimension, so that this new direction vector will allow us
    3570 !--         to traverse the ray path within grid coordinates directly
    3571             sunorig_grid = (/ sunorig(3)/dz, sunorig(2)/dy, sunorig(1)/dx /)
    3572 !--         sunorig_grid = sunorig_grid / norm2(sunorig_grid)
    3573             sunorig_grid = sunorig_grid / SQRT(SUM(sunorig_grid**2))
    3574 
    3575             IF ( plant_canopy )  THEN
    3576 !--            precompute effective box depth with prototype Leaf Area Density
    3577                pc_box_dimshift = maxloc(sunorig, 1) - 1
    3578                CALL usm_box_absorb(cshift((/dx,dy,dz/), pc_box_dimshift),      &
    3579                                    60, prototype_lad,                          &
    3580                                    cshift(sunorig, pc_box_dimshift),           &
    3581                                    pc_box_area, pc_abs_frac)
    3582                pc_box_area = pc_box_area * sunorig(pc_box_dimshift+1) / sunorig(3)
    3583                pc_abs_eff = log(1._wp - pc_abs_frac) / prototype_lad
    3584             ENDIF
    3585         ENDIF
    3586        
    3587 !--     split diffusion and direct part of the solar downward radiation
    3588 !--     comming from radiation model and store it in 2D arrays
    3589 !--     rad_sw_in_diff, rad_sw_in_dir and rad_lw_in_diff
    3590         IF ( split_diffusion_radiation )  THEN
    3591             CALL usm_calc_diffusion_radiation
    3592         ELSE
    3593             rad_sw_in_diff = 0.0_wp
    3594             rad_sw_in_dir(:,:)  = rad_sw_in(0,:,:)
    3595             rad_lw_in_diff(:,:) = rad_lw_in(0,:,:)
    3596         ENDIF
    3597 
    3598 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3599 !--     First pass: direct + diffuse irradiance
    3600 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3601         surfinswdir   = 0._wp !nsurfl
    3602         surfinswdif   = 0._wp !nsurfl
    3603         surfinlwdif   = 0._wp !nsurfl
    3604         surfins       = 0._wp !nsurfl
    3605         surfinl       = 0._wp !nsurfl
    3606         surfoutsl(:)  = 0.0_wp !start-end
    3607         surfoutll(:)  = 0.0_wp !start-end
    3608        
    3609 !--     Set up thermal radiation from surfaces
    3610 !--     emiss_surf is defined only for surfaces for which energy balance is calculated
    3611 !--     Workaround: reorder surface data type back on 1D array including all surfaces,
    3612 !--     which implies to reorder horizontal and vertical surfaces
    3613 !
    3614 !--     Horizontal walls
    3615         mm = 1
    3616         DO  i = nxl, nxr
    3617            DO  j = nys, nyn
    3618 
    3619               DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
    3620                  surfoutll(mm) = surf_usm_h%emiss_surf(m) * sigma_sb   &
    3621                                      * t_surf_h(m)**4
    3622                  albedo_surf(mm) = surf_usm_h%albedo_surf(m)
    3623                  emiss_surf(mm)  = surf_usm_h%emiss_surf(m)
    3624                  mm = mm + 1
    3625               ENDDO
    3626            ENDDO
    3627         ENDDO
    3628 !
    3629 !--     Vertical walls
    3630         DO  i = nxl, nxr
    3631            DO  j = nys, nyn
    3632               DO  ll = 0, 3
    3633                  l = reorder(ll)
    3634                  DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
    3635                     surfoutll(mm) = surf_usm_v(l)%emiss_surf(m) * sigma_sb   &
    3636                                      * t_surf_v(l)%t(m)**4
    3637                     albedo_surf(mm) = surf_usm_v(l)%albedo_surf(m)
    3638                     emiss_surf(mm) = surf_usm_v(l)%emiss_surf(m)
    3639                     mm = mm + 1
    3640                  ENDDO
    3641               ENDDO
    3642            ENDDO
    3643         ENDDO
    3644        
    3645 #if defined( __parallel )
    3646 !--     might be optimized and gather only values relevant for current processor
    3647        
    3648         CALL MPI_AllGatherv(surfoutll, nenergy, MPI_REAL, &
    3649                             surfoutl, nsurfs, surfstart, MPI_REAL, comm2d, ierr) !nsurf global
    3650 #else
    3651         surfoutl(:) = surfoutll(:) !nsurf global
    3652 #endif
    3653        
    3654         isurf1 = -1   !< previous processed surface
    3655         DO isvf = 1, nsvfl
    3656             isurf = svfsurf(1, isvf)
    3657             k = surfl(iz, isurf)
    3658             j = surfl(iy, isurf)
    3659             i = surfl(ix, isurf)
    3660             isurfsrc = svfsurf(2, isvf)
    3661             IF ( zenith(0) > 0  .AND.  isurf /= isurf1 )  THEN
    3662 !--             locate the virtual surface where the direct solar ray crosses domain boundary
    3663 !--             (once per target surface)
    3664                 d = surfl(id, isurf)
    3665                 rz = REAL(k, wp) - 0.5_wp * kdir(d)
    3666                 ry = REAL(j, wp) - 0.5_wp * jdir(d)
    3667                 rx = REAL(i, wp) - 0.5_wp * idir(d)
    3668                
    3669                 CALL usm_find_boundary_face( (/ rz, ry, rx /), sunorig_grid, bdycross)
    3670                
    3671                 isurf1 = isurf
    3672             ENDIF
    3673 
    3674             IF ( surf(id, isurfsrc) >= isky )  THEN
    3675 !--             diffuse rad from boundary surfaces. Since it is a simply
    3676 !--             calculated value, it is not assigned to surfref(s/l),
    3677 !--             instead it is used directly here
    3678 !--             we consider the radiation from the radiation model falling on surface
    3679 !--             as the radiation falling on the top of urban layer into the place of the source surface
    3680 !--             we consider it as a very reasonable simplification which allow as avoid
    3681 !--             necessity of other global range arrays and some all to all mpi communication
    3682                 surfinswdif(isurf) = surfinswdif(isurf) + rad_sw_in_diff(j,i) * svf(1,isvf) * svf(2,isvf)
    3683                                                                 !< canopy shading is applied only to shortwave
    3684                 surfinlwdif(isurf) = surfinlwdif(isurf) + rad_lw_in_diff(j,i) * svf(1,isvf)
    3685             ELSE
    3686 !--             for surface-to-surface factors we calculate thermal radiation in 1st pass
    3687                 surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
    3688             ENDIF
    3689 
    3690             IF ( zenith(0) > 0  .AND.  all( surf(1:4,isurfsrc) == bdycross ) )  THEN
    3691 !--             found svf between model boundary and the face => face isn't shaded
    3692                 surfinswdir(isurf) = rad_sw_in_dir(j,i) &
    3693                     * costheta(surfl(id, isurf)) * svf(2,isvf) / zenith(0)
    3694 
    3695             ENDIF
    3696         ENDDO
    3697 
    3698         IF ( plant_canopy )  THEN
    3699        
    3700             pcbinsw(:) = 0._wp
    3701             pcbinlw(:) = 0._wp  !< will stay always 0 since we don't absorb lw anymore
    3702             !
    3703 !--         pcsf first pass
    3704             isurf1 = -1  !< previous processed pcgb
    3705             DO icsf = 1, ncsfl
    3706                 ipcgb = csfsurf(1, icsf)
    3707                 i = pcbl(ix,ipcgb)
    3708                 j = pcbl(iy,ipcgb)
    3709                 k = pcbl(iz,ipcgb)
    3710                 isurfsrc = csfsurf(2, icsf)
    3711 
    3712                 IF ( zenith(0) > 0  .AND.  ipcgb /= isurf1 )  THEN
    3713 !--                 locate the virtual surface where the direct solar ray crosses domain boundary
    3714 !--                 (once per target PC gridbox)
    3715                     rz = REAL(k, wp)
    3716                     ry = REAL(j, wp)
    3717                     rx = REAL(i, wp)
    3718                     CALL usm_find_boundary_face( (/ rz, ry, rx /), &
    3719                         sunorig_grid, bdycross)
    3720 
    3721                     isurf1 = ipcgb
    3722                 ENDIF
    3723 
    3724                 IF ( surf(id, isurfsrc) >= isky )  THEN
    3725 !--                 Diffuse rad from boundary surfaces. See comments for svf above.
    3726                     pcbinsw(ipcgb) = pcbinsw(ipcgb) + csf(1,icsf) * csf(2,icsf) * rad_sw_in_diff(j,i)
    3727 !--                 canopy shading is applied only to shortwave, therefore no absorbtion for lw
    3728 !--                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + svf(1,isvf) * rad_lw_in_diff(j,i)
    3729                 !ELSE
    3730 !--                 Thermal radiation in 1st pass
    3731 !--                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + svf(1,isvf) * surfoutl(isurfsrc)
    3732                 ENDIF
    3733 
    3734                 IF ( zenith(0) > 0  .AND.  all( surf(1:4,isurfsrc) == bdycross ) )  THEN
    3735 !--                 found svf between model boundary and the pcgb => pcgb isn't shaded
    3736                     pc_abs_frac = 1._wp - exp(pc_abs_eff * lad_s(k,j,i))
    3737                     pcbinsw(ipcgb) = pcbinsw(ipcgb) &
    3738                         + rad_sw_in_dir(j, i) * pc_box_area * csf(2,icsf) * pc_abs_frac
    3739                 ENDIF
    3740             ENDDO
    3741         ENDIF
    3742 
    3743         surfins(startenergy:endenergy) = surfinswdir(startenergy:endenergy) + surfinswdif(startenergy:endenergy)
    3744         surfinl(startenergy:endenergy) = surfinl(startenergy:endenergy) + surfinlwdif(startenergy:endenergy)
    3745         surfinsw(:) = surfins(:)
    3746         surfinlw(:) = surfinl(:)
    3747         surfoutsw(:) = 0.0_wp
    3748         surfoutlw(:) = surfoutll(:)
    3749 !         surfhf(startenergy:endenergy) = surfinsw(startenergy:endenergy) + surfinlw(startenergy:endenergy) &
    3750 !                                       - surfoutsw(startenergy:endenergy) - surfoutlw(startenergy:endenergy)
    3751        
    3752 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3753 !--     Next passes - reflections
    3754 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3755         DO refstep = 1, nrefsteps
    3756        
    3757             surfoutsl(startenergy:endenergy) = albedo_surf(startenergy:endenergy) * surfins(startenergy:endenergy)
    3758 !--         for non-transparent surfaces, longwave albedo is 1 - emissivity
    3759             surfoutll(startenergy:endenergy) = (1._wp - emiss_surf(startenergy:endenergy)) * surfinl(startenergy:endenergy)
    3760 
    3761 #if defined( __parallel )
    3762             CALL MPI_AllGatherv(surfoutsl, nsurfl, MPI_REAL, &
    3763                 surfouts, nsurfs, surfstart, MPI_REAL, comm2d, ierr)
    3764             CALL MPI_AllGatherv(surfoutll, nsurfl, MPI_REAL, &
    3765                 surfoutl, nsurfs, surfstart, MPI_REAL, comm2d, ierr)
    3766 #else
    3767             surfouts(:) = surfoutsl(:)
    3768             surfoutl(:) = surfoutll(:)
    3769 #endif
    3770 
    3771 !--         reset for next pass input
    3772             surfins(:) = 0._wp
    3773             surfinl(:) = 0._wp
    3774            
    3775 !--         reflected radiation
    3776             DO isvf = 1, nsvfl
    3777                 isurf = svfsurf(1, isvf)
    3778                 isurfsrc = svfsurf(2, isvf)
    3779 
    3780 !--             TODO: to remove if, use start+end for isvf
    3781                 IF ( surf(id, isurfsrc) < isky )  THEN
    3782                     surfins(isurf) = surfins(isurf) + svf(1,isvf) * svf(2,isvf) * surfouts(isurfsrc)
    3783                     surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
    3784                 ENDIF
    3785             ENDDO
    3786 
    3787 !--         radiation absorbed by plant canopy
    3788             DO icsf = 1, ncsfl
    3789                 ipcgb = csfsurf(1, icsf)
    3790                 isurfsrc = csfsurf(2, icsf)
    3791 
    3792                 IF ( surf(id, isurfsrc) < isky )  THEN
    3793                     pcbinsw(ipcgb) = pcbinsw(ipcgb) + csf(1,icsf) * csf(2,icsf) * surfouts(isurfsrc)
    3794 !--                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + csf(1,icsf) * surfoutl(isurfsrc)
    3795                 ENDIF
    3796             ENDDO
    3797            
    3798             surfinsw(:) = surfinsw(:)  + surfins(:)
    3799             surfinlw(:) = surfinlw(:)  + surfinl(:)
    3800             surfoutsw(startenergy:endenergy) = surfoutsw(startenergy:endenergy) + surfoutsl(startenergy:endenergy)
    3801             surfoutlw(startenergy:endenergy) = surfoutlw(startenergy:endenergy) + surfoutll(startenergy:endenergy)
    3802 !             surfhf(startenergy:endenergy) = surfinsw(startenergy:endenergy) + surfinlw(startenergy:endenergy) &
    3803 !                                           - surfoutsw(startenergy:endenergy) - surfoutlw(startenergy:endenergy)
    3804        
    3805         ENDDO
    3806 
    3807 !--     push heat flux absorbed by plant canopy to respective 3D arrays
    3808 #if ! defined( __nopointer )
    3809         IF ( plant_canopy )  THEN
    3810             pc_heating_rate(:,:,:) = 0._wp
    3811             DO ipcgb = 1, npcbl
    3812                 j = pcbl(iy, ipcgb)
    3813                 i = pcbl(ix, ipcgb)
    3814                 k = pcbl(iz, ipcgb)
    3815 !
    3816 !--             Following expression equals former kk = k - nzb_s_inner(j,i)
    3817                 kk = k - ( get_topography_top_index( j, i, 's' ) )  !- lad arrays are defined flat
    3818                 pc_heating_rate(kk, j, i) = (pcbinsw(ipcgb) + pcbinlw(ipcgb)) &
    3819                     * pchf_prep(k) * pt(k, j, i) !-- = dT/dt
    3820             ENDDO
    3821         ENDIF
    3822 #endif
    3823 !
    3824 !--     Transfer radiation arrays required for energy balance to the respective data types
    3825         DO  i = startenergy, endenergy
    3826            m  = surfl(5,i)         
    3827 !
    3828 !--        upward-facing
    3829            IF ( surfl(1,i) == 0 )  THEN
    3830               surf_usm_h%rad_in_sw(m)  = surfinsw(i)
    3831               surf_usm_h%rad_out_sw(m) = surfoutsw(i)
    3832               surf_usm_h%rad_in_lw(m)  = surfinlw(i)
    3833               surf_usm_h%rad_out_lw(m) = surfoutlw(i)
    3834 !
    3835 !--        southward-facding
    3836            ELSEIF ( surfl(1,i) == 1 )  THEN
    3837               surf_usm_v(1)%rad_in_sw(m)  = surfinsw(i)
    3838               surf_usm_v(1)%rad_out_sw(m) = surfoutsw(i)
    3839               surf_usm_v(1)%rad_in_lw(m)  = surfinlw(i)
    3840               surf_usm_v(1)%rad_out_lw(m) = surfoutlw(i)
    3841 !
    3842 !--        northward-facding
    3843            ELSEIF ( surfl(1,i) == 2 )  THEN
    3844               surf_usm_v(0)%rad_in_sw(m)  = surfinsw(i)
    3845               surf_usm_v(0)%rad_out_sw(m) = surfoutsw(i)
    3846               surf_usm_v(0)%rad_in_lw(m)  = surfinlw(i)
    3847               surf_usm_v(0)%rad_out_lw(m) = surfoutlw(i)
    3848 !
    3849 !--        westward-facding
    3850            ELSEIF ( surfl(1,i) == 3 )  THEN
    3851               surf_usm_v(3)%rad_in_sw(m)  = surfinsw(i)
    3852               surf_usm_v(3)%rad_out_sw(m) = surfoutsw(i)
    3853               surf_usm_v(3)%rad_in_lw(m)  = surfinlw(i)
    3854               surf_usm_v(3)%rad_out_lw(m) = surfoutlw(i)
    3855 !
    3856 !--        eastward-facing
    3857            ELSEIF ( surfl(1,i) == 4 )  THEN
    3858               surf_usm_v(2)%rad_in_sw(m)  = surfinsw(i)
    3859               surf_usm_v(2)%rad_out_sw(m) = surfoutsw(i)
    3860               surf_usm_v(2)%rad_in_lw(m)  = surfinlw(i)
    3861               surf_usm_v(2)%rad_out_lw(m) = surfoutlw(i)
    3862            ENDIF
    3863 
    3864         ENDDO
    3865 
    3866 
    3867         DO  m = 1, surf_usm_h%ns
    3868            surf_usm_h%surfhf(m) = surf_usm_h%rad_in_sw(m)  +                   &
    3869                                   surf_usm_h%rad_in_lw(m)  -                   &
    3870                                   surf_usm_h%rad_out_sw(m) -                   &
    3871                                   surf_usm_h%rad_out_lw(m)
    3872         ENDDO
    3873 
    3874         DO  l = 0, 3
    3875            DO  m = 1, surf_usm_v(l)%ns
    3876               surf_usm_v(l)%surfhf(m) = surf_usm_v(l)%rad_in_sw(m)  +          &
    3877                                         surf_usm_v(l)%rad_in_lw(m)  -          &
    3878                                         surf_usm_v(l)%rad_out_sw(m) -          &
    3879                                         surf_usm_v(l)%rad_out_lw(m)
    3880            ENDDO
    3881         ENDDO
    3882 
    3883 !--     return surface radiation to horizontal surfaces
    3884 !--     to rad_sw_in, rad_lw_in and rad_net for outputs
    3885         !!!!!!!!!!
    3886 !--     we need the original radiation on urban top layer
    3887 !--     for calculation of MRT so we can't do adjustment here for now
    3888         !!!!!!!!!!
    3889         !!!DO isurf = 1, nsurfl
    3890         !!!    i = surfl(ix,isurf)
    3891         !!!    j = surfl(iy,isurf)
    3892         !!!    k = surfl(iz,isurf)
    3893         !!!    d = surfl(id,isurf)
    3894         !!!    IF ( d==iroof )  THEN
    3895         !!!        rad_sw_in(:,j,i) = surfinsw(isurf)
    3896         !!!        rad_lw_in(:,j,i) = surfinlw(isurf)
    3897         !!!        rad_net(j,i) = rad_sw_in(k,j,i) - rad_sw_out(k,j,i) + rad_lw_in(k,j,i) - rad_lw_out(k,j,i)
    3898         !!!    ENDIF
    3899         !!!ENDDO
    3900 
    3901     END SUBROUTINE usm_radiation
    3902 
    3903    
    3904 !------------------------------------------------------------------------------!
    3905 ! Description:
    3906 ! ------------
    3907 !> Raytracing for detecting obstacles and calculating compound canopy sink
    3908 !> factors. (A simple obstacle detection would only need to process faces in
    3909 !> 3 dimensions without any ordering.)
    3910 !> Assumtions:
    3911 !> -----------
    3912 !> 1. The ray always originates from a face midpoint (only one coordinate equals
    3913 !>    *.5, i.e. wall) and doesn't travel parallel to the surface (that would mean
    3914 !>    shape factor=0). Therefore, the ray may never travel exactly along a face
    3915 !>    or an edge.
    3916 !> 2. From grid bottom to urban surface top the grid has to be *equidistant*
    3917 !>    within each of the dimensions, including vertical (but the resolution
    3918 !>    doesn't need to be the same in all three dimensions).
    3919 !------------------------------------------------------------------------------!
    3920     SUBROUTINE usm_raytrace(src, targ, isrc, rirrf, atarg, create_csf, visible, transparency, win_lad)
    3921         IMPLICIT NONE
    3922 
    3923         REAL(wp), DIMENSION(3), INTENT(in)     :: src, targ    !< real coordinates z,y,x
    3924         INTEGER(iwp), INTENT(in)               :: isrc         !< index of source face for csf
    3925         REAL(wp), INTENT(in)                   :: rirrf        !< irradiance factor for csf
    3926         REAL(wp), INTENT(in)                   :: atarg        !< target surface area for csf
    3927         LOGICAL, INTENT(in)                    :: create_csf   !< whether to generate new CSFs during raytracing
    3928         LOGICAL, INTENT(out)                   :: visible
    3929         REAL(wp), INTENT(out)                  :: transparency !< along whole path
    3930         INTEGER(iwp), INTENT(in)               :: win_lad
    3931         INTEGER(iwp)                           :: i, j, k, d
    3932         INTEGER(iwp)                           :: seldim       !< dimension to be incremented
    3933         INTEGER(iwp)                           :: ncsb         !< no of written plant canopy sinkboxes
    3934         INTEGER(iwp)                           :: maxboxes     !< max no of gridboxes visited
    3935         REAL(wp)                               :: distance     !< euclidean along path
    3936         REAL(wp)                               :: crlen        !< length of gridbox crossing
    3937         REAL(wp)                               :: lastdist     !< beginning of current crossing
    3938         REAL(wp)                               :: nextdist     !< end of current crossing
    3939         REAL(wp)                               :: realdist     !< distance in meters per unit distance
    3940         REAL(wp)                               :: crmid        !< midpoint of crossing
    3941         REAL(wp)                               :: cursink      !< sink factor for current canopy box
    3942         REAL(wp), DIMENSION(3)                 :: delta        !< path vector
    3943         REAL(wp), DIMENSION(3)                 :: uvect        !< unit vector
    3944         REAL(wp), DIMENSION(3)                 :: dimnextdist  !< distance for each dimension increments
    3945         INTEGER(iwp), DIMENSION(3)             :: box          !< gridbox being crossed
    3946         INTEGER(iwp), DIMENSION(3)             :: dimnext      !< next dimension increments along path
    3947         INTEGER(iwp), DIMENSION(3)             :: dimdelta     !< dimension direction = +- 1
    3948         INTEGER(iwp)                           :: px, py       !< number of processors in x and y dir before
    3949                                                                !< the processor in the question
    3950         INTEGER(iwp)                           :: ip           !< number of processor where gridbox reside
    3951         INTEGER(iwp)                           :: ig           !< 1D index of gridbox in global 2D array
    3952         REAL(wp)                               :: lad_s_target !< recieved lad_s of particular grid box
    3953         REAL(wp), PARAMETER                    :: grow_factor = 1.5_wp !< factor of expansion of grow arrays
    3954 
    3955 !
    3956 !--     Maximum number of gridboxes visited equals to maximum number of boundaries crossed in each dimension plus one. That's also
    3957 !--     the maximum number of plant canopy boxes written. We grow the acsf array accordingly using exponential factor.
    3958         maxboxes = SUM(ABS(NINT(targ) - NINT(src))) + 1
    3959         IF ( plant_canopy  .AND.  ncsfl + maxboxes > ncsfla )  THEN
    3960 !--         use this code for growing by fixed exponential increments (equivalent to case where ncsfl always increases by 1)
    3961 !--         k = CEILING(grow_factor ** real(CEILING(log(real(ncsfl + maxboxes, kind=wp)) &
    3962 !--                                                / log(grow_factor)), kind=wp))
    3963 !--         or use this code to simply always keep some extra space after growing
    3964             k = CEILING(REAL(ncsfl + maxboxes, kind=wp) * grow_factor)
    3965 
    3966             CALL usm_merge_and_grow_csf(k)
    3967         ENDIF
    3968        
    3969         transparency = 1._wp
    3970         ncsb = 0
    3971 
    3972         delta(:) = targ(:) - src(:)
    3973         distance = SQRT(SUM(delta(:)**2))
    3974         IF ( distance == 0._wp )  THEN
    3975             visible = .TRUE.
    3976             RETURN
    3977         ENDIF
    3978         uvect(:) = delta(:) / distance
    3979         realdist = SQRT(SUM( (uvect(:)*(/dz,dy,dx/))**2 ))
    3980 
    3981         lastdist = 0._wp
    3982 
    3983 !--     Since all face coordinates have values *.5 and we'd like to use
    3984 !--     integers, all these have .5 added
    3985         DO d = 1, 3
    3986             IF ( uvect(d) == 0._wp )  THEN
    3987                 dimnext(d) = 999999999
    3988                 dimdelta(d) = 999999999
    3989                 dimnextdist(d) = 1.0E20_wp
    3990             ELSE IF ( uvect(d) > 0._wp )  THEN
    3991                 dimnext(d) = CEILING(src(d) + .5_wp)
    3992                 dimdelta(d) = 1
    3993                 dimnextdist(d) = (dimnext(d) - .5_wp - src(d)) / uvect(d)
    3994             ELSE
    3995                 dimnext(d) = FLOOR(src(d) + .5_wp)
    3996                 dimdelta(d) = -1
    3997                 dimnextdist(d) = (dimnext(d) - .5_wp - src(d)) / uvect(d)
    3998             ENDIF
    3999         ENDDO
    4000 
    4001         DO
    4002 !--         along what dimension will the next wall crossing be?
    4003             seldim = minloc(dimnextdist, 1)
    4004             nextdist = dimnextdist(seldim)
    4005             IF ( nextdist > distance ) nextdist = distance
    4006 
    4007             crlen = nextdist - lastdist
    4008             IF ( crlen > .001_wp )  THEN
    4009                 crmid = (lastdist + nextdist) * .5_wp
    4010                 box = NINT(src(:) + uvect(:) * crmid)
    4011 
    4012 !--             calculate index of the grid with global indices (box(2),box(3))
    4013 !--             in the array nzterr and plantt and id of the coresponding processor
    4014                 px = box(3)/nnx
    4015                 py = box(2)/nny
    4016                 ip = px*pdims(2)+py
    4017                 ig = ip*nnx*nny + (box(3)-px*nnx)*nny + box(2)-py*nny
    4018                 IF ( box(1) <= nzterr(ig) )  THEN
    4019                     visible = .FALSE.
    4020                     RETURN
    4021                 ENDIF
    4022 
    4023                 IF ( plant_canopy )  THEN
    4024                     IF ( box(1) <= plantt(ig) )  THEN
    4025                         ncsb = ncsb + 1
    4026                         boxes(:,ncsb) = box
    4027                         crlens(ncsb) = crlen
    4028 #if defined( __parallel )
    4029                         lad_ip(ncsb) = ip
    4030                         lad_disp(ncsb) = (box(3)-px*nnx)*(nny*nzu) + (box(2)-py*nny)*nzu + box(1)-nzub
    4031 #endif
    4032                     ENDIF
    4033                 ENDIF
    4034             ENDIF
    4035 
    4036             IF ( nextdist >= distance ) EXIT
    4037             lastdist = nextdist
    4038             dimnext(seldim) = dimnext(seldim) + dimdelta(seldim)
    4039             dimnextdist(seldim) = (dimnext(seldim) - .5_wp - src(seldim)) / uvect(seldim)
    4040         ENDDO
    4041        
    4042         IF ( plant_canopy )  THEN
    4043 #if defined( __parallel )
    4044             IF ( usm_lad_rma )  THEN
    4045 !--             send requests for lad_s to appropriate processor
    4046                 CALL cpu_log( log_point_s(77), 'usm_init_rma', 'start' )
    4047                 DO i = 1, ncsb
    4048                     CALL MPI_Get(lad_s_ray(i), 1, MPI_REAL, lad_ip(i), lad_disp(i), &
    4049                                  1, MPI_REAL, win_lad, ierr)
    4050                     IF ( ierr /= 0 )  THEN
    4051                         WRITE(message_string, *) 'MPI error ', ierr, ' at MPI_Get'
    4052                         CALL message( 'usm_raytrace', 'PA0519', 1, 2, 0, 6, 0 )
    4053                     ENDIF
    4054                 ENDDO
    4055                
    4056 !--             wait for all pending local requests complete
    4057                 CALL MPI_Win_flush_local_all(win_lad, ierr)
    4058                 IF ( ierr /= 0 )  THEN
    4059                     WRITE(message_string, *) 'MPI error ', ierr, ' at MPI_Win_flush_local_all'
    4060                     CALL message( 'usm_raytrace', 'PA0519', 1, 2, 0, 6, 0 )
    4061                 ENDIF
    4062                 CALL cpu_log( log_point_s(77), 'usm_init_rma', 'stop' )
    4063                
    4064             ENDIF
    4065 #endif
    4066 
    4067 !--         calculate csf and transparency
    4068             DO i = 1, ncsb
    4069 #if defined( __parallel )
    4070                 IF ( usm_lad_rma )  THEN
    4071                     lad_s_target = lad_s_ray(i)
    4072                 ELSE
    4073                     lad_s_target = usm_lad_g(lad_ip(i)*nnx*nny*nzu + lad_disp(i))
    4074                 ENDIF
    4075 #else
    4076                 lad_s_target = usm_lad(boxes(1,i),boxes(2,i),boxes(3,i))
    4077 #endif
    4078                 cursink = 1._wp - exp(-ext_coef * lad_s_target * crlens(i)*realdist)
    4079 
    4080                 IF ( create_csf )  THEN
    4081 !--                 write svf values into the array
    4082                     ncsfl = ncsfl + 1
    4083                     acsf(ncsfl)%ip = lad_ip(i)
    4084                     acsf(ncsfl)%itx = boxes(3,i)
    4085                     acsf(ncsfl)%ity = boxes(2,i)
    4086                     acsf(ncsfl)%itz = boxes(1,i)
    4087                     acsf(ncsfl)%isurfs = isrc
    4088                     acsf(ncsfl)%rsvf = REAL(cursink*rirrf*atarg, wp) !-- we postpone multiplication by transparency
    4089                     acsf(ncsfl)%rtransp = REAL(transparency, wp)
    4090                 ENDIF  !< create_csf
    4091 
    4092                 transparency = transparency * (1._wp - cursink)
    4093                
    4094             ENDDO
    4095         ENDIF
    4096        
    4097         visible = .TRUE.
    4098 
    4099     END SUBROUTINE usm_raytrace
     5105    SUBROUTINE usm_temperature_near_surface
     5106
     5107       IMPLICIT NONE
     5108
     5109       INTEGER(iwp)                          :: i, j, k, l, m   !< running indices
     5110
     5111!       
     5112!--    First, treat horizontal surface elements
     5113       DO  m = 1, surf_usm_h%ns
     5114
     5115!--       Get indices of respective grid point
     5116          i = surf_usm_h%i(m)
     5117          j = surf_usm_h%j(m)
     5118          k = surf_usm_h%k(m)
     5119
     5120          t_surf_10cm_h(m) = t_surf_whole_h(m) + surf_usm_h%ts(m) / kappa        &
     5121                             * ( log( 0.1_wp /  surf_usm_h%z0h(m) )              &
     5122                               - psi_h( 0.1_wp / surf_usm_h%ol(m) )              &
     5123                               + psi_h( surf_usm_h%z0h(m) / surf_usm_h%ol(m) ) )
     5124
     5125       ENDDO
     5126!
     5127!--    Now, treat vertical surface elements
     5128       DO  l = 0, 3
     5129          DO  m = 1, surf_usm_v(l)%ns
     5130
     5131!--          Get indices of respective grid point
     5132             i = surf_usm_v(l)%i(m)
     5133             j = surf_usm_v(l)%j(m)
     5134             k = surf_usm_v(l)%k(m)
     5135
     5136             t_surf_10cm_v(l)%t(m) = t_surf_whole_v(l)%t(m) + surf_usm_v(l)%ts(m) / kappa &
     5137                                     * ( log( 0.1_wp / surf_usm_v(l)%z0h(m) )             &
     5138                                       - psi_h( 0.1_wp / surf_usm_v(l)%ol(m) )            &
     5139                                       + psi_h( surf_usm_v(l)%z0h(m) / surf_usm_v(l)%ol(m) ) )
     5140
     5141          ENDDO
     5142
     5143       ENDDO
     5144
     5145
     5146    END SUBROUTINE usm_temperature_near_surface
     5147
    41005148   
    41015149 
     
    42425290       INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) ::  end_index_on_file
    42435291       
    4244        REAL(wp), DIMENSION(:), ALLOCATABLE   ::  tmp_surf_h
    4245        REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmp_wall_h
     5292       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  tmp_surf_h, tmp_surf_window_h, tmp_surf_green_h
     5293       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmp_wall_h, tmp_window_h, tmp_green_h
    42465294       
    4247        TYPE( t_surf_vertical ), DIMENSION(0:3) ::  tmp_surf_v
    4248        TYPE( t_wall_vertical ), DIMENSION(0:3) ::  tmp_wall_v
     5295       TYPE( t_surf_vertical ), DIMENSION(0:3) ::  tmp_surf_v, tmp_surf_window_v, tmp_surf_green_v
     5296       TYPE( t_wall_vertical ), DIMENSION(0:3) ::  tmp_wall_v, tmp_window_v, tmp_green_v
    42495297
    42505298       
     
    42745322          ALLOCATE( tmp_surf_h(1:ns_h_on_file_usm) )
    42755323          ALLOCATE( tmp_wall_h(nzb_wall:nzt_wall+1,1:ns_h_on_file_usm) )
     5324          ALLOCATE( tmp_surf_window_h(1:ns_h_on_file_usm) )
     5325          ALLOCATE( tmp_window_h(nzb_wall:nzt_wall+1,1:ns_h_on_file_usm) )
     5326          ALLOCATE( tmp_surf_green_h(1:ns_h_on_file_usm) )
     5327          ALLOCATE( tmp_green_h(nzb_wall:nzt_wall+1,1:ns_h_on_file_usm) )
    42765328         
    42775329          DO  l = 0, 3
    42785330             ALLOCATE( tmp_surf_v(l)%t(1:ns_v_on_file_usm(l)) )
    42795331             ALLOCATE( tmp_wall_v(l)%t(nzb_wall:nzt_wall+1,1:ns_v_on_file_usm(l) ) )
     5332             ALLOCATE( tmp_surf_window_v(l)%t(1:ns_v_on_file_usm(l)) )
     5333             ALLOCATE( tmp_window_v(l)%t(nzb_wall:nzt_wall+1,1:ns_v_on_file_usm(l) ) )
     5334             ALLOCATE( tmp_surf_green_v(l)%t(1:ns_v_on_file_usm(l)) )
     5335             ALLOCATE( tmp_green_v(l)%t(nzb_wall:nzt_wall+1,1:ns_v_on_file_usm(l) ) )
    42805336          ENDDO
    42815337         
     
    43165372                         READ ( 13 )  tmp_surf_h
    43175373                      ENDIF
    4318                       CALL restore_surface_elements_usm_1d(                    &
     5374                      CALL surface_restore_elements(                           &
    43195375                                              t_surf_h, tmp_surf_h,            &
    4320                                               surf_usm_h%start_index )
     5376                                              surf_usm_h%start_index,          &
     5377                                              start_index_on_file,             &
     5378                                              end_index_on_file,               &
     5379                                              nxlc, nysc,                      &
     5380                                              nxlf, nxrf, nysf, nynf,          &
     5381                                              nys_on_file, nyn_on_file,        &
     5382                                              nxl_on_file,nxr_on_file )
    43215383#else                     
    43225384                      IF ( kk == 1 )  THEN
     
    43255387                         READ ( 13 )  tmp_surf_h
    43265388                      ENDIF
    4327                       CALL restore_surface_elements_usm_1d(                    &
     5389                      CALL surface_restore_elements(                           &
    43285390                                              t_surf_h_1, tmp_surf_h,          &
    4329                                               surf_usm_h%start_index )
     5391                                              surf_usm_h%start_index,          &
     5392                                              start_index_on_file,             &
     5393                                              end_index_on_file,               &
     5394                                              nxlc, nysc,                      &
     5395                                              nxlf, nxrf, nysf, nynf,          &
     5396                                              nys_on_file, nyn_on_file,        &
     5397                                              nxl_on_file,nxr_on_file )
    43305398#endif
    43315399
     
    43375405                         READ ( 13 )  tmp_surf_v(0)%t
    43385406                      ENDIF
    4339                       CALL restore_surface_elements_usm_1d(                    &
     5407                      CALL surface_restore_elements(                           &
    43405408                                              t_surf_v(0)%t, tmp_surf_v(0)%t,  &
    4341                                               surf_usm_v(0)%start_index )
     5409                                              surf_usm_v(0)%start_index,       &
     5410                                              start_index_on_file,             &
     5411                                              end_index_on_file,               &
     5412                                              nxlc, nysc,                      &
     5413                                              nxlf, nxrf, nysf, nynf,          &
     5414                                              nys_on_file, nyn_on_file,        &
     5415                                              nxl_on_file,nxr_on_file )
    43425416#else                     
    43435417                      IF ( kk == 1 )  THEN
     
    43465420                         READ ( 13 )  tmp_surf_v(0)%t
    43475421                      ENDIF
    4348                       CALL restore_surface_elements_usm_1d(                    &
     5422                      CALL surface_restore_elements(                           &
    43495423                                              t_surf_v_1(0)%t, tmp_surf_v(0)%t,&
    4350                                               surf_usm_v(0)%start_index )
     5424                                              surf_usm_v(0)%start_index,       &
     5425                                              start_index_on_file,             &
     5426                                              end_index_on_file,               &
     5427                                              nxlc, nysc,                      &
     5428                                              nxlf, nxrf, nysf, nynf,          &
     5429                                              nys_on_file, nyn_on_file,        &
     5430                                              nxl_on_file,nxr_on_file )
    43515431#endif
    43525432                         
     
    43585438                         READ ( 13 )  tmp_surf_v(1)%t
    43595439                      ENDIF
    4360                       CALL restore_surface_elements_usm_1d(                    &
     5440                      CALL surface_restore_elements(                           &
    43615441                                              t_surf_v(1)%t, tmp_surf_v(1)%t,  &
    4362                                               surf_usm_v(1)%start_index )                       
     5442                                              surf_usm_v(1)%start_index,       &
     5443                                              start_index_on_file,             &
     5444                                              end_index_on_file,               &
     5445                                              nxlc, nysc,                      &
     5446                                              nxlf, nxrf, nysf, nynf,          &
     5447                                              nys_on_file, nyn_on_file,        &
     5448                                              nxl_on_file,nxr_on_file )                 
    43635449#else                     
    43645450                      IF ( kk == 1 )  THEN
     
    43675453                         READ ( 13 )  tmp_surf_v(1)%t
    43685454                      ENDIF
    4369                       CALL restore_surface_elements_usm_1d(                    &
     5455                      CALL surface_restore_elements(                           &
    43705456                                              t_surf_v_1(1)%t, tmp_surf_v(1)%t,&
    4371                                               surf_usm_v(1)%start_index )
     5457                                              surf_usm_v(1)%start_index,       &
     5458                                              start_index_on_file,             &
     5459                                              end_index_on_file,               &
     5460                                              nxlc, nysc,                      &
     5461                                              nxlf, nxrf, nysf, nynf,          &
     5462                                              nys_on_file, nyn_on_file,        &
     5463                                              nxl_on_file,nxr_on_file )
    43725464#endif
    43735465
     
    43795471                         READ ( 13 )  tmp_surf_v(2)%t
    43805472                      ENDIF
    4381                       CALL restore_surface_elements_usm_1d(                    &
     5473                      CALL surface_restore_elements(                           &
    43825474                                              t_surf_v(2)%t, tmp_surf_v(2)%t,  &
    4383                                               surf_usm_v(2)%start_index )
     5475                                              surf_usm_v(2)%start_index,       &
     5476                                              start_index_on_file,             &
     5477                                              end_index_on_file,               &
     5478                                              nxlc, nysc,                      &
     5479                                              nxlf, nxrf, nysf, nynf,          &
     5480                                              nys_on_file, nyn_on_file,        &
     5481                                              nxl_on_file,nxr_on_file )
    43845482#else                     
    43855483                      IF ( kk == 1 )  THEN
     
    43885486                         READ ( 13 )  tmp_surf_v(2)%t
    43895487                      ENDIF
    4390                       CALL restore_surface_elements_usm_1d(                    &
     5488                      CALL surface_restore_elements(                           &
    43915489                                              t_surf_v_1(2)%t, tmp_surf_v(2)%t,&
    4392                                               surf_usm_v(2)%start_index )
     5490                                              surf_usm_v(2)%start_index,       &
     5491                                              start_index_on_file,             &
     5492                                              end_index_on_file,               &
     5493                                              nxlc, nysc,                      &
     5494                                              nxlf, nxrf, nysf, nynf,          &
     5495                                              nys_on_file, nyn_on_file,        &
     5496                                              nxl_on_file,nxr_on_file )
    43935497#endif
    43945498                         
     
    44005504                         READ ( 13 )  tmp_surf_v(3)%t
    44015505                      ENDIF
    4402                       CALL restore_surface_elements_usm_1d(                    &
     5506                      CALL surface_restore_elements(                           &
    44035507                                              t_surf_v(3)%t, tmp_surf_v(3)%t,  &
    4404                                               surf_usm_v(3)%start_index )
     5508                                              surf_usm_v(3)%start_index,       &
     5509                                              start_index_on_file,             &
     5510                                              end_index_on_file,               &
     5511                                              nxlc, nysc,                      &
     5512                                              nxlf, nxrf, nysf, nynf,          &
     5513                                              nys_on_file, nyn_on_file,        &
     5514                                              nxl_on_file,nxr_on_file )
    44055515#else                     
    44065516                      IF ( kk == 1 )  THEN
     
    44095519                         READ ( 13 )  tmp_surf_v(3)%t
    44105520                      ENDIF
    4411                       CALL restore_surface_elements_usm_1d(                    &
     5521                      CALL surface_restore_elements(                           &
    44125522                                              t_surf_v_1(3)%t, tmp_surf_v(3)%t,&
    4413                                               surf_usm_v(3)%start_index )
     5523                                              surf_usm_v(3)%start_index,       &
     5524                                              start_index_on_file,             &
     5525                                              end_index_on_file,               &
     5526                                              nxlc, nysc,                      &
     5527                                              nxlf, nxrf, nysf, nynf,          &
     5528                                              nys_on_file, nyn_on_file,        &
     5529                                              nxl_on_file,nxr_on_file )
     5530#endif
     5531                   CASE ( 't_surf_green_h' )
     5532#if defined( __nopointer )                   
     5533                      IF ( kk == 1 )  THEN
     5534                         IF ( .NOT.  ALLOCATED( t_surf_green_h ) )                   &
     5535                            ALLOCATE( t_surf_green_h(1:surf_usm_h%ns) )
     5536                         READ ( 13 )  tmp_surf_green_h
     5537                      ENDIF
     5538                      CALL surface_restore_elements(                           &
     5539                                              t_surf_green_h, tmp_surf_green_h, &
     5540                                              surf_usm_h%start_index,          &
     5541                                              start_index_on_file,             &
     5542                                              end_index_on_file,               &
     5543                                              nxlc, nysc,                      &
     5544                                              nxlf, nxrf, nysf, nynf,          &
     5545                                              nys_on_file, nyn_on_file,        &
     5546                                              nxl_on_file,nxr_on_file )
     5547#else                     
     5548                      IF ( kk == 1 )  THEN
     5549                         IF ( .NOT.  ALLOCATED( t_surf_green_h_1 ) )                 &
     5550                            ALLOCATE( t_surf_green_h_1(1:surf_usm_h%ns) )
     5551                         READ ( 13 )  tmp_surf_green_h
     5552                      ENDIF
     5553                      CALL surface_restore_elements(                           &
     5554                                              t_surf_green_h_1, tmp_surf_green_h, &
     5555                                              surf_usm_h%start_index,          &
     5556                                              start_index_on_file,             &
     5557                                              end_index_on_file,               &
     5558                                              nxlc, nysc,                      &
     5559                                              nxlf, nxrf, nysf, nynf,          &
     5560                                              nys_on_file, nyn_on_file,        &
     5561                                              nxl_on_file,nxr_on_file )
     5562#endif
     5563
     5564                   CASE ( 't_surf_green_v(0)' )
     5565#if defined( __nopointer )           
     5566                      IF ( kk == 1 )  THEN
     5567                         IF ( .NOT.  ALLOCATED( t_surf_green_v(0)%t ) )              &
     5568                            ALLOCATE( t_surf_green_v(0)%t(1:surf_usm_v(0)%ns) )
     5569                         READ ( 13 )  tmp_surf_green_v(0)%t
     5570                      ENDIF
     5571                      CALL surface_restore_elements(                           &
     5572                                              t_surf_green_v(0)%t, tmp_surf_green_v(0)%t,  &
     5573                                              surf_usm_v(0)%start_index,       &
     5574                                              start_index_on_file,             &
     5575                                              end_index_on_file,               &
     5576                                              nxlc, nysc,                      &
     5577                                              nxlf, nxrf, nysf, nynf,          &
     5578                                              nys_on_file, nyn_on_file,        &
     5579                                              nxl_on_file,nxr_on_file )
     5580#else                     
     5581                      IF ( kk == 1 )  THEN
     5582                         IF ( .NOT.  ALLOCATED( t_surf_green_v_1(0)%t ) )            &
     5583                            ALLOCATE( t_surf_green_v_1(0)%t(1:surf_usm_v(0)%ns) )
     5584                         READ ( 13 )  tmp_surf_green_v(0)%t
     5585                      ENDIF
     5586                      CALL surface_restore_elements(                           &
     5587                                              t_surf_green_v_1(0)%t, tmp_surf_green_v(0)%t,&
     5588                                              surf_usm_v(0)%start_index,       &
     5589                                              start_index_on_file,             &
     5590                                              end_index_on_file,               &
     5591                                              nxlc, nysc,                      &
     5592                                              nxlf, nxrf, nysf, nynf,          &
     5593                                              nys_on_file, nyn_on_file,        &
     5594                                              nxl_on_file,nxr_on_file )
     5595#endif
     5596                         
     5597                   CASE ( 't_surf_green_v(1)' )
     5598#if defined( __nopointer )       
     5599                      IF ( kk == 1 )  THEN
     5600                         IF ( .NOT.  ALLOCATED( t_surf_green_v(1)%t ) )              &
     5601                            ALLOCATE( t_surf_green_v(1)%t(1:surf_usm_v(1)%ns) )
     5602                         READ ( 13 )  tmp_surf_green_v(1)%t
     5603                      ENDIF
     5604                      CALL surface_restore_elements(                           &
     5605                                              t_surf_green_v(1)%t, tmp_surf_green_v(1)%t,  &
     5606                                              surf_usm_v(1)%start_index,       &
     5607                                              start_index_on_file,             &
     5608                                              end_index_on_file,               &
     5609                                              nxlc, nysc,                      &
     5610                                              nxlf, nxrf, nysf, nynf,          &
     5611                                              nys_on_file, nyn_on_file,        &
     5612                                              nxl_on_file,nxr_on_file )                 
     5613#else                     
     5614                      IF ( kk == 1 )  THEN
     5615                         IF ( .NOT.  ALLOCATED( t_surf_green_v_1(1)%t ) )            &
     5616                            ALLOCATE( t_surf_green_v_1(1)%t(1:surf_usm_v(1)%ns) )
     5617                         READ ( 13 )  tmp_surf_green_v(1)%t
     5618                      ENDIF
     5619                      CALL surface_restore_elements(                           &
     5620                                              t_surf_green_v_1(1)%t, tmp_surf_green_v(1)%t,&
     5621                                              surf_usm_v(1)%start_index,       &
     5622                                              start_index_on_file,             &
     5623                                              end_index_on_file,               &
     5624                                              nxlc, nysc,                      &
     5625                                              nxlf, nxrf, nysf, nynf,          &
     5626                                              nys_on_file, nyn_on_file,        &
     5627                                              nxl_on_file,nxr_on_file )
     5628#endif
     5629
     5630                   CASE ( 't_surf_green_v(2)' )
     5631#if defined( __nopointer )         
     5632                      IF ( kk == 1 )  THEN
     5633                         IF ( .NOT.  ALLOCATED( t_surf_green_v(2)%t ) )              &
     5634                            ALLOCATE( t_surf_green_v(2)%t(1:surf_usm_v(2)%ns) )
     5635                         READ ( 13 )  tmp_surf_green_v(2)%t
     5636                      ENDIF
     5637                      CALL surface_restore_elements(                           &
     5638                                              t_surf_green_v(2)%t, tmp_surf_green_v(2)%t,  &
     5639                                              surf_usm_v(2)%start_index,       &
     5640                                              start_index_on_file,             &
     5641                                              end_index_on_file,               &
     5642                                              nxlc, nysc,                      &
     5643                                              nxlf, nxrf, nysf, nynf,          &
     5644                                              nys_on_file, nyn_on_file,        &
     5645                                              nxl_on_file,nxr_on_file )
     5646#else                     
     5647                      IF ( kk == 1 )  THEN
     5648                         IF ( .NOT.  ALLOCATED( t_surf_green_v_1(2)%t ) )            &
     5649                            ALLOCATE( t_surf_green_v_1(2)%t(1:surf_usm_v(2)%ns) )
     5650                         READ ( 13 )  tmp_surf_green_v(2)%t
     5651                      ENDIF
     5652                      CALL surface_restore_elements(                           &
     5653                                              t_surf_green_v_1(2)%t, tmp_surf_green_v(2)%t,&
     5654                                              surf_usm_v(2)%start_index,       &
     5655                                              start_index_on_file,             &
     5656                                              end_index_on_file,               &
     5657                                              nxlc, nysc,                      &
     5658                                              nxlf, nxrf, nysf, nynf,          &
     5659                                              nys_on_file, nyn_on_file,        &
     5660                                              nxl_on_file,nxr_on_file )
     5661#endif
     5662                         
     5663                   CASE ( 't_surf_green_v(3)' )
     5664#if defined( __nopointer )   
     5665                      IF ( kk == 1 )  THEN
     5666                         IF ( .NOT.  ALLOCATED( t_surf_green_v(3)%t ) )              &
     5667                            ALLOCATE( t_surf_green_v(3)%t(1:surf_usm_v(3)%ns) )
     5668                         READ ( 13 )  tmp_surf_green_v(3)%t
     5669                      ENDIF
     5670                      CALL surface_restore_elements(                           &
     5671                                              t_surf_green_v(3)%t, tmp_surf_green_v(3)%t,  &
     5672                                              surf_usm_v(3)%start_index,       &
     5673                                              start_index_on_file,             &
     5674                                              end_index_on_file,               &
     5675                                              nxlc, nysc,                      &
     5676                                              nxlf, nxrf, nysf, nynf,          &
     5677                                              nys_on_file, nyn_on_file,        &
     5678                                              nxl_on_file,nxr_on_file )
     5679#else                     
     5680                      IF ( kk == 1 )  THEN
     5681                         IF ( .NOT.  ALLOCATED( t_surf_green_v_1(3)%t ) )            &
     5682                            ALLOCATE( t_surf_green_v_1(3)%t(1:surf_usm_v(3)%ns) )
     5683                         READ ( 13 )  tmp_surf_green_v(3)%t
     5684                      ENDIF
     5685                      CALL surface_restore_elements(                           &
     5686                                              t_surf_green_v_1(3)%t, tmp_surf_green_v(3)%t,&
     5687                                              surf_usm_v(3)%start_index,       &
     5688                                              start_index_on_file,             &
     5689                                              end_index_on_file,               &
     5690                                              nxlc, nysc,                      &
     5691                                              nxlf, nxrf, nysf, nynf,          &
     5692                                              nys_on_file, nyn_on_file,        &
     5693                                              nxl_on_file,nxr_on_file )
     5694#endif
     5695                   CASE ( 't_surf_window_h' )
     5696#if defined( __nopointer )                   
     5697                      IF ( kk == 1 )  THEN
     5698                         IF ( .NOT.  ALLOCATED( t_surf_window_h ) )                   &
     5699                            ALLOCATE( t_surf_window_h(1:surf_usm_h%ns) )
     5700                         READ ( 13 )  tmp_surf_window_h
     5701                      ENDIF
     5702                      CALL surface_restore_elements(                           &
     5703                                              t_surf_window_h, tmp_surf_window_h,            &
     5704                                              surf_usm_h%start_index,          &
     5705                                              start_index_on_file,             &
     5706                                              end_index_on_file,               &
     5707                                              nxlc, nysc,                      &
     5708                                              nxlf, nxrf, nysf, nynf,          &
     5709                                              nys_on_file, nyn_on_file,        &
     5710                                              nxl_on_file,nxr_on_file )
     5711#else                     
     5712                      IF ( kk == 1 )  THEN
     5713                         IF ( .NOT.  ALLOCATED( t_surf_window_h_1 ) )                 &
     5714                            ALLOCATE( t_surf_window_h_1(1:surf_usm_h%ns) )
     5715                         READ ( 13 )  tmp_surf_window_h
     5716                      ENDIF
     5717                      CALL surface_restore_elements(                           &
     5718                                              t_surf_window_h_1, tmp_surf_window_h,          &
     5719                                              surf_usm_h%start_index,          &
     5720                                              start_index_on_file,             &
     5721                                              end_index_on_file,               &
     5722                                              nxlc, nysc,                      &
     5723                                              nxlf, nxrf, nysf, nynf,          &
     5724                                              nys_on_file, nyn_on_file,        &
     5725                                              nxl_on_file,nxr_on_file )
     5726#endif
     5727
     5728                   CASE ( 't_surf_window_v(0)' )
     5729#if defined( __nopointer )           
     5730                      IF ( kk == 1 )  THEN
     5731                         IF ( .NOT.  ALLOCATED( t_surf_window_v(0)%t ) )              &
     5732                            ALLOCATE( t_surf_window_v(0)%t(1:surf_usm_v(0)%ns) )
     5733                         READ ( 13 )  tmp_surf_window_v(0)%t
     5734                      ENDIF
     5735                      CALL surface_restore_elements(                           &
     5736                                              t_surf_window_v(0)%t, tmp_surf_window_v(0)%t,  &
     5737                                              surf_usm_v(0)%start_index,       &
     5738                                              start_index_on_file,             &
     5739                                              end_index_on_file,               &
     5740                                              nxlc, nysc,                      &
     5741                                              nxlf, nxrf, nysf, nynf,          &
     5742                                              nys_on_file, nyn_on_file,        &
     5743                                              nxl_on_file,nxr_on_file )
     5744#else                     
     5745                      IF ( kk == 1 )  THEN
     5746                         IF ( .NOT.  ALLOCATED( t_surf_window_v_1(0)%t ) )            &
     5747                            ALLOCATE( t_surf_window_v_1(0)%t(1:surf_usm_v(0)%ns) )
     5748                         READ ( 13 )  tmp_surf_window_v(0)%t
     5749                      ENDIF
     5750                      CALL surface_restore_elements(                           &
     5751                                              t_surf_window_v_1(0)%t, tmp_surf_window_v(0)%t,&
     5752                                              surf_usm_v(0)%start_index,       &
     5753                                              start_index_on_file,             &
     5754                                              end_index_on_file,               &
     5755                                              nxlc, nysc,                      &
     5756                                              nxlf, nxrf, nysf, nynf,          &
     5757                                              nys_on_file, nyn_on_file,        &
     5758                                              nxl_on_file,nxr_on_file )
     5759#endif
     5760                         
     5761                   CASE ( 't_surf_window_v(1)' )
     5762#if defined( __nopointer )       
     5763                      IF ( kk == 1 )  THEN
     5764                         IF ( .NOT.  ALLOCATED( t_surf_window_v(1)%t ) )              &
     5765                            ALLOCATE( t_surf_window_v(1)%t(1:surf_usm_v(1)%ns) )
     5766                         READ ( 13 )  tmp_surf_window_v(1)%t
     5767                      ENDIF
     5768                      CALL surface_restore_elements(                           &
     5769                                              t_surf_window_v(1)%t, tmp_surf_window_v(1)%t,  &
     5770                                              surf_usm_v(1)%start_index,       &
     5771                                              start_index_on_file,             &
     5772                                              end_index_on_file,               &
     5773                                              nxlc, nysc,                      &
     5774                                              nxlf, nxrf, nysf, nynf,          &
     5775                                              nys_on_file, nyn_on_file,        &
     5776                                              nxl_on_file,nxr_on_file )                 
     5777#else                     
     5778                      IF ( kk == 1 )  THEN
     5779                         IF ( .NOT.  ALLOCATED( t_surf_window_v_1(1)%t ) )            &
     5780                            ALLOCATE( t_surf_window_v_1(1)%t(1:surf_usm_v(1)%ns) )
     5781                         READ ( 13 )  tmp_surf_window_v(1)%t
     5782                      ENDIF
     5783                      CALL surface_restore_elements(                           &
     5784                                              t_surf_window_v_1(1)%t, tmp_surf_window_v(1)%t,&
     5785                                              surf_usm_v(1)%start_index,       &
     5786                                              start_index_on_file,             &
     5787                                              end_index_on_file,               &
     5788                                              nxlc, nysc,                      &
     5789                                              nxlf, nxrf, nysf, nynf,          &
     5790                                              nys_on_file, nyn_on_file,        &
     5791                                              nxl_on_file,nxr_on_file )
     5792#endif
     5793
     5794                   CASE ( 't_surf_window_v(2)' )
     5795#if defined( __nopointer )         
     5796                      IF ( kk == 1 )  THEN
     5797                         IF ( .NOT.  ALLOCATED( t_surf_window_v(2)%t ) )              &
     5798                            ALLOCATE( t_surf_window_v(2)%t(1:surf_usm_v(2)%ns) )
     5799                         READ ( 13 )  tmp_surf_window_v(2)%t
     5800                      ENDIF
     5801                      CALL surface_restore_elements(                           &
     5802                                              t_surf_window_v(2)%t, tmp_surf_window_v(2)%t,  &
     5803                                              surf_usm_v(2)%start_index,       &
     5804                                              start_index_on_file,             &
     5805                                              end_index_on_file,               &
     5806                                              nxlc, nysc,                      &
     5807                                              nxlf, nxrf, nysf, nynf,          &
     5808                                              nys_on_file, nyn_on_file,        &
     5809                                              nxl_on_file,nxr_on_file )
     5810#else                     
     5811                      IF ( kk == 1 )  THEN
     5812                         IF ( .NOT.  ALLOCATED( t_surf_window_v_1(2)%t ) )            &
     5813                            ALLOCATE( t_surf_window_v_1(2)%t(1:surf_usm_v(2)%ns) )
     5814                         READ ( 13 )  tmp_surf_window_v(2)%t
     5815                      ENDIF
     5816                      CALL surface_restore_elements(                           &
     5817                                              t_surf_window_v_1(2)%t, tmp_surf_window_v(2)%t,&
     5818                                              surf_usm_v(2)%start_index,       &
     5819                                              start_index_on_file,             &
     5820                                              end_index_on_file,               &
     5821                                              nxlc, nysc,                      &
     5822                                              nxlf, nxrf, nysf, nynf,          &
     5823                                              nys_on_file, nyn_on_file,        &
     5824                                              nxl_on_file,nxr_on_file )
     5825#endif
     5826                         
     5827                   CASE ( 't_surf_window_v(3)' )
     5828#if defined( __nopointer )   
     5829                      IF ( kk == 1 )  THEN
     5830                         IF ( .NOT.  ALLOCATED( t_surf_window_v(3)%t ) )              &
     5831                            ALLOCATE( t_surf_window_v(3)%t(1:surf_usm_v(3)%ns) )
     5832                         READ ( 13 )  tmp_surf_window_v(3)%t
     5833                      ENDIF
     5834                      CALL surface_restore_elements(                           &
     5835                                              t_surf_window_v(3)%t, tmp_surf_window_v(3)%t,  &
     5836                                              surf_usm_v(3)%start_index,       &
     5837                                              start_index_on_file,             &
     5838                                              end_index_on_file,               &
     5839                                              nxlc, nysc,                      &
     5840                                              nxlf, nxrf, nysf, nynf,          &
     5841                                              nys_on_file, nyn_on_file,        &
     5842                                              nxl_on_file,nxr_on_file )
     5843#else                     
     5844                      IF ( kk == 1 )  THEN
     5845                         IF ( .NOT.  ALLOCATED( t_surf_window_v_1(3)%t ) )            &
     5846                            ALLOCATE( t_surf_window_v_1(3)%t(1:surf_usm_v(3)%ns) )
     5847                         READ ( 13 )  tmp_surf_window_v(3)%t
     5848                      ENDIF
     5849                      CALL surface_restore_elements(                           &
     5850                                              t_surf_window_v_1(3)%t, tmp_surf_window_v(3)%t,&
     5851                                              surf_usm_v(3)%start_index,       &
     5852                                              start_index_on_file,             &
     5853                                              end_index_on_file,               &
     5854                                              nxlc, nysc,                      &
     5855                                              nxlf, nxrf, nysf, nynf,          &
     5856                                              nys_on_file, nyn_on_file,        &
     5857                                              nxl_on_file,nxr_on_file )
    44145858#endif
    44155859                   CASE ( 't_wall_h' )
     
    44205864                         READ ( 13 )  tmp_wall_h
    44215865                      ENDIF
    4422                       CALL restore_surface_elements_usm_2d(                    &
     5866                      CALL surface_restore_elements(                           &
    44235867                                              t_wall_h, tmp_wall_h,            &
    4424                                               surf_usm_h%start_index )
     5868                                              surf_usm_h%start_index,          &
     5869                                              start_index_on_file,             &
     5870                                              end_index_on_file,               &
     5871                                              nxlc, nysc,                      &
     5872                                              nxlf, nxrf, nysf, nynf,          &
     5873                                              nys_on_file, nyn_on_file,        &
     5874                                              nxl_on_file,nxr_on_file )
    44255875#else
    44265876                      IF ( kk == 1 )  THEN
     
    44295879                         READ ( 13 )  tmp_wall_h
    44305880                      ENDIF
    4431                       CALL restore_surface_elements_usm_2d(                    &
     5881                      CALL surface_restore_elements(                           &
    44325882                                              t_wall_h_1, tmp_wall_h,          &
    4433                                               surf_usm_h%start_index )
     5883                                              surf_usm_h%start_index,          &
     5884                                              start_index_on_file,             &
     5885                                              end_index_on_file,               &
     5886                                              nxlc, nysc,                      &
     5887                                              nxlf, nxrf, nysf, nynf,          &
     5888                                              nys_on_file, nyn_on_file,        &
     5889                                              nxl_on_file,nxr_on_file )
    44345890#endif
    44355891                   CASE ( 't_wall_v(0)' )
     
    44405896                         READ ( 13 )  tmp_wall_v(0)%t
    44415897                      ENDIF
    4442                       CALL restore_surface_elements_usm_2d(                    &
     5898                      CALL surface_restore_elements(                           &
    44435899                                              t_wall_v(0)%t, tmp_wall_v(0)%t,  &
    4444                                               surf_usm_v(0)%start_index )
     5900                                              surf_usm_v(0)%start_index,       &
     5901                                              start_index_on_file,             &
     5902                                              end_index_on_file,               &
     5903                                              nxlc, nysc,                      &
     5904                                              nxlf, nxrf, nysf, nynf,          &
     5905                                              nys_on_file, nyn_on_file,        &
     5906                                              nxl_on_file,nxr_on_file )
    44455907#else
    44465908                      IF ( kk == 1 )  THEN
     
    44495911                         READ ( 13 )  tmp_wall_v(0)%t
    44505912                      ENDIF
    4451                       CALL restore_surface_elements_usm_2d(                    &
     5913                      CALL surface_restore_elements(                           &
    44525914                                              t_wall_v_1(0)%t, tmp_wall_v(0)%t,&
    4453                                               surf_usm_v(0)%start_index )
     5915                                              surf_usm_v(0)%start_index,       &
     5916                                              start_index_on_file,             &
     5917                                              end_index_on_file,               &
     5918                                              nxlc, nysc,                      &
     5919                                              nxlf, nxrf, nysf, nynf,          &
     5920                                              nys_on_file, nyn_on_file,        &
     5921                                              nxl_on_file,nxr_on_file )
    44545922#endif
    44555923                   CASE ( 't_wall_v(1)' )
     
    44605928                         READ ( 13 )  tmp_wall_v(1)%t
    44615929                      ENDIF
    4462                       CALL restore_surface_elements_usm_2d(                    &
     5930                      CALL surface_restore_elements(                           &
    44635931                                              t_wall_v(1)%t, tmp_wall_v(1)%t,  &
    4464                                               surf_usm_v(1)%start_index )
     5932                                              surf_usm_v(1)%start_index,       &
     5933                                              start_index_on_file,             &
     5934                                              end_index_on_file ,              &
     5935                                              nxlc, nysc,           ,          &
     5936                                              nys_on_file, nyn_on_file,        &
     5937                                              nxl_on_file,nxr_on_file )
    44655938#else
    44665939                      IF ( kk == 1 )  THEN
     
    44695942                         READ ( 13 )  tmp_wall_v(1)%t
    44705943                      ENDIF
    4471                       CALL restore_surface_elements_usm_2d(                    &
     5944                      CALL surface_restore_elements(                           &
    44725945                                              t_wall_v_1(1)%t, tmp_wall_v(1)%t,&
    4473                                               surf_usm_v(1)%start_index )
     5946                                              surf_usm_v(1)%start_index,       &
     5947                                              start_index_on_file,             &
     5948                                              end_index_on_file,               &
     5949                                              nxlc, nysc,                      &
     5950                                              nxlf, nxrf, nysf, nynf,          &
     5951                                              nys_on_file, nyn_on_file,        &
     5952                                              nxl_on_file,nxr_on_file )
    44745953#endif
    44755954                   CASE ( 't_wall_v(2)' )
     
    44805959                         READ ( 13 )  tmp_wall_v(2)%t
    44815960                      ENDIF
    4482                       CALL restore_surface_elements_usm_2d(                    &
     5961                      CALL surface_restore_elements(                           &
    44835962                                              t_wall_v(2)%t, tmp_wall_v(2)%t,  &
    4484                                               surf_usm_v(2)%start_index )
     5963                                              surf_usm_v(2)%start_index,       &
     5964                                              start_index_on_file,             &
     5965                                              end_index_on_file,               &
     5966                                              nxlc, nysc,                      &
     5967                                              nxlf, nxrf, nysf, nynf,          &
     5968                                              nys_on_file, nyn_on_file,        &
     5969                                              nxl_on_file,nxr_on_file )
    44855970#else
    44865971                      IF ( kk == 1 )  THEN
     
    44895974                         READ ( 13 )  tmp_wall_v(2)%t
    44905975                      ENDIF
    4491                       CALL restore_surface_elements_usm_2d(                    &
     5976                      CALL surface_restore_elements(                           &
    44925977                                              t_wall_v_1(2)%t, tmp_wall_v(2)%t,&
    4493                                               surf_usm_v(2)%start_index )
     5978                                              surf_usm_v(2)%start_index,       &
     5979                                              start_index_on_file,             &
     5980                                              end_index_on_file ,               &
     5981                                              nxlc, nysc,                      &
     5982                                              nxlf, nxrf, nysf, nynf,          &
     5983                                              nys_on_file, nyn_on_file,        &
     5984                                              nxl_on_file,nxr_on_file )
    44945985#endif
    44955986                   CASE ( 't_wall_v(3)' )
     
    45005991                         READ ( 13 )  tmp_wall_v(3)%t
    45015992                      ENDIF
    4502                       CALL restore_surface_elements_usm_2d(                    &
     5993                      CALL surface_restore_elements(                           &
    45035994                                              t_wall_v(3)%t, tmp_wall_v(3)%t,  &
    4504                                               surf_usm_v(3)%start_index )
     5995                                              surf_usm_v(3)%start_index,       &
     5996                                              start_index_on_file,             &
     5997                                              end_index_on_file,               &
     5998                                              nxlc, nysc,                      &
     5999                                              nxlf, nxrf, nysf, nynf,          &
     6000                                              nys_on_file, nyn_on_file,        &
     6001                                              nxl_on_file,nxr_on_file )
    45056002#else
    45066003                      IF ( kk == 1 )  THEN
     
    45096006                         READ ( 13 )  tmp_wall_v(3)%t
    45106007                      ENDIF
    4511                       CALL restore_surface_elements_usm_2d(                    &
     6008                      CALL surface_restore_elements(                           &
    45126009                                              t_wall_v_1(3)%t, tmp_wall_v(3)%t,&
    4513                                               surf_usm_v(3)%start_index )
     6010                                              surf_usm_v(3)%start_index,       &
     6011                                              start_index_on_file,             &
     6012                                              end_index_on_file,               &
     6013                                              nxlc, nysc,                      &
     6014                                              nxlf, nxrf, nysf, nynf,          &
     6015                                              nys_on_file, nyn_on_file,        &
     6016                                              nxl_on_file,nxr_on_file )
    45146017#endif
    4515 
     6018                   CASE ( 't_green_h' )
     6019#if defined( __nopointer )
     6020                      IF ( kk == 1 )  THEN
     6021                         IF ( .NOT.  ALLOCATED( t_green_h ) )                   &
     6022                            ALLOCATE( t_green_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     6023                         READ ( 13 )  tmp_green_h
     6024                      ENDIF
     6025                      CALL surface_restore_elements(                           &
     6026                                              t_green_h, tmp_green_h,            &
     6027                                              surf_usm_h%start_index,          &
     6028                                              start_index_on_file,             &
     6029                                              end_index_on_file,               &
     6030                                              nxlc, nysc,                      &
     6031                                              nxlf, nxrf, nysf, nynf,          &
     6032                                              nys_on_file, nyn_on_file,        &
     6033                                              nxl_on_file,nxr_on_file )
     6034#else
     6035                      IF ( kk == 1 )  THEN
     6036                         IF ( .NOT.  ALLOCATED( t_green_h_1 ) )                 &
     6037                            ALLOCATE( t_green_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     6038                         READ ( 13 )  tmp_green_h
     6039                      ENDIF
     6040                      CALL surface_restore_elements(                           &
     6041                                              t_green_h_1, tmp_green_h,          &
     6042                                              surf_usm_h%start_index,          &
     6043                                              start_index_on_file,             &
     6044                                              end_index_on_file,               &
     6045                                              nxlc, nysc,                      &
     6046                                              nxlf, nxrf, nysf, nynf,          &
     6047                                              nys_on_file, nyn_on_file,        &
     6048                                              nxl_on_file,nxr_on_file )
     6049#endif
     6050                   CASE ( 't_green_v(0)' )
     6051#if defined( __nopointer )
     6052                      IF ( kk == 1 )  THEN
     6053                         IF ( .NOT.  ALLOCATED( t_green_v(0)%t ) )              &
     6054                            ALLOCATE( t_green_v(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) )
     6055                         READ ( 13 )  tmp_green_v(0)%t
     6056                      ENDIF
     6057                      CALL surface_restore_elements(                           &
     6058                                              t_green_v(0)%t, tmp_green_v(0)%t,  &
     6059                                              surf_usm_v(0)%start_index,       &
     6060                                              start_index_on_file,             &
     6061                                              end_index_on_file,               &
     6062                                              nxlc, nysc,                      &
     6063                                              nxlf, nxrf, nysf, nynf,          &
     6064                                              nys_on_file, nyn_on_file,        &
     6065                                              nxl_on_file,nxr_on_file )
     6066#else
     6067                      IF ( kk == 1 )  THEN
     6068                         IF ( .NOT.  ALLOCATED( t_green_v_1(0)%t ) )            &
     6069                            ALLOCATE( t_green_v_1(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) )
     6070                         READ ( 13 )  tmp_green_v(0)%t
     6071                      ENDIF
     6072                      CALL surface_restore_elements(                           &
     6073                                              t_green_v_1(0)%t, tmp_green_v(0)%t,&
     6074                                              surf_usm_v(0)%start_index,       &
     6075                                              start_index_on_file,             &
     6076                                              end_index_on_file,               &
     6077                                              nxlc, nysc,                      &
     6078                                              nxlf, nxrf, nysf, nynf,          &
     6079                                              nys_on_file, nyn_on_file,        &
     6080                                              nxl_on_file,nxr_on_file )
     6081#endif
     6082                   CASE ( 't_green_v(1)' )
     6083#if defined( __nopointer )
     6084                      IF ( kk == 1 )  THEN
     6085                         IF ( .NOT.  ALLOCATED( t_green_v(1)%t ) )              &
     6086                            ALLOCATE( t_green_v(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) )
     6087                         READ ( 13 )  tmp_green_v(1)%t
     6088                      ENDIF
     6089                      CALL surface_restore_elements(                           &
     6090                                              t_green_v(1)%t, tmp_green_v(1)%t,  &
     6091                                              surf_usm_v(1)%start_index,       &
     6092                                              start_index_on_file,             &
     6093                                              end_index_on_file ,              &
     6094                                              nxlc, nysc,           ,          &
     6095                                              nys_on_file, nyn_on_file,        &
     6096                                              nxl_on_file,nxr_on_file )
     6097#else
     6098                      IF ( kk == 1 )  THEN
     6099                         IF ( .NOT.  ALLOCATED( t_green_v_1(1)%t ) )            &
     6100                            ALLOCATE( t_green_v_1(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) )
     6101                         READ ( 13 )  tmp_green_v(1)%t
     6102                      ENDIF
     6103                      CALL surface_restore_elements(                           &
     6104                                              t_green_v_1(1)%t, tmp_green_v(1)%t,&
     6105                                              surf_usm_v(1)%start_index,       &
     6106                                              start_index_on_file,             &
     6107                                              end_index_on_file,               &
     6108                                              nxlc, nysc,                      &
     6109                                              nxlf, nxrf, nysf, nynf,          &
     6110                                              nys_on_file, nyn_on_file,        &
     6111                                              nxl_on_file,nxr_on_file )
     6112#endif
     6113                   CASE ( 't_green_v(2)' )
     6114#if defined( __nopointer )
     6115                      IF ( kk == 1 )  THEN
     6116                         IF ( .NOT.  ALLOCATED( t_green_v(2)%t ) )              &
     6117                            ALLOCATE( t_green_v(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) )
     6118                         READ ( 13 )  tmp_green_v(2)%t
     6119                      ENDIF
     6120                      CALL surface_restore_elements(                           &
     6121                                              t_green_v(2)%t, tmp_green_v(2)%t,  &
     6122                                              surf_usm_v(2)%start_index,       &
     6123                                              start_index_on_file,             &
     6124                                              end_index_on_file,               &
     6125                                              nxlc, nysc,                      &
     6126                                              nxlf, nxrf, nysf, nynf,          &
     6127                                              nys_on_file, nyn_on_file,        &
     6128                                              nxl_on_file,nxr_on_file )
     6129#else
     6130                      IF ( kk == 1 )  THEN
     6131                         IF ( .NOT.  ALLOCATED( t_green_v_1(2)%t ) )            &
     6132                            ALLOCATE( t_green_v_1(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) )
     6133                         READ ( 13 )  tmp_green_v(2)%t
     6134                      ENDIF
     6135                      CALL surface_restore_elements(                           &
     6136                                              t_green_v_1(2)%t, tmp_green_v(2)%t,&
     6137                                              surf_usm_v(2)%start_index,       &
     6138                                              start_index_on_file,             &
     6139                                              end_index_on_file ,               &
     6140                                              nxlc, nysc,                      &
     6141                                              nxlf, nxrf, nysf, nynf,          &
     6142                                              nys_on_file, nyn_on_file,        &
     6143                                              nxl_on_file,nxr_on_file )
     6144#endif
     6145                   CASE ( 't_green_v(3)' )
     6146#if defined( __nopointer )
     6147                      IF ( kk == 1 )  THEN
     6148                         IF ( .NOT.  ALLOCATED( t_green_v(3)%t ) )              &
     6149                            ALLOCATE( t_green_v(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
     6150                         READ ( 13 )  tmp_green_v(3)%t
     6151                      ENDIF
     6152                      CALL surface_restore_elements(                           &
     6153                                              t_green_v(3)%t, tmp_green_v(3)%t,  &
     6154                                              surf_usm_v(3)%start_index,       &
     6155                                              start_index_on_file,             &
     6156                                              end_index_on_file,               &
     6157                                              nxlc, nysc,                      &
     6158                                              nxlf, nxrf, nysf, nynf,          &
     6159                                              nys_on_file, nyn_on_file,        &
     6160                                              nxl_on_file,nxr_on_file )
     6161#else
     6162                      IF ( kk == 1 )  THEN
     6163                         IF ( .NOT.  ALLOCATED( t_green_v_1(3)%t ) )            &
     6164                            ALLOCATE( t_green_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
     6165                         READ ( 13 )  tmp_green_v(3)%t
     6166                      ENDIF
     6167                      CALL surface_restore_elements(                           &
     6168                                              t_green_v_1(3)%t, tmp_green_v(3)%t,&
     6169                                              surf_usm_v(3)%start_index,       &
     6170                                              start_index_on_file,             &
     6171                                              end_index_on_file,               &
     6172                                              nxlc, nysc,                      &
     6173                                              nxlf, nxrf, nysf, nynf,          &
     6174                                              nys_on_file, nyn_on_file,        &
     6175                                              nxl_on_file,nxr_on_file )
     6176#endif
     6177                   CASE ( 't_window_h' )
     6178#if defined( __nopointer )
     6179                      IF ( kk == 1 )  THEN
     6180                         IF ( .NOT.  ALLOCATED( t_window_h ) )                   &
     6181                            ALLOCATE( t_window_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     6182                         READ ( 13 )  tmp_window_h
     6183                      ENDIF
     6184                      CALL surface_restore_elements(                           &
     6185                                              t_window_h, tmp_window_h,            &
     6186                                              surf_usm_h%start_index,          &
     6187                                              start_index_on_file,             &
     6188                                              end_index_on_file,               &
     6189                                              nxlc, nysc,                      &
     6190                                              nxlf, nxrf, nysf, nynf,          &
     6191                                              nys_on_file, nyn_on_file,        &
     6192                                              nxl_on_file,nxr_on_file )
     6193#else
     6194                      IF ( kk == 1 )  THEN
     6195                         IF ( .NOT.  ALLOCATED( t_window_h_1 ) )                 &
     6196                            ALLOCATE( t_window_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
     6197                         READ ( 13 )  tmp_window_h
     6198                      ENDIF
     6199                      CALL surface_restore_elements(                           &
     6200                                              t_window_h_1, tmp_window_h,          &
     6201                                              surf_usm_h%start_index,          &
     6202                                              start_index_on_file,             &
     6203                                              end_index_on_file,               &
     6204                                              nxlc, nysc,                      &
     6205                                              nxlf, nxrf, nysf, nynf,          &
     6206                                              nys_on_file, nyn_on_file,        &
     6207                                              nxl_on_file,nxr_on_file )
     6208#endif
     6209                   CASE ( 't_window_v(0)' )
     6210#if defined( __nopointer )
     6211                      IF ( kk == 1 )  THEN
     6212                         IF ( .NOT.  ALLOCATED( t_window_v(0)%t ) )              &
     6213                            ALLOCATE( t_window_v(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) )
     6214                         READ ( 13 )  tmp_window_v(0)%t
     6215                      ENDIF
     6216                      CALL surface_restore_elements(                           &
     6217                                              t_window_v(0)%t, tmp_window_v(0)%t,  &
     6218                                              surf_usm_v(0)%start_index,       &
     6219                                              start_index_on_file,             &
     6220                                              end_index_on_file,               &
     6221                                              nxlc, nysc,                      &
     6222                                              nxlf, nxrf, nysf, nynf,          &
     6223                                              nys_on_file, nyn_on_file,        &
     6224                                              nxl_on_file,nxr_on_file )
     6225#else
     6226                      IF ( kk == 1 )  THEN
     6227                         IF ( .NOT.  ALLOCATED( t_window_v_1(0)%t ) )            &
     6228                            ALLOCATE( t_window_v_1(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) )
     6229                         READ ( 13 )  tmp_window_v(0)%t
     6230                      ENDIF
     6231                      CALL surface_restore_elements(                           &
     6232                                              t_window_v_1(0)%t, tmp_window_v(0)%t,&
     6233                                              surf_usm_v(0)%start_index,       &
     6234                                              start_index_on_file,             &
     6235                                              end_index_on_file,               &
     6236                                              nxlc, nysc,                      &
     6237                                              nxlf, nxrf, nysf, nynf,          &
     6238                                              nys_on_file, nyn_on_file,        &
     6239                                              nxl_on_file,nxr_on_file )
     6240#endif
     6241                   CASE ( 't_window_v(1)' )
     6242#if defined( __nopointer )
     6243                      IF ( kk == 1 )  THEN
     6244                         IF ( .NOT.  ALLOCATED( t_window_v(1)%t ) )              &
     6245                            ALLOCATE( t_window_v(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) )
     6246                         READ ( 13 )  tmp_window_v(1)%t
     6247                      ENDIF
     6248                      CALL surface_restore_elements(                           &
     6249                                              t_window_v(1)%t, tmp_window_v(1)%t,  &
     6250                                              surf_usm_v(1)%start_index,       &
     6251                                              start_index_on_file,             &
     6252                                              end_index_on_file ,              &
     6253                                              nxlc, nysc,           ,          &
     6254                                              nys_on_file, nyn_on_file,        &
     6255                                              nxl_on_file,nxr_on_file )
     6256#else
     6257                      IF ( kk == 1 )  THEN
     6258                         IF ( .NOT.  ALLOCATED( t_window_v_1(1)%t ) )            &
     6259                            ALLOCATE( t_window_v_1(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) )
     6260                         READ ( 13 )  tmp_window_v(1)%t
     6261                      ENDIF
     6262                      CALL surface_restore_elements(                           &
     6263                                              t_window_v_1(1)%t, tmp_window_v(1)%t,&
     6264                                              surf_usm_v(1)%start_index,       &
     6265                                              start_index_on_file,             &
     6266                                              end_index_on_file,               &
     6267                                              nxlc, nysc,                      &
     6268                                              nxlf, nxrf, nysf, nynf,          &
     6269                                              nys_on_file, nyn_on_file,        &
     6270                                              nxl_on_file,nxr_on_file )
     6271#endif
     6272                   CASE ( 't_window_v(2)' )
     6273#if defined( __nopointer )
     6274                      IF ( kk == 1 )  THEN
     6275                         IF ( .NOT.  ALLOCATED( t_window_v(2)%t ) )              &
     6276                            ALLOCATE( t_window_v(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) )
     6277                         READ ( 13 )  tmp_window_v(2)%t
     6278                      ENDIF
     6279                      CALL surface_restore_elements(                           &
     6280                                              t_window_v(2)%t, tmp_window_v(2)%t,  &
     6281                                              surf_usm_v(2)%start_index,       &
     6282                                              start_index_on_file,             &
     6283                                              end_index_on_file,               &
     6284                                              nxlc, nysc,                      &
     6285                                              nxlf, nxrf, nysf, nynf,          &
     6286                                              nys_on_file, nyn_on_file,        &
     6287                                              nxl_on_file,nxr_on_file )
     6288#else
     6289                      IF ( kk == 1 )  THEN
     6290                         IF ( .NOT.  ALLOCATED( t_window_v_1(2)%t ) )            &
     6291                            ALLOCATE( t_window_v_1(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) )
     6292                         READ ( 13 )  tmp_window_v(2)%t
     6293                      ENDIF
     6294                      CALL surface_restore_elements(                           &
     6295                                              t_window_v_1(2)%t, tmp_window_v(2)%t,&
     6296                                              surf_usm_v(2)%start_index,       &
     6297                                              start_index_on_file,             &
     6298                                              end_index_on_file ,               &
     6299                                              nxlc, nysc,                      &
     6300                                              nxlf, nxrf, nysf, nynf,          &
     6301                                              nys_on_file, nyn_on_file,        &
     6302                                              nxl_on_file,nxr_on_file )
     6303#endif
     6304                   CASE ( 't_window_v(3)' )
     6305#if defined( __nopointer )
     6306                      IF ( kk == 1 )  THEN
     6307                         IF ( .NOT.  ALLOCATED( t_window_v(3)%t ) )              &
     6308                            ALLOCATE( t_window_v(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
     6309                         READ ( 13 )  tmp_window_v(3)%t
     6310                      ENDIF
     6311                      CALL surface_restore_elements(                           &
     6312                                              t_window_v(3)%t, tmp_window_v(3)%t,  &
     6313                                              surf_usm_v(3)%start_index,       &
     6314                                              start_index_on_file,             &
     6315                                              end_index_on_file,               &
     6316                                              nxlc, nysc,                      &
     6317                                              nxlf, nxrf, nysf, nynf,          &
     6318                                              nys_on_file, nyn_on_file,        &
     6319                                              nxl_on_file,nxr_on_file )
     6320#else
     6321                      IF ( kk == 1 )  THEN
     6322                         IF ( .NOT.  ALLOCATED( t_window_v_1(3)%t ) )            &
     6323                            ALLOCATE( t_window_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
     6324                         READ ( 13 )  tmp_window_v(3)%t
     6325                      ENDIF
     6326                      CALL surface_restore_elements(                           &
     6327                                              t_window_v_1(3)%t, tmp_window_v(3)%t,&
     6328                                              surf_usm_v(3)%start_index,       &
     6329                                              start_index_on_file,             &
     6330                                              end_index_on_file,               &
     6331                                              nxlc, nysc,                      &
     6332                                              nxlf, nxrf, nysf, nynf,          &
     6333                                              nys_on_file, nyn_on_file,        &
     6334                                              nxl_on_file,nxr_on_file )
     6335#endif
    45166336                   CASE DEFAULT
    45176337                      WRITE ( message_string, * )  'unknown variable named "', &
     
    45306350       ENDIF
    45316351       
    4532        CONTAINS
    4533        
    4534           SUBROUTINE restore_surface_elements_usm_1d( surf_target, surf_file, start_index_c )
    4535 
    4536              IMPLICIT NONE
    4537        
    4538              INTEGER(iwp) ::  i         !< running index along x-direction, refers to former domain size
    4539              INTEGER(iwp) ::  ic        !< running index along x-direction, refers to current domain size
    4540              INTEGER(iwp) ::  j         !< running index along y-direction, refers to former domain size
    4541              INTEGER(iwp) ::  jc        !< running index along y-direction, refers to former domain size       
    4542              INTEGER(iwp) ::  m         !< surface-element index on file
    4543              INTEGER(iwp) ::  mm        !< surface-element index on current subdomain
    4544 
    4545              INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  start_index_c             
    4546              
    4547              REAL(wp), DIMENSION(:) ::  surf_target !< target surface type
    4548              REAL(wp), DIMENSION(:) ::  surf_file   !< surface type on file
    4549              
    4550              ic = nxlc
    4551              DO  i = nxlf, nxrf
    4552                 jc = nysc
    4553                 DO  j = nysf, nynf
    4554 
    4555                    mm = start_index_c(jc,ic)
    4556                    DO  m = start_index_on_file(j,i), end_index_on_file(j,i)
    4557                       surf_target(mm) = surf_file(m)
    4558                       mm = mm + 1
    4559                    ENDDO
    4560 
    4561                    jc = jc + 1
    4562                 ENDDO
    4563                 ic = ic + 1
    4564              ENDDO
    4565 
    4566 
    4567           END SUBROUTINE restore_surface_elements_usm_1d
    4568          
    4569           SUBROUTINE restore_surface_elements_usm_2d( surf_target, surf_file, start_index_c )
    4570 
    4571              IMPLICIT NONE
    4572        
    4573              INTEGER(iwp) ::  i         !< running index along x-direction, refers to former domain size
    4574              INTEGER(iwp) ::  ic        !< running index along x-direction, refers to current domain size
    4575              INTEGER(iwp) ::  j         !< running index along y-direction, refers to former domain size
    4576              INTEGER(iwp) ::  jc        !< running index along y-direction, refers to former domain size       
    4577              INTEGER(iwp) ::  m         !< surface-element index on file
    4578              INTEGER(iwp) ::  mm        !< surface-element index on current subdomain
    4579 
    4580              INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  start_index_c
    4581              
    4582              REAL(wp), DIMENSION(:,:) ::  surf_target !< target surface type
    4583              REAL(wp), DIMENSION(:,:) ::  surf_file   !< surface type on file
    4584              
    4585              ic = nxlc
    4586              DO  i = nxlf, nxrf
    4587                 jc = nysc
    4588                 DO  j = nysf, nynf
    4589 
    4590                    mm = start_index_c(jc,ic)
    4591                    DO  m = start_index_on_file(j,i), end_index_on_file(j,i)
    4592                       surf_target(:,mm) = surf_file(:,m)
    4593                       mm = mm + 1
    4594                    ENDDO
    4595 
    4596                    jc = jc + 1
    4597                 ENDDO
    4598                 ic = ic + 1
    4599              ENDDO
    4600 
    4601           END SUBROUTINE restore_surface_elements_usm_2d
    4602 
    46036352    END SUBROUTINE usm_read_restart_data
    46046353   
    4605 
    4606 
    4607 !------------------------------------------------------------------------------!
    4608 !
    4609 ! Description:
    4610 ! ------------
    4611 !> Soubroutine reads svf and svfsurf data from saved file
    4612 !------------------------------------------------------------------------------!
    4613     SUBROUTINE usm_read_svf_from_file
    4614 
    4615         IMPLICIT NONE
    4616         INTEGER(iwp)                 :: fsvf = 89
    4617         INTEGER(iwp)                 :: i
    4618         CHARACTER(usm_version_len)   :: usm_version_field
    4619         CHARACTER(svf_code_len)      :: svf_code_field
    4620 
    4621         DO  i = 0, io_blocks-1
    4622             IF ( i == io_group )  THEN
    4623                 OPEN ( fsvf, file=TRIM(svf_file_name)//TRIM(coupling_char)//myid_char,               &
    4624                     form='unformatted', status='old' )
    4625 
    4626 !--             read and check version
    4627                 READ ( fsvf ) usm_version_field
    4628                 IF ( TRIM(usm_version_field) /= TRIM(usm_version) )  THEN
    4629                     WRITE( message_string, * ) 'Version of binary SVF file "',           &
    4630                                             TRIM(usm_version_field), '" does not match ',            &
    4631                                             'the version of model "', TRIM(usm_version), '"'
    4632                     CALL message( 'usm_read_svf_from_file', 'UI0012', 1, 2, 0, 6, 0 )
    4633                 ENDIF
    4634                
    4635 !--             read nsvfl, ncsfl
    4636                 READ ( fsvf ) nsvfl, ncsfl
    4637                 IF ( nsvfl <= 0  .OR.  ncsfl < 0 )  THEN
    4638                     WRITE( message_string, * ) 'Wrong number of SVF or CSF'
    4639                     CALL message( 'usm_read_svf_from_file', 'UI0012', 1, 2, 0, 6, 0 )
    4640                 ELSE
    4641                     WRITE(message_string,*) '    Number of SVF and CSF to read', nsvfl, ncsfl
    4642                     CALL location_message( message_string, .TRUE. )
    4643                 ENDIF
    4644                
    4645                 ALLOCATE(svf(ndsvf,nsvfl))
    4646                 ALLOCATE(svfsurf(idsvf,nsvfl))
    4647                 READ(fsvf) svf
    4648                 READ(fsvf) svfsurf
    4649                 IF ( plant_canopy )  THEN
    4650                     ALLOCATE(csf(ndcsf,ncsfl))
    4651                     ALLOCATE(csfsurf(idcsf,ncsfl))
    4652                     READ(fsvf) csf
    4653                     READ(fsvf) csfsurf
    4654                 ENDIF
    4655                 READ ( fsvf ) svf_code_field
    4656                
    4657                 IF ( TRIM(svf_code_field) /= TRIM(svf_code) )  THEN
    4658                     WRITE( message_string, * ) 'Wrong structure of binary svf file'
    4659                     CALL message( 'usm_read_svf_from_file', 'UI0012', 1, 2, 0, 6, 0 )
    4660                 ENDIF
    4661                
    4662                 CLOSE (fsvf)
    4663                
    4664             ENDIF
    4665 #if defined( __parallel )
    4666             CALL MPI_BARRIER( comm2d, ierr )
    4667 #endif
    4668         ENDDO
    4669 
    4670     END SUBROUTINE usm_read_svf_from_file
    46716354
    46726355   
     
    46806363    SUBROUTINE usm_read_urban_surface_types
    46816364   
     6365        USE netcdf_data_input_mod,                                             &
     6366            ONLY:  building_pars_f, building_type_f
     6367
     6368        IMPLICIT NONE
     6369
    46826370        CHARACTER(12)                                         :: wtn
    46836371        INTEGER(iwp)                                          :: wtc
     
    46986386        REAL(wp)                                              :: wealbedo3, wethick3, snalbedo3, snthick3
    46996387       
     6388        LOGICAL                                               ::  surfpar
     6389        LOGICAL                                               ::  urbsurf
     6390
     6391!
     6392!--     If building_pars or building_type are already read from static input
     6393!--     file, skip reading ASCII file.
     6394        IF ( building_type_f%from_file  .OR.  building_pars_f%from_file )      &
     6395           RETURN
     6396
    47006397!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    47016398!--     read categories of walls and their parameters
     
    48446541              ENDIF
    48456542#endif
    4846               surf_usm_h%albedo_surf(m)    = -1.0_wp
     6543              surf_usm_h%albedo(:,m)    = -1.0_wp
    48476544              surf_usm_h%thickness_wall(m) = -1.0_wp
     6545              surf_usm_h%thickness_green(m) = -1.0_wp
     6546              surf_usm_h%thickness_window(m) = -1.0_wp
    48486547           ELSE
    48496548              IF ( usm_par(2,jw,iw)==0 )  THEN
    48506549                 surf_usm_h%isroof_surf(m)    = .FALSE.
    48516550                 surf_usm_h%thickness_wall(m) = -1.0_wp
     6551                 surf_usm_h%thickness_window(m) = -1.0_wp
     6552                 surf_usm_h%thickness_green(m)  = -1.0_wp
    48526553              ELSE
    48536554                 surf_usm_h%isroof_surf(m)    = .TRUE.
    48546555                 surf_usm_h%thickness_wall(m) = usm_val(2,jw,iw)
     6556                 surf_usm_h%thickness_window(m) = usm_val(2,jw,iw)
     6557                 surf_usm_h%thickness_green(m)  = usm_val(2,jw,iw)
    48556558              ENDIF
    48566559              surf_usm_h%surface_types(m) = usm_par(5,jw,iw)
    4857               surf_usm_h%albedo_surf(m)   = usm_val(1,jw,iw)
     6560              surf_usm_h%albedo(:,m)   = usm_val(1,jw,iw)
     6561              surf_usm_h%transmissivity(m)    = 0.0_wp
    48586562           ENDIF
    48596563!
     
    48756579!
    48766580!--        Albedo
    4877            IF ( surf_usm_h%albedo_surf(m) < 0.0_wp )  THEN
    4878               surf_usm_h%albedo_surf(m) = surface_params(ialbedo,ip)
     6581           IF ( surf_usm_h%albedo(0,m) < 0.0_wp )  THEN
     6582              surf_usm_h%albedo(:,m) = surface_params(ialbedo,ip)
    48796583           ENDIF
     6584!--        Transmissivity
     6585           IF ( surf_usm_h%transmissivity(m) < 0.0_wp )  THEN
     6586              surf_usm_h%transmissivity(m) = 0.0_wp
     6587           ENDIF
    48806588!
    48816589!--        emissivity of the wall
    4882            surf_usm_h%emiss_surf(m) = surface_params(iemiss,ip)
     6590           surf_usm_h%emissivity(:,m) = surface_params(iemiss,ip)
    48836591!           
    48846592!--        heat conductivity λS between air and wall ( W m−2 K−1 )
    48856593           surf_usm_h%lambda_surf(m) = surface_params(ilambdas,ip)
     6594           surf_usm_h%lambda_surf_window(m) = surface_params(ilambdas,ip)
     6595           surf_usm_h%lambda_surf_green(m)  = surface_params(ilambdas,ip)
    48866596!           
    48876597!--        roughness relative to concrete
    4888            surf_usm_h%roughness_wall(m) = surface_params(irough,ip)
     6598           surf_usm_h%z0(m) = surface_params(irough,ip)
    48896599!           
    48906600!--        Surface skin layer heat capacity (J m−2 K−1 )
    48916601           surf_usm_h%c_surface(m) = surface_params(icsurf,ip)
     6602           surf_usm_h%c_surface_window(m) = surface_params(icsurf,ip)
     6603           surf_usm_h%c_surface_green(m)  = surface_params(icsurf,ip)
    48926604!           
    48936605!--        wall material parameters:
     
    48976609                surf_usm_h%thickness_wall(m) = surface_params(ithick,ip)
    48986610           ENDIF
     6611           IF ( surf_usm_h%thickness_window(m) <= 0.001_wp )  THEN
     6612                surf_usm_h%thickness_window(m) = surface_params(ithick,ip)
     6613           ENDIF
     6614           IF ( surf_usm_h%thickness_green(m) <= 0.001_wp )  THEN
     6615                surf_usm_h%thickness_green(m) = surface_params(ithick,ip)
     6616           ENDIF
    48996617!           
    49006618!--        volumetric heat capacity rho*C of the wall ( J m−3 K−1 )
    49016619           surf_usm_h%rho_c_wall(:,m) = surface_params(irhoC,ip)
     6620           surf_usm_h%rho_c_window(:,m) = surface_params(irhoC,ip)
     6621           surf_usm_h%rho_c_green(:,m)  = surface_params(irhoC,ip)
    49026622!           
    49036623!--        thermal conductivity λH of the wall (W m−1 K−1 )
    49046624           surf_usm_h%lambda_h(:,m) = surface_params(ilambdah,ip)
     6625           surf_usm_h%lambda_h_window(:,m) = surface_params(ilambdah,ip)
     6626           surf_usm_h%lambda_h_green(:,m)  = surface_params(ilambdah,ip)
    49056627
    49066628        ENDDO
     
    49406662                 IF ( usm_par(ii+1,jw,iw) == 0 )  THEN
    49416663                     surf_usm_v(l)%surface_types(m)  = pedestrant_category   !< default category for wall surface in pedestrant zone
    4942                      surf_usm_v(l)%albedo_surf(m)    = -1.0_wp
     6664                     surf_usm_v(l)%albedo(:,m)    = -1.0_wp
    49436665                     surf_usm_v(l)%thickness_wall(m) = -1.0_wp
     6666                     surf_usm_v(l)%thickness_window(m)   = -1.0_wp
     6667                     surf_usm_v(l)%thickness_green(m)    = -1.0_wp
     6668                     surf_usm_v(l)%transmissivity(m)  = -1.0_wp
    49446669                 ELSE
    49456670                     surf_usm_v(l)%surface_types(m)  = usm_par(ii+1,jw,iw)
    4946                      surf_usm_v(l)%albedo_surf(m)    = usm_val(ij,jw,iw)
     6671                     surf_usm_v(l)%albedo(:,m)    = usm_val(ij,jw,iw)
    49476672                     surf_usm_v(l)%thickness_wall(m) = usm_val(ij+1,jw,iw)
     6673                     surf_usm_v(l)%thickness_window(m)   = usm_val(ij+1,jw,iw)
     6674                     surf_usm_v(l)%thickness_green(m)    = usm_val(ij+1,jw,iw)
     6675                     surf_usm_v(l)%transmissivity(m)  = 0.0_wp
    49486676                 ENDIF
    49496677              ELSE IF ( kw <= usm_par(ii+2,jw,iw) )  THEN
     
    49516679                 IF ( usm_par(ii+3,jw,iw) == 0 )  THEN
    49526680                     surf_usm_v(l)%surface_types(m)  = wall_category         !< default category for wall surface
    4953                      surf_usm_v(l)%albedo_surf(m)    = -1.0_wp
     6681                     surf_usm_v(l)%albedo(:,m)    = -1.0_wp
    49546682                     surf_usm_v(l)%thickness_wall(m) = -1.0_wp
     6683                     surf_usm_v(l)%thickness_window(m)   = -1.0_wp
     6684                     surf_usm_v(l)%thickness_green(m)    = -1.0_wp
     6685                     surf_usm_v(l)%transmissivity(m)  = -1.0_wp
    49556686                 ELSE
    49566687                     surf_usm_v(l)%surface_types(m)  = usm_par(ii+3,jw,iw)
    4957                      surf_usm_v(l)%albedo_surf(m)    = usm_val(ij+2,jw,iw)
     6688                     surf_usm_v(l)%albedo(:,m)    = usm_val(ij+2,jw,iw)
    49586689                     surf_usm_v(l)%thickness_wall(m) = usm_val(ij+3,jw,iw)
     6690                     surf_usm_v(l)%thickness_window(m)   = usm_val(ij+3,jw,iw)
     6691                     surf_usm_v(l)%thickness_green(m)    = usm_val(ij+3,jw,iw)
     6692                     surf_usm_v(l)%transmissivity(m)  = 0.0_wp
    49596693                 ENDIF
    49606694              ELSE IF ( kw <= usm_par(ii+4,jw,iw) )  THEN
     
    49626696                 IF ( usm_par(ii+5,jw,iw) == 0 )  THEN
    49636697                     surf_usm_v(l)%surface_types(m)  = roof_category         !< default category for roof surface
    4964                      surf_usm_v(l)%albedo_surf(m)    = -1.0_wp
     6698                     surf_usm_v(l)%albedo(:,m)    = -1.0_wp
    49656699                     surf_usm_v(l)%thickness_wall(m) = -1.0_wp
     6700                     surf_usm_v(l)%thickness_window(m)   = -1.0_wp
     6701                     surf_usm_v(l)%thickness_green(m)    = -1.0_wp
     6702                     surf_usm_v(l)%transmissivity(m)  = -1.0_wp
    49666703                 ELSE
    49676704                     surf_usm_v(l)%surface_types(m)  = usm_par(ii+5,jw,iw)
    4968                      surf_usm_v(l)%albedo_surf(m)    = usm_val(ij+4,jw,iw)
     6705                     surf_usm_v(l)%albedo(:,m)    = usm_val(ij+4,jw,iw)
    49696706                     surf_usm_v(l)%thickness_wall(m) = usm_val(ij+5,jw,iw)
     6707                     surf_usm_v(l)%thickness_window(m)   = usm_val(ij+5,jw,iw)
     6708                     surf_usm_v(l)%thickness_green(m)    = usm_val(ij+5,jw,iw)
     6709                     surf_usm_v(l)%transmissivity(m)  = 0.0_wp
    49706710                 ENDIF
    49716711              ELSE
     
    49926732!
    49936733!--           Albedo
    4994               IF ( surf_usm_v(l)%albedo_surf(m) < 0.0_wp )  THEN
    4995                  surf_usm_v(l)%albedo_surf(m) = surface_params(ialbedo,ip)
     6734              IF ( surf_usm_v(l)%albedo(0,m) < 0.0_wp )  THEN
     6735                 surf_usm_v(l)%albedo(:,m) = surface_params(ialbedo,ip)
    49966736              ENDIF
     6737!--           Transmissivity of the windows
     6738              IF ( surf_usm_v(l)%transmissivity(m) < 0.0_wp )  THEN
     6739                 surf_usm_v(l)%transmissivity(m) = 0.0_wp
     6740              ENDIF
    49976741!
    49986742!--           emissivity of the wall
    4999               surf_usm_v(l)%emiss_surf(m) = surface_params(iemiss,ip)
     6743              surf_usm_v(l)%emissivity(:,m) = surface_params(iemiss,ip)
    50006744!           
    50016745!--           heat conductivity λS between air and wall ( W m−2 K−1 )
    50026746              surf_usm_v(l)%lambda_surf(m) = surface_params(ilambdas,ip)
     6747              surf_usm_v(l)%lambda_surf_window(m) = surface_params(ilambdas,ip)
     6748              surf_usm_v(l)%lambda_surf_green(m) = surface_params(ilambdas,ip)
    50036749!           
    50046750!--           roughness relative to concrete
    5005               surf_usm_v(l)%roughness_wall(m) = surface_params(irough,ip)
     6751              surf_usm_v(l)%z0(m) = surface_params(irough,ip)
    50066752!           
    50076753!--           Surface skin layer heat capacity (J m−2 K−1 )
    50086754              surf_usm_v(l)%c_surface(m) = surface_params(icsurf,ip)
     6755              surf_usm_v(l)%c_surface_window(m) = surface_params(icsurf,ip)
     6756              surf_usm_v(l)%c_surface_green(m) = surface_params(icsurf,ip)
    50096757!           
    50106758!--           wall material parameters:
     
    50146762                   surf_usm_v(l)%thickness_wall(m) = surface_params(ithick,ip)
    50156763              ENDIF
     6764              IF ( surf_usm_v(l)%thickness_window(m) <= 0.001_wp )  THEN
     6765                   surf_usm_v(l)%thickness_window(m) = surface_params(ithick,ip)
     6766              ENDIF
     6767              IF ( surf_usm_v(l)%thickness_green(m) <= 0.001_wp )  THEN
     6768                   surf_usm_v(l)%thickness_green(m) = surface_params(ithick,ip)
     6769              ENDIF
    50166770!           
    50176771!--           volumetric heat capacity rho*C of the wall ( J m−3 K−1 )
    50186772              surf_usm_v(l)%rho_c_wall(:,m) = surface_params(irhoC,ip)
     6773              surf_usm_v(l)%rho_c_window(:,m) = surface_params(irhoC,ip)
     6774              surf_usm_v(l)%rho_c_green(:,m) = surface_params(irhoC,ip)
    50196775!           
    50206776!--           thermal conductivity λH of the wall (W m−1 K−1 )
    50216777              surf_usm_v(l)%lambda_h(:,m) = surface_params(ilambdah,ip)
    5022 
     6778              surf_usm_v(l)%lambda_h_window(:,m) = surface_params(ilambdah,ip)
     6779              surf_usm_v(l)%lambda_h_green(:,m) = surface_params(ilambdah,ip)
     6780
     6781           ENDDO
     6782        ENDDO
     6783!
     6784!--     Initialize wall layer thicknesses. Please note, this will be removed
     6785!--     after migration to Palm input data standard. 
     6786        DO k = nzb_wall, nzt_wall
     6787           zwn(k) = zwn_default(k)
     6788           zwn_green(k) = zwn_default_green(k)
     6789           zwn_window(k) = zwn_default_window(k)
     6790        ENDDO
     6791!
     6792!--     apply for all particular surface grids. First for horizontal surfaces
     6793        DO  m = 1, surf_usm_h%ns
     6794           surf_usm_h%zw(:,m) = zwn(:) * surf_usm_h%thickness_wall(m)
     6795           surf_usm_h%zw_green(:,m) = zwn_green(:) * surf_usm_h%thickness_green(m)
     6796           surf_usm_h%zw_window(:,m) = zwn_window(:) * surf_usm_h%thickness_window(m)
     6797        ENDDO
     6798        DO  l = 0, 3
     6799           DO  m = 1, surf_usm_v(l)%ns
     6800              surf_usm_v(l)%zw(:,m) = zwn(:) * surf_usm_v(l)%thickness_wall(m)
     6801              surf_usm_v(l)%zw_green(:,m) = zwn_green(:) * surf_usm_v(l)%thickness_green(m)
     6802              surf_usm_v(l)%zw_window(:,m) = zwn_window(:) * surf_usm_v(l)%thickness_window(m)
    50236803           ENDDO
    50246804        ENDDO
     
    50436823        INTEGER(iwp)                          :: i, j, k, l, d, m   !< running indices
    50446824       
    5045         REAL(wp)                              :: pt1                !< temperature at first grid box adjacent to surface
    50466825        REAL(wp)                              :: u1,v1,w1           !< near wall u,v,w
    50476826        REAL(wp)                              :: stend              !< surface tendency
     6827        REAL(wp)                              :: stend_window       !< surface tendency
     6828        REAL(wp)                              :: stend_green        !< surface tendency
    50486829        REAL(wp)                              :: coef_1             !< first coeficient for prognostic equation
     6830        REAL(wp)                              :: coef_window_1      !< first coeficient for prognostic window equation
     6831        REAL(wp)                              :: coef_green_1       !< first coeficient for prognostic green wall equation
    50496832        REAL(wp)                              :: coef_2             !< second  coeficient for prognostic equation
     6833        REAL(wp)                              :: coef_window_2      !< second  coeficient for prognostic window equation
     6834        REAL(wp)                              :: coef_green_2       !< second  coeficient for prognostic green wall equation
    50506835        REAL(wp)                              :: rho_cp             !< rho_wall_surface * cp
    50516836        REAL(wp)                              :: r_a                !< aerodynamic resistance for horizontal and vertical surfaces
     6837        REAL(wp)                              :: r_a_window         !< aerodynamic resistance for horizontal and vertical window surfaces
     6838        REAL(wp)                              :: r_a_green          !< aerodynamic resistance for horizontal and vertical green surfaces
    50526839        REAL(wp)                              :: f_shf              !< factor for shf_eb
     6840        REAL(wp)                              :: f_shf_window       !< factor for shf_eb window
     6841        REAL(wp)                              :: f_shf_green        !< factor for shf_eb green wall
    50536842        REAL(wp)                              :: lambda_surface     !< current value of lambda_surface (heat conductivity between air and wall)
     6843        REAL(wp)                              :: lambda_surface_window !< current value of lambda_surface (heat conductivity between air and window)
     6844        REAL(wp)                              :: lambda_surface_green  !< current value of lambda_surface (heat conductivity between air and greeb wall)
    50546845        REAL(wp)                              :: Ueff               !< effective wind speed for calculation of heat transfer coefficients
    50556846        REAL(wp)                              :: httc               !< heat transfer coefficient
     6847        REAL(wp)                              :: httc_window        !< heat transfer coefficient window
     6848        REAL(wp)                              :: httc_green         !< heat transfer coefficient green wall
    50566849        REAL(wp), DIMENSION(nzub:nzut)        :: exn                !< value of the Exner function in layers
    50576850       
     
    50686861!       
    50696862!--     First, treat horizontal surface elements
    5070 
    50716863        DO  m = 1, surf_usm_h%ns
    50726864!
     
    50816873           IF ( surf_usm_h%ol(m) >= 0.0_wp )  THEN
    50826874              lambda_surface = surf_usm_h%lambda_surf(m)
     6875              lambda_surface_window = surf_usm_h%lambda_surf_window(m)
     6876              lambda_surface_green = surf_usm_h%lambda_surf_green(m)
    50836877           ELSE
    50846878              lambda_surface = surf_usm_h%lambda_surf(m)
     6879              lambda_surface_window = surf_usm_h%lambda_surf_window(m)
     6880              lambda_surface_green = surf_usm_h%lambda_surf_green(m)
    50856881           ENDIF
    50866882#if ! defined( __nopointer )
    5087            pt1  = pt(k,j,i)
    50886883!
    50896884!--        calculate rho * cp coefficient at surface layer
    5090            rho_cp  = cp * hyp(k) / ( r_d * pt1 * exn(k) )
     6885           rho_cp  = cp * hyp(k) / ( r_d * surf_usm_h%pt1(m) * exn(k) )
    50916886#endif
    50926887!
     
    50966891!--        data from the last time step is used here.
    50976892               
    5098            r_a = ( pt1 - t_surf_h(m) / exn(k) ) /                              &
    5099                  ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-10_wp )
     6893           r_a = ( surf_usm_h%pt1(m) - t_surf_h(m) / exn(k) ) /                              &
     6894                 ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
     6895           r_a_window = ( surf_usm_h%pt1(m) - t_surf_window_h(m) / exn(k) ) /                &
     6896                 ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
     6897           r_a_green = ( surf_usm_h%pt1(m) - t_surf_green_h(m) / exn(k) ) /                  &
     6898                 ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
    51006899               
    51016900!--        make sure that the resistance does not drop to zero
    5102            IF ( ABS(r_a) < 1.0E-10_wp )  r_a = 1.0E-10_wp
     6901           IF ( r_a        < 1.0_wp )  r_a        = 1.0_wp
     6902           IF ( r_a_window < 1.0_wp )  r_a_window = 1.0_wp
     6903           IF ( r_a_green  < 1.0_wp )  r_a_green  = 1.0_wp
     6904
    51036905               
    51046906!--        the parameterization is developed originally for larger scales
     
    51066908!--        our first experiences show that the parameterization underestimates
    51076909!--        r_a in meter resolution.
    5108 !--        temporary solution - multiplication by magic constant :-(.
    5109            r_a = r_a * ra_horiz_coef
     6910!--        A temporary solution would be multiplication by magic constant :-(.
     6911!--        For the moment this is comment out.
     6912           r_a        = r_a        !* ra_horiz_coef
     6913           r_a_window = r_a_window !* ra_horiz_coef
     6914           r_a_green  = r_a_green  !* ra_horiz_coef
    51106915               
    51116916!--        factor for shf_eb
    51126917           f_shf  = rho_cp / r_a
     6918           f_shf_window  = rho_cp / r_a_window
     6919           f_shf_green  = rho_cp / r_a_green
    51136920       
    51146921!--        add LW up so that it can be removed in prognostic equation
    5115            surf_usm_h%rad_net_l(m) = surf_usm_h%rad_in_sw(m)  -                &
    5116                                      surf_usm_h%rad_out_sw(m) +                &
    5117                                      surf_usm_h%rad_in_lw(m)  -                &
    5118                                      surf_usm_h%rad_out_lw(m)
     6922           surf_usm_h%rad_net_l(m) = surf_usm_h%rad_sw_in(m)  -                &
     6923                                     surf_usm_h%rad_sw_out(m) +                &
     6924                                     surf_usm_h%rad_lw_in(m)  -                &
     6925                                     surf_usm_h%rad_lw_out(m)
    51196926
    51206927!--        numerator of the prognostic equation
     6928!--     Todo: Adjust to tile approach. So far, emissivity for wall (element 0)
     6929!--           is used
    51216930           coef_1 = surf_usm_h%rad_net_l(m) +                                  &
    5122                    ( 3.0_wp + 1.0_wp ) * surf_usm_h%emiss_surf(m) * sigma_sb * &
     6931                 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(0,m) * sigma_sb * &
    51236932                                       t_surf_h(m) ** 4 +                      & 
    5124                                        f_shf * pt1 +                           &
     6933                                       f_shf * surf_usm_h%pt1(m) +                           &
    51256934                                       lambda_surface * t_wall_h(nzb_wall,m)
     6935           coef_window_1 = surf_usm_h%rad_net_l(m) +                                  &
     6936                   ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(2,m) * sigma_sb * &
     6937                                       t_surf_window_h(m) ** 4 +                      & 
     6938                                       f_shf_window * surf_usm_h%pt1(m) +                           &
     6939                                       lambda_surface_window * t_window_h(nzb_wall,m)
     6940           coef_green_1 = surf_usm_h%rad_net_l(m) +                                  &
     6941                   ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(1,m) * sigma_sb * &
     6942                                       t_surf_green_h(m) ** 4 +                      & 
     6943                                       f_shf_green * surf_usm_h%pt1(m) +                           &
     6944                                       lambda_surface_green * t_wall_h(nzb_wall,m)
    51266945
    51276946!--        denominator of the prognostic equation
    5128            coef_2 = 4.0_wp * surf_usm_h%emiss_surf(m) * sigma_sb *            &
     6947           coef_2 = 4.0_wp * surf_usm_h%emissivity(0,m) * sigma_sb *          &
    51296948                             t_surf_h(m) ** 3                                 &
    51306949                           + lambda_surface + f_shf / exn(k)
     6950           coef_window_2 = 4.0_wp * surf_usm_h%emissivity(2,m) * sigma_sb *  &
     6951                             t_surf_window_h(m) ** 3                              &
     6952                           + lambda_surface_window + f_shf_window / exn(k)
     6953           coef_green_2 = 4.0_wp * surf_usm_h%emissivity(1,m) * sigma_sb *    &
     6954                             t_surf_green_h(m) ** 3                               &
     6955                           + lambda_surface_green + f_shf_green / exn(k)
    51316956
    51326957!--        implicit solution when the surface layer has no heat capacity,
     
    51356960                             surf_usm_h%c_surface(m) * t_surf_h(m) ) /        &
    51366961                           ( surf_usm_h%c_surface(m) + coef_2 * dt_3d * tsc(2) )
     6962           t_surf_window_h_p(m) = ( coef_window_1 * dt_3d * tsc(2) +                        &
     6963                             surf_usm_h%c_surface_window(m) * t_surf_window_h(m) ) /        &
     6964                           ( surf_usm_h%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) )
     6965           t_surf_green_h_p(m) = ( coef_green_1 * dt_3d * tsc(2) +                        &
     6966                             surf_usm_h%c_surface_green(m) * t_surf_green_h(m) ) /        &
     6967                           ( surf_usm_h%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) )
    51376968
    51386969!--        add RK3 term
    51396970           t_surf_h_p(m) = t_surf_h_p(m) + dt_3d * tsc(3) *                   &
    51406971                           surf_usm_h%tt_surface_m(m)
    5141            
     6972           t_surf_window_h_p(m) = t_surf_window_h_p(m) + dt_3d * tsc(3) *     &
     6973                           surf_usm_h%tt_surface_window_m(m)
     6974           t_surf_green_h_p(m) = t_surf_green_h_p(m) + dt_3d * tsc(3) *       &
     6975                           surf_usm_h%tt_surface_green_m(m)
     6976!
     6977!--        Store surface temperature       
     6978           surf_usm_h%pt_surface(m) = ( surf_usm_h%frac(0,m) * t_surf_h_p(m)   &
     6979                               + surf_usm_h%frac(2,m) * t_surf_window_h_p(m)   &
     6980                               + surf_usm_h%frac(1,m) * t_surf_green_h_p(m) )  &
     6981                               / exn(k)
     6982                       
    51426983!--        calculate true tendency
    51436984           stend = ( t_surf_h_p(m) - t_surf_h(m) - dt_3d * tsc(3) *           &
    51446985                     surf_usm_h%tt_surface_m(m)) / ( dt_3d  * tsc(2) )
     6986           stend_window = ( t_surf_window_h_p(m) - t_surf_window_h(m) - dt_3d * tsc(3) *        &
     6987                     surf_usm_h%tt_surface_window_m(m)) / ( dt_3d  * tsc(2) )
     6988           stend_green = ( t_surf_green_h_p(m) - t_surf_green_h(m) - dt_3d * tsc(3) *           &
     6989                     surf_usm_h%tt_surface_green_m(m)) / ( dt_3d  * tsc(2) )
    51456990
    51466991!--        calculate t_surf tendencies for the next Runge-Kutta step
     
    51486993              IF ( intermediate_timestep_count == 1 )  THEN
    51496994                 surf_usm_h%tt_surface_m(m) = stend
     6995                 surf_usm_h%tt_surface_window_m(m) = stend_window
     6996                 surf_usm_h%tt_surface_green_m(m) = stend_green
    51506997              ELSEIF ( intermediate_timestep_count <                          &
    51516998                        intermediate_timestep_count_max )  THEN
    51526999                 surf_usm_h%tt_surface_m(m) = -9.5625_wp * stend +            &
    51537000                                     5.3125_wp * surf_usm_h%tt_surface_m(m)
     7001                 surf_usm_h%tt_surface_window_m(m) = -9.5625_wp * stend_window +   &
     7002                                     5.3125_wp * surf_usm_h%tt_surface_window_m(m)
     7003                 surf_usm_h%tt_surface_green_m(m) = -9.5625_wp * stend_green +     &
     7004                                     5.3125_wp * surf_usm_h%tt_surface_green_m(m)
    51547005              ENDIF
    51557006           ENDIF
     
    51577008!--        in case of fast changes in the skin temperature, it is required to
    51587009!--        update the radiative fluxes in order to keep the solution stable
    5159            IF ( ABS( t_surf_h_p(m) - t_surf_h(m) ) > 1.0_wp )  THEN
     7010           IF ( ( ABS( t_surf_h_p(m) - t_surf_h(m) ) > 1.0_wp ) .OR. &
     7011                ( ABS( t_surf_green_h_p(m) - t_surf_green_h(m) ) > 1.0_wp ) .OR. &
     7012                ( ABS( t_surf_window_h_p(m) - t_surf_window_h(m) ) > 1.0_wp ) ) THEN
    51607013              force_radiation_call_l = .TRUE.
    51617014           ENDIF
     
    51667019!--        using surface and wall heat fluxes
    51677020#if ! defined( __nopointer )
    5168            pt(k-1,j,i) = t_surf_h_p(m) / exn(k)  ! not for vertical surfaces
     7021!            pt(k-1,j,i) = ( surf_usm_h%frac(0,m) * t_surf_h_p(m)       &
     7022!                          + surf_usm_h%frac(2,m) * t_surf_window_h_p(m)  &
     7023!                          + surf_usm_h%frac(1,m) * t_surf_green_h_p(m) ) &
     7024!                          / exn(k)  ! not for vertical surfaces
    51697025#endif
    51707026
    51717027!--        calculate fluxes
    51727028!--        rad_net_l is never used!           
    5173            surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net_l(m) +                &
    5174                                      3.0_wp * sigma_sb *                      &
    5175                                      t_surf_h(m)**4 - 4.0_wp * sigma_sb *     &
    5176                                      t_surf_h(m)**3 * t_surf_h_p(m)
     7029           surf_usm_h%rad_net_l(m) = surf_usm_h%frac(0,m) *                         &
     7030                                     ( surf_usm_h%rad_net_l(m) +                    &
     7031                                     3.0_wp * sigma_sb *                            &
     7032                                     t_surf_h(m)**4 - 4.0_wp * sigma_sb *           &
     7033                                     t_surf_h(m)**3 * t_surf_h_p(m) )               &
     7034                                   + surf_usm_h%frac(2,m) *                         &
     7035                                     ( surf_usm_h%rad_net_l(m) +                    &
     7036                                     3.0_wp * sigma_sb *                            &
     7037                                     t_surf_window_h(m)**4 - 4.0_wp * sigma_sb *    &
     7038                                     t_surf_window_h(m)**3 * t_surf_window_h_p(m) ) &
     7039                                   + surf_usm_h%frac(1,m) *                         &
     7040                                     ( surf_usm_h%rad_net_l(m) +                    &
     7041                                     3.0_wp * sigma_sb *                            &
     7042                                     t_surf_green_h(m)**4 - 4.0_wp * sigma_sb *     &
     7043                                     t_surf_green_h(m)**3 * t_surf_green_h_p(m) )
    51777044           surf_usm_h%wghf_eb(m)   = lambda_surface *                         &
    51787045                                      ( t_surf_h_p(m) - t_wall_h(nzb_wall,m) )
     7046           surf_usm_h%wghf_eb_green(m)  = lambda_surface_green *                        &
     7047                                          ( t_surf_green_h_p(m) - t_green_h(nzb_wall,m) )
     7048           surf_usm_h%wghf_eb_window(m) = lambda_surface_window *                       &
     7049                                           ( t_surf_window_h_p(m) - t_window_h(nzb_wall,m) )
     7050
    51797051!
    51807052!--        ground/wall/roof surface heat flux
    5181            surf_usm_h%wshf_eb(m)   = - f_shf  * ( pt1 - t_surf_h_p(m) )
     7053           surf_usm_h%wshf_eb(m)   = - f_shf  * ( surf_usm_h%pt1(m) - t_surf_h_p(m) / exn(k) ) *               &
     7054                                       surf_usm_h%frac(0,m)                         &
     7055                                     - f_shf_window  * ( surf_usm_h%pt1(m) - t_surf_window_h_p(m) / exn(k) ) * &
     7056                                       surf_usm_h%frac(2,m)                          &
     7057                                     - f_shf_green  * ( surf_usm_h%pt1(m) - t_surf_green_h_p(m) / exn(k) ) *   &
     7058                                       surf_usm_h%frac(1,m)
    51827059!           
    51837060!--        store kinematic surface heat fluxes for utilization in other processes
     
    51957072             j = surf_usm_v(l)%j(m)
    51967073             k = surf_usm_v(l)%k(m)
     7074
    51977075!
    51987076!--          TODO - how to calculate lambda_surface for horizontal (??? do you mean verical ???) surfaces
     
    52017079!--          stratification is not considered in this case.
    52027080             lambda_surface = surf_usm_v(l)%lambda_surf(m)
     7081             lambda_surface_window = surf_usm_v(l)%lambda_surf_window(m)
     7082             lambda_surface_green = surf_usm_v(l)%lambda_surf_green(m)
     7083
    52037084#if ! defined( __nopointer )         
    5204              pt1  = pt(k,j,i)
    52057085!
    52067086!--          calculate rho * cp coefficient at surface layer
    5207              rho_cp  = cp * hyp(k) / ( r_d * pt1 * exn(k) )
     7087             rho_cp  = cp * hyp(k) / ( r_d * surf_usm_v(l)%pt1(m) * exn(k) )
    52087088#endif
    52097089
     
    52387118               
    52397119             Ueff   = SQRT( u1**2 + v1**2 + w1**2 )
    5240              httc   = surf_usm_v(l)%roughness_wall(m) *                       &
     7120             httc   = surf_usm_v(l)%z0(m) *                                    &
    52417121                       ( 11.8_wp + 4.2_wp * Ueff ) - 4.0_wp
    5242              f_shf  = httc
     7122             f_shf         = httc
     7123             f_shf_window  = httc
     7124             f_shf_green   = httc
    52437125
    52447126!--          add LW up so that it can be removed in prognostic equation
    5245              surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_in_sw(m)  -        &
    5246                                           surf_usm_v(l)%rad_out_sw(m) +        &
    5247                                           surf_usm_v(l)%rad_in_lw(m)  -        &
    5248                                           surf_usm_v(l)%rad_out_lw(m)
     7127             surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_sw_in(m)  -        &
     7128                                          surf_usm_v(l)%rad_sw_out(m) +        &
     7129                                          surf_usm_v(l)%rad_lw_in(m)  -        &
     7130                                          surf_usm_v(l)%rad_lw_out(m)
    52497131
    52507132!--           numerator of the prognostic equation
    52517133              coef_1 = surf_usm_v(l)%rad_net_l(m) +                            & ! coef +1 corresponds to -lwout included in calculation of radnet_l
    5252                ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emiss_surf(m) * sigma_sb *  &
     7134             ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(0,m) * sigma_sb *  &
    52537135                                     t_surf_v(l)%t(m) ** 4 +                   & 
    5254                                      f_shf * pt1 +                             &
     7136                                     f_shf * surf_usm_v(l)%pt1(m) +                             &
    52557137                                     lambda_surface * t_wall_v(l)%t(nzb_wall,m)
     7138              coef_window_1 = surf_usm_v(l)%rad_net_l(m) +                            & ! coef +1 corresponds to -lwout included in calculation of radnet_l
     7139               ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(2,m) * sigma_sb *  &
     7140                                     t_surf_window_v(l)%t(m) ** 4 +                   & 
     7141                                     f_shf * surf_usm_v(l)%pt1(m) +                             &
     7142                                     lambda_surface_window * t_window_v(l)%t(nzb_wall,m)
     7143
     7144              coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                            & ! coef +1 corresponds to -lwout included in calculation of radnet_l
     7145               ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(1,m) * sigma_sb *  &
     7146                                     t_surf_green_v(l)%t(m) ** 4 +                   & 
     7147                                     f_shf * surf_usm_v(l)%pt1(m) +                             &
     7148                                     lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
    52567149
    52577150!--           denominator of the prognostic equation
    5258               coef_2 = 4.0_wp * surf_usm_v(l)%emiss_surf(m) * sigma_sb *       &
     7151              coef_2 = 4.0_wp * surf_usm_v(l)%emissivity(0,m) * sigma_sb *     &
    52597152                                t_surf_v(l)%t(m) ** 3                          &
    52607153                              + lambda_surface + f_shf / exn(k)
     7154              coef_window_2 = 4.0_wp * surf_usm_v(l)%emissivity(2,m) * sigma_sb *     &
     7155                                t_surf_window_v(l)%t(m) ** 3                         &
     7156                              + lambda_surface_window + f_shf / exn(k)
     7157              coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(1,m) * sigma_sb *       &
     7158                                t_surf_green_v(l)%t(m) ** 3                          &
     7159                              + lambda_surface_green + f_shf / exn(k)
    52617160
    52627161!--           implicit solution when the surface layer has no heat capacity,
     
    52657164                             surf_usm_v(l)%c_surface(m) * t_surf_v(l)%t(m) ) / &
    52667165                           ( surf_usm_v(l)%c_surface(m) + coef_2 * dt_3d * tsc(2) )
     7166              t_surf_window_v_p(l)%t(m) = ( coef_window_1 * dt_3d * tsc(2) +                 &
     7167                             surf_usm_v(l)%c_surface_window(m) * t_surf_window_v(l)%t(m) ) / &
     7168                           ( surf_usm_v(l)%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) )
     7169
     7170              t_surf_green_v_p(l)%t(m) = ( coef_green_1 * dt_3d * tsc(2) +                 &
     7171                             surf_usm_v(l)%c_surface_green(m) * t_surf_green_v(l)%t(m) ) / &
     7172                           ( surf_usm_v(l)%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) )
     7173
     7174
    52677175
    52687176!--           add RK3 term
    52697177              t_surf_v_p(l)%t(m) = t_surf_v_p(l)%t(m) + dt_3d * tsc(3) *       &
    52707178                                surf_usm_v(l)%tt_surface_m(m)
     7179              t_surf_window_v_p(l)%t(m) = t_surf_window_v_p(l)%t(m) + dt_3d * tsc(3) *     &
     7180                                surf_usm_v(l)%tt_surface_window_m(m)
     7181              t_surf_green_v_p(l)%t(m) = t_surf_green_v_p(l)%t(m) + dt_3d * tsc(3) *       &
     7182                                surf_usm_v(l)%tt_surface_green_m(m)
     7183!
     7184!--           Store surface temperature       
     7185              surf_usm_v(l)%pt_surface(m) =  ( surf_usm_v(l)%frac(0,m) * t_surf_v_p(l)%t(m)  &
     7186                                      + surf_usm_v(l)%frac(2,m) * t_surf_window_v_p(l)%t(m)  &
     7187                                      + surf_usm_v(l)%frac(1,m) * t_surf_green_v_p(l)%t(m) ) &
     7188                                      / exn(k)
    52717189           
    52727190!--           calculate true tendency
    52737191              stend = ( t_surf_v_p(l)%t(m) - t_surf_v(l)%t(m) - dt_3d * tsc(3) *&
    52747192                        surf_usm_v(l)%tt_surface_m(m) ) / ( dt_3d  * tsc(2) )
     7193              stend_window = ( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) - dt_3d * tsc(3) *&
     7194                        surf_usm_v(l)%tt_surface_window_m(m) ) / ( dt_3d  * tsc(2) )
     7195              stend_green = ( t_surf_green_v_p(l)%t(m) - t_surf_green_v(l)%t(m) - dt_3d * tsc(3) *&
     7196                        surf_usm_v(l)%tt_surface_green_m(m) ) / ( dt_3d  * tsc(2) )
    52757197
    52767198!--           calculate t_surf tendencies for the next Runge-Kutta step
     
    52787200                 IF ( intermediate_timestep_count == 1 )  THEN
    52797201                    surf_usm_v(l)%tt_surface_m(m) = stend
     7202                    surf_usm_v(l)%tt_surface_window_m(m) = stend_window
     7203                    surf_usm_v(l)%tt_surface_green_m(m) = stend_green
    52807204                 ELSEIF ( intermediate_timestep_count <                        &
    52817205                          intermediate_timestep_count_max )  THEN
    52827206                    surf_usm_v(l)%tt_surface_m(m) = -9.5625_wp * stend +       &
    5283                                      5.3125_wp * surf_usm_h%tt_surface_m(m)
     7207                                     5.3125_wp * surf_usm_v(l)%tt_surface_m(m)
     7208                    surf_usm_v(l)%tt_surface_green_m(m) = -9.5625_wp * stend_green +       &
     7209                                     5.3125_wp * surf_usm_v(l)%tt_surface_green_m(m)
     7210                    surf_usm_v(l)%tt_surface_window_m(m) = -9.5625_wp * stend_window +       &
     7211                                     5.3125_wp * surf_usm_v(l)%tt_surface_window_m(m)
    52847212                 ENDIF
    52857213              ENDIF
     
    52877215!--           in case of fast changes in the skin temperature, it is required to
    52887216!--           update the radiative fluxes in order to keep the solution stable
    5289               IF ( ABS( t_surf_v_p(l)%t(m) - t_surf_v(l)%t(m) ) > 1.0_wp )  THEN
     7217
     7218              IF ( ( ABS( t_surf_v_p(l)%t(m) - t_surf_v(l)%t(m) ) > 1.0_wp ) .OR. &
     7219                   ( ABS( t_surf_green_v_p(l)%t(m) - t_surf_green_v(l)%t(m) ) > 1.0_wp ) .OR.  &
     7220                   ( ABS( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) ) > 1.0_wp ) ) THEN
    52907221                 force_radiation_call_l = .TRUE.
    52917222              ENDIF
     
    52937224!--           calculate fluxes
    52947225!--           rad_net_l is never used!           
    5295               surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_net_l(m) +        &
    5296                                      3.0_wp * sigma_sb *                       &
    5297                                      t_surf_v(l)%t(m)**4 - 4.0_wp * sigma_sb * &
    5298                                      t_surf_v(l)%t(m)**3 * t_surf_v_p(l)%t(m)
    5299 
     7226              surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%frac(0,m) *                             &
     7227                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
     7228                                           3.0_wp * sigma_sb *                                       &
     7229                                           t_surf_v(l)%t(m)**4 - 4.0_wp * sigma_sb *                 &
     7230                                           t_surf_v(l)%t(m)**3 * t_surf_v_p(l)%t(m) )                &
     7231                                         + surf_usm_v(l)%frac(2,m) *                              &
     7232                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
     7233                                           3.0_wp * sigma_sb *                                       &
     7234                                           t_surf_window_v(l)%t(m)**4 - 4.0_wp * sigma_sb *          &
     7235                                           t_surf_window_v(l)%t(m)**3 * t_surf_window_v_p(l)%t(m) )  &
     7236                                         + surf_usm_v(l)%frac(1,m) *                            &
     7237                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
     7238                                           3.0_wp * sigma_sb *                                       &
     7239                                           t_surf_green_v(l)%t(m)**4 - 4.0_wp * sigma_sb *           &
     7240                                           t_surf_green_v(l)%t(m)**3 * t_surf_green_v_p(l)%t(m) )
     7241
     7242              surf_usm_v(l)%wghf_eb_window(m) = lambda_surface_window * &
     7243                                                ( t_surf_window_v_p(l)%t(m) - t_window_v(l)%t(nzb_wall,m) )
    53007244              surf_usm_v(l)%wghf_eb(m)   = lambda_surface *                    &
    53017245                                     ( t_surf_v_p(l)%t(m) - t_wall_v(l)%t(nzb_wall,m) )
     7246              surf_usm_v(l)%wghf_eb_green(m)  = lambda_surface_green *  &
     7247                                                ( t_surf_green_v_p(l)%t(m) - t_green_v(l)%t(nzb_wall,m) )
    53027248
    53037249!--           ground/wall/roof surface heat flux
    5304               surf_usm_v(l)%wshf_eb(m)   = - f_shf  * ( pt1 - t_surf_v_p(l)%t(m) )
     7250              surf_usm_v(l)%wshf_eb(m)   = - f_shf  * ( surf_usm_v(l)%pt1(m) - t_surf_v_p(l)%t(m) / exn(k) ) * surf_usm_v(l)%frac(0,m)               &
     7251                                           - f_shf_window  * ( surf_usm_v(l)%pt1(m) - t_surf_window_v_p(l)%t(m) / exn(k) ) * surf_usm_v(l)%frac(2,m)  &
     7252                                           - f_shf_green  * ( surf_usm_v(l)%pt1(m) - t_surf_green_v_p(l)%t(m) / exn(k) ) * surf_usm_v(l)%frac(1,m)
    53057253
    53067254!           
     
    53527300        CALL exchange_horiz( pt, nbgp )
    53537301#endif
    5354 
    53557302
    53567303!--     calculation of force_radiation_call:
     
    53907337       t_surf_v    = t_surf_v_p
    53917338       t_wall_v    = t_wall_v_p
     7339       t_surf_window_h    = t_surf_window_h_p
     7340       t_window_h    = t_window_h_p
     7341       t_surf_window_v    = t_surf_window_v_p
     7342       t_window_v    = t_window_v_p
     7343       t_surf_green_h    = t_surf_green_h_p
     7344       t_surf_green_v    = t_surf_green_v_p
     7345       t_green_h    = t_green_h_p
     7346       t_green_v    = t_green_v_p
     7347       t_surf_whole_h    = t_surf_whole_h_p
     7348       t_surf_whole_v    = t_surf_whole_v_p
    53927349#else
    53937350       SELECT CASE ( mod_count )
     
    53977354             t_surf_h  => t_surf_h_1; t_surf_h_p  => t_surf_h_2
    53987355             t_wall_h     => t_wall_h_1;    t_wall_h_p     => t_wall_h_2
     7356             t_surf_window_h  => t_surf_window_h_1; t_surf_window_h_p  => t_surf_window_h_2
     7357             t_window_h     => t_window_h_1;    t_window_h_p     => t_window_h_2
     7358             t_surf_green_h  => t_surf_green_h_1; t_surf_green_h_p  => t_surf_green_h_2
     7359             t_green_h     => t_green_h_1;    t_green_h_p     => t_green_h_2
     7360             t_surf_whole_h  => t_surf_whole_h_1; t_surf_whole_h_p  => t_surf_whole_h_2
    53997361!
    54007362!--          Vertical surfaces
    54017363             t_surf_v  => t_surf_v_1; t_surf_v_p  => t_surf_v_2
    54027364             t_wall_v     => t_wall_v_1;    t_wall_v_p     => t_wall_v_2
     7365             t_surf_window_v  => t_surf_window_v_1; t_surf_window_v_p  => t_surf_window_v_2
     7366             t_window_v     => t_window_v_1;    t_window_v_p     => t_window_v_2
     7367             t_surf_green_v  => t_surf_green_v_1; t_surf_green_v_p  => t_surf_green_v_2
     7368             t_green_v     => t_green_v_1;    t_green_v_p     => t_green_v_2
     7369             t_surf_whole_v  => t_surf_whole_v_1; t_surf_whole_v_p  => t_surf_whole_v_2
    54037370          CASE ( 1 )
    54047371!
     
    54067373             t_surf_h  => t_surf_h_2; t_surf_h_p  => t_surf_h_1
    54077374             t_wall_h     => t_wall_h_2;    t_wall_h_p     => t_wall_h_1
     7375             t_surf_window_h  => t_surf_window_h_2; t_surf_window_h_p  => t_surf_window_h_1
     7376             t_window_h     => t_window_h_2;    t_window_h_p     => t_window_h_1
     7377             t_surf_green_h  => t_surf_green_h_2; t_surf_green_h_p  => t_surf_green_h_1
     7378             t_green_h     => t_green_h_2;    t_green_h_p     => t_green_h_1
     7379             t_surf_whole_h  => t_surf_whole_h_2; t_surf_whole_h_p  => t_surf_whole_h_1
    54087380!
    54097381!--          Vertical surfaces
    54107382             t_surf_v  => t_surf_v_2; t_surf_v_p  => t_surf_v_1
    54117383             t_wall_v     => t_wall_v_2;    t_wall_v_p     => t_wall_v_1
     7384             t_surf_window_v  => t_surf_window_v_2; t_surf_window_v_p  => t_surf_window_v_1
     7385             t_window_v     => t_window_v_2;    t_window_v_p     => t_window_v_1
     7386             t_surf_green_v  => t_surf_green_v_2; t_surf_green_v_p  => t_surf_green_v_1
     7387             t_green_v     => t_green_v_2;    t_green_v_p     => t_green_v_1
     7388             t_surf_whole_v  => t_surf_whole_v_2; t_surf_whole_v_p  => t_surf_whole_v_1
    54127389       END SELECT
    54137390#endif
     
    54447421       WRITE ( 14 ) 't_surf_h                      '
    54457422       WRITE ( 14 ) t_surf_h
     7423       WRITE ( 14 ) 't_surf_window_h               '
     7424       WRITE ( 14 ) t_surf_window_h
     7425       WRITE ( 14 ) 't_surf_green_h                '
     7426       WRITE ( 14 ) t_surf_green_h
    54467427       
    54477428       DO  l = 0, 3
     
    54537434          WRITE ( 14 ) 't_surf_v(' // dum // ')                   '
    54547435          WRITE ( 14 ) t_surf_v(l)%t         
     7436          WRITE ( 14 ) 't_surf_window_v(' // dum // ')            '
     7437          WRITE ( 14 ) t_surf_window_v(l)%t         
     7438          WRITE ( 14 ) 't_surf_green_v(' // dum // ')             '
     7439          WRITE ( 14 ) t_surf_green_v(l)%t         
    54557440       ENDDO
    54567441
     
    54617446       WRITE ( 14 ) 't_wall_h                      '
    54627447       WRITE ( 14 ) t_wall_h
     7448       WRITE ( 14 ) 't_window_h                    '
     7449       WRITE ( 14 ) t_window_h
     7450       WRITE ( 14 ) 't_green_h                     '
     7451       WRITE ( 14 ) t_green_h
    54637452       DO  l = 0, 3
    54647453          WRITE ( 14 ) 'usm_start_index_v             '
     
    54697458          WRITE ( 14 )  't_wall_v(' // dum // ')                   '
    54707459          WRITE ( 14 )  t_wall_v(l)%t         
     7460          WRITE ( 14 )  't_window_v(' // dum // ')                 '
     7461          WRITE ( 14 )  t_window_v(l)%t         
     7462          WRITE ( 14 )  't_green_v(' // dum // ')                  '
     7463          WRITE ( 14 )  t_green_v(l)%t         
    54717464       ENDDO
    54727465
     
    54757468    END SUBROUTINE usm_write_restart_data
    54767469
    5477 
    5478 !------------------------------------------------------------------------------!
    5479 !
    5480 ! Description:
    5481 ! ------------
    5482 !> Subroutine stores svf, svfsurf, csf and csfsurf data to a file.
    5483 !------------------------------------------------------------------------------!
    5484     SUBROUTINE usm_write_svf_to_file
    5485 
    5486         IMPLICIT NONE
    5487         INTEGER(iwp)        :: fsvf = 89
    5488         INTEGER(iwp)        :: i
    5489 
    5490         DO  i = 0, io_blocks-1
    5491             IF ( i == io_group )  THEN
    5492                 OPEN ( fsvf, file=TRIM(svf_file_name)//TRIM(coupling_char)//myid_char,               &
    5493                     form='unformatted', status='new' )
    5494 
    5495                 WRITE ( fsvf )  usm_version
    5496                 WRITE ( fsvf )  nsvfl, ncsfl
    5497                 WRITE ( fsvf )  svf
    5498                 WRITE ( fsvf )  svfsurf
    5499                 IF ( plant_canopy )  THEN
    5500                     WRITE ( fsvf )  csf
    5501                     WRITE ( fsvf )  csfsurf
    5502                 ENDIF
    5503                 WRITE ( fsvf )  TRIM(svf_code)
    5504 
    5505                 CLOSE (fsvf)
    5506 #if defined( __parallel )
    5507                 CALL MPI_BARRIER( comm2d, ierr )
    5508 #endif
    5509             ENDIF
    5510         ENDDO
    5511     END SUBROUTINE usm_write_svf_to_file
    5512 
    5513 
    5514 !------------------------------------------------------------------------------!
    5515 !
    5516 ! Description:
    5517 ! ------------
    5518 !> Block of auxiliary subroutines:
    5519 !> 1. quicksort and corresponding comparison
    5520 !> 2. usm_merge_and_grow_csf for implementation of "dynamical growing"
    5521 !>    array for csf
    5522 !------------------------------------------------------------------------------!   
    5523     PURE FUNCTION svf_lt(svf1,svf2) result (res)
    5524       TYPE (t_svf), INTENT(in) :: svf1,svf2
    5525       LOGICAL                  :: res
    5526       IF ( svf1%isurflt < svf2%isurflt  .OR.    &
    5527           (svf1%isurflt == svf2%isurflt  .AND.  svf1%isurfs < svf2%isurfs) )  THEN
    5528           res = .TRUE.
     7470!
     7471!-- Integrated stability function for heat and moisture
     7472    FUNCTION psi_h( zeta )
     7473
     7474           USE kinds
     7475
     7476       IMPLICIT NONE
     7477
     7478       REAL(wp)            :: psi_h !< Integrated similarity function result
     7479       REAL(wp)            :: zeta  !< Stability parameter z/L
     7480       REAL(wp)            :: x     !< dummy variable
     7481
     7482       REAL(wp), PARAMETER :: a = 1.0_wp            !< constant
     7483       REAL(wp), PARAMETER :: b = 0.66666666666_wp  !< constant
     7484       REAL(wp), PARAMETER :: c = 5.0_wp            !< constant
     7485       REAL(wp), PARAMETER :: d = 0.35_wp           !< constant
     7486       REAL(wp), PARAMETER :: c_d_d = c / d         !< constant
     7487       REAL(wp), PARAMETER :: bc_d_d = b * c / d    !< constant
     7488
     7489
     7490      IF ( zeta < 0.0_wp )  THEN
     7491         x = SQRT( 1.0_wp  - 16.0_wp * zeta )
     7492         psi_h = 2.0_wp * LOG( (1.0_wp + x ) / 2.0_wp )
    55297493      ELSE
    5530           res = .FALSE.
    5531       ENDIF
    5532     END FUNCTION svf_lt
    5533    
    5534  
    5535 !-- quicksort.f -*-f90-*-
    5536 !-- Author: t-nissie, adaptation J.Resler
    5537 !-- License: GPLv3
    5538 !-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
    5539     RECURSIVE SUBROUTINE quicksort_svf(svfl, first, last)
    5540         IMPLICIT NONE
    5541         TYPE(t_svf), DIMENSION(:), INTENT(INOUT)  :: svfl
    5542         INTEGER(iwp), INTENT(IN)                  :: first, last
    5543         TYPE(t_svf)                               :: x, t
    5544         INTEGER(iwp)                              :: i, j
    5545 
    5546         IF ( first>=last ) RETURN
    5547         x = svfl( (first+last) / 2 )
    5548         i = first
    5549         j = last
    5550         DO
    5551             DO while ( svf_lt(svfl(i),x) )
    5552                i=i+1
    5553             ENDDO
    5554             DO while ( svf_lt(x,svfl(j)) )
    5555                 j=j-1
    5556             ENDDO
    5557             IF ( i >= j ) EXIT
    5558             t = svfl(i);  svfl(i) = svfl(j);  svfl(j) = t
    5559             i=i+1
    5560             j=j-1
    5561         ENDDO
    5562         IF ( first < i-1 ) CALL quicksort_svf(svfl, first, i-1)
    5563         IF ( j+1 < last )  CALL quicksort_svf(svfl, j+1, last)
    5564     END SUBROUTINE quicksort_svf
    5565 
    5566    
    5567     PURE FUNCTION csf_lt(csf1,csf2) result (res)
    5568       TYPE (t_csf), INTENT(in) :: csf1,csf2
    5569       LOGICAL                  :: res
    5570       IF ( csf1%ip < csf2%ip  .OR.    &
    5571            (csf1%ip == csf2%ip  .AND.  csf1%itx < csf2%itx)  .OR.  &
    5572            (csf1%ip == csf2%ip  .AND.  csf1%itx == csf2%itx  .AND.  csf1%ity < csf2%ity)  .OR.  &
    5573            (csf1%ip == csf2%ip  .AND.  csf1%itx == csf2%itx  .AND.  csf1%ity == csf2%ity  .AND.   &
    5574             csf1%itz < csf2%itz)  .OR.  &
    5575            (csf1%ip == csf2%ip  .AND.  csf1%itx == csf2%itx  .AND.  csf1%ity == csf2%ity  .AND.   &
    5576             csf1%itz == csf2%itz  .AND.  csf1%isurfs < csf2%isurfs) )  THEN
    5577           res = .TRUE.
    5578       ELSE
    5579           res = .FALSE.
    5580       ENDIF
    5581     END FUNCTION csf_lt
    5582 
    5583 
    5584 !-- quicksort.f -*-f90-*-
    5585 !-- Author: t-nissie, adaptation J.Resler
    5586 !-- License: GPLv3
    5587 !-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
    5588     RECURSIVE SUBROUTINE quicksort_csf(csfl, first, last)
    5589         IMPLICIT NONE
    5590         TYPE(t_csf), DIMENSION(:), INTENT(INOUT)  :: csfl
    5591         INTEGER(iwp), INTENT(IN)                  :: first, last
    5592         TYPE(t_csf)                               :: x, t
    5593         INTEGER(iwp)                              :: i, j
    5594 
    5595         IF ( first>=last ) RETURN
    5596         x = csfl( (first+last)/2 )
    5597         i = first
    5598         j = last
    5599         DO
    5600             DO while ( csf_lt(csfl(i),x) )
    5601                 i=i+1
    5602             ENDDO
    5603             DO while ( csf_lt(x,csfl(j)) )
    5604                 j=j-1
    5605             ENDDO
    5606             IF ( i >= j ) EXIT
    5607             t = csfl(i);  csfl(i) = csfl(j);  csfl(j) = t
    5608             i=i+1
    5609             j=j-1
    5610         ENDDO
    5611         IF ( first < i-1 ) CALL quicksort_csf(csfl, first, i-1)
    5612         IF ( j+1 < last )  CALL quicksort_csf(csfl, j+1, last)
    5613     END SUBROUTINE quicksort_csf
    5614 
    5615    
    5616     SUBROUTINE usm_merge_and_grow_csf(newsize)
    5617         INTEGER(iwp), INTENT(in)                :: newsize  !< new array size after grow, must be >= ncsfl
    5618                                                             !< or -1 to shrink to minimum
    5619         INTEGER(iwp)                            :: iread, iwrite
    5620         TYPE(t_csf), DIMENSION(:), POINTER      :: acsfnew
    5621 
    5622         IF ( newsize == -1 )  THEN
    5623 !--         merge in-place
    5624             acsfnew => acsf
    5625         ELSE
    5626 !--         allocate new array
    5627             IF ( mcsf == 0 )  THEN
    5628                 ALLOCATE( acsf1(newsize) )
    5629                 acsfnew => acsf1
    5630             ELSE
    5631                 ALLOCATE( acsf2(newsize) )
    5632                 acsfnew => acsf2
    5633             ENDIF
    5634         ENDIF
    5635 
    5636         IF ( ncsfl >= 1 )  THEN
    5637 !--         sort csf in place (quicksort)
    5638             CALL quicksort_csf(acsf,1,ncsfl)
    5639 
    5640 !--         while moving to a new array, aggregate canopy sink factor records with identical box & source
    5641             acsfnew(1) = acsf(1)
    5642             iwrite = 1
    5643             DO iread = 2, ncsfl
    5644 !--             here acsf(kcsf) already has values from acsf(icsf)
    5645                 IF ( acsfnew(iwrite)%itx == acsf(iread)%itx &
    5646                          .AND.  acsfnew(iwrite)%ity == acsf(iread)%ity &
    5647                          .AND.  acsfnew(iwrite)%itz == acsf(iread)%itz &
    5648                          .AND.  acsfnew(iwrite)%isurfs == acsf(iread)%isurfs )  THEN
    5649 !--                 We could simply take either first or second rtransp, both are valid. As a very simple heuristic about which ray
    5650 !--                 probably passes nearer the center of the target box, we choose DIF from the entry with greater CSF, since that
    5651 !--                 might mean that the traced beam passes longer through the canopy box.
    5652                     IF ( acsfnew(iwrite)%rsvf < acsf(iread)%rsvf )  THEN
    5653                         acsfnew(iwrite)%rtransp = acsf(iread)%rtransp
    5654                     ENDIF
    5655                     acsfnew(iwrite)%rsvf = acsfnew(iwrite)%rsvf + acsf(iread)%rsvf
    5656 !--                 advance reading index, keep writing index
    5657                 ELSE
    5658 !--                 not identical, just advance and copy
    5659                     iwrite = iwrite + 1
    5660                     acsfnew(iwrite) = acsf(iread)
    5661                 ENDIF
    5662             ENDDO
    5663             ncsfl = iwrite
    5664         ENDIF
    5665 
    5666         IF ( newsize == -1 )  THEN
    5667 !--         allocate new array and copy shrinked data
    5668             IF ( mcsf == 0 )  THEN
    5669                 ALLOCATE( acsf1(ncsfl) )
    5670                 acsf1(1:ncsfl) = acsf2(1:ncsfl)
    5671             ELSE
    5672                 ALLOCATE( acsf2(ncsfl) )
    5673                 acsf2(1:ncsfl) = acsf1(1:ncsfl)
    5674             ENDIF
    5675         ENDIF
    5676 
    5677 !--     deallocate old array
    5678         IF ( mcsf == 0 )  THEN
    5679             mcsf = 1
    5680             acsf => acsf1
    5681             DEALLOCATE( acsf2 )
    5682         ELSE
    5683             mcsf = 0
    5684             acsf => acsf2
    5685             DEALLOCATE( acsf1 )
    5686         ENDIF
    5687         ncsfla = newsize
    5688     END SUBROUTINE usm_merge_and_grow_csf
    5689 
    5690    
    5691 !-- quicksort.f -*-f90-*-
    5692 !-- Author: t-nissie, adaptation J.Resler
    5693 !-- License: GPLv3
    5694 !-- Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
    5695     RECURSIVE SUBROUTINE quicksort_csf2(kpcsflt, pcsflt, first, last)
    5696         IMPLICIT NONE
    5697         INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT)  :: kpcsflt
    5698         REAL(wp), DIMENSION(:,:), INTENT(INOUT)      :: pcsflt
    5699         INTEGER(iwp), INTENT(IN)                     :: first, last
    5700         REAL(wp), DIMENSION(ndcsf)                   :: t2
    5701         INTEGER(iwp), DIMENSION(kdcsf)               :: x, t1
    5702         INTEGER(iwp)                                 :: i, j
    5703 
    5704         IF ( first>=last ) RETURN
    5705         x = kpcsflt(:, (first+last)/2 )
    5706         i = first
    5707         j = last
    5708         DO
    5709             DO while ( csf_lt2(kpcsflt(:,i),x) )
    5710                 i=i+1
    5711             ENDDO
    5712             DO while ( csf_lt2(x,kpcsflt(:,j)) )
    5713                 j=j-1
    5714             ENDDO
    5715             IF ( i >= j ) EXIT
    5716             t1 = kpcsflt(:,i);  kpcsflt(:,i) = kpcsflt(:,j);  kpcsflt(:,j) = t1
    5717             t2 = pcsflt(:,i);  pcsflt(:,i) = pcsflt(:,j);  pcsflt(:,j) = t2
    5718             i=i+1
    5719             j=j-1
    5720         ENDDO
    5721         IF ( first < i-1 ) CALL quicksort_csf2(kpcsflt, pcsflt, first, i-1)
    5722         IF ( j+1 < last )  CALL quicksort_csf2(kpcsflt, pcsflt, j+1, last)
    5723     END SUBROUTINE quicksort_csf2
    5724    
    5725 
    5726     PURE FUNCTION csf_lt2(item1, item2) result(res)
    5727         INTEGER(iwp), DIMENSION(kdcsf), INTENT(in)  :: item1, item2
    5728         LOGICAL                                     :: res
    5729         res = ( (item1(3) < item2(3))                                                        &
    5730              .OR.  (item1(3) == item2(3)  .AND.  item1(2) < item2(2))                            &
    5731              .OR.  (item1(3) == item2(3)  .AND.  item1(2) == item2(2)  .AND.  item1(1) < item2(1)) &
    5732              .OR.  (item1(3) == item2(3)  .AND.  item1(2) == item2(2)  .AND.  item1(1) == item2(1) &
    5733                  .AND.  item1(4) < item2(4)) )
    5734     END FUNCTION csf_lt2
    5735 
     7494         psi_h = - b * ( zeta - c_d_d ) * EXP( -d * zeta ) - (1.0_wp          &
     7495                 + 0.66666666666_wp * a * zeta )**1.5_wp - bc_d_d             &
     7496                 + 1.0_wp
     7497!
     7498!--       Old version for stable conditions (only valid for z/L < 0.5)
     7499!--       psi_h = - 5.0_wp * zeta
     7500       ENDIF
     7501
     7502   END FUNCTION psi_h
    57367503   
    57377504 END MODULE urban_surface_mod
Note: See TracChangeset for help on using the changeset viewer.