Ignore:
Timestamp:
Aug 25, 2020 7:52:08 AM (4 years ago)
Author:
raasch
Message:

files re-formatted to follow the PALM coding standard

File:
1 edited

Legend:

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

    r4630 r4648  
    11!> @file init_grid.f90
    2 !------------------------------------------------------------------------------!
     2!--------------------------------------------------------------------------------------------------!
    33! This file is part of the PALM model system.
    44!
    5 ! PALM is free software: you can redistribute it and/or modify it under the
    6 ! terms of the GNU General Public License as published by the Free Software
    7 ! Foundation, either version 3 of the License, or (at your option) any later
    8 ! version.
    9 !
    10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
    11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
    12 ! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
    13 !
    14 ! You should have received a copy of the GNU General Public License along with
    15 ! PALM. If not, see <http://www.gnu.org/licenses/>.
     5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
     6! Public License as published by the Free Software Foundation, either version 3 of the License, or
     7! (at your option) any later version.
     8!
     9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
     10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
     11! Public License for more details.
     12!
     13! You should have received a copy of the GNU General Public License along with PALM. If not, see
     14! <http://www.gnu.org/licenses/>.
    1615!
    1716! Copyright 1997-2020 Leibniz Universitaet Hannover
    18 !------------------------------------------------------------------------------!
     17!--------------------------------------------------------------------------------------------------!
    1918!
    2019! Current revisions:
     
    2524! -----------------
    2625! $Id$
     26! file re-formatted to follow the PALM coding standard
     27!
     28! 4630 2020-07-30 14:54:34Z suehring
    2729! In case of ASCII topography input flag grid points as terrain and building.
    2830!
    2931! 4601 2020-07-14 12:06:09Z suehring
    3032! Minor formatting adjustments
    31 ! 
     33!
    3234! 4564 2020-06-12 14:03:36Z raasch
    3335! Vertical nesting method of Huq et al. (2019) removed
    34 ! 
     36!
    3537! 4543 2020-05-20 14:12:22Z gronemeier
    3638! Remove non-required check for canyon height
    37 ! 
     39!
    3840! 4507 2020-04-22 18:21:45Z gronemeier
    3941! update origin_z with shifting height of orography (oro_min)
    40 ! 
     42!
    4143! 4457 2020-03-11 14:20:43Z raasch
    4244! use statement for exchange horiz added,
    4345! bugfix for call of exchange horiz 2d
    44 ! 
     46!
    4547! 4444 2020-03-05 15:59:50Z raasch
    4648! bugfix: cpp-directives for serial mode added
    47 ! 
     49!
    4850! 4414 2020-02-19 20:16:04Z suehring
    4951! - Remove deprecated topography arrays nzb_s_inner, nzb_u_inner, etc.
    50 ! - Move initialization of boundary conditions and multigrid into an extra
    51 !   module interface.
    52 !
     52! - Move initialization of boundary conditions and multigrid into an extra module interface.
     53!
    5354! 4386 2020-01-27 15:07:30Z Giersch
    54 ! Allocation statements, comments, naming of variables revised and _wp added to
    55 ! real type values
    56 !
     55! Allocation statements, comments, naming of variables revised and _wp added to real type values
     56!
    5757! 4360 2020-01-07 11:25:50Z suehring
    5858! Revise error messages for generic tunnel setup.
    59 ! 
     59!
    6060! 4346 2019-12-18 11:55:56Z motisi
    61 ! Introduction of wall_flags_total_0, which currently sets bits based on static
    62 ! topography information used in wall_flags_static_0
    63 ! 
     61! Introduction of wall_flags_total_0, which currently sets bits based on static topography
     62! information used in wall_flags_static_0
     63!
    6464! 4340 2019-12-16 08:17:03Z Giersch
    6565! Topography closed channel flow with symmetric boundaries implemented
    66 ! 
     66!
    6767! 4329 2019-12-10 15:46:36Z motisi
    6868! Renamed wall_flags_0 to wall_flags_static_0
    69 ! 
     69!
    7070! 4328 2019-12-09 18:53:04Z suehring
    7171! Minor change in nzb_max computation. Commentation added.
    72 ! 
     72!
    7373! 4314 2019-11-29 10:29:20Z suehring
    74 ! Set additional topography flag 4 to mark topography grid points emerged
    75 ! from the filtering process.
    76 !
     74! Set additional topography flag 4 to mark topography grid points emerged from the filtering process.
     75!
    7776! 4294 2019-11-13 18:34:16Z suehring
    78 ! Bugfix, always set bit 5 and 6 of wall_flags, indicating terrain- and
    79 ! building surfaces in all  cases, in order to enable terrain-following output
    80 ! also when no land- or urban-surface model is applied.
    81 ! 
     77! Bugfix, always set bit 5 and 6 of wall_flags, indicating terrain- and building surfaces in all
     78! cases, in order to enable terrain-following output also when no land- or urban-surface model is
     79! applied.
     80!
    8281! 4265 2019-10-15 16:16:24Z suehring
    83 ! Bugfix for last commit, exchange oro_max variable only when it is allocated
    84 ! (not necessarily the case when topography is input from ASCII file).
    85 ! 
     82! Bugfix for last commit, exchange oro_max variable only when it is allocated (not necessarily the
     83! case when topography is input from ASCII file).
     84!
    8685! 4245 2019-09-30 08:40:37Z pavelkrc
    8786! Store oro_max (building z-offset) in 2D for building surfaces
    88 ! 
     87!
    8988! 4189 2019-08-26 16:19:38Z suehring
    9089! - Add check for proper setting of namelist parameter topography
    9190! - Set flag to indicate land surfaces in case no topography is provided
    92 ! 
     91!
    9392! 4182 2019-08-22 15:20:23Z scharf
    9493! Corrected "Former revisions" section
    95 ! 
     94!
    9695! 4168 2019-08-16 13:50:17Z suehring
    97 ! Pre-calculate topography top index and store it on an array (replaces former
    98 ! functions get_topography_top_index)
    99 ! 
     96! Pre-calculate topography top index and store it on an array (replaces former functions
     97! get_topography_top_index)
     98!
    10099! 4159 2019-08-15 13:31:35Z suehring
    101 ! Revision of topography processing. This was not consistent between 2D and 3D
    102 ! buildings.
    103 !
     100! Revision of topography processing. This was not consistent between 2D and 3D buildings.
     101!
    104102! 4144 2019-08-06 09:11:47Z raasch
    105103! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
    106 ! 
     104!
    107105! 4115 2019-07-24 12:50:49Z suehring
    108 ! Bugfix in setting near-surface flag 24, inidicating wall-bounded grid points 
    109 ! 
     106! Bugfix in setting near-surface flag 24, inidicating wall-bounded grid points
     107!
    110108! 4110 2019-07-22 17:05:21Z suehring
    111109! - Separate initialization of advection flags for momentum and scalars.
    112110! - Change subroutine interface for ws_init_flags_scalar to pass boundary flags
    113 ! 
     111!
    114112! 4109 2019-07-22 17:00:34Z suehring
    115113! Fix bad commit
    116 ! 
     114!
    117115! 3926 2019-04-23 12:56:42Z suehring
    118 ! Minor bugfix in building mapping when all building IDs in the model domain
    119 ! are missing
    120 !
     116! Minor bugfix in building mapping when all building IDs in the model domain are missing
     117!
    121118! 3857 2019-04-03 13:00:16Z knoop
    122 ! In projection of non-building 3D objects onto numerical grid remove
    123 ! dependency on building_type
    124 !
     119! In projection of non-building 3D objects onto numerical grid remove dependency on building_type
     120!
    125121! 3763 2019-02-25 17:33:49Z suehring
    126 ! Replace work-around for ghost point exchange of 1-byte arrays with specific
    127 ! routine as already done in other routines
    128 ! 
     122! Replace work-around for ghost point exchange of 1-byte arrays with specific routine as already
     123! done in other routines
     124!
    129125! 3761 2019-02-25 15:31:42Z raasch
    130126! unused variables removed
    131 ! 
     127!
    132128! 3661 2019-01-08 18:22:50Z suehring
    133 ! Remove setting of nzb_max to nzt at non-cyclic boundary PEs, instead,
    134 ! order degradation of advection scheme is handeled directly in advec_ws
    135 ! 
     129! Remove setting of nzb_max to nzt at non-cyclic boundary PEs, instead, order degradation of
     130! advection scheme is handeled directly in advec_ws
     131!
    136132! 3655 2019-01-07 16:51:22Z knoop
    137133! Comment added
     
    142138!
    143139! Description:
    144 ! -----------------------------------------------------------------------------!
     140! -------------------------------------------------------------------------------------------------!
    145141!> Creating grid depending constants
    146142!> @todo: Rearrange topo flag list
    147 !> @todo: reference 3D buildings on top of orography is not tested and may need
    148 !>        further improvement for steep slopes
    149 !> @todo: Use more advanced setting of building type at filled holes 
    150 !------------------------------------------------------------------------------!
     143!> @todo: reference 3D buildings on top of orography is not tested and may need further improvement
     144!>        for steep slopes
     145!> @todo: Use more advanced setting of building type at filled holes
     146!--------------------------------------------------------------------------------------------------!
    151147 SUBROUTINE init_grid
    152148
    153     USE arrays_3d,                                                             &
     149    USE arrays_3d,                                                                                 &
    154150        ONLY:  dd2zu, ddzu, ddzu_pres, ddzw, dzu, dzw, x, xu, y, yv, zu, zw
    155151
    156     USE control_parameters,                                                    &
    157         ONLY:  constant_flux_layer, dz, dz_max, dz_stretch_factor,             &
    158                dz_stretch_factor_array, dz_stretch_level, dz_stretch_level_end,&
    159                dz_stretch_level_end_index, dz_stretch_level_start_index,       &
    160                dz_stretch_level_start, ibc_uv_b, message_string,               &
    161                number_stretch_level_end,                                       &
    162                number_stretch_level_start,                                     &
    163                ocean_mode,                                                     &
    164                psolver,                                                        &
    165                symmetry_flag,                                                  &
    166                topography,                                                     &
     152    USE control_parameters,                                                                        &
     153        ONLY:  constant_flux_layer, dz, dz_max, dz_stretch_factor,                                 &
     154               dz_stretch_factor_array, dz_stretch_level, dz_stretch_level_end,                    &
     155               dz_stretch_level_end_index, dz_stretch_level_start_index,                           &
     156               dz_stretch_level_start, ibc_uv_b, message_string,                                   &
     157               number_stretch_level_end,                                                           &
     158               number_stretch_level_start,                                                         &
     159               ocean_mode,                                                                         &
     160               psolver,                                                                            &
     161               symmetry_flag,                                                                      &
     162               topography,                                                                         &
    167163               use_surface_fluxes
    168164
    169     USE grid_variables,                                                        &
     165    USE grid_variables,                                                                            &
    170166        ONLY:  ddx, ddx2, ddy, ddy2, dx, dx2, dy, dy2, zu_s_inner, zw_w_inner
    171167
    172     USE indices,                                                               &
    173         ONLY:  nbgp,                                                           &
    174                nx,                                                             &
    175                nxl,                                                            &
    176                nxlg,                                                           &
    177                nxr,                                                            &
    178                nxrg,                                                           &
    179                ny,                                                             &
    180                nyn,                                                            &
    181                nyng,                                                           &
    182                nys,                                                            &
    183                nysg,                                                           &
    184                nz,                                                             &
    185                nzb,                                                            &
    186                nzb_diff,                                                       &
    187                nzb_max,                                                        &
    188                nzt,                                                            &
    189                topo_top_ind,                                                   &
     168    USE indices,                                                                                   &
     169        ONLY:  nbgp,                                                                               &
     170               nx,                                                                                 &
     171               nxl,                                                                                &
     172               nxlg,                                                                               &
     173               nxr,                                                                                &
     174               nxrg,                                                                               &
     175               ny,                                                                                 &
     176               nyn,                                                                                &
     177               nyng,                                                                               &
     178               nys,                                                                                &
     179               nysg,                                                                               &
     180               nz,                                                                                 &
     181               nzb,                                                                                &
     182               nzb_diff,                                                                           &
     183               nzb_max,                                                                            &
     184               nzt,                                                                                &
     185               topo_top_ind,                                                                       &
    190186               topo_min_level
    191187
     
    196192    IMPLICIT NONE
    197193
    198     INTEGER(iwp) ::  i             !< index variable along x 
     194    INTEGER(iwp) ::  i             !< index variable along x
    199195    INTEGER(iwp) ::  j             !< index variable along y
    200196    INTEGER(iwp) ::  k             !< index variable along z
    201197    INTEGER(iwp) ::  k_top         !< topography top index on local PE
    202198    INTEGER(iwp) ::  n             !< loop variable for stretching
    203     INTEGER(iwp) ::  number_dz     !< number of user-specified dz values       
     199    INTEGER(iwp) ::  number_dz     !< number of user-specified dz values
    204200    INTEGER(iwp) ::  nzb_local_max !< vertical grid index of maximum topography height
    205201    INTEGER(iwp) ::  nzb_local_min !< vertical grid index of minimum topography height
     
    209205    REAL(wp) ::  dz_level_end  !< distance between calculated height level for u/v-grid and user-specified end level for stretching
    210206    REAL(wp) ::  dz_stretched  !< stretched vertical grid spacing
    211    
    212     REAL(wp), DIMENSION(:), ALLOCATABLE ::  min_dz_stretch_level_end !< Array that contains all minimum heights where the stretching can end
     207
     208    REAL(wp), DIMENSION(:), ALLOCATABLE ::  min_dz_stretch_level_end !< Array that contains all minimum heights where the stretching
     209                                                                     !< can end
    213210
    214211
     
    224221    ALLOCATE( x(0:nx) )
    225222    ALLOCATE( xu(0:nx) )
    226    
     223
    227224    DO i = 0, nx
    228225       xu(i) = i * dx
     
    232229    ALLOCATE( y(0:ny) )
    233230    ALLOCATE( yv(0:ny) )
    234    
     231
    235232    DO j = 0, ny
    236233       yv(j) = j * dy
     
    247244
    248245!
    249 !-- For constructing an appropriate grid, the vertical grid spacing dz has to
    250 !-- be specified with a non-negative value in the parameter file
     246!-- For constructing an appropriate grid, the vertical grid spacing dz has to be specified with a
     247!-- non-negative value in the parameter file.
    251248    IF ( dz(1) == -1.0_wp )  THEN
    252249       message_string = 'missing dz'
    253        CALL message( 'init_grid', 'PA0200', 1, 2, 0, 6, 0 ) 
     250       CALL message( 'init_grid', 'PA0200', 1, 2, 0, 6, 0 )
    254251    ELSEIF ( dz(1) <= 0.0_wp )  THEN
    255252       WRITE( message_string, * ) 'dz=',dz(1),' <= 0.0'
     
    258255
    259256!
    260 !-- Initialize dz_stretch_level_start with the value of dz_stretch_level
    261 !-- if it was set by the user
     257!-- Initialize dz_stretch_level_start with the value of dz_stretch_level if it was set by the user.
    262258    IF ( dz_stretch_level /= -9999999.9_wp ) THEN
    263259       dz_stretch_level_start(1) = dz_stretch_level
    264260    ENDIF
    265        
    266 !
    267 !-- Determine number of dz values and stretching levels specified by the
    268 !-- user to allow right controlling of the stretching mechanism and to
    269 !-- perform error checks. The additional requirement that dz /= dz_max
    270 !-- for counting number of user-specified dz values is necessary. Otherwise
    271 !-- restarts would abort if the old stretching mechanism with dz_stretch_level
    272 !-- is used (Attention: The user is not allowed to specify a dz value equal
    273 !-- to the default of dz_max = 999.0).
    274     number_dz = COUNT( dz /= -1.0_wp .AND. dz /= dz_max)
    275     number_stretch_level_start = COUNT( dz_stretch_level_start /=              &
    276                                        -9999999.9_wp )
    277     number_stretch_level_end = COUNT( dz_stretch_level_end /=                  &
    278                                       9999999.9_wp )
    279 
    280 !
    281 !-- The number of specified end levels +1 has to be the same as the number
     261
     262!
     263!-- Determine number of dz values and stretching levels specified by the user to allow right
     264!-- controlling of the stretching mechanism and to perform error checks. The additional requirement
     265!-- that dz /= dz_max for counting number of user-specified dz values is necessary. Otherwise
     266!-- restarts would abort if the old stretching mechanism with dz_stretch_level is used (Attention:
     267!-- The user is not allowed to specify a dz value equal to the default of dz_max = 999.0).
     268    number_dz = COUNT( dz /= -1.0_wp  .AND.  dz /= dz_max)
     269    number_stretch_level_start = COUNT( dz_stretch_level_start /= -9999999.9_wp )
     270    number_stretch_level_end = COUNT( dz_stretch_level_end /= 9999999.9_wp )
     271
     272!
     273!-- The number of specified end levels +1 has to be the same as the number
    282274!-- of specified dz values
    283275    IF ( number_dz /= number_stretch_level_end + 1 ) THEN
    284        WRITE( message_string, * ) 'The number of values for dz = ',            &
    285                                    number_dz, 'has to be the same as& ',       &
    286                                    'the number of values for ',                &
    287                                    'dz_stretch_level_end + 1 = ',              &
    288                                    number_stretch_level_end+1
     276       WRITE( message_string, * )  'The number of values for dz = ', number_dz,                    &
     277                                   'has to be the same as& ', 'the number of values for ',         &
     278                                   'dz_stretch_level_end + 1 = ', number_stretch_level_end+1
    289279       CALL message( 'init_grid', 'PA0156', 1, 2, 0, 6, 0 )
    290280    ENDIF
    291    
    292 !
    293 !-- The number of specified start levels has to be the same or one less than
    294 !-- the number of specified dz values
    295     IF ( number_dz /= number_stretch_level_start + 1 .AND.                     &
    296          number_dz /= number_stretch_level_start ) THEN
    297        WRITE( message_string, * ) 'The number of values for dz = ',            &
    298                                    number_dz, 'has to be the same as or one ', &
    299                                    'more than& the number of values for ',     &
    300                                    'dz_stretch_level_start = ',                &
    301                                    number_stretch_level_start
     281
     282!
     283!-- The number of specified start levels has to be the same or one less than the number of specified
     284!-- dz values
     285    IF ( number_dz /= number_stretch_level_start + 1  .AND.                                        &
     286         number_dz /= number_stretch_level_start )  THEN
     287       WRITE( message_string, * )  'The number of values for dz = ', number_dz,                    &
     288                                   'has to be the same as or one ',                                &
     289                                   'more than& the number of values for ',                         &
     290                                   'dz_stretch_level_start = ', number_stretch_level_start
    302291       CALL message( 'init_grid', 'PA0211', 1, 2, 0, 6, 0 )
    303292    ENDIF
    304    
    305 !-- The number of specified start levels has to be the same or one more than
    306 !-- the number of specified end levels
    307     IF ( number_stretch_level_start /= number_stretch_level_end + 1 .AND.      &
     293
     294!-- The number of specified start levels has to be the same or one more than the number of specified
     295!-- end levels
     296    IF ( number_stretch_level_start /= number_stretch_level_end + 1  .AND.                         &
    308297         number_stretch_level_start /= number_stretch_level_end ) THEN
    309        WRITE( message_string, * ) 'The number of values for ',                 &
    310                                   'dz_stretch_level_start = ',                 &
    311                                    dz_stretch_level_start, 'has to be the ',   &
    312                                    'same or one more than& the number of ',    &
    313                                    'values for dz_stretch_level_end = ',       &
    314                                    number_stretch_level_end
     298       WRITE( message_string, * )  'The number of values for ',                                    &
     299                                   'dz_stretch_level_start = ', dz_stretch_level_start,            &
     300                                   'has to be the ', 'same or one more than& the number of ',      &
     301                                   'values for dz_stretch_level_end = ', number_stretch_level_end
    315302       CALL message( 'init_grid', 'PA0216', 1, 2, 0, 6, 0 )
    316303    ENDIF
     
    318305!
    319306!-- Initialize dz for the free atmosphere with the value of dz_max
    320     IF ( dz(number_stretch_level_start+1) == -1.0_wp .AND.                     &
    321          number_stretch_level_start /= 0 ) THEN
     307    IF ( dz(number_stretch_level_start+1) == -1.0_wp  .AND.  number_stretch_level_start /= 0 ) THEN
    322308       dz(number_stretch_level_start+1) = dz_max
    323309    ENDIF
    324        
    325 !
    326 !-- Initialize the stretching factor if (infinitely) stretching in the free
    327 !-- atmosphere is desired (dz_stretch_level_end was not specified for the
    328 !-- free atmosphere)
    329     IF ( number_stretch_level_start == number_stretch_level_end + 1 ) THEN
    330        dz_stretch_factor_array(number_stretch_level_start) =                   &
    331        dz_stretch_factor
     310
     311!
     312!-- Initialize the stretching factor if (infinitely) stretching in the free atmosphere is desired
     313!-- (dz_stretch_level_end was not specified for the free atmosphere)
     314    IF ( number_stretch_level_start == number_stretch_level_end + 1 )  THEN
     315       dz_stretch_factor_array(number_stretch_level_start) = dz_stretch_factor
    332316    ENDIF
    333    
     317
    334318!
    335319!-- Allocation of arrays for stretching
     
    339323!-- Define the vertical grid levels. Start with atmosphere branch
    340324    IF ( .NOT. ocean_mode )  THEN
    341    
    342 !
    343 !--    The stretching region has to be large enough to allow for a smooth
    344 !--    transition between two different grid spacings. The number 4 is an
    345 !--    empirical value
     325
     326!
     327!--    The stretching region has to be large enough to allow for a smooth transition between two
     328!--    different grid spacings. The number 4 is an empirical value.
    346329       DO n = 1, number_stretch_level_start
    347           min_dz_stretch_level_end(n) = dz_stretch_level_start(n) +            &
    348                                         4 * MAX( dz(n),dz(n+1) )
     330          min_dz_stretch_level_end(n) = dz_stretch_level_start(n) + 4 * MAX( dz(n),dz(n+1) )
    349331       ENDDO
    350332
    351        IF ( ANY( min_dz_stretch_level_end(1:number_stretch_level_start) >      &
    352                  dz_stretch_level_end(1:number_stretch_level_start) ) ) THEN
    353           message_string= 'Each dz_stretch_level_end has to be larger ' //     &
    354                           'than its corresponding value for &' //              &
    355                           'dz_stretch_level_start + 4*MAX(dz(n),dz(n+1)) '//   &
     333       IF ( ANY( min_dz_stretch_level_end(1:number_stretch_level_start) >                          &
     334                 dz_stretch_level_end(1:number_stretch_level_start) ) )  THEN
     335          message_string= 'Each dz_stretch_level_end has to be larger ' //                         &
     336                          'than its corresponding value for &' //                                  &
     337                          'dz_stretch_level_start + 4*MAX(dz(n),dz(n+1)) '//                       &
    356338                          'to allow for smooth grid stretching'
    357339          CALL message( 'init_grid', 'PA0224', 1, 2, 0, 6, 0 )
    358340       ENDIF
    359        
    360 !
    361 !--    Stretching must not be applied within the surface layer
    362 !--    (first two grid points). For the default case dz_stretch_level_start
    363 !--    is negative. Therefore the absolut value is checked here.
     341
     342!
     343!--    Stretching must not be applied within the surface layer (first two grid points). For the
     344!--    default case dz_stretch_level_start is negative. Therefore the absolut value is checked here.
    364345       IF ( ANY( ABS( dz_stretch_level_start ) <= dz(1) * 1.5_wp ) ) THEN
    365           WRITE( message_string, * ) 'Each dz_stretch_level_start has to be ',&
    366                                      'larger than ', dz(1) * 1.5
     346          WRITE( message_string, * )  'Each dz_stretch_level_start has to be ',                    &
     347                                      'larger than ', dz(1) * 1.5
    367348          CALL message( 'init_grid', 'PA0226', 1, 2, 0, 6, 0 )
    368349       ENDIF
    369350
    370351!
    371 !--    The stretching has to start and end on a grid level. Therefore
    372 !--    user-specified values are mapped to the next lowest level. The 
    373 !--    calculation of the first level is realized differently just because of
    374 !--    historical reasons (the advanced/new stretching mechanism was realized 
    375 !--    in a way that results don't change if the old parameters
    376 !--    dz_stretch_level, dz_stretch_factor and dz_max are used)
    377        IF ( number_stretch_level_start /= 0 ) THEN
    378           dz_stretch_level_start(1) = INT( (dz_stretch_level_start(1) -        &
    379                                             dz(1)/2.0) / dz(1) )               &
     352!--    The stretching has to start and end on a grid level. Therefore user-specified values are
     353!--    mapped to the next lowest level. The calculation of the first level is realized differently
     354!--    just because of historical reasons (the advanced/new stretching mechanism was realized in a
     355!--    way that results don't change if the old parameters dz_stretch_level, dz_stretch_factor and
     356!--    dz_max are used).
     357       IF ( number_stretch_level_start /= 0 )  THEN
     358          dz_stretch_level_start(1) = INT( (dz_stretch_level_start(1) - dz(1)/2.0) / dz(1) )       &
    380359                                      * dz(1) + dz(1)/2.0
    381360       ENDIF
    382        
     361
    383362       IF ( number_stretch_level_start > 1 ) THEN
    384363          DO n = 2, number_stretch_level_start
    385              dz_stretch_level_start(n) = INT( dz_stretch_level_start(n) /      &
    386                                               dz(n) ) * dz(n)
    387           ENDDO
    388        ENDIF
    389        
     364             dz_stretch_level_start(n) = INT( dz_stretch_level_start(n) / dz(n) ) * dz(n)
     365          ENDDO
     366       ENDIF
     367
    390368       IF ( number_stretch_level_end /= 0 ) THEN
    391369          DO n = 1, number_stretch_level_end
    392              dz_stretch_level_end(n) = INT( dz_stretch_level_end(n) /          &
    393                                             dz(n+1) ) * dz(n+1)
     370             dz_stretch_level_end(n) = INT( dz_stretch_level_end(n) / dz(n+1) ) * dz(n+1)
    394371          ENDDO
    395372       ENDIF
     
    397374!
    398375!--    Determine stretching factor if necessary
    399        IF ( number_stretch_level_end >= 1 ) THEN 
     376       IF ( number_stretch_level_end >= 1 ) THEN
    400377          CALL calculate_stretching_factor( number_stretch_level_end )
    401378       ENDIF
     
    403380!
    404381!--    Grid for atmosphere with surface at z=0 (k=0, w-grid).
    405 !--    First compute the u- and v-levels. In case of dirichlet bc for u and v
    406 !--    the first u/v- and w-level (k=0) are defined at same height (z=0).
    407 !--    The second u-level (k=1) corresponds to the top of the
    408 !--    surface layer. In case of symmetric boundaries (closed channel flow),
    409 !--    the first grid point is always at z=0.
    410        IF ( ibc_uv_b == 0 .OR. ibc_uv_b == 2 .OR.                              &
    411             topography == 'closed_channel' ) THEN
     382!--    First compute the u- and v-levels. In case of dirichlet bc for u and v the first u/v- and
     383!--    w-level (k=0) are defined at same height (z=0).
     384!--    The second u-level (k=1) corresponds to the top of the surface layer. In case of symmetric
     385!--    boundaries (closed channel flow), the first grid point is always at z=0.
     386       IF ( ibc_uv_b == 0  .OR.  ibc_uv_b == 2  .OR.  topography == 'closed_channel' )  THEN
    412387          zu(0) = 0.0_wp
    413388       ELSE
    414389          zu(0) = - dz(1) * 0.5_wp
    415390       ENDIF
    416          
     391
    417392       zu(1) =   dz(1) * 0.5_wp
    418        
    419 !
    420 !--    Determine u and v height levels considering the possibility of grid
    421 !--    stretching in several heights.
     393
     394!
     395!--    Determine u and v height levels considering the possibility of grid stretching in several
     396!--    heights.
    422397       n = 1
    423398       dz_stretch_level_start_index = nzt+1
     
    425400       dz_stretched = dz(1)
    426401
    427 !--    The default value of dz_stretch_level_start is negative, thus the first
    428 !--    condition is true even if no stretching shall be applied. Hence, the
    429 !--    second condition is also necessary.
     402!--    The default value of dz_stretch_level_start is negative, thus the first condition is true
     403!--    even if no stretching shall be applied. Hence, the second condition is also necessary.
    430404       DO  k = 2, nzt+1-symmetry_flag
    431           IF ( dz_stretch_level_start(n) <= zu(k-1) .AND.                      &
    432                dz_stretch_level_start(n) /= -9999999.9_wp ) THEN
     405          IF ( dz_stretch_level_start(n) <= zu(k-1)  .AND.                                         &
     406               dz_stretch_level_start(n) /= -9999999.9_wp )  THEN
    433407             dz_stretched = dz_stretched * dz_stretch_factor_array(n)
    434              
    435              IF ( dz(n) > dz(n+1) ) THEN
     408
     409             IF ( dz(n) > dz(n+1) )  THEN
    436410                dz_stretched = MAX( dz_stretched, dz(n+1) ) !Restrict dz_stretched to the user-specified (higher) dz
    437411             ELSE
    438412                dz_stretched = MIN( dz_stretched, dz(n+1) ) !Restrict dz_stretched to the user-specified (lower) dz
    439413             ENDIF
    440              
    441              IF ( dz_stretch_level_start_index(n) == nzt+1 )                         &
    442              dz_stretch_level_start_index(n) = k-1
    443              
    444           ENDIF
    445          
     414
     415             IF ( dz_stretch_level_start_index(n) == nzt+1 )  dz_stretch_level_start_index(n) = k-1
     416
     417          ENDIF
     418
    446419          zu(k) = zu(k-1) + dz_stretched
    447          
    448 !
    449 !--       Make sure that the stretching ends exactly at dz_stretch_level_end 
    450           dz_level_end = ABS( zu(k) - dz_stretch_level_end(n) ) 
    451          
    452           IF ( dz_level_end  < dz(n+1)/3.0 ) THEN
     420
     421!
     422!--       Make sure that the stretching ends exactly at dz_stretch_level_end
     423          dz_level_end = ABS( zu(k) - dz_stretch_level_end(n) )
     424
     425          IF ( dz_level_end  < dz(n+1)/3.0 )  THEN
    453426             zu(k) = dz_stretch_level_end(n)
    454427             dz_stretched = dz(n+1)
    455428             dz_stretch_level_end_index(n) = k
    456              n = n + 1             
     429             n = n + 1
    457430          ENDIF
    458431       ENDDO
    459        
    460 !
    461 !--    If a closed channel flow is simulated, make sure that grid structure is 
    462 !--    the same for both bottom and top boundary. (Hint: Using a different dz
    463 !--    at the bottom and at the top makes no sense due to symmetric boundaries
    464 !--    where dz should be equal. Therefore, different dz at the bottom and top 
    465 !--    causes an abort (see check_parameters).)
    466        IF ( topography == 'closed_channel' ) THEN
     432
     433!
     434!--    If a closed channel flow is simulated, make sure that grid structure is the same for both
     435!--    bottom and top boundary. (Hint: Using a different dz at the bottom and at the top makes no
     436!--    sense due to symmetric boundaries where dz should be equal. Therefore, different dz at the
     437!--    bottom and top causes an abort (see check_parameters).)
     438       IF ( topography == 'closed_channel' )  THEN
    467439          zu(nzt+1) = zu(nzt) + dz(1) * 0.5_wp
    468440       ENDIF
    469441
    470442!
    471 !--    Compute the w-levels. They are always staggered half-way between the
    472 !--    corresponding u-levels. In case of dirichlet bc for u and v at the
    473 !--    ground the first u- and w-level (k=0) are defined at same height (z=0).
    474 !--    Per default, the top w-level is extrapolated linearly. In case of
    475 !--    a closed channel flow, zu(nzt+1) and zw(nzt) must be set explicitely.
    476 !--    (Hint: Using a different dz at the bottom and at the top makes no sense
    477 !--    due to symmetric boundaries where dz should be equal. Therefore,
    478 !--    different dz at the bottom and top causes an abort (see
    479 !--    check_parameters).)
     443!--    Compute the w-levels. They are always staggered half-way between the corresponding u-levels.
     444!--    In case of dirichlet bc for u and v at the ground the first u- and w-level (k=0) are defined
     445!--    at same height (z=0).
     446!--    Per default, the top w-level is extrapolated linearly. In case of a closed channel flow,
     447!--    zu(nzt+1) and zw(nzt) must be set explicitely.
     448!--    (Hint: Using a different dz at the bottom and at the top makes no sense due to symmetric
     449!--    boundaries where dz should be equal. Therefore, different dz at the bottom and top causes an
     450!--    abort (see check_parameters).)
    480451       zw(0) = 0.0_wp
    481452       DO  k = 1, nzt-symmetry_flag
    482453          zw(k) = ( zu(k) + zu(k+1) ) * 0.5_wp
    483454       ENDDO
    484        IF ( topography == 'closed_channel' ) THEN
     455       IF ( topography == 'closed_channel' )  THEN
    485456          zw(nzt)   = zw(nzt-1) + dz(1)
    486457          zw(nzt+1) = zw(nzt) + dz(1)
     
    492463
    493464!
    494 !--    The stretching region has to be large enough to allow for a smooth
    495 !--    transition between two different grid spacings. The number 4 is an
    496 !--    empirical value
     465!--    The stretching region has to be large enough to allow for a smooth transition between two
     466!--    different grid spacings. The number 4 is an empirical value
    497467       DO n = 1, number_stretch_level_start
    498           min_dz_stretch_level_end(n) = dz_stretch_level_start(n) -            &
    499                                         4 * MAX( dz(n),dz(n+1) )
     468          min_dz_stretch_level_end(n) = dz_stretch_level_start(n) - 4 * MAX( dz(n),dz(n+1) )
    500469       ENDDO
    501        
    502        IF ( ANY( min_dz_stretch_level_end (1:number_stretch_level_start) <     &
    503                  dz_stretch_level_end(1:number_stretch_level_start) ) ) THEN
    504              message_string= 'Each dz_stretch_level_end has to be less ' //   &
    505                              'than its corresponding value for &' //           &
    506                              'dz_stretch_level_start - 4*MAX(dz(n),dz(n+1)) '//&
     470
     471       IF ( ANY( min_dz_stretch_level_end (1:number_stretch_level_start) <                         &
     472                 dz_stretch_level_end(1:number_stretch_level_start) ) )  THEN
     473             message_string= 'Each dz_stretch_level_end has to be less ' //                        &
     474                             'than its corresponding value for &' //                               &
     475                             'dz_stretch_level_start - 4*MAX(dz(n),dz(n+1)) '//                    &
    507476                             'to allow for smooth grid stretching'
    508477             CALL message( 'init_grid', 'PA0224', 1, 2, 0, 6, 0 )
    509478       ENDIF
    510        
    511 !
    512 !--    Stretching must not be applied close to the surface (last two grid
    513 !--    points). For the default case dz_stretch_level_start is negative.
    514        IF ( ANY( dz_stretch_level_start >= - dz(1) * 1.5_wp ) ) THEN
    515           WRITE( message_string, * ) 'Each dz_stretch_level_start has to be ',&
    516                                      'less than ', -dz(1) * 1.5
     479
     480!
     481!--    Stretching must not be applied close to the surface (last two grid points). For the default
     482!--    case dz_stretch_level_start is negative.
     483       IF ( ANY( dz_stretch_level_start >= - dz(1) * 1.5_wp ) )  THEN
     484          WRITE( message_string, * )  'Each dz_stretch_level_start has to be ',                    &
     485                                      'less than ', -dz(1) * 1.5
    517486             CALL message( 'init_grid', 'PA0226', 1, 2, 0, 6, 0 )
    518487       ENDIF
    519488
    520489!
    521 !--    The stretching has to start and end on a grid level. Therefore
    522 !--    user-specified values are mapped to the next highest level. The 
    523 !--    calculation of the first level is realized differently just because of
    524 !--    historical reasons (the advanced/new stretching mechanism was realized 
    525 !--    in a way that results don't change if the old parameters
    526 !--    dz_stretch_level, dz_stretch_factor and dz_max are used)
    527        IF ( number_stretch_level_start /= 0 ) THEN
    528           dz_stretch_level_start(1) = INT( (dz_stretch_level_start(1) +        &
    529                                             dz(1)/2.0) / dz(1) )               &
     490!--    The stretching has to start and end on a grid level. Therefore user-specified values are
     491!--    mapped to the next highest level. The calculation of the first level is realized differently
     492!--    just because of historical reasons (the advanced/new stretching mechanism was realized in a
     493!--    way that results don't change if the old parameters dz_stretch_level, dz_stretch_factor and
     494!--    dz_max are used)
     495       IF ( number_stretch_level_start /= 0 )  THEN
     496          dz_stretch_level_start(1) = INT( (dz_stretch_level_start(1) + dz(1)/2.0) / dz(1) )       &
    530497                                      * dz(1) - dz(1)/2.0
    531498       ENDIF
    532        
    533        IF ( number_stretch_level_start > 1 ) THEN
     499
     500       IF ( number_stretch_level_start > 1 )  THEN
    534501          DO n = 2, number_stretch_level_start
    535              dz_stretch_level_start(n) = INT( dz_stretch_level_start(n) /      &
    536                                               dz(n) ) * dz(n)
    537           ENDDO
    538        ENDIF
    539        
    540        IF ( number_stretch_level_end /= 0 ) THEN
     502             dz_stretch_level_start(n) = INT( dz_stretch_level_start(n) / dz(n) ) * dz(n)
     503          ENDDO
     504       ENDIF
     505
     506       IF ( number_stretch_level_end /= 0 )  THEN
    541507          DO n = 1, number_stretch_level_end
    542              dz_stretch_level_end(n) = INT( dz_stretch_level_end(n) /          &
    543                                             dz(n+1) ) * dz(n+1)
    544           ENDDO
    545        ENDIF
    546        
     508             dz_stretch_level_end(n) = INT( dz_stretch_level_end(n) / dz(n+1) ) * dz(n+1)
     509          ENDDO
     510       ENDIF
     511
    547512!
    548513!--    Determine stretching factor if necessary
    549        IF ( number_stretch_level_end >= 1 ) THEN 
     514       IF ( number_stretch_level_end >= 1 ) THEN
    550515          CALL calculate_stretching_factor( number_stretch_level_end )
    551516       ENDIF
     
    553518!
    554519!--    Grid for ocean with free water surface is at k=nzt (w-grid).
    555 !--    In case of neumann bc at the ground the first first u-level (k=0) lies
    556 !--    below the first w-level (k=0). In case of dirichlet bc the first u- and
    557 !--    w-level are defined at same height, but staggered from the second level.
     520!--    In case of neumann bc at the ground the first first u-level (k=0) lies below the first
     521!--    w-level (k=0). In case of dirichlet bc the first u- and w-level are defined at same height,
     522!--    but staggered from the second level.
    558523!--    The second u-level (k=1) corresponds to the top of the surface layer.
    559524!--    z values are negative starting from z=0 (surface)
     
    562527
    563528!
    564 !--    Determine u and v height levels considering the possibility of grid
    565 !--    stretching in several heights.
     529!--    Determine u and v height levels considering the possibility of grid stretching in several
     530!--    heights.
    566531       n = 1
    567532       dz_stretch_level_start_index = 0
     
    570535
    571536       DO  k = nzt-1, 0, -1
    572          
    573           IF ( dz_stretch_level_start(n) >= zu(k+1) ) THEN
     537
     538          IF ( dz_stretch_level_start(n) >= zu(k+1) )  THEN
    574539             dz_stretched = dz_stretched * dz_stretch_factor_array(n)
    575540
    576              IF ( dz(n) > dz(n+1) ) THEN
     541             IF ( dz(n) > dz(n+1) )  THEN
    577542                dz_stretched = MAX( dz_stretched, dz(n+1) ) !Restrict dz_stretched to the user-specified (higher) dz
    578543             ELSE
    579544                dz_stretched = MIN( dz_stretched, dz(n+1) ) !Restrict dz_stretched to the user-specified (lower) dz
    580545             ENDIF
    581              
    582              IF ( dz_stretch_level_start_index(n) == 0 )                             &
    583              dz_stretch_level_start_index(n) = k+1
    584              
    585           ENDIF
    586          
     546
     547             IF ( dz_stretch_level_start_index(n) == 0 )  dz_stretch_level_start_index(n) = k+1
     548
     549          ENDIF
     550
    587551          zu(k) = zu(k+1) - dz_stretched
    588          
    589 !
    590 !--       Make sure that the stretching ends exactly at dz_stretch_level_end 
    591           dz_level_end = ABS( zu(k) - dz_stretch_level_end(n) ) 
    592          
    593           IF ( dz_level_end  < dz(n+1)/3.0 ) THEN
     552
     553!
     554!--       Make sure that the stretching ends exactly at dz_stretch_level_end
     555          dz_level_end = ABS( zu(k) - dz_stretch_level_end(n) )
     556
     557          IF ( dz_level_end  < dz(n+1)/3.0 )  THEN
    594558             zu(k) = dz_stretch_level_end(n)
    595559             dz_stretched = dz(n+1)
    596560             dz_stretch_level_end_index(n) = k
    597              n = n + 1             
     561             n = n + 1
    598562          ENDIF
    599563       ENDDO
    600        
    601 !
    602 !--    Compute the w-levels. They are always staggered half-way between the
    603 !--    corresponding u-levels, except in case of dirichlet bc for u and v
    604 !--    at the ground. In this case the first u- and w-level are defined at
    605 !--    same height. The top w-level (nzt+1) is not used but set for
     564
     565!
     566!--    Compute the w-levels. They are always staggered half-way between the corresponding u-levels,
     567!--    except in case of dirichlet bc for u and v at the ground. In this case the first u- and
     568!--    w-level are defined at same height. The top w-level (nzt+1) is not used but set for
    606569!--    consistency, since w and all scalar variables are defined up tp nzt+1.
    607570       zw(nzt+1) = dz(1)
     
    612575
    613576!
    614 !--    In case of dirichlet bc for u and v the first u- and w-level are defined
    615 !--    at same height.
     577!--    In case of dirichlet bc for u and v the first u- and w-level are defined at same height.
    616578       IF ( ibc_uv_b == 0 ) THEN
    617579          zu(0) = zw(0)
     
    632594       dd2zu(k) = 1.0_wp / ( dzu(k) + dzu(k+1) )
    633595    ENDDO
    634    
    635 !   
    636 !-- The FFT- SOR-pressure solvers assume grid spacings of a staggered grid
    637 !-- everywhere. For the actual grid, the grid spacing at the lowest level
    638 !-- is only dz/2, but should be dz. Therefore, an additional array
    639 !-- containing with appropriate grid information is created for these
    640 !-- solvers.
     596
     597!
     598!-- The FFT- SOR-pressure solvers assume grid spacings of a staggered grid everywhere. For the
     599!-- actual grid, the grid spacing at the lowest level is only dz/2, but should be dz. Therefore, an
     600!-- additional array containing with appropriate grid information is created for these solvers.
    641601    IF ( psolver(1:9) /= 'multigrid' )  THEN
    642602       ALLOCATE( ddzu_pres(1:nzt+1) )
     
    659619    topo = 0
    660620!
    661 !-- Initialize topography by generic topography or read topography from file. 
     621!-- Initialize topography by generic topography or read topography from file.
    662622    CALL init_topo( topo )
    663623!
    664 !-- Set flags to mask topography on the grid. 
     624!-- Set flags to mask topography on the grid.
    665625    CALL set_topo_flags( topo )
    666626
    667627!
    668 !-- Determine the maximum level of topography. It is used for
    669 !-- steering the degradation of order of the applied advection scheme,
    670 !-- as well in the lpm.
     628!-- Determine the maximum level of topography. It is used for steering the degradation of order of
     629!-- the applied advection scheme, as well in the lpm.
    671630    k_top = 0
    672631    DO  i = nxl, nxr
     
    678637    ENDDO
    679638#if defined( __parallel )
    680     CALL MPI_ALLREDUCE( k_top, nzb_max, 1, MPI_INTEGER,                        &
    681                         MPI_MAX, comm2d, ierr )
     639    CALL MPI_ALLREDUCE( k_top, nzb_max, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
    682640#else
    683641    nzb_max = k_top
     
    686644!-- Increment nzb_max by 1 in order to allow for proper diverengence correction.
    687645!-- Further, in case topography extents up to the model top, limit to nzt.
    688     nzb_max = MIN( nzb_max+1, nzt ) 
    689 !
    690 !-- Determine minimum index of topography. Usually, this will be nzb. In case
    691 !-- there is elevated topography, however, the lowest topography will be higher.
    692 !-- This index is e.g. used to calculate mean first-grid point atmosphere
    693 !-- temperature, surface pressure and density, etc. .
     646    nzb_max = MIN( nzb_max+1, nzt )
     647!
     648!-- Determine minimum index of topography. Usually, this will be nzb. In case there is elevated
     649!-- topography, however, the lowest topography will be higher.
     650!-- This index is e.g. used to calculate mean first-grid point atmosphere temperature, surface
     651!-- pressure and density, etc. .
    694652    topo_min_level   = 0
    695653#if defined( __parallel )
    696     CALL MPI_ALLREDUCE( MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ),             &
    697                         topo_min_level, 1, MPI_INTEGER, MPI_MIN, comm2d, ierr )
     654    CALL MPI_ALLREDUCE( MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ), topo_min_level, 1, MPI_INTEGER, &
     655                        MPI_MIN, comm2d, ierr )
    698656#else
    699657    topo_min_level = MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) )
     
    701659
    702660!
    703 !-- Check topography for consistency with model domain. Therefore, use
    704 !-- maximum and minium topography-top indices. Note, minimum topography top
    705 !-- index is already calculated. 
     661!-- Check topography for consistency with model domain. Therefore, use maximum and minium
     662!-- topography-top indices. Note, minimum topography top index is already calculated.
    706663    IF ( TRIM( topography ) /= 'flat' )  THEN
    707664#if defined( __parallel )
    708        CALL MPI_ALLREDUCE( MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ),          &
    709                            nzb_local_max, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )               
     665       CALL MPI_ALLREDUCE( MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ), nzb_local_max, 1,            &
     666                           MPI_INTEGER, MPI_MAX, comm2d, ierr )
    710667#else
    711668       nzb_local_max = MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) )
     
    715672!--    Consistency checks
    716673       IF ( nzb_local_min < 0  .OR.  nzb_local_max  > nz + 1 )  THEN
    717           WRITE( message_string, * ) 'nzb_local values are outside the',       &
    718                                 ' model domain',                               &
    719                                 '&MINVAL( nzb_local ) = ', nzb_local_min,      &
    720                                 '&MAXVAL( nzb_local ) = ', nzb_local_max
     674          WRITE( message_string, * ) 'nzb_local values are outside the model domain',              &
     675                                     '&MINVAL( nzb_local ) = ', nzb_local_min,                     &
     676                                     '&MAXVAL( nzb_local ) = ', nzb_local_max
    721677          CALL message( 'init_grid', 'PA0210', 1, 2, 0, 6, 0 )
    722678       ENDIF
    723679    ENDIF
    724680!
    725 !-- Define vertical gridpoint from (or to) which on the usual finite difference
    726 !-- form (which does not use surface fluxes) is applied
     681!-- Define vertical gridpoint from (or to) which on the usual finite difference form (which does not
     682!-- use surface fluxes) is applied.
    727683    IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
    728684       nzb_diff = nzb + 2
     
    733689    IF ( TRIM( topography ) /= 'flat' )  THEN
    734690!
    735 !--    Allocate and set the arrays containing the topography height (for output
    736 !--    reasons only).
     691!--    Allocate and set the arrays containing the topography height (for output reasons only).
    737692       IF ( nxr == nx  .AND.  nyn /= ny )  THEN
    738           ALLOCATE( zu_s_inner(nxl:nxr+1,nys:nyn),                             &
    739                     zw_w_inner(nxl:nxr+1,nys:nyn) )
     693          ALLOCATE( zu_s_inner(nxl:nxr+1,nys:nyn), zw_w_inner(nxl:nxr+1,nys:nyn) )
    740694       ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
    741           ALLOCATE( zu_s_inner(nxl:nxr,nys:nyn+1),                             &
    742                     zw_w_inner(nxl:nxr,nys:nyn+1) )
     695          ALLOCATE( zu_s_inner(nxl:nxr,nys:nyn+1), zw_w_inner(nxl:nxr,nys:nyn+1) )
    743696       ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
    744           ALLOCATE( zu_s_inner(nxl:nxr+1,nys:nyn+1),                           &
    745                     zw_w_inner(nxl:nxr+1,nys:nyn+1) )
     697          ALLOCATE( zu_s_inner(nxl:nxr+1,nys:nyn+1), zw_w_inner(nxl:nxr+1,nys:nyn+1) )
    746698       ELSE
    747           ALLOCATE( zu_s_inner(nxl:nxr,nys:nyn),                               &
    748                     zw_w_inner(nxl:nxr,nys:nyn) )
     699          ALLOCATE( zu_s_inner(nxl:nxr,nys:nyn), zw_w_inner(nxl:nxr,nys:nyn) )
    749700       ENDIF
    750701
     
    752703       zw_w_inner   = 0.0_wp
    753704!
    754 !--    Determine local topography height on scalar and w-grid. Note, setting
    755 !--    lateral boundary values is not necessary, realized via wall_flags_static_0
    756 !--    array. Further, please note that loop bounds are different from
    757 !--    nxl to nxr and nys to nyn on south and right model boundary, hence,
     705!--    Determine local topography height on scalar and w-grid. Note, setting lateral boundary values
     706!--    is not necessary, realized via wall_flags_static_0 array. Further, please note that loop
     707!--    bounds are different from nxl to nxr and nys to nyn on south and right model boundary, hence,
    758708!--    use intrinsic lbound and ubound functions to infer array bounds.
    759709       DO  i = LBOUND(zu_s_inner, 1), UBOUND(zu_s_inner, 1)
    760710          DO  j = LBOUND(zu_s_inner, 2), UBOUND(zu_s_inner, 2)
    761711!
    762 !--          Topography height on scalar grid. Therefore, determine index of
    763 !--          upward-facing surface element on scalar grid.
     712!--          Topography height on scalar grid. Therefore, determine index of upward-facing surface
     713!--          element on scalar grid.
    764714             zu_s_inner(i,j) = zu(topo_top_ind(j,i,0))
    765715!
    766 !--          Topography height on w grid. Therefore, determine index of
    767 !--          upward-facing surface element on w grid.
     716!--          Topography height on w grid. Therefore, determine index of upward-facing surface
     717!--          element on w grid.
    768718             zw_w_inner(i,j) = zw(topo_top_ind(j,i,3))
    769719          ENDDO
     
    775725
    776726! Description:
    777 ! -----------------------------------------------------------------------------!
    778 !> Calculation of the stretching factor through an iterative method. Ideas were
    779 !> taken from the paper "Regional stretched grid generation and its application
    780 !> to the NCAR RegCM (1999)". Normally, no analytic solution exists because the
    781 !> system of equations has two variables (r,l) but four requirements
    782 !> (l=integer, r=[0,88;1,2], Eq(6), Eq(5) starting from index j=1) which
    783 !> results into an overdetermined system.
    784 !------------------------------------------------------------------------------!
     727! -------------------------------------------------------------------------------------------------!
     728!> Calculation of the stretching factor through an iterative method. Ideas were taken from the paper
     729!> "Regional stretched grid generation and its application to the NCAR RegCM (1999)". Normally, no
     730!> analytic solution exists because the system of equations has two variables (r,l) but four
     731!> requirements  (l=integer, r=[0,88;1,2], Eq(6), Eq(5) starting from index j=1) which results into
     732!> an overdetermined system.
     733!--------------------------------------------------------------------------------------------------!
    785734 SUBROUTINE calculate_stretching_factor( number_end )
    786  
    787     USE control_parameters,                                                    &
    788         ONLY:  dz, dz_stretch_factor_array,                 &
    789                dz_stretch_level_end, dz_stretch_level_start, message_string
    790  
     735
     736    USE control_parameters,                                                                        &
     737        ONLY:  dz, dz_stretch_factor_array, dz_stretch_level_end, dz_stretch_level_start,          &
     738               message_string
     739
    791740    USE kinds
    792    
     741
    793742    IMPLICIT NONE
    794    
    795     INTEGER(iwp) ::  iterations  !< number of iterations until stretch_factor_lower/upper_limit is reached 
    796     INTEGER(iwp) ::  l_rounded   !< after l_rounded grid levels dz(n) is strechted to dz(n+1) with stretch_factor_2
     743
     744    REAL(wp), PARAMETER ::  stretch_factor_interval = 1.0E-06_wp  !< interval for sampling possible stretching factors
     745    REAL(wp), PARAMETER ::  stretch_factor_lower_limit = 0.88_wp  !< lowest possible stretching factor
     746    REAL(wp), PARAMETER ::  stretch_factor_upper_limit = 1.12_wp  !< highest possible stretching factor
     747
     748    INTEGER(iwp) ::  iterations  !< number of iterations until stretch_factor_lower/upper_limit is reached
     749    INTEGER(iwp) ::  l_rounded   !< after l_rounded grid levels dz(n) is strechted to dz(n+1) with stretch_factor_2
    797750    INTEGER(iwp) ::  n           !< loop variable for stretching
    798    
     751
    799752    INTEGER(iwp), INTENT(IN) ::  number_end !< number of user-specified end levels for stretching
    800        
     753
    801754    REAL(wp) ::  delta_l               !< absolute difference between l and l_rounded
    802755    REAL(wp) ::  delta_stretch_factor  !< absolute difference between stretch_factor_1 and stretch_factor_2
    803     REAL(wp) ::  delta_total_new       !< sum of delta_l and delta_stretch_factor for the next iteration (should be as small as possible)
    804     REAL(wp) ::  delta_total_old       !< sum of delta_l and delta_stretch_factor for the last iteration
     756    REAL(wp) ::  delta_total_new       !< sum of delta_l and delta_stretch_factor for the next iteration (should be as small as
     757                                       !< possible)
     758    REAL(wp) ::  delta_total_old       !< sum of delta_l and delta_stretch_factor for the last iteration
    805759    REAL(wp) ::  distance              !< distance between dz_stretch_level_start and dz_stretch_level_end (stretching region)
    806     REAL(wp) ::  l                     !< value that fulfil Eq. (5) in the paper mentioned above together with stretch_factor_1 exactly
     760    REAL(wp) ::  l                     !< value that fulfil Eq. (5) in the paper mentioned above together with stretch_factor_1
     761                                       !< exactly
    807762    REAL(wp) ::  numerator             !< numerator of the quotient
    808763    REAL(wp) ::  stretch_factor_1      !< stretching factor that fulfil Eq. (5) togehter with l exactly
    809764    REAL(wp) ::  stretch_factor_2      !< stretching factor that fulfil Eq. (6) togehter with l_rounded exactly
    810    
    811     REAL(wp) ::  dz_stretch_factor_array_2(9) = 1.08_wp  !< Array that contains all stretch_factor_2 that belongs to stretch_factor_1
    812    
    813     REAL(wp), PARAMETER ::  stretch_factor_interval = 1.0E-06_wp  !< interval for sampling possible stretching factors
    814     REAL(wp), PARAMETER ::  stretch_factor_lower_limit = 0.88_wp  !< lowest possible stretching factor
    815     REAL(wp), PARAMETER ::  stretch_factor_upper_limit = 1.12_wp  !< highest possible stretching factor
    816  
    817  
     765
     766    REAL(wp) ::  dz_stretch_factor_array_2(9) = 1.08_wp  !< Array that contains all stretch_factor_2 that belongs to
     767                                                         !< stretch_factor_1
     768
     769
    818770    l = 0
    819771    DO  n = 1, number_end
    820    
     772
    821773       iterations = 1
    822        stretch_factor_1 = 1.0_wp 
     774       stretch_factor_1 = 1.0_wp
    823775       stretch_factor_2 = 1.0_wp
    824776       delta_total_old = 1.0_wp
    825        
     777
    826778!
    827779!--    First branch for stretching from rough to fine
    828        IF ( dz(n) > dz(n+1) ) THEN
    829           DO WHILE ( stretch_factor_1 >= stretch_factor_lower_limit ) 
    830              
     780       IF ( dz(n) > dz(n+1) )  THEN
     781          DO WHILE ( stretch_factor_1 >= stretch_factor_lower_limit )
     782
    831783             stretch_factor_1 = 1.0_wp - iterations * stretch_factor_interval
    832              distance = ABS( dz_stretch_level_end(n) -                         &
    833                         dz_stretch_level_start(n) )   
    834              numerator = distance*stretch_factor_1/dz(n) +                     &
    835                          stretch_factor_1 - distance/dz(n)
    836              
    837              IF ( numerator > 0.0_wp ) THEN
     784             distance = ABS( dz_stretch_level_end(n) - dz_stretch_level_start(n) )
     785             numerator = distance * stretch_factor_1 / dz(n) + stretch_factor_1 - distance / dz(n)
     786
     787             IF ( numerator > 0.0_wp )  THEN
    838788                l = LOG( numerator ) / LOG( stretch_factor_1 ) - 1.0_wp
    839789                l_rounded = NINT( l )
    840790                delta_l = ABS( l_rounded - l ) / l
    841791             ENDIF
    842              
     792
    843793             stretch_factor_2 = EXP( LOG( dz(n+1)/dz(n) ) / (l_rounded) )
    844              
    845              delta_stretch_factor = ABS( stretch_factor_1 -                    &
    846                                          stretch_factor_2 ) /                  &
    847                                     stretch_factor_2
    848              
     794
     795             delta_stretch_factor = ABS( stretch_factor_1 - stretch_factor_2 ) / stretch_factor_2
     796
    849797             delta_total_new = delta_l + delta_stretch_factor
    850798
    851799!
    852 !--          stretch_factor_1 is taken to guarantee that the stretching
    853 !--          procedure ends as close as possible to dz_stretch_level_end.
    854 !--          stretch_factor_2 would guarantee that the stretched dz(n) is
    855 !--          equal to dz(n+1) after l_rounded grid levels.
    856              IF (delta_total_new < delta_total_old) THEN
     800!--          stretch_factor_1 is taken to guarantee that the stretching procedure ends as close as
     801!--          possible to dz_stretch_level_end.
     802!--          stretch_factor_2 would guarantee that the stretched dz(n) is equal to dz(n+1) after
     803!--          l_rounded grid levels.
     804             IF (delta_total_new < delta_total_old)  THEN
    857805                dz_stretch_factor_array(n) = stretch_factor_1
    858806                dz_stretch_factor_array_2(n) = stretch_factor_2
    859807                delta_total_old = delta_total_new
    860808             ENDIF
    861              
     809
    862810             iterations = iterations + 1
    863            
     811
    864812          ENDDO
    865813
    866814!
    867815!--    Second branch for stretching from fine to rough
    868        ELSEIF ( dz(n) < dz(n+1) ) THEN
     816       ELSEIF ( dz(n) < dz(n+1) )  THEN
    869817          DO WHILE ( stretch_factor_1 <= stretch_factor_upper_limit )
    870                      
     818
    871819             stretch_factor_1 = 1.0_wp + iterations * stretch_factor_interval
    872              distance = ABS( dz_stretch_level_end(n) -                         &
    873                         dz_stretch_level_start(n) )
    874              numerator = distance*stretch_factor_1/dz(n) +                     &
    875                          stretch_factor_1 - distance/dz(n)
    876              
     820             distance = ABS( dz_stretch_level_end(n) - dz_stretch_level_start(n) )
     821             numerator = distance * stretch_factor_1 / dz(n) + stretch_factor_1 - distance / dz(n)
     822
    877823             l = LOG( numerator ) / LOG( stretch_factor_1 ) - 1.0_wp
    878824             l_rounded = NINT( l )
    879825             delta_l = ABS( l_rounded - l ) / l
    880              
     826
    881827             stretch_factor_2 = EXP( LOG( dz(n+1)/dz(n) ) / (l_rounded) )
    882828
    883              delta_stretch_factor = ABS( stretch_factor_1 -                    &
    884                                         stretch_factor_2 ) /                   &
    885                                         stretch_factor_2
    886              
     829             delta_stretch_factor = ABS( stretch_factor_1 - stretch_factor_2 ) / stretch_factor_2
     830
    887831             delta_total_new = delta_l + delta_stretch_factor
    888              
    889 !
    890 !--          stretch_factor_1 is taken to guarantee that the stretching
    891 !--          procedure ends as close as possible to dz_stretch_level_end.
    892 !--          stretch_factor_2 would guarantee that the stretched dz(n) is
    893 !--          equal to dz(n+1) after l_rounded grid levels.
    894              IF (delta_total_new < delta_total_old) THEN
     832
     833!
     834!--          stretch_factor_1 is taken to guarantee that the stretching procedure ends as close as
     835!--          possible to dz_stretch_level_end.
     836!--          stretch_factor_2 would guarantee that the stretched dz(n) is equal to dz(n+1) after
     837!--          l_rounded grid levels.
     838             IF (delta_total_new < delta_total_old)  THEN
    895839                dz_stretch_factor_array(n) = stretch_factor_1
    896840                dz_stretch_factor_array_2(n) = stretch_factor_2
    897841                delta_total_old = delta_total_new
    898842             ENDIF
    899              
     843
    900844             iterations = iterations + 1
    901845          ENDDO
    902          
     846
    903847       ELSE
    904848          message_string= 'Two adjacent values of dz must be different'
    905849          CALL message( 'init_grid', 'PA0228', 1, 2, 0, 6, 0 )
    906          
    907        ENDIF
    908 
    909 !
    910 !--    Check if also the second stretching factor fits into the allowed
    911 !--    interval. If not, print a warning for the user.
    912        IF ( dz_stretch_factor_array_2(n) < stretch_factor_lower_limit .OR.     &
    913             dz_stretch_factor_array_2(n) > stretch_factor_upper_limit ) THEN
    914           WRITE( message_string, * ) 'stretch_factor_2 = ',                    &
    915                                      dz_stretch_factor_array_2(n), ' which is',&
    916                                      ' responsible for exactly reaching& dz =',&
    917                                       dz(n+1), 'after a specific amount of',   &
    918                                      ' grid levels& exceeds the upper',        &
    919                                      ' limit =', stretch_factor_upper_limit,   &
    920                                      ' &or lower limit = ',                    &
    921                                      stretch_factor_lower_limit
     850
     851       ENDIF
     852
     853!
     854!--    Check if also the second stretching factor fits into the allowed interval. If not, print a
     855!--    warning for the user.
     856       IF ( dz_stretch_factor_array_2(n) < stretch_factor_lower_limit  .OR.                        &
     857            dz_stretch_factor_array_2(n) > stretch_factor_upper_limit )  THEN
     858          WRITE( message_string, * ) 'stretch_factor_2 = ', dz_stretch_factor_array_2(n),          &
     859                                     ' which is', ' responsible for exactly reaching& dz =',       &
     860                                      dz(n+1), 'after a specific amount of',                       &
     861                                     ' grid levels& exceeds the upper',                            &
     862                                     ' limit =', stretch_factor_upper_limit,                       &
     863                                     ' &or lower limit = ', stretch_factor_lower_limit
    922864          CALL message( 'init_grid', 'PA0499', 0, 1, 0, 6, 0 )
    923            
     865
    924866       ENDIF
    925867    ENDDO
    926        
     868
    927869 END SUBROUTINE calculate_stretching_factor
    928  
    929  
     870
     871
    930872! Description:
    931 ! -----------------------------------------------------------------------------!
    932 !> Set temporary topography flags and reference buildings on top of underlying
    933 !> orography.
    934 !------------------------------------------------------------------------------!
     873! -------------------------------------------------------------------------------------------------!
     874!> Set temporary topography flags and reference buildings on top of underlying orography.
     875!--------------------------------------------------------------------------------------------------!
    935876 SUBROUTINE process_topography( topo_3d )
    936877
    937     USE arrays_3d,                                                             &
     878    USE arrays_3d,                                                                                 &
    938879        ONLY:  zu, zw
    939880
    940     USE control_parameters,                                                    &
     881    USE control_parameters,                                                                        &
    941882        ONLY:  bc_lr_cyc, bc_ns_cyc, ocean_mode
    942883
    943     USE exchange_horiz_mod,                                                    &
    944         ONLY:  exchange_horiz_int, exchange_horiz_2d
    945 
    946     USE indices,                                                               &
    947         ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb,  &
    948                nzt
    949 
    950     USE netcdf_data_input_mod,                                                 &
    951         ONLY:  buildings_f, building_id_f, building_type_f,                    &
    952                init_model,                                                     &
    953                input_pids_static,                                              &
     884    USE exchange_horiz_mod,                                                                        &
     885        ONLY:  exchange_horiz_2d, exchange_horiz_int
     886
     887    USE indices,                                                                                   &
     888        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nzt
     889
     890    USE netcdf_data_input_mod,                                                                     &
     891        ONLY:  buildings_f, building_id_f, building_type_f,                                        &
     892               init_model,                                                                         &
     893               input_pids_static,                                                                  &
    954894               terrain_height_f
    955895
     
    972912#endif
    973913    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids           !< building IDs on entire model domain
    974     INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_final     !< building IDs on entire model domain, multiple occurences are sorted out
     914    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_final     !< building IDs on entire model domain, multiple occurences are
     915                                                                    !< sorted out
    975916    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_final_tmp !< temporary array used for resizing
    976917    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  build_ids_l         !< building IDs on local subdomain
     
    980921    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  num_buildings_l   !< number of buildings with different ID on local subdomain
    981922
    982     INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo_3d !< input array for 3D topography and dummy array for setting "outer"-flags
    983 
    984     REAL(wp)                            ::  ocean_offset        !< offset to consider inverse vertical coordinate at topography definition
    985     REAL(wp)                            ::  oro_min = 0.0_wp    !< minimum terrain height in entire model domain, used to reference terrain to zero
     923    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo_3d !< input array for 3D topography and dummy array for setting
     924                                                                       !< "outer"-flags
     925
     926    REAL(wp)                            ::  ocean_offset        !< offset to consider inverse vertical coordinate at topography
     927                                                                !< definition
     928    REAL(wp)                            ::  oro_min = 0.0_wp    !< minimum terrain height in entire model domain, used to reference
     929                                                                !< terrain to zero
    986930    REAL(wp), DIMENSION(:), ALLOCATABLE ::  oro_max             !< maximum terrain height occupied by an building with certain id
    987     REAL(wp), DIMENSION(:), ALLOCATABLE ::  oro_max_l           !< maximum terrain height occupied by an building with certain id, on local subdomain
    988 
    989 !
    990 !-- Reference lowest terrain height to zero. This ensures that first,
    991 !-- non-required gird levels (those which lie entirely below the minimum
    992 !-- orography) are avoided, and second, that also negative orography can be used
    993 !-- within the input file.
    994 !-- Please note, in case of a nested run, the global minimum from all parent and
    995 !-- childs need to be remove to avoid steep edges at the child-domain boundaries.
     931    REAL(wp), DIMENSION(:), ALLOCATABLE ::  oro_max_l           !< maximum terrain height occupied by an building with certain id,
     932                                                                !< on local subdomain
     933
     934!
     935!-- Reference lowest terrain height to zero. This ensures that first, non-required gird levels
     936!-- (those which lie entirely below the minimum orography) are avoided, and second, that also
     937!-- negative orography can be used within the input file.
     938!-- Please note, in case of a nested run, the global minimum from all parent and childs needs to be
     939!-- removed to avoid steep edges at the child-domain boundaries.
    996940    IF ( input_pids_static )  THEN
    997    
    998 #if defined( __parallel ) 
    999        CALL MPI_ALLREDUCE( MINVAL( terrain_height_f%var ), oro_min, 1,         &
    1000                            MPI_REAL, MPI_MIN, MPI_COMM_WORLD, ierr )
     941
     942#if defined( __parallel )
     943       CALL MPI_ALLREDUCE( MINVAL( terrain_height_f%var ), oro_min, 1, MPI_REAL, MPI_MIN,          &
     944                           MPI_COMM_WORLD, ierr )
    1001945#else
    1002946       oro_min = MINVAL( terrain_height_f%var )
     
    1007951       init_model%origin_z = init_model%origin_z + oro_min
    1008952
    1009     ENDIF   
    1010    
    1011 !
    1012 !-- In the following, buildings and orography are further preprocessed
    1013 !-- before they are mapped on the LES grid.
    1014 !-- Buildings are mapped on top of the orography by maintaining the roof
    1015 !-- shape of the building. This can be achieved by referencing building on
    1016 !-- top of the maximum terrain height within the area occupied by the
    1017 !-- respective building. As buildings and terrain height are defined PE-wise,
    1018 !-- parallelization of this referencing is required (a building can be
    1019 !-- distributed between different PEs). 
    1020 !-- In a first step, determine the number of buildings with different
    1021 !-- building id on each PE. In a next step, all building ids are gathered
    1022 !-- into one array which is present to all PEs. For each building ID,
    1023 !-- the maximum terrain height occupied by the respective building is
    1024 !-- computed and distributed to each PE. 
    1025 !-- Finally, for each building id and its respective reference orography,
    1026 !-- builidings are mapped on top.   
    1027 !--
    1028 !-- First, pre-set topography flags, bit 1 indicates orography, bit 2
    1029 !-- buildings
    1030 !-- classify the respective surfaces.
     953    ENDIF
     954
     955!
     956!-- In the following, buildings and orography are further preprocessed before they are mapped on the
     957!-- LES grid.
     958!-- Buildings are mapped on top of the orography by maintaining the roof shape of the building. This
     959!-- can be achieved by referencing building on top of the maximum terrain height within the area
     960!-- occupied by the respective building. As buildings and terrain height are defined PE-wise,
     961!-- parallelization of this referencing is required (a building can be distributed between different
     962!-- PEs).
     963!-- In a first step, determine the number of buildings with different building id on each PE. In a
     964!-- next step, all building ids are gathered into one array which is present to all PEs. For each
     965!-- building ID, the maximum terrain height occupied by the respective building is computed and
     966!-- distributed to each PE.
     967!-- Finally, for each building id and its respective reference orography, builidings are mapped on
     968!-- top.
     969!--
     970!-- First, pre-set topography flags, bit 1 indicates orography, bit 2 buildings classify the
     971!-- respective surfaces.
    1031972    topo_3d          = IBSET( topo_3d, 0 )
    1032973    topo_3d(nzb,:,:) = IBCLR( topo_3d(nzb,:,:), 0 )
    1033974!
    1034 !-- In order to map topography on PALM grid also in case of ocean simulations,
    1035 !-- pre-calculate an offset value.
     975!-- In order to map topography on PALM grid also in case of ocean simulations, pre-calculate an
     976!-- offset value.
    1036977    ocean_offset = MERGE( zw(0), 0.0_wp, ocean_mode )
    1037978!
    1038 !-- Reference buildings on top of orography. This is not necessary
    1039 !-- if topography is read from ASCII file as no distinction between buildings
    1040 !-- and terrain height can be made. Moreover, this is also not necessary if
    1041 !-- urban-surface and land-surface model are used at the same time.
     979!-- Reference buildings on top of orography. This is not necessary if topography is read from ASCII
     980!-- file as no distinction between buildings and terrain height can be made. Moreover, this is also
     981!-- not necessary if urban-surface and land-surface model are used at the same time.
    1042982    IF ( input_pids_static )  THEN
    1043983
    1044        IF ( buildings_f%from_file )  THEN 
     984       IF ( buildings_f%from_file )  THEN
    1045985          num_buildings_l = 0
    1046986          num_buildings   = 0
    1047987!
    1048 !--       Allocate at least one element for building ids and give it an inital
    1049 !--       negative value that will be overwritten later. This, however, is
    1050 !--       necessary in case there all IDs in the model domain are fill values.
     988!--       Allocate at least one element for building ids and give it an inital negative value that
     989!--       will be overwritten later. This, however, is necessary in case there all IDs in the model
     990!--       domain are fill values.
    1051991          ALLOCATE( build_ids_l(1) )
    1052           build_ids_l = -1 
     992          build_ids_l = -1
    1053993          DO  i = nxl, nxr
    1054994             DO  j = nys, nyn
    1055995                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
    1056996                   IF ( num_buildings_l(myid) > 0 )  THEN
    1057                       IF ( ANY( building_id_f%var(j,i) ==  build_ids_l ) )   &
    1058                       THEN
     997                      IF ( ANY( building_id_f%var(j,i) ==  build_ids_l ) )  THEN
    1059998                         CYCLE
    1060999                      ELSE
     
    10661005                      DEALLOCATE( build_ids_l )
    10671006                      ALLOCATE( build_ids_l(1:num_buildings_l(myid)) )
    1068                       build_ids_l(1:num_buildings_l(myid)-1) =                 &
    1069                                   build_ids_l_tmp(1:num_buildings_l(myid)-1)
     1007                      build_ids_l(1:num_buildings_l(myid)-1) =                                     &
     1008                                                          build_ids_l_tmp(1:num_buildings_l(myid)-1)
    10701009                      build_ids_l(num_buildings_l(myid)) = building_id_f%var(j,i)
    10711010                      DEALLOCATE( build_ids_l_tmp )
    10721011                   ENDIF
    10731012!
    1074 !--                First occuring building id on PE 
    1075                    ELSE 
     1013!--                First occuring building id on PE
     1014                   ELSE
    10761015                      num_buildings_l(myid) = num_buildings_l(myid) + 1
    10771016                      build_ids_l(1) = building_id_f%var(j,i)
     
    10811020          ENDDO
    10821021!
    1083 !--       Determine number of different building ids for the entire domain 
    1084 #if defined( __parallel ) 
    1085           CALL MPI_ALLREDUCE( num_buildings_l, num_buildings, numprocs,              &
    1086                               MPI_INTEGER, MPI_SUM, comm2d, ierr )
     1022!--       Determine number of different building ids for the entire domain
     1023#if defined( __parallel )
     1024          CALL MPI_ALLREDUCE( num_buildings_l, num_buildings, numprocs, MPI_INTEGER, MPI_SUM,      &
     1025                              comm2d, ierr )
    10871026#else
    10881027          num_buildings = num_buildings_l
    10891028#endif
    10901029!
    1091 !--       Gather all buildings ids on each PEs. 
    1092 !--       First, allocate array encompassing all building ids in model domain. 
     1030!--       Gather all buildings ids on each PEs.
     1031!--       First, allocate array encompassing all building ids in model domain.
    10931032          ALLOCATE( build_ids(1:SUM(num_buildings)) )
    1094 #if defined( __parallel )
    1095 !
    1096 !--       Allocate array for displacements.
    1097 !--       As each PE may has a different number of buildings, so that
    1098 !--       the block sizes send by each PE may not be equal. Hence,
    1099 !--       information about the respective displacement is required, indicating
    1100 !--       the respective adress where each MPI-task writes into the receive
    1101 !--       buffer array 
     1033#if defined( __parallel )
     1034!
     1035!--       Allocate array for displacements.
     1036!--       As each PE may has a different number of buildings, so that the block sizes send by each
     1037!--       PE may not be equal. Hence,  information about the respective displacement is required,
     1038!--       indicating the respective adress where each MPI-task writes into the receive buffer array.
    11021039          ALLOCATE( displace_dum(0:numprocs-1) )
    11031040          displace_dum(0) = 0
     
    11061043          ENDDO
    11071044
    1108           CALL MPI_ALLGATHERV( build_ids_l(1:num_buildings_l(myid)),                 &
    1109                                num_buildings(myid),                                  &
    1110                                MPI_INTEGER,                                          &
    1111                                build_ids,                                            &
    1112                                num_buildings,                                        &
    1113                                displace_dum,                                         &
    1114                                MPI_INTEGER,                                          &
    1115                                comm2d, ierr )   
     1045          CALL MPI_ALLGATHERV( build_ids_l(1:num_buildings_l(myid)), num_buildings(myid),          &
     1046                               MPI_INTEGER, build_ids, num_buildings, displace_dum, MPI_INTEGER,   &
     1047                               comm2d, ierr )
    11161048
    11171049          DEALLOCATE( displace_dum )
     
    11221054
    11231055!
    1124 !--       Note, in parallel mode building ids can occure mutliple times, as
    1125 !--       each PE has send its own ids. Therefore, sort out building ids which
    1126 !--       appear more than one time.
     1056!--       Note, in parallel mode building ids can occure mutliple times, as each PE has send its own
     1057!--       ids. Therefore, sort out building ids which appear more than one time.
    11271058          num_build = 0
    11281059          DO  nr = 1, SIZE(build_ids)
     
    11421073                   build_ids_final(num_build) = build_ids(nr)
    11431074                   DEALLOCATE( build_ids_final_tmp )
    1144                 ENDIF             
     1075                ENDIF
    11451076             ELSE
    11461077                num_build = num_build + 1
     
    11511082
    11521083!
    1153 !--       Determine maximumum terrain height occupied by the respective
    1154 !--       building and temporalily store on oro_max
     1084!--       Determine maximumum terrain height occupied by the respective building and temporalily
     1085!--       store on oro_max.
    11551086          ALLOCATE( oro_max_l(1:SIZE(build_ids_final)) )
    11561087          ALLOCATE( oro_max(1:SIZE(build_ids_final))   )
     
    11581089
    11591090          DO  nr = 1, SIZE(build_ids_final)
    1160              oro_max_l(nr) = MAXVAL(                                           &
    1161                               MERGE( terrain_height_f%var(nys:nyn,nxl:nxr),    &
    1162                                      0.0_wp,                                   &
    1163                                      building_id_f%var(nys:nyn,nxl:nxr) ==     &
    1164                                      build_ids_final(nr) ) )
    1165           ENDDO
    1166    
    1167 #if defined( __parallel )   
    1168           IF ( SIZE(build_ids_final) >= 1 ) THEN
    1169              CALL MPI_ALLREDUCE( oro_max_l, oro_max, SIZE( oro_max ), MPI_REAL,&
    1170                                  MPI_MAX, comm2d, ierr )
     1091             oro_max_l(nr) = MAXVAL( MERGE( terrain_height_f%var(nys:nyn,nxl:nxr),                 &
     1092                                              0.0_wp,                                              &
     1093                                              building_id_f%var(nys:nyn,nxl:nxr) ==                &
     1094                                              build_ids_final(nr) ) )
     1095          ENDDO
     1096
     1097#if defined( __parallel )
     1098          IF ( SIZE(build_ids_final) >= 1 )  THEN
     1099             CALL MPI_ALLREDUCE( oro_max_l, oro_max, SIZE( oro_max ), MPI_REAL, MPI_MAX, comm2d,   &
     1100                                 ierr )
    11711101          ENDIF
    11721102#else
     
    11741104#endif
    11751105!
    1176 !--       Finally, determine discrete grid height of maximum orography occupied
    1177 !--       by a building. Use all-or-nothing approach, i.e. if terrain
    1178 !--       exceeds the scalar level the grid box is fully terrain and the
    1179 !--       maximum terrain is set to the zw level.
    1180 !--       terrain or
     1106!--       Finally, determine discrete grid height of maximum orography occupied by a building. Use
     1107!--       all-or-nothing approach, i.e. if terrain exceeds the scalar level the grid box is fully
     1108!--       terrain and the maximum terrain is set to the zw level.
     1109!--       terrain or
    11811110          oro_max_l = 0.0
    11821111          DO  nr = 1, SIZE(build_ids_final)
    11831112             DO  k = nzb, nzt
    1184                 IF ( zu(k) - ocean_offset <= oro_max(nr) )                     &
    1185                    oro_max_l(nr) = zw(k) - ocean_offset
     1113                IF ( zu(k) - ocean_offset <= oro_max(nr) )  oro_max_l(nr) = zw(k) - ocean_offset
    11861114             ENDDO
    11871115             oro_max(nr) = oro_max_l(nr)
     
    11951123       END IF
    11961124!
    1197 !--    Map orography as well as buildings onto grid. 
     1125!--    Map orography as well as buildings onto grid.
    11981126       DO  i = nxl, nxr
    11991127          DO  j = nys, nyn
     
    12041132                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
    12051133!
    1206 !--                Determine index where maximum terrain height occupied by
    1207 !--                the respective building height is stored.
    1208                    nr = MINLOC( ABS( build_ids_final -                         &
    1209                                      building_id_f%var(j,i) ), DIM = 1 )
     1134!--                Determine index where maximum terrain height occupied by the respective building
     1135!--                height is stored.
     1136                   nr = MINLOC( ABS( build_ids_final - building_id_f%var(j,i) ), DIM=1 )
    12101137!
    12111138!--                Save grid-indexed oro_max
     
    12151142             DO  k = nzb, nzt
    12161143!
    1217 !--             In a first step, if grid point is below or equal the given
    1218 !--             terrain height, grid point is flagged to be of type natural.
    1219 !--             Please note, in case there is also a building which is lower
    1220 !--             than the vertical grid spacing, initialization of surface
    1221 !--             attributes will not be correct as given surface information
    1222 !--             will not be in accordance to the classified grid points.
     1144!--             In a first step, if grid point is below or equal the given terrain height, grid
     1145!--             point is flagged to be of type natural.
     1146!--             Please note, in case there is also a building which is lower than the vertical grid
     1147!--             spacing, initialization of surface attributes will not be correct as given surface
     1148!--             information will not be in accordance to the classified grid points.
    12231149!--             Hence, in this case, also a building flag.
    12241150                IF ( zu(k) - ocean_offset <= terrain_height_f%var(j,i) )  THEN
     
    12281154                ENDIF
    12291155!
    1230 !--             Set building grid points. Here, only consider 2D buildings. 
    1231 !--             3D buildings require separate treatment. 
     1156!--             Set building grid points. Here, only consider 2D buildings.
     1157!--             3D buildings require separate treatment.
    12321158                IF ( buildings_f%from_file  .AND.  buildings_f%lod == 1 )  THEN
    12331159!
    1234 !--                Fill-up the terrain to the level of maximum orography
    1235 !--                within the building-covered area.
     1160!--                Fill-up the terrain to the level of maximum orography within the building-covered
     1161!--                area.
    12361162                   IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
    12371163!
    1238 !--                   Note, oro_max is always on zw level                   
     1164!--                   Note, oro_max is always on zw level
    12391165                      IF ( zu(k) - ocean_offset < oro_max(nr) )  THEN
    12401166                         topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
    12411167                         topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 )
    1242                       ELSEIF ( zu(k) - ocean_offset <=                         &
    1243                                oro_max(nr) + buildings_f%var_2d(j,i) )  THEN
     1168                      ELSEIF ( zu(k) - ocean_offset <= oro_max(nr) + buildings_f%var_2d(j,i) )  THEN
    12441169                         topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
    12451170                         topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
     
    12491174             ENDDO
    12501175!
    1251 !--          Special treatment for non grid-resolved buildings. This case,
    1252 !--          the uppermost terrain grid point is flagged as building as well
    1253 !--          well, even though no building exists at all. However, the
    1254 !--          surface element will be identified as urban-surface and the
    1255 !--          input data provided by the drivers is consistent to the surface
    1256 !--          classification. Else, all non grid-resolved buildings would vanish
    1257 !--          and identified as terrain grid points, which, however, won't be
    1258 !--          consistent with the input data.
     1176!--          Special treatment for non grid-resolved buildings. This case, the uppermost terrain
     1177!--          grid point is flagged as building as well, even though no building exists at all.
     1178!--          However, the surface element will be identified as urban-surface and the input data
     1179!--          provided by the drivers is consistent to the surface classification. Else, all non
     1180!--          grid-resolved buildings would vanish and identified as terrain grid points, which,
     1181!--          however, won't be consistent with the input data.
    12591182             IF ( buildings_f%from_file  .AND.  buildings_f%lod == 1 )  THEN
    12601183                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
     
    12691192             ENDIF
    12701193!
    1271 !--          Map 3D buildings onto terrain height. 
    1272 !--          In case of any slopes, map building on top of maximum terrain
    1273 !--          height covered by the building. In other words, extend
    1274 !--          building down to the respective local terrain-surface height.
     1194!--          Map 3D buildings onto terrain height.
     1195!--          In case of any slopes, map building on top of maximum terrain height covered by the
     1196!--          building. In other words, extend building down to the respective local terrain-surface
     1197!--          height.
    12751198             IF ( buildings_f%from_file  .AND.  buildings_f%lod == 2 )  THEN
    12761199                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
    12771200!
    1278 !--                Extend building down to the terrain surface, i.e. fill-up
    1279 !--                surface irregularities below a building. Note, oro_max
    1280 !--                is already a discrete height according to the all-or-nothing
    1281 !--                approach, i.e. grid box is either topography or atmosphere,
     1201!--                Extend building down to the terrain surface, i.e. fill-up surface irregularities
     1202!--                below a building. Note, oro_max is already a discrete height according to the
     1203!--                all-or-nothing approach, i.e. grid box is either topography or atmosphere,
    12821204!--                terrain top is defined at upper bound of the grid box.
    1283 !--                Hence, check for zw in this case.
    1284 !--                Note, do this only for buildings which are surface mounted,
    1285 !--                i.e. building types 1-6. Below bridges, which are represented
    1286 !--                exclusively by building type 7, terrain shape should be
    1287 !--                maintained.
     1205!--                Hence, check for zw in this case.
     1206!--                Note, do this only for buildings which are surface mounted, i.e. building types
     1207!--                1-6. Below bridges, which are represented exclusively by building type 7, terrain
     1208!--                shape should be maintained.
    12881209                   IF ( building_type_f%from_file )  THEN
    12891210                      IF ( building_type_f%var(j,i) /= 7 )  THEN
    1290                          DO k = topo_top_index + 1, nzt + 1     
     1211                         DO k = topo_top_index + 1, nzt + 1
    12911212                            IF ( zu(k) - ocean_offset <= oro_max(nr) )  THEN
    12921213                               topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
    12931214                               topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 )
    12941215                            ENDIF
    1295                          ENDDO       
    1296 !                     
    1297 !--                      After surface irregularities are smoothen, determine
    1298 !--                      lower start index where building starts.
     1216                         ENDDO
     1217!
     1218!--                      After surface irregularities are smoothen, determine lower start index
     1219!--                      where building starts.
    12991220                         DO  k = nzb, nzt
    1300                             IF ( zu(k) - ocean_offset <= oro_max(nr) )         &
    1301                                topo_top_index = k
     1221                            IF ( zu(k) - ocean_offset <= oro_max(nr) )  topo_top_index = k
    13021222                         ENDDO
    13031223                      ENDIF
     
    13201240       ENDDO
    13211241!
    1322 !--    Horizontal exchange the oro_max array, which is required to for
    1323 !--    initialization of building-surface properties.
     1242!--    Horizontal exchange the oro_max array, which is required to for initialization of
     1243!--    building-surface properties.
    13241244       IF ( ALLOCATED( buildings_f%oro_max ) )  THEN
    13251245          CALL exchange_horiz_2d( buildings_f%oro_max(:,:) )
     
    13311251       IF ( ALLOCATED( build_ids_final ) )  DEALLOCATE( build_ids_final )
    13321252!
    1333 !-- Topography input via ASCII format. 
     1253!-- Topography input via ASCII format.
    13341254    ELSE
    13351255       ocean_offset     = MERGE( zw(0), 0.0_wp, ocean_mode )
    13361256!
    1337 !--    Initialize topography bit 0 (indicates obstacle) everywhere to zero
    1338 !--    and clear all grid points at nzb, where alway a surface is defined.
    1339 !--    Further, set also bit 1 (indicates terrain) at nzb, which is further
    1340 !--    used for masked data output and further processing. Note, in the
    1341 !--    ASCII case no distinction is made between buildings and terrain,
    1342 !--    so that setting of bit 1 and 2 at the same time has no effect.
     1257!--    Initialize topography bit 0 (indicates obstacle) everywhere to zero and clear all grid points
     1258!--    at nzb, where alway a surface is defined.
     1259!--    Further, set also bit 1 (indicates terrain) at nzb, which is further used for masked data
     1260!--    output and further processing. Note, in the ASCII case no distinction is made between
     1261!--    buildings and terrain,  so that setting of bit 1 and 2 at the same time has no effect.
    13431262       topo_3d          = IBSET( topo_3d, 0 )
    13441263       topo_3d(nzb,:,:) = IBCLR( topo_3d(nzb,:,:), 0 )
     
    13481267             DO  k = nzb, nzt
    13491268!
    1350 !--             Flag topography for all grid points which are below
    1351 !--             the local topography height.
    1352 !--             Note, each topography is flagged as building (bit 2) as well as
    1353 !--             terrain (bit 1) in order to employ urban-surface as well as
    1354 !--             land-surface model.
     1269!--             Flag topography for all grid points which are below the local topography height.
     1270!--             Note, each topography is flagged as building (bit 2) as well as terrain (bit 1) in
     1271!--             order to employ urban-surface as well as land-surface model.
    13551272                IF ( zu(k) - ocean_offset <= buildings_f%var_2d(j,i) )  THEN
    13561273                   topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
     
    13721289    IF ( .NOT. bc_lr_cyc )  THEN
    13731290       IF ( nxl == 0  )  topo_3d(:,:,-1)   = topo_3d(:,:,0)
    1374        IF ( nxr == nx )  topo_3d(:,:,nx+1) = topo_3d(:,:,nx)         
     1291       IF ( nxr == nx )  topo_3d(:,:,nx+1) = topo_3d(:,:,nx)
    13751292    ENDIF
    13761293
     
    13791296
    13801297! Description:
    1381 ! -----------------------------------------------------------------------------!
    1382 !> Filter topography, i.e. fill holes resolved by only one grid point. 
    1383 !> Such holes are suspected to lead to velocity blow-ups as continuity
    1384 !> equation on discrete grid cannot be fulfilled in such case.
    1385 !------------------------------------------------------------------------------!
     1298! -------------------------------------------------------------------------------------------------!
     1299!> Filter topography, i.e. fill holes resolved by only one grid point.
     1300!> Such holes are suspected to lead to velocity blow-ups as continuity equation on discrete grid
     1301!> cannot be fulfilled in such case.
     1302!--------------------------------------------------------------------------------------------------!
    13861303 SUBROUTINE filter_topography( topo_3d )
    13871304
    1388     USE control_parameters,                                                    &
     1305    USE control_parameters,                                                                        &
    13891306        ONLY:  bc_lr_cyc, bc_ns_cyc, message_string
    13901307
    1391     USE exchange_horiz_mod,                                                    &
     1308    USE exchange_horiz_mod,                                                                        &
    13921309        ONLY:  exchange_horiz_int, exchange_horiz_2d_byte, exchange_horiz_2d_int
    13931310
    1394     USE indices,                                                               &
     1311    USE indices,                                                                                   &
    13951312        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nzt
    13961313
    1397     USE netcdf_data_input_mod,                                                 &
    1398         ONLY:  building_id_f, building_type_f 
     1314    USE netcdf_data_input_mod,                                                                     &
     1315        ONLY:  building_id_f, building_type_f
    13991316
    14001317    USE  pegrid
    14011318
    14021319    IMPLICIT NONE
    1403 
    1404     LOGICAL      ::  filled = .FALSE. !< flag indicating if holes were filled
    14051320
    14061321    INTEGER(iwp) ::  i          !< running index along x-direction
    14071322    INTEGER(iwp) ::  j          !< running index along y-direction
    14081323    INTEGER(iwp) ::  k          !< running index along z-direction
    1409     INTEGER(iwp) ::  num_hole   !< number of holes (in topography) resolved by only one grid point 
    1410     INTEGER(iwp) ::  num_hole_l !< number of holes (in topography) resolved by only one grid point on local PE     
     1324    INTEGER(iwp) ::  num_hole   !< number of holes (in topography) resolved by only one grid point
     1325    INTEGER(iwp) ::  num_hole_l !< number of holes (in topography) resolved by only one grid point on local PE
    14111326    INTEGER(iwp) ::  num_wall   !< number of surrounding vertical walls for a single grid point
    14121327
    14131328    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE            ::  topo_tmp          !< temporary 3D-topography used to fill holes
    1414     INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo_3d           !< 3D-topography array merging buildings and orography
    1415 !
    1416 !-- Before checking for holes, set lateral boundary conditions for
     1329    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo_3d           !< 3D-topography array merging buildings and
     1330                                                                                 !< orography
     1331
     1332    LOGICAL      ::  filled = .FALSE. !< flag indicating if holes were filled
     1333
     1334!
     1335!-- Before checking for holes, set lateral boundary conditions for
    14171336!-- topography. After hole-filling, boundary conditions must be set again.
    1418 !-- Several iterations are performed, in order to fill holes which might 
     1337!-- Several iterations are performed, in order to fill holes which might
    14191338!-- emerge by the filling-algorithm itself.
    14201339    ALLOCATE( topo_tmp(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     
    14221341
    14231342    num_hole = 99999
    1424     DO WHILE ( num_hole > 0 )       
    1425 
    1426        num_hole = 0   
     1343    DO WHILE ( num_hole > 0 )
     1344
     1345       num_hole = 0
    14271346       CALL exchange_horiz_int( topo_3d, nys, nyn, nxl, nxr, nzt, nbgp )
    14281347!
    1429 !--    Exchange also building ID and type. Note, building_type is an one-byte
    1430 !--    variable.
    1431        IF ( building_id_f%from_file )                                          &
     1348!--    Exchange also building ID and type. Note, building_type is an one-byte variable.
     1349       IF ( building_id_f%from_file )                                                              &
    14321350          CALL exchange_horiz_2d_int( building_id_f%var, nys, nyn, nxl, nxr, nbgp )
    1433        IF ( building_type_f%from_file )                                        &
     1351       IF ( building_type_f%from_file )                                                            &
    14341352          CALL exchange_horiz_2d_byte( building_type_f%var, nys, nyn, nxl, nxr, nbgp )
    14351353
    14361354       topo_tmp = topo_3d
    14371355!
    1438 !--    In case of non-cyclic lateral boundaries, assume lateral boundary to be
    1439 !--    a solid wall. Thus, intermediate spaces of one grid point between
    1440 !--    boundary and some topographic structure will be filled.           
     1356!--    In case of non-cyclic lateral boundaries, assume lateral boundary to be a solid wall. Thus,
     1357!--    intermediate spaces of one grid point between boundary and some topographic structure will be
     1358!--    filled.
    14411359       IF ( .NOT. bc_ns_cyc )  THEN
    14421360          IF ( nys == 0  )  topo_tmp(:,-1,:)   = IBCLR( topo_tmp(:,0,:),  0 )
     
    14461364       IF ( .NOT. bc_lr_cyc )  THEN
    14471365          IF ( nxl == 0  )  topo_tmp(:,:,-1)   = IBCLR( topo_tmp(:,:,0),  0 )
    1448           IF ( nxr == nx )  topo_tmp(:,:,nx+1) = IBCLR( topo_tmp(:,:,nx), 0 )         
     1366          IF ( nxr == nx )  topo_tmp(:,:,nx+1) = IBCLR( topo_tmp(:,:,nx), 0 )
    14491367       ENDIF
    14501368
     
    14551373                IF ( BTEST( topo_tmp(k,j,i), 0 ) )  THEN
    14561374                   num_wall = 0
    1457                    IF ( .NOT. BTEST( topo_tmp(k,j-1,i), 0 ) )                  &
    1458                       num_wall = num_wall + 1
    1459                    IF ( .NOT. BTEST( topo_tmp(k,j+1,i), 0 ) )                  &
    1460                       num_wall = num_wall + 1
    1461                    IF ( .NOT. BTEST( topo_tmp(k,j,i-1), 0 ) )                  &
    1462                       num_wall = num_wall + 1
    1463                    IF ( .NOT. BTEST( topo_tmp(k,j,i+1), 0 ) )                  &
    1464                       num_wall = num_wall + 1
    1465                    IF ( .NOT. BTEST( topo_tmp(k-1,j,i), 0 ) )                  &
    1466                       num_wall = num_wall + 1   
    1467                    IF ( .NOT. BTEST( topo_tmp(k+1,j,i), 0 ) )                  &
    1468                       num_wall = num_wall + 1
     1375                   IF ( .NOT. BTEST( topo_tmp(k,j-1,i), 0 ) )  num_wall = num_wall + 1
     1376                   IF ( .NOT. BTEST( topo_tmp(k,j+1,i), 0 ) )  num_wall = num_wall + 1
     1377                   IF ( .NOT. BTEST( topo_tmp(k,j,i-1), 0 ) )  num_wall = num_wall + 1
     1378                   IF ( .NOT. BTEST( topo_tmp(k,j,i+1), 0 ) )  num_wall = num_wall + 1
     1379                   IF ( .NOT. BTEST( topo_tmp(k-1,j,i), 0 ) )  num_wall = num_wall + 1
     1380                   IF ( .NOT. BTEST( topo_tmp(k+1,j,i), 0 ) )  num_wall = num_wall + 1
    14691381
    14701382                   IF ( num_wall >= 4 )  THEN
    14711383                      num_hole_l     = num_hole_l + 1
    14721384!
    1473 !--                   Clear flag 0 and set special flag ( bit 4) to indicate
    1474 !--                   that new topography point is a result of filtering process.
     1385!--                   Clear flag 0 and set special flag ( bit 4) to indicate that new topography
     1386!--                   point is a result of filtering process.
    14751387                      topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
    14761388                      topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 4 )
    14771389!
    1478 !--                   If filled grid point is occupied by a building, classify
    1479 !--                   it as building grid point.
     1390!--                   If filled grid point is occupied by a building, classify it as building grid
     1391!--                   point.
    14801392                      IF ( building_type_f%from_file )  THEN
    1481                          IF ( building_type_f%var(j,i)   /=                    & 
    1482                               building_type_f%fill            .OR.             &       
    1483                               building_type_f%var(j+1,i) /=                    & 
    1484                               building_type_f%fill            .OR.             &               
    1485                               building_type_f%var(j-1,i) /=                    &               
    1486                               building_type_f%fill            .OR.             &               
    1487                               building_type_f%var(j,i+1) /=                    &               
    1488                               building_type_f%fill            .OR.             &               
    1489                               building_type_f%var(j,i-1) /=                    &               
    1490                               building_type_f%fill )  THEN
     1393                         IF ( building_type_f%var(j,i)   /=  building_type_f%fill  .OR.            &
     1394                              building_type_f%var(j+1,i) /=  building_type_f%fill  .OR.            &
     1395                              building_type_f%var(j-1,i) /=  building_type_f%fill  .OR.            &
     1396                              building_type_f%var(j,i+1) /=  building_type_f%fill  .OR.            &
     1397                              building_type_f%var(j,i-1) /=  building_type_f%fill )  THEN
    14911398!
    14921399!--                         Set flag indicating building surfaces
    14931400                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
    14941401!
    1495 !--                         Set building_type and ID at this position if not
    1496 !--                         already set. This is required for proper
    1497 !--                         initialization of urban-surface energy balance
     1402!--                         Set building_type and ID at this position if not already set. This is
     1403!--                         required for proper initialization of urban-surface energy balance
    14981404!--                         solver.
    1499                             IF ( building_type_f%var(j,i) ==                   &
    1500                                  building_type_f%fill )  THEN
    1501 
    1502                                IF ( building_type_f%var(j+1,i) /=              &
    1503                                     building_type_f%fill )  THEN
    1504                                   building_type_f%var(j,i) =                   &
    1505                                                     building_type_f%var(j+1,i)
    1506                                   building_id_f%var(j,i) =                     &
    1507                                                     building_id_f%var(j+1,i)
    1508                                ELSEIF ( building_type_f%var(j-1,i) /=          &
    1509                                         building_type_f%fill )  THEN
    1510                                   building_type_f%var(j,i) =                   &
    1511                                                     building_type_f%var(j-1,i)
    1512                                   building_id_f%var(j,i) =                     &
    1513                                                     building_id_f%var(j-1,i)
    1514                                ELSEIF ( building_type_f%var(j,i+1) /=          &
    1515                                         building_type_f%fill )  THEN
    1516                                   building_type_f%var(j,i) =                   &
    1517                                                     building_type_f%var(j,i+1)
    1518                                   building_id_f%var(j,i) =                     &
    1519                                                     building_id_f%var(j,i+1)
    1520                                ELSEIF ( building_type_f%var(j,i-1) /=          &
    1521                                         building_type_f%fill )  THEN
    1522                                   building_type_f%var(j,i) =                   &
    1523                                                     building_type_f%var(j,i-1)
    1524                                   building_id_f%var(j,i) =                     &
    1525                                                     building_id_f%var(j,i-1)
     1405                            IF ( building_type_f%var(j,i) == building_type_f%fill )  THEN
     1406
     1407                               IF ( building_type_f%var(j+1,i) /= building_type_f%fill )  THEN
     1408                                  building_type_f%var(j,i) = building_type_f%var(j+1,i)
     1409                                  building_id_f%var(j,i)   = building_id_f%var(j+1,i)
     1410                               ELSEIF ( building_type_f%var(j-1,i) /= building_type_f%fill )  THEN
     1411                                  building_type_f%var(j,i) = building_type_f%var(j-1,i)
     1412                                  building_id_f%var(j,i)   = building_id_f%var(j-1,i)
     1413                               ELSEIF ( building_type_f%var(j,i+1) /= building_type_f%fill )  THEN
     1414                                  building_type_f%var(j,i) = building_type_f%var(j,i+1)
     1415                                  building_id_f%var(j,i)   = building_id_f%var(j,i+1)
     1416                               ELSEIF ( building_type_f%var(j,i-1) /= building_type_f%fill )  THEN
     1417                                  building_type_f%var(j,i) = building_type_f%var(j,i-1)
     1418                                  building_id_f%var(j,i)   = building_id_f%var(j,i-1)
    15261419                               ENDIF
    15271420                            ENDIF
     
    15291422                      ENDIF
    15301423!
    1531 !--                   If filled grid point is already classified as building
    1532 !--                   everything is fine, else classify this grid point as
    1533 !--                   natural type grid point. This case, values for the
    1534 !--                   surface type are already set.
     1424!--                   If filled grid point is already classified as building everything is fine,
     1425!--                   else classify this grid point as natural type grid point. This case, values
     1426!--                   for the surface type are already set.
    15351427                      IF ( .NOT. BTEST( topo_3d(k,j,i), 2 ) )  THEN
    15361428                         topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 )
     
    15441436!--    Count the total number of holes, required for informative message.
    15451437#if defined( __parallel )
    1546        CALL MPI_ALLREDUCE( num_hole_l, num_hole, 1, MPI_INTEGER, MPI_SUM,      &
    1547                            comm2d, ierr )
     1438       CALL MPI_ALLREDUCE( num_hole_l, num_hole, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr )
    15481439#else
    15491440       num_hole = num_hole_l
    1550 #endif   
     1441#endif
    15511442       IF ( num_hole > 0  .AND.  .NOT. filled )  filled = .TRUE.
    15521443
     
    15551446!-- Create an informative message if any holes were filled.
    15561447    IF ( filled )  THEN
    1557        WRITE( message_string, * ) 'Topography was filtered, i.e. holes ' //    &
    1558                                   'resolved by only one grid point '     //    &
     1448       WRITE( message_string, * ) 'Topography was filtered, i.e. holes ' //                        &
     1449                                  'resolved by only one grid point '     //                        &
    15591450                                  'were filled during initialization.'
    15601451       CALL message( 'init_grid', 'PA0430', 0, 0, 0, 6, 0 )
     
    15631454    DEALLOCATE( topo_tmp )
    15641455!
    1565 !-- Finally, exchange topo_3d array again and if necessary set Neumann boundary
    1566 !-- condition in case of non-cyclic lateral boundaries.
     1456!-- Finally, exchange topo_3d array again and if necessary set Neumann boundary condition in case of
     1457!-- non-cyclic lateral boundaries.
    15671458    CALL exchange_horiz_int( topo_3d, nys, nyn, nxl, nxr, nzt, nbgp )
    15681459
     
    15741465    IF ( .NOT. bc_lr_cyc )  THEN
    15751466       IF ( nxl == 0  )  topo_3d(:,:,-1)   = topo_3d(:,:,0)
    1576        IF ( nxr == nx )  topo_3d(:,:,nx+1) = topo_3d(:,:,nx)         
     1467       IF ( nxr == nx )  topo_3d(:,:,nx+1) = topo_3d(:,:,nx)
    15771468    ENDIF
    15781469!
    15791470!-- Exchange building ID and type. Note, building_type is an one-byte variable.
    1580     IF ( building_id_f%from_file )                                             &
     1471    IF ( building_id_f%from_file )                                                                 &
    15811472       CALL exchange_horiz_2d_int( building_id_f%var, nys, nyn, nxl, nxr, nbgp )
    1582     IF ( building_type_f%from_file )                                           &
     1473    IF ( building_type_f%from_file )                                                               &
    15831474       CALL exchange_horiz_2d_byte( building_type_f%var, nys, nyn, nxl, nxr, nbgp )
    15841475
     
    15871478
    15881479! Description:
    1589 ! -----------------------------------------------------------------------------!
    1590 !> Reads topography information from file or sets generic topography. Moreover,
    1591 !> all topography-relevant topography arrays are initialized, and grid flags
    1592 !> are set. 
    1593 !------------------------------------------------------------------------------!
     1480! -------------------------------------------------------------------------------------------------!
     1481!> Reads topography information from file or sets generic topography. Moreover, all
     1482!> topography-relevant topography arrays are initialized, and grid flags are set.
     1483!--------------------------------------------------------------------------------------------------!
    15941484 SUBROUTINE init_topo( topo )
    15951485
    1596     USE arrays_3d,                                                             &
     1486    USE arrays_3d,                                                                                 &
    15971487        ONLY:  zw
    1598        
    1599     USE control_parameters,                                                    &
    1600         ONLY:  bc_lr_cyc, bc_ns_cyc, building_height, building_length_x,       &
    1601                building_length_y, building_wall_left, building_wall_south,     &
    1602                canyon_height, canyon_wall_left, canyon_wall_south,             &
    1603                canyon_width_x, canyon_width_y, dp_level_ind_b, dz,             &
    1604                message_string, topography, topography_grid_convention,         &
    1605                tunnel_height, tunnel_length, tunnel_width_x, tunnel_width_y,   &
    1606                tunnel_wall_depth
    1607          
    1608     USE exchange_horiz_mod,                                                    &
     1488
     1489    USE control_parameters,                                                                        &
     1490        ONLY:  bc_lr_cyc, bc_ns_cyc, building_height, building_length_x, building_length_y,        &
     1491               building_wall_left, building_wall_south, canyon_height, canyon_wall_left,           &
     1492               canyon_wall_south, canyon_width_x, canyon_width_y, dp_level_ind_b, dz,              &
     1493               message_string, topography, topography_grid_convention, tunnel_height,              &
     1494               tunnel_length, tunnel_width_x, tunnel_width_y, tunnel_wall_depth
     1495
     1496    USE exchange_horiz_mod,                                                                        &
    16091497        ONLY:  exchange_horiz_int
    16101498
    1611     USE grid_variables,                                                        &
     1499    USE grid_variables,                                                                            &
    16121500        ONLY:  dx, dy
    1613        
    1614     USE indices,                                                               &
    1615         ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz,   &
    1616                nzb, nzt
    1617    
     1501
     1502    USE indices,                                                                                   &
     1503        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt
     1504
    16181505    USE kinds
    1619    
    1620     USE netcdf_data_input_mod,                                                 &
    1621         ONLY:  buildings_f, terrain_height_f 
     1506
     1507    USE netcdf_data_input_mod,                                                                     &
     1508        ONLY:  buildings_f, terrain_height_f
    16221509
    16231510    USE pegrid
     
    16261513
    16271514    INTEGER(iwp) ::  bh                !< temporary vertical index of building height
     1515    INTEGER(iwp) ::  ch                !< temporary vertical index for canyon height
     1516    INTEGER(iwp) ::  hv_in             !< heavyside function to model inner tunnel surface
     1517    INTEGER(iwp) ::  i                 !< index variable along x
     1518    INTEGER(iwp) ::  index_left_bwall  !< index for left building wall
     1519    INTEGER(iwp) ::  index_north_bwall !< index for north building wall
     1520    INTEGER(iwp) ::  index_right_bwall !< index for right building wall
     1521    INTEGER(iwp) ::  index_south_bwall !< index for south building wall
     1522    INTEGER(iwp) ::  index_left_cwall  !< index for left canyon wall
     1523    INTEGER(iwp) ::  index_north_cwall !< index for north canyon wall
     1524    INTEGER(iwp) ::  index_right_cwall !< index for right canyon wall
     1525    INTEGER(iwp) ::  index_south_cwall !< index for south canyon wall
     1526    INTEGER(iwp) ::  j                 !< index variable along y
     1527    INTEGER(iwp) ::  k                 !< index variable along z
    16281528    INTEGER(iwp) ::  ngp_bx            !< grid point number of building size along x
    16291529    INTEGER(iwp) ::  ngp_by            !< grid point number of building size along y
    1630     INTEGER(iwp) ::  index_left_bwall  !< index for left building wall
    1631     INTEGER(iwp) ::  index_right_bwall !< index for right building wall
    1632     INTEGER(iwp) ::  index_north_bwall !< index for north building wall
    1633     INTEGER(iwp) ::  index_south_bwall !< index for south building wall
    1634     INTEGER(iwp) ::  ch                !< temporary vertical index for canyon height
    16351530    INTEGER(iwp) ::  ngp_cx            !< grid point number of canyon size along x
    16361531    INTEGER(iwp) ::  ngp_cy            !< grid point number of canyon size along y
    1637     INTEGER(iwp) ::  index_left_cwall  !< index for left canyon wall
    1638     INTEGER(iwp) ::  index_right_cwall !< index for right canyon wall
    1639     INTEGER(iwp) ::  index_north_cwall !< index for north canyon wall
    1640     INTEGER(iwp) ::  index_south_cwall !< index for south canyon wall
    1641     INTEGER(iwp) ::  i                 !< index variable along x
    1642     INTEGER(iwp) ::  j                 !< index variable along y
    1643     INTEGER(iwp) ::  k                 !< index variable along z
    1644     INTEGER(iwp) ::  hv_in             !< heavyside function to model inner tunnel surface
    1645     INTEGER(iwp) ::  hv_out            !< heavyside function to model outer tunnel surface
    1646     INTEGER(iwp) ::  txe_out           !< end position of outer tunnel wall in x
    1647     INTEGER(iwp) ::  txs_out           !< start position of outer tunnel wall in x
    1648     INTEGER(iwp) ::  tye_out           !< end position of outer tunnel wall in y
    1649     INTEGER(iwp) ::  tys_out           !< start position of outer tunnel wall in y
    1650     INTEGER(iwp) ::  txe_in            !< end position of inner tunnel wall in x
    1651     INTEGER(iwp) ::  txs_in            !< start position of inner tunnel wall in x
    1652     INTEGER(iwp) ::  tye_in            !< end position of inner tunnel wall in y
    1653     INTEGER(iwp) ::  tys_in            !< start position of inner tunnel wall in y
     1532    INTEGER(iwp) ::  hv_out            !< heavyside function to model outer tunnel surface
    16541533    INTEGER(iwp) ::  td                !< tunnel wall depth
    16551534    INTEGER(iwp) ::  th                !< height of outer tunnel wall
     1535    INTEGER(iwp) ::  txe_in            !< end position of inner tunnel wall in x
     1536    INTEGER(iwp) ::  txe_out           !< end position of outer tunnel wall in x
     1537    INTEGER(iwp) ::  txs_in            !< start position of inner tunnel wall in x
     1538    INTEGER(iwp) ::  txs_out           !< start position of outer tunnel wall in x
     1539    INTEGER(iwp) ::  tye_in            !< end position of inner tunnel wall in y
     1540    INTEGER(iwp) ::  tye_out           !< end position of outer tunnel wall in y
     1541    INTEGER(iwp) ::  tys_in            !< start position of inner tunnel wall in y
     1542    INTEGER(iwp) ::  tys_out           !< start position of outer tunnel wall in y
    16561543
    16571544    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_local         !< index for topography top at cell-center
    1658     INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo !< input array for 3D topography and dummy array for setting "outer"-flags
    1659 !
    1660 !-- Check for correct setting of the namelist parameter topography. If
    1661 !-- topography information is read from file but topography = 'flat',
    1662 !-- initialization does not work properly.
    1663     IF ( ( buildings_f%from_file  .OR.  terrain_height_f%from_file )  .AND.    &
     1545    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo !< input array for 3D topography and dummy array for setting
     1546                                                                    !< "outer"-flags
     1547!
     1548!-- Check for correct setting of the namelist parameter topography. If topography information is
     1549!-- read from file but topography = 'flat', initialization does not work properly.
     1550    IF ( ( buildings_f%from_file  .OR.  terrain_height_f%from_file )  .AND.                        &
    16641551           TRIM( topography ) /= 'read_from_file' )  THEN
    1665        message_string =  'If topography information is provided (via ' //      &
    1666                          'Netcdf or ASCII input) topography = '        //      &
     1552       message_string =  'If topography information is provided (via ' //                          &
     1553                         'Netcdf or ASCII input) topography = '        //                          &
    16671554                         '"read_from_file" is required.'
    1668        CALL message( 'init_grid', 'PA0437', 1, 2, 0, 6, 0 )     
     1555       CALL message( 'init_grid', 'PA0437', 1, 2, 0, 6, 0 )
    16691556    ENDIF
    16701557!
    16711558!-- Set outer and inner index arrays for non-flat topography.
    1672 !-- Here consistency checks concerning domain size and periodicity are
    1673 !-- necessary.
    1674 !-- Within this SELECT CASE structure only nzb_local is initialized
    1675 !-- individually depending on the chosen topography type, all other index
    1676 !-- arrays are initialized further below.
     1559!-- Here consistency checks concerning domain size and periodicity are necessary.
     1560!-- Within this SELECT CASE structure only nzb_local is initialized individually depending on the
     1561!-- chosen topography type, all other index arrays are initialized further below.
    16771562    SELECT CASE ( TRIM( topography ) )
    16781563
    16791564       CASE ( 'flat' )
    1680 !   
     1565!
    16811566!--       Initialilize 3D topography array, used later for initializing flags
    16821567          topo(nzb+1:nzt+1,:,:) = IBSET( topo(nzb+1:nzt+1,:,:), 0 )
    1683          
     1568
    16841569       CASE ( 'closed_channel' )
    1685 !   
     1570!
    16861571!--       Initialilize 3D topography array, used later for initializing flags
    1687           topo(nzb+1:nzt,:,:) = IBSET( topo(nzb+1:nzt,:,:), 0 ) 
     1572          topo(nzb+1:nzt,:,:) = IBSET( topo(nzb+1:nzt,:,:), 0 )
    16881573
    16891574       CASE ( 'single_building' )
     
    16941579          ngp_by = NINT( building_length_y / dy )
    16951580          bh  = MINLOC( ABS( zw - building_height ), 1 ) - 1
    1696           IF ( ABS( zw(bh)   - building_height ) == &
    1697                ABS( zw(bh+1) - building_height )    )  bh = bh + 1
     1581          IF ( ABS( zw(bh) - building_height ) ==  ABS( zw(bh+1) - building_height ) )  bh = bh + 1
    16981582          IF ( building_wall_left == 9999999.9_wp )  THEN
    16991583             building_wall_left = ( nx + 1 - ngp_bx ) / 2 * dx
     
    17101594!
    17111595!--       Building size has to meet some requirements
    1712           IF ( ( index_left_bwall < 1 ) .OR. ( index_right_bwall > nx-1 ) .OR. &
    1713                ( index_right_bwall < index_left_bwall+3 ) .OR.                 &
    1714                ( index_south_bwall < 1 ) .OR. ( index_north_bwall > ny-1 ) .OR.&
     1596          IF ( ( index_left_bwall  < 1 )  .OR.  ( index_right_bwall > nx-1 )  .OR.                &
     1597               ( index_right_bwall < index_left_bwall+3 )  .OR.                                    &
     1598               ( index_south_bwall < 1 )  .OR.  ( index_north_bwall > ny-1 )  .OR.                 &
    17151599               ( index_north_bwall < index_south_bwall+3 ) )  THEN
    1716              WRITE( message_string, * ) 'inconsistent building parameters:',   &
    1717                                       '&index_left_bwall=', index_left_bwall,  &
    1718                                       'index_right_bwall=', index_right_bwall, &
    1719                                       'index_south_bwall=', index_south_bwall, &
    1720                                       'index_north_bwall=', index_north_bwall, &
     1600             WRITE( message_string, * ) 'inconsistent building parameters:',                       &
     1601                                      '&index_left_bwall=', index_left_bwall,                      &
     1602                                      'index_right_bwall=', index_right_bwall,                     &
     1603                                      'index_south_bwall=', index_south_bwall,                     &
     1604                                      'index_north_bwall=', index_north_bwall,                     &
    17211605                                      'nx=', nx, 'ny=', ny
    17221606             CALL message( 'init_grid', 'PA0203', 1, 2, 0, 6, 0 )
     
    17261610          nzb_local = 0
    17271611!
    1728 !--       Define the building. 
    1729           IF ( index_left_bwall <= nxr  .AND.  index_right_bwall >= nxl  .AND. &
    1730                index_south_bwall <= nyn  .AND.  index_north_bwall >= nys )     &
    1731              nzb_local(MAX(nys,index_south_bwall):MIN(nyn,index_north_bwall),  &
     1612!--       Define the building.
     1613          IF ( index_left_bwall <= nxr  .AND.  index_right_bwall >= nxl  .AND.                     &
     1614               index_south_bwall <= nyn  .AND.  index_north_bwall >= nys )                         &
     1615             nzb_local(MAX(nys,index_south_bwall):MIN(nyn,index_north_bwall),                      &
    17321616                       MAX(nxl,index_left_bwall):MIN(nxr,index_right_bwall)) = bh
    17331617!
     
    17351619          DO  i = nxl, nxr
    17361620             DO  j = nys, nyn
    1737                 topo(nzb_local(j,i)+1:nzt+1,j,i) =                             &
    1738                                  IBSET( topo(nzb_local(j,i)+1:nzt+1,j,i), 0 )
     1621                topo(nzb_local(j,i)+1:nzt+1,j,i) = IBSET( topo(nzb_local(j,i)+1:nzt+1,j,i), 0 )
    17391622             ENDDO
    17401623          ENDDO
    1741        
     1624
    17421625          DEALLOCATE( nzb_local )
    17431626
    17441627          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
    17451628!
    1746 !--       Set boundary conditions also for flags. Can be interpreted as Neumann
    1747 !--       boundary conditions for topography.
     1629!--       Set boundary conditions also for flags. Can be interpreted as Neumannb oundary conditions
     1630!--       for topography.
    17481631          IF ( .NOT. bc_ns_cyc )  THEN
    17491632             IF ( nys == 0  )  THEN
    1750                 DO  i = 1, nbgp     
     1633                DO  i = 1, nbgp
    17511634                   topo(:,nys-i,:)   = topo(:,nys,:)
    17521635                ENDDO
    17531636             ENDIF
    17541637             IF ( nyn == ny )  THEN
    1755                 DO  i = 1, nbgp 
     1638                DO  i = 1, nbgp
    17561639                   topo(:,nyn+i,:) = topo(:,nyn,:)
    17571640                ENDDO
     
    17601643          IF ( .NOT. bc_lr_cyc )  THEN
    17611644             IF ( nxl == 0  )  THEN
    1762                 DO  i = 1, nbgp   
     1645                DO  i = 1, nbgp
    17631646                   topo(:,:,nxl-i)   = topo(:,:,nxl)
    17641647                ENDDO
    17651648             ENDIF
    1766              IF ( nxr == nx )  THEN 
    1767                 DO  i = 1, nbgp   
    1768                    topo(:,:,nxr+i) = topo(:,:,nxr)     
     1649             IF ( nxr == nx )  THEN
     1650                DO  i = 1, nbgp
     1651                   topo(:,:,nxr+i) = topo(:,:,nxr)
    17691652                ENDDO
    1770              ENDIF     
     1653             ENDIF
    17711654          ENDIF
    17721655
     
    17931676             index_south_cwall = NINT( canyon_wall_south / dy )
    17941677             index_north_cwall = index_south_cwall + ngp_cy
    1795      
     1678
    17961679          ELSE
    1797              
     1680
    17981681             message_string = 'no street canyon width given'
    17991682             CALL message( 'init_grid', 'PA0204', 1, 2, 0, 6, 0 )
    1800  
     1683
    18011684          ENDIF
    18021685
    18031686          ch  = MINLOC( ABS( zw - canyon_height ), 1 ) - 1
    1804           IF ( ABS( zw(ch)   - canyon_height ) == &
    1805                ABS( zw(ch+1) - canyon_height )    )  ch = ch + 1
     1687          IF ( ABS( zw(ch) - canyon_height ) == ABS( zw(ch+1) - canyon_height ) )  ch = ch + 1
    18061688          dp_level_ind_b = ch
    18071689!
    18081690!--       Street canyon size has to meet some requirements
    18091691          IF ( canyon_width_x /= 9999999.9_wp )  THEN
    1810              IF ( ( index_left_cwall< 1 ) .OR. ( index_right_cwall> nx-1 ) .OR.&
     1692             IF ( ( index_left_cwall< 1 )  .OR.  ( index_right_cwall> nx-1 )  .OR.                 &
    18111693                  ( ngp_cx < 3 ) )  THEN
    1812                 WRITE( message_string, * ) 'inconsistent canyon parameters:',  &
    1813                                            '&index_left_cwall=', index_left_cwall, &
    1814                                            ' index_right_cwall=', index_right_cwall, &
    1815                                            ' ngp_cx=', ngp_cx,                 &
    1816                                            ' ch=', ch, ' nx=', nx, ' ny=', ny
    1817                 CALL message( 'init_grid', 'PA0205', 1, 2, 0, 6, 0 )
     1694                WRITE( message_string, * ) 'inconsistent canyon parameters:',                      &
     1695                                           '&index_left_cwall=', index_left_cwall,                 &
     1696                                           ' index_right_cwall=', index_right_cwall,               &
     1697                                           ' ngp_cx=', ngp_cx, ' ch=', ch, ' nx=', nx, ' ny=', ny
     1698                CALL message( 'init_grid', 'PA0205', 1, 2, 0, 6, 0 )
    18181699             ENDIF
    18191700          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
    1820              IF ( ( index_south_cwall < 1 ) .OR.                               &
    1821                   ( index_north_cwall > ny-1 ) .OR. ( ngp_cy < 3 ) )  THEN
    1822                 WRITE( message_string, * ) 'inconsistent canyon parameters:',  &
    1823                                            '&index_south_cwall=', index_south_cwall, &
    1824                                            ' index_north_cwall=', index_north_cwall, &
    1825                                            ' ngp_cy=', ngp_cy,                 &
    1826                                            ' ch=', ch, ' nx=', nx, ' ny=', ny
    1827                 CALL message( 'init_grid', 'PA0206', 1, 2, 0, 6, 0 )
    1828              ENDIF
    1829           ENDIF
    1830           IF ( canyon_width_x /= 9999999.9_wp .AND.                            &                 
    1831                canyon_width_y /= 9999999.9_wp )  THEN
    1832              message_string = 'inconsistent canyon parameters:' //             &   
    1833                               '&street canyon can only be oriented' //         &
     1701             IF ( ( index_south_cwall < 1 )  .OR.                                                  &
     1702                  ( index_north_cwall > ny-1 )  .OR.  ( ngp_cy < 3 ) )  THEN
     1703                WRITE( message_string, * ) 'inconsistent canyon parameters:',                      &
     1704                                           '&index_south_cwall=', index_south_cwall,               &
     1705                                           ' index_north_cwall=', index_north_cwall,               &
     1706                                           ' ngp_cy=', ngp_cy, ' ch=', ch, ' nx=', nx, ' ny=', ny
     1707                CALL message( 'init_grid', 'PA0206', 1, 2, 0, 6, 0 )
     1708             ENDIF
     1709          ENDIF
     1710          IF ( canyon_width_x /= 9999999.9_wp  .AND.  canyon_width_y /= 9999999.9_wp )  THEN
     1711             message_string = 'inconsistent canyon parameters:' //                                 &
     1712                              '&street canyon can only be oriented' //                             &
    18341713                              ' either in x- or in y-direction'
    18351714             CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
     
    18391718          nzb_local = ch
    18401719          IF ( canyon_width_x /= 9999999.9_wp )  THEN
    1841              IF ( index_left_cwall<= nxr  .AND.  index_right_cwall>= nxl )     &
     1720             IF ( index_left_cwall<= nxr  .AND.  index_right_cwall>= nxl )                         &
    18421721                nzb_local(:,MAX(nxl,index_left_cwall+1):MIN(nxr,index_right_cwall-1)) = 0
    18431722          ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
    1844              IF ( index_south_cwall <= nyn  .AND.  index_north_cwall >= nys )  &         
     1723             IF ( index_south_cwall <= nyn  .AND.  index_north_cwall >= nys )                      &
    18451724                nzb_local(MAX(nys,index_south_cwall+1):MIN(nyn,index_north_cwall-1),:) = 0
    18461725          ENDIF
     
    18491728          DO  i = nxl, nxr
    18501729             DO  j = nys, nyn
    1851                 topo(nzb_local(j,i)+1:nzt+1,j,i) =                             &
    1852                                  IBSET( topo(nzb_local(j,i)+1:nzt+1,j,i), 0 )
     1730                topo(nzb_local(j,i)+1:nzt+1,j,i) = IBSET( topo(nzb_local(j,i)+1:nzt+1,j,i), 0 )
    18531731             ENDDO
    18541732          ENDDO
     
    18571735          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
    18581736!
    1859 !--       Set boundary conditions also for flags. Can be interpreted as Neumann
    1860 !--       boundary conditions for topography.
     1737!--       Set boundary conditions also for flags. Can be interpreted as Neumann boundary conditions
     1738!--       for topography.
    18611739          IF ( .NOT. bc_ns_cyc )  THEN
    18621740             IF ( nys == 0  )  THEN
    1863                 DO  i = 1, nbgp     
    1864                    topo(:,nys-i,:)   = topo(:,nys,:)
     1741                DO  i = 1, nbgp
     1742                   topo(:,nys-i,:) = topo(:,nys,:)
    18651743                ENDDO
    18661744             ENDIF
    18671745             IF ( nyn == ny )  THEN
    1868                 DO  i = 1, nbgp 
     1746                DO  i = 1, nbgp
    18691747                   topo(:,nyn+i,:) = topo(:,nyn,:)
    18701748                ENDDO
     
    18731751          IF ( .NOT. bc_lr_cyc )  THEN
    18741752             IF ( nxl == 0  )  THEN
    1875                 DO  i = 1, nbgp   
    1876                    topo(:,:,nxl-i)   = topo(:,:,nxl)
     1753                DO  i = 1, nbgp
     1754                   topo(:,:,nxl-i) = topo(:,:,nxl)
    18771755                ENDDO
    18781756             ENDIF
    1879              IF ( nxr == nx )  THEN 
    1880                 DO  i = 1, nbgp   
    1881                    topo(:,:,nxr+i) = topo(:,:,nxr)     
     1757             IF ( nxr == nx )  THEN
     1758                DO  i = 1, nbgp
     1759                   topo(:,:,nxr+i) = topo(:,:,nxr)
    18821760                ENDDO
    1883              ENDIF     
     1761             ENDIF
    18841762          ENDIF
    18851763
     
    18951773!
    18961774!--       Tunnel-wall depth
    1897           IF ( tunnel_wall_depth == 9999999.9_wp )  THEN 
     1775          IF ( tunnel_wall_depth == 9999999.9_wp )  THEN
    18981776             td = MAX ( dx, dy, dz(1) )
    18991777          ELSE
     
    19021780!
    19031781!--       Check for tunnel width
    1904           IF ( tunnel_width_x == 9999999.9_wp  .AND.                           &
    1905                tunnel_width_y == 9999999.9_wp  )  THEN
     1782          IF ( tunnel_width_x == 9999999.9_wp  .AND.  tunnel_width_y == 9999999.9_wp  )  THEN
    19061783             message_string = 'No tunnel width is given. '
    19071784             CALL message( 'init_grid', 'PA0280', 1, 2, 0, 6, 0 )
    19081785          ENDIF
    1909           IF ( tunnel_width_x /= 9999999.9_wp  .AND.                           &
    1910                tunnel_width_y /= 9999999.9_wp  )  THEN
    1911              message_string = 'Inconsistent tunnel parameters:' //             &   
    1912                               'tunnel can only be oriented' //                 &
     1786          IF ( tunnel_width_x /= 9999999.9_wp  .AND.  tunnel_width_y /= 9999999.9_wp  )  THEN
     1787             message_string = 'Inconsistent tunnel parameters:' //                                 &
     1788                              'tunnel can only be oriented' //                                     &
    19131789                              'either in x- or in y-direction.'
    19141790             CALL message( 'init_grid', 'PA0281', 1, 2, 0, 6, 0 )
     
    19161792!
    19171793!--       Check for too small tunnel width in x- and y-direction
    1918           IF ( tunnel_width_x /= 9999999.9_wp  .AND.                           &   
     1794          IF ( tunnel_width_x /= 9999999.9_wp  .AND.                                               &
    19191795               tunnel_width_x - 2.0_wp * td <= 2.0_wp * dx )  THEN
    19201796             message_string = 'tunnel_width_x too small'
    19211797             CALL message( 'init_grid', 'PA0175', 1, 2, 0, 6, 0 )
    19221798          ENDIF
    1923           IF ( tunnel_width_y /= 9999999.9_wp  .AND.                           &
     1799          IF ( tunnel_width_y /= 9999999.9_wp  .AND.                                               &
    19241800               tunnel_width_y - 2.0_wp * td <= 2.0_wp * dy )  THEN
    19251801             message_string = 'tunnel_width_y too small'
     
    19271803          ENDIF
    19281804!
    1929 !--       Check for too large tunnel width. 
     1805!--       Check for too large tunnel width.
    19301806!--       Tunnel axis along y.
    19311807          IF ( tunnel_width_x /= 9999999.9_wp )  THEN
     
    19371813             txs_out = INT( ( nx + 1 ) * 0.5_wp * dx - tunnel_width_x * 0.5_wp )
    19381814             txe_out = INT( ( nx + 1 ) * 0.5_wp * dx + tunnel_width_x * 0.5_wp )
    1939              txs_in  = INT( ( nx + 1 ) * 0.5_wp * dx -                         &
    1940                                       ( tunnel_width_x * 0.5_wp - td ) )
    1941              txe_in  = INT( ( nx + 1 ) * 0.5_wp * dx +                         &
    1942                                    ( tunnel_width_x * 0.5_wp - td ) )
     1815             txs_in  = INT( ( nx + 1 ) * 0.5_wp * dx - ( tunnel_width_x * 0.5_wp - td ) )
     1816             txe_in  = INT( ( nx + 1 ) * 0.5_wp * dx + ( tunnel_width_x * 0.5_wp - td ) )
    19431817
    19441818             tys_out = INT( ( ny + 1 ) * 0.5_wp * dy - tunnel_length * 0.5_wp )
     
    19621836             tys_out = INT( ( ny + 1 ) * 0.5_wp * dy - tunnel_width_y * 0.5_wp )
    19631837             tye_out = INT( ( ny + 1 ) * 0.5_wp * dy + tunnel_width_y * 0.5_wp )
    1964              tys_in  = INT( ( ny + 1 ) * 0.5_wp * dy -                         &
    1965                                         ( tunnel_width_y * 0.5_wp - td ) )
    1966              tye_in  = INT( ( ny + 1 ) * 0.5_wp * dy +                         &
    1967                                      ( tunnel_width_y * 0.5_wp - td ) )
     1838             tys_in  = INT( ( ny + 1 ) * 0.5_wp * dy - ( tunnel_width_y * 0.5_wp - td ) )
     1839             tye_in  = INT( ( ny + 1 ) * 0.5_wp * dy + ( tunnel_width_y * 0.5_wp - td ) )
    19681840          ENDIF
    19691841
     
    19731845!
    19741846!--             Use heaviside function to model outer tunnel surface
    1975                 hv_out = th * 0.5_wp *                                         &
    1976                               ( ( SIGN( 1.0_wp, i * dx - txs_out ) + 1.0_wp )  &
    1977                               - ( SIGN( 1.0_wp, i * dx - txe_out ) + 1.0_wp ) )
    1978 
    1979                 hv_out = hv_out * 0.5_wp *                                     &
    1980                             ( ( SIGN( 1.0_wp, j * dy - tys_out ) + 1.0_wp )    &
    1981                             - ( SIGN( 1.0_wp, j * dy - tye_out ) + 1.0_wp ) )
    1982 !   
     1847                hv_out = th * 0.5_wp * ( ( SIGN( 1.0_wp, i * dx - txs_out ) + 1.0_wp )             &
     1848                                       - ( SIGN( 1.0_wp, i * dx - txe_out ) + 1.0_wp ) )
     1849
     1850                hv_out = hv_out * 0.5_wp * ( ( SIGN( 1.0_wp, j * dy - tys_out ) + 1.0_wp )         &
     1851                                           - ( SIGN( 1.0_wp, j * dy - tye_out ) + 1.0_wp ) )
     1852!
    19831853!--             Use heaviside function to model inner tunnel surface
    1984                 hv_in  = ( th - td ) * 0.5_wp *                                &
    1985                                 ( ( SIGN( 1.0_wp, i * dx - txs_in ) + 1.0_wp ) &
    1986                                 - ( SIGN( 1.0_wp, i * dx - txe_in ) + 1.0_wp ) )
    1987 
    1988                 hv_in = hv_in * 0.5_wp *                                       &
    1989                                 ( ( SIGN( 1.0_wp, j * dy - tys_in ) + 1.0_wp ) &
    1990                                 - ( SIGN( 1.0_wp, j * dy - tye_in ) + 1.0_wp ) )
     1854                hv_in  = ( th - td ) * 0.5_wp * ( ( SIGN( 1.0_wp, i * dx - txs_in ) + 1.0_wp )     &
     1855                                                - ( SIGN( 1.0_wp, i * dx - txe_in ) + 1.0_wp ) )
     1856
     1857                hv_in = hv_in * 0.5_wp * ( ( SIGN( 1.0_wp, j * dy - tys_in ) + 1.0_wp )            &
     1858                                         - ( SIGN( 1.0_wp, j * dy - tye_in ) + 1.0_wp ) )
    19911859!
    19921860!--             Set flags at x-y-positions without any tunnel surface
     
    20091877!--                   Lateral tunnel walls
    20101878                      IF ( hv_out - hv_in == td )  THEN
    2011                          IF ( zw(k) <= hv_in )  THEN 
     1879                         IF ( zw(k) <= hv_in )  THEN
    20121880                            topo(k,j,i) = IBSET( topo(k,j,i), 0 )
    2013                          ELSEIF ( zw(k) > hv_in  .AND.  zw(k) <= hv_out )  THEN 
     1881                         ELSEIF ( zw(k) > hv_in  .AND.  zw(k) <= hv_out )  THEN
    20141882                            topo(k,j,i) = IBCLR( topo(k,j,i), 0 )
    2015                          ELSEIF ( zw(k) > hv_out )  THEN 
     1883                         ELSEIF ( zw(k) > hv_out )  THEN
    20161884                            topo(k,j,i) = IBSET( topo(k,j,i), 0 )
    20171885                         ENDIF
     
    20241892          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
    20251893!
    2026 !--       Set boundary conditions also for flags. Can be interpreted as Neumann
    2027 !--       boundary conditions for topography.
     1894!--       Set boundary conditions also for flags. Can be interpreted as Neumann boundary conditions
     1895!--       for topography.
    20281896          IF ( .NOT. bc_ns_cyc )  THEN
    20291897             IF ( nys == 0  )  THEN
    2030                 DO  i = 1, nbgp     
    2031                    topo(:,nys-i,:)   = topo(:,nys,:)
     1898                DO  i = 1, nbgp
     1899                   topo(:,nys-i,:) = topo(:,nys,:)
    20321900                ENDDO
    20331901             ENDIF
    20341902             IF ( nyn == ny )  THEN
    2035                 DO  i = 1, nbgp 
     1903                DO  i = 1, nbgp
    20361904                   topo(:,nyn+i,:) = topo(:,nyn,:)
    20371905                ENDDO
     
    20401908          IF ( .NOT. bc_lr_cyc )  THEN
    20411909             IF ( nxl == 0  )  THEN
    2042                 DO  i = 1, nbgp   
    2043                    topo(:,:,nxl-i)   = topo(:,:,nxl)
     1910                DO  i = 1, nbgp
     1911                   topo(:,:,nxl-i) = topo(:,:,nxl)
    20441912                ENDDO
    20451913             ENDIF
    2046              IF ( nxr == nx )  THEN 
    2047                 DO  i = 1, nbgp   
    2048                    topo(:,:,nxr+i) = topo(:,:,nxr)     
     1914             IF ( nxr == nx )  THEN
     1915                DO  i = 1, nbgp
     1916                   topo(:,:,nxr+i) = topo(:,:,nxr)
    20491917                ENDDO
    2050              ENDIF     
     1918             ENDIF
    20511919          ENDIF
    20521920
    20531921       CASE ( 'read_from_file' )
    20541922!
    2055 !--       Note, topography information have been already read. 
    2056 !--       If required, further process topography, i.e. reference buildings on
    2057 !--       top of orography and set temporary 3D topography array, which is
    2058 !--       used later to set grid flags. Calling of this rouinte is also
    2059 !--       required in case of ASCII input, even though no distinction between
    2060 !--       terrain- and building height is made in this case. 
     1923!--       Note, topography information have been already read.
     1924!--       If required, further process topography, i.e. reference buildings on top of orography and
     1925!--       set temporary 3D topography array, which is used later to set grid flags. Calling of this
     1926!--       rouinte is also required in case of ASCII input, even though no distinction between
     1927!--       terrain- and building height is made in this case.
    20611928          CALL process_topography( topo )
    20621929!
     
    20641931          CALL filter_topography( topo )
    20651932!
    2066 !--       Exchange ghost-points, as well as add cyclic or Neumann boundary
    2067 !--       conditions.
     1933!--       Exchange ghost-points, as well as add cyclic or Neumann boundary conditions.
    20681934          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
    20691935!
     
    20711937          IF ( .NOT. bc_ns_cyc )  THEN
    20721938             IF ( nys == 0  )  THEN
    2073                 DO  i = 1, nbgp         
     1939                DO  i = 1, nbgp
    20741940                   topo(:,nys-i,:) = topo(:,nys,:)
    20751941                ENDDO
    20761942             ENDIF
    20771943             IF ( nyn == ny )  THEN
    2078                 DO  i = 1, nbgp         
     1944                DO  i = 1, nbgp
    20791945                   topo(:,nyn+i,:) = topo(:,nyn,:)
    20801946                ENDDO
     
    20841950          IF ( .NOT. bc_lr_cyc )  THEN
    20851951             IF ( nxl == 0  )  THEN
    2086                 DO  i = 1, nbgp 
     1952                DO  i = 1, nbgp
    20871953                   topo(:,:,nxl-i) = topo(:,:,nxl)
    20881954                ENDDO
    20891955             ENDIF
    20901956             IF ( nxr == nx )  THEN
    2091                 DO  i = 1, nbgp 
     1957                DO  i = 1, nbgp
    20921958                   topo(:,:,nxr+i) = topo(:,:,nxr)
    20931959                ENDDO
     
    20971963
    20981964       CASE DEFAULT
    2099 !   
    2100 !--       The DEFAULT case is reached either if the parameter topography
    2101 !--       contains a wrong character string or if the user has defined a special
    2102 !--       case in the user interface. There, the subroutine user_init_grid
    2103 !--       checks which of these two conditions applies.
     1965!
     1966!--       The DEFAULT case is reached either if the parameter topography contains a wrong character
     1967!--       string or if the user has defined a special case in the user interface. There, the
     1968!--       subroutine user_init_grid checks which of these two conditions applies.
    21041969          CALL user_init_grid( topo )
    21051970          CALL filter_topography( topo )
     
    21071972    END SELECT
    21081973!
    2109 !-- Consistency checks and index array initialization are only required for
    2110 !-- non-flat topography.
     1974!-- Consistency checks and index array initialization are only required for non-flat topography.
    21111975    IF ( TRIM( topography ) /= 'flat' )  THEN
    21121976!
    2113 !--    In case of non-flat topography, check whether the convention how to
    2114 !--    define the topography grid has been set correctly, or whether the default
    2115 !--    is applicable. If this is not possible, abort.
     1977!--    In case of non-flat topography, check whether the convention how to define the topography
     1978!--    grid has been set correctly, or whether the default is applicable. If this is not possible,
     1979!--    abort.
    21161980       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
    2117           IF ( TRIM( topography ) /= 'closed_channel' .AND.                    &
    2118                TRIM( topography ) /= 'single_building' .AND.                   &
    2119                TRIM( topography ) /= 'single_street_canyon' .AND.              &
    2120                TRIM( topography ) /= 'tunnel'  .AND.                           &
     1981          IF ( TRIM( topography ) /= 'closed_channel'        .AND.                                 &
     1982               TRIM( topography ) /= 'single_building'       .AND.                                 &
     1983               TRIM( topography ) /= 'single_street_canyon'  .AND.                                 &
     1984               TRIM( topography ) /= 'tunnel'                .AND.                                 &
    21211985               TRIM( topography ) /= 'read_from_file')  THEN
    2122 !--          The default value is not applicable here, because it is only valid
    2123 !--          for the four standard cases 'single_building',
    2124 !--          'single_street_canyon', 'tunnel' and 'read_from_file'
     1986!--          The default value is not applicable here, because it is only valid for the four
     1987!--          standard cases 'single_building', 'single_street_canyon', 'tunnel' and 'read_from_file'
    21251988!--          defined in init_grid.
    2126              WRITE( message_string, * )                                        &
    2127                'The value for "topography_grid_convention" ',                  &
    2128                'is not set. Its default value is & only valid for ',           &
    2129                '"topography" = ''single_building'', ''tunnel'' ',              &
    2130                '''single_street_canyon'', ''closed_channel'' & or ',           &
    2131                '''read_from_file''.',                                          &
    2132                '& Choose ''cell_edge'' or ''cell_center''.'
     1989             WRITE( message_string, * ) 'The value for "topography_grid_convention" ',             &
     1990                                        'is not set. Its default value is & only valid for ',      &
     1991                                        '"topography" = ''single_building'', ''tunnel'' ',         &
     1992                                        '''single_street_canyon'', ''closed_channel'' & or ',      &
     1993                                        '''read_from_file''.',                                     &
     1994                                        '& Choose ''cell_edge'' or ''cell_center''.'
    21331995             CALL message( 'init_grid', 'PA0239', 1, 2, 0, 6, 0 )
    21341996          ELSE
    21351997!--          The default value is applicable here.
    21361998!--          Set convention according to topography.
    2137              IF ( TRIM( topography ) == 'single_building' .OR.                 &
     1999             IF ( TRIM( topography ) == 'single_building'  .OR.                                    &
    21382000                  TRIM( topography ) == 'single_street_canyon' )  THEN
    21392001                topography_grid_convention = 'cell_edge'
    2140              ELSEIF ( TRIM( topography ) == 'read_from_file'  .OR.             &
     2002             ELSEIF ( TRIM( topography ) == 'read_from_file'  .OR.                                 &
    21412003                      TRIM( topography ) == 'tunnel')  THEN
    21422004                topography_grid_convention = 'cell_center'
    21432005             ENDIF
    21442006          ENDIF
    2145        ELSEIF ( TRIM( topography_grid_convention ) /= 'cell_edge' .AND.        &
     2007       ELSEIF ( TRIM( topography_grid_convention ) /= 'cell_edge'  .AND.                           &
    21462008                TRIM( topography_grid_convention ) /= 'cell_center' )  THEN
    2147           WRITE( message_string, * )                                           &
    2148             'The value for "topography_grid_convention" is ',                  &
    2149             'not recognized.& Choose ''cell_edge'' or ''cell_center''.'
     2009          WRITE( message_string, * )  'The value for "topography_grid_convention" is ',            &
     2010                                      'not recognized.& Choose ''cell_edge'' or ''cell_center''.'
    21502011          CALL message( 'init_grid', 'PA0240', 1, 2, 0, 6, 0 )
    21512012       ENDIF
     
    21532014
    21542015       IF ( topography_grid_convention == 'cell_edge' )  THEN
    2155 ! 
    2156 !--       The array nzb_local as defined using the 'cell_edge' convention 
    2157 !--       describes the actual total size of topography which is defined at the 
    2158 !--       cell edges where u=0 on the topography walls in x-direction and v=0 
     2016!
     2017!--       The array nzb_local as defined using the 'cell_edge' convention
     2018!--       describes the actual total size of topography which is defined at the
     2019!--       cell edges where u=0 on the topography walls in x-direction and v=0
    21592020!--       on the topography walls in y-direction. However, PALM uses individual
    21602021!--       arrays nzb_u|v|w|s_inner|outer that are based on nzb_s_inner.
    2161 !--       Therefore, the extent of topography in nzb_local is now reduced by 
    2162 !--       1dx at the E topography walls and by 1dy at the N topography walls 
    2163 !--       to form the basis for nzb_s_inner. 
     2022!--       Therefore, the extent of topography in nzb_local is now reduced by
     2023!--       1dx at the E topography walls and by 1dy at the N topography walls
     2024!--       to form the basis for nzb_s_inner.
    21642025!--       Note, the reverse memory access (i-j instead of j-i) is absolutely
    21652026!--       required at this point.
     
    21672028             DO  i = nxl-1, nxr
    21682029                DO  k = nzb, nzt+1
    2169                    IF ( BTEST( topo(k,j,i), 0 )  .OR.                          &
    2170                         BTEST( topo(k,j,i+1), 0 ) )                            &
     2030                   IF ( BTEST( topo(k,j,i), 0 )  .OR.  BTEST( topo(k,j,i+1), 0 ) )                 &
    21712031                       topo(k,j,i) = IBSET( topo(k,j,i), 0 )
    21722032                ENDDO
    21732033             ENDDO
    2174           ENDDO     
     2034          ENDDO
    21752035          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
    21762036
     
    21782038             DO  j = nys-1, nyn
    21792039                DO  k = nzb, nzt+1
    2180                    IF ( BTEST( topo(k,j,i), 0 )  .OR.                          &
    2181                         BTEST( topo(k,j+1,i), 0 ) )                            &
     2040                   IF ( BTEST( topo(k,j,i), 0 )  .OR.  BTEST( topo(k,j+1,i), 0 ) )                 &
    21822041                      topo(k,j,i) = IBSET( topo(k,j,i), 0 )
    21832042                ENDDO
    21842043             ENDDO
    2185           ENDDO 
     2044          ENDDO
    21862045          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
    2187    
     2046
    21882047       ENDIF
    21892048    ENDIF
     
    21942053 SUBROUTINE set_topo_flags(topo)
    21952054
    2196     USE control_parameters,                                                    &
    2197         ONLY:  bc_lr_cyc, bc_ns_cyc, constant_flux_layer,                      &
    2198                scalar_advec, topography, use_surface_fluxes, use_top_fluxes
    2199 
    2200     USE exchange_horiz_mod,                                                    &
     2055    USE control_parameters,                                                                        &
     2056        ONLY:  bc_lr_cyc, bc_ns_cyc, constant_flux_layer, scalar_advec, topography,                &
     2057               use_surface_fluxes, use_top_fluxes
     2058
     2059    USE exchange_horiz_mod,                                                                        &
    22012060        ONLY:  exchange_horiz_int
    22022061
    2203     USE indices,                                                               &
    2204         ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, &
    2205                nzt, topo_top_ind, wall_flags_static_0, wall_flags_total_0
     2062    USE indices,                                                                                   &
     2063        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nzt, topo_top_ind,  &
     2064               wall_flags_static_0, wall_flags_total_0
    22062065
    22072066    USE kinds
     
    22142073    INTEGER(iwp) ::  k             !< index variable along z
    22152074
    2216     INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo !< input array for 3D topography and dummy array for setting "outer"-flags
     2075    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo !< input array for 3D topography and dummy array for setting
     2076                                                                    !< "outer"-flags
    22172077
    22182078    ALLOCATE( wall_flags_static_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     
    22202080!
    22212081!-- Set-up topography flags. First, set flags only for s, u, v and w-grid.
    2222 !-- Further special flags will be set in following loops. 
     2082!-- Further special flags will be set in following loops.
    22232083    DO  i = nxl, nxr
    22242084       DO  j = nys, nyn
     
    22262086!
    22272087!--          scalar grid
    2228              IF ( BTEST( topo(k,j,i), 0 ) )                                    &
     2088             IF ( BTEST( topo(k,j,i), 0 ) )                                                        &
    22292089                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 0 )
    22302090!
    22312091!--          u grid
    2232              IF ( BTEST( topo(k,j,i),   0 )  .AND.                             &
    2233                   BTEST( topo(k,j,i-1), 0 ) )                                  &
     2092             IF ( BTEST( topo(k,j,i), 0 )  .AND.  BTEST( topo(k,j,i-1), 0 ) )                      &
    22342093                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 1 )
    22352094!
    22362095!--          v grid
    2237              IF ( BTEST( topo(k,j,i),   0 )  .AND.                             &
    2238                   BTEST( topo(k,j-1,i), 0 ) )                                  &
     2096             IF ( BTEST( topo(k,j,i), 0 )  .AND.  BTEST( topo(k,j-1,i), 0 ) )                      &
    22392097                 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 2 )
    22402098
     
    22442102!
    22452103!--          w grid
    2246              IF ( BTEST( topo(k,j,i),   0 )  .AND.                             &
    2247                   BTEST( topo(k+1,j,i), 0 ) )                                  &
     2104             IF ( BTEST( topo(k,j,i), 0 )  .AND.  BTEST( topo(k+1,j,i), 0 ) )                      &
    22482105                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 3 )
    22492106          ENDDO
    2250          
    2251           IF ( topography /= 'closed_channel' ) THEN
     2107
     2108          IF ( topography /= 'closed_channel' )  THEN
    22522109             wall_flags_static_0(nzt+1,j,i) = IBSET( wall_flags_static_0(nzt+1,j,i), 3 )
    22532110          ENDIF
     
    22592116
    22602117!
    2261 !-- Set outer array for scalars to mask near-surface grid points. Note, on
    2262 !-- basis of flag 24 futher flags will be derived which are used to control
    2263 !-- production of subgrid TKE production near walls.
    2264    
     2118!-- Set outer array for scalars to mask near-surface grid points. Note, on basis of flag 24 futher
     2119!-- flags will be derived which are used to control production of subgrid TKE production near walls.
     2120
    22652121    ALLOCATE( wall_flags_total_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    22662122    wall_flags_total_0 = 0
    2267                                    
     2123
    22682124    DO i = nxl, nxr
    22692125       DO j = nys, nyn
     
    22732129       ENDDO
    22742130    ENDDO
    2275    
     2131
    22762132    CALL exchange_horiz_int( wall_flags_total_0, nys, nyn, nxl, nxr, nzt, nbgp )
    2277    
     2133
    22782134    DO i = nxl, nxr
    22792135       DO j = nys, nyn
    22802136          DO k = nzb, nzt+1
    2281              IF ( BTEST( wall_flags_total_0(k,j-1,i), 0 )    .AND.                   &
    2282                   BTEST( wall_flags_total_0(k,j+1,i), 0 )    .AND.                   &
    2283                   BTEST( wall_flags_total_0(k,j,i-1), 0 )    .AND.                   &
    2284                   BTEST( wall_flags_total_0(k,j,i+1), 0 )    .AND.                   &
    2285                   BTEST( wall_flags_total_0(k,j-1,i-1), 0 )  .AND.                   &
    2286                   BTEST( wall_flags_total_0(k,j+1,i-1), 0 )  .AND.                   &
    2287                   BTEST( wall_flags_total_0(k,j-1,i+1), 0 )  .AND.                   &
    2288                   BTEST( wall_flags_total_0(k,j+1,i+1), 0 ) )                        &
     2137             IF ( BTEST( wall_flags_total_0(k,j-1,i), 0 )    .AND.                                 &
     2138                  BTEST( wall_flags_total_0(k,j+1,i), 0 )    .AND.                                 &
     2139                  BTEST( wall_flags_total_0(k,j,i-1), 0 )    .AND.                                 &
     2140                  BTEST( wall_flags_total_0(k,j,i+1), 0 )    .AND.                                 &
     2141                  BTEST( wall_flags_total_0(k,j-1,i-1), 0 )  .AND.                                 &
     2142                  BTEST( wall_flags_total_0(k,j+1,i-1), 0 )  .AND.                                 &
     2143                  BTEST( wall_flags_total_0(k,j-1,i+1), 0 )  .AND.                                 &
     2144                  BTEST( wall_flags_total_0(k,j+1,i+1), 0 ) )                                      &
    22892145                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 24 )
    22902146          ENDDO
     
    22982154!
    22992155!--          scalar grid, former nzb_diff_s_inner.
    2300 !--          Note, use this flag also to mask topography in diffusion_u and
    2301 !--          diffusion_v along the vertical direction. In case of
    2302 !--          use_surface_fluxes, fluxes are calculated via MOST, else, simple
    2303 !--          gradient approach is applied. Please note, in case of u- and v-
    2304 !--          diffuison, a small error is made at edges (on the east side for u,
    2305 !--          at the north side for v), since topography on scalar grid point
    2306 !--          is used instead of topography on u/v-grid. As number of topography grid
    2307 !--          points on uv-grid is different than s-grid, different number of
    2308 !--          surface elements would be required. In order to avoid this,
    2309 !--          treat edges (u(k,j,i+1)) simply by a gradient approach, i.e. these
    2310 !--          points are not masked within diffusion_u. Tests had shown that the
    2311 !--          effect on the flow is negligible.
     2156!--          Note, use this flag also to mask topography in diffusion_u and diffusion_v along the
     2157!--          vertical direction. In case of use_surface_fluxes, fluxes are calculated via MOST,
     2158!--          else, simple gradient approach is applied. Please note, in case of u- and v-diffuison,
     2159!--          a small error is made at edges (on the east side for u, at the north side for v), since
     2160!--          topography on scalar grid point is used instead of topography on u/v-grid. As number of
     2161!--          topography grid points on uv-grid is different than s-grid, different number of surface
     2162!--          elements would be required. In order to avoid this, treat edges (u(k,j,i+1)) simply by
     2163!--          a gradient approach, i.e. these points are not masked within diffusion_u. Tests had
     2164!--          shown that the effect on the flow is negligible.
    23122165             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
    2313                 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )                         &
     2166                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )                                       &
    23142167                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 8 )
    23152168             ELSE
     
    23192172          ENDDO
    23202173!
    2321 !--       Special flag to control vertical diffusion at model top - former
    2322 !--       nzt_diff
     2174!--       Special flag to control vertical diffusion at model top - former nzt_diff
    23232175          wall_flags_total_0(:,j,i) = IBSET( wall_flags_total_0(:,j,i), 9 )
    23242176          IF ( use_top_fluxes )                                                &
     
    23282180          DO k = nzb+1, nzt
    23292181!
    2330 !--          Special flag on u grid, former nzb_u_inner + 1, required   
    2331 !--          for disturb_field and initialization. Do not disturb directly at
    2332 !--          topography, as well as initialize u with zero one grid point outside
    2333 !--          of topography.
    2334              IF ( BTEST( wall_flags_total_0(k-1,j,i), 1 )  .AND.                     &
    2335                   BTEST( wall_flags_total_0(k,j,i),   1 )  .AND.                     &
    2336                   BTEST( wall_flags_total_0(k+1,j,i), 1 ) )                          &
     2182!--          Special flag on u grid, former nzb_u_inner + 1, required for disturb_field and
     2183!--          initialization. Do not disturb directly at topography, as well as initialize u with
     2184!--          zero one grid point outside of topography.
     2185             IF ( BTEST( wall_flags_total_0(k-1,j,i), 1 )  .AND.                                   &
     2186                  BTEST( wall_flags_total_0(k,j,i),   1 )  .AND.                                   &
     2187                  BTEST( wall_flags_total_0(k+1,j,i), 1 ) )                                        &
    23372188                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 20 )
    23382189!
    2339 !--          Special flag on v grid, former nzb_v_inner + 1, required   
    2340 !--          for disturb_field and initialization. Do not disturb directly at
    2341 !--          topography, as well as initialize v with zero one grid point outside
    2342 !--          of topography.
    2343              IF ( BTEST( wall_flags_total_0(k-1,j,i), 2 )  .AND.                     &
    2344                   BTEST( wall_flags_total_0(k,j,i),   2 )  .AND.                     &
    2345                   BTEST( wall_flags_total_0(k+1,j,i), 2 ) )                          &
     2190!--          Special flag on v grid, former nzb_v_inner + 1, required for disturb_field and
     2191!--          initialization. Do not disturb directly at topography, as well as initialize v with
     2192!--          zero one grid point outside of topography.
     2193             IF ( BTEST( wall_flags_total_0(k-1,j,i), 2 )  .AND.                                   &
     2194                  BTEST( wall_flags_total_0(k,j,i),   2 )  .AND.                                   &
     2195                  BTEST( wall_flags_total_0(k+1,j,i), 2 ) )                                        &
    23462196                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 21 )
    23472197!
    2348 !--          Special flag on scalar grid, former nzb_s_inner+1. Used for
    2349 !--          lpm_sgs_tke
    2350              IF ( BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                     &
    2351                   BTEST( wall_flags_total_0(k-1,j,i), 0 )  .AND.                     &
    2352                   BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                          &
     2198!--          Special flag on scalar grid, former nzb_s_inner+1. Used for lpm_sgs_tke
     2199             IF ( BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                                   &
     2200                  BTEST( wall_flags_total_0(k-1,j,i), 0 )  .AND.                                   &
     2201                  BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                        &
    23532202                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 25 )
    23542203!
    2355 !--          Special flag on scalar grid, nzb_diff_s_outer - 1, required in
     2204!--          Special flag on scalar grid, nzb_diff_s_outer - 1, required in in production_e
     2205             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
     2206                IF ( BTEST( wall_flags_total_0(k,j,i),   24 )  .AND.                               &
     2207                     BTEST( wall_flags_total_0(k-1,j,i), 24 )  .AND.                               &
     2208                     BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                     &
     2209                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 29 )
     2210             ELSE
     2211                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )                                       &
     2212                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 29 )
     2213             ENDIF
     2214!
     2215!--          Special flag on scalar grid, nzb_diff_s_outer - 1, required in
    23562216!--          in production_e
    23572217             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
    2358                 IF ( BTEST( wall_flags_total_0(k,j,i),   24 )  .AND.                 &
    2359                      BTEST( wall_flags_total_0(k-1,j,i), 24 )  .AND.                 &
    2360                      BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                       &
    2361                    wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 29 )
    2362              ELSE
    2363                 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )                         &
    2364                    wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 29 )
    2365              ENDIF
    2366 !
    2367 !--          Special flag on scalar grid, nzb_diff_s_outer - 1, required in
    2368 !--          in production_e
    2369              IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
    2370                 IF ( BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                  &
    2371                      BTEST( wall_flags_total_0(k-1,j,i), 0 )  .AND.                  &
    2372                      BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                       &
     2218                IF ( BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                                &
     2219                     BTEST( wall_flags_total_0(k-1,j,i), 0 )  .AND.                                &
     2220                     BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                     &
    23732221                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 30 )
    23742222             ELSE
    2375                 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )                         &
     2223                IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) )                                       &
    23762224                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 30 )
    23772225             ENDIF
     
    23822230!
    23832231!--          Scalar grid
    2384              IF ( BTEST( wall_flags_total_0(k-1,j,i), 0 )  .AND.                     &
    2385             .NOT. BTEST( wall_flags_total_0(k,j,i), 0   ) )                          &
    2386                  wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 13 ) 
     2232             IF (       BTEST( wall_flags_total_0(k-1,j,i), 0 )  .AND.                             &
     2233                  .NOT. BTEST( wall_flags_total_0(k,j,i), 0   ) )                                  &
     2234                 wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 13 )
    23872235!
    23882236!--          Downward facing wall on u grid
    2389              IF ( BTEST( wall_flags_total_0(k-1,j,i), 1 )  .AND.                     &
    2390             .NOT. BTEST( wall_flags_total_0(k,j,i), 1   ) )                          &
     2237             IF (       BTEST( wall_flags_total_0(k-1,j,i), 1 )  .AND.                             &
     2238                  .NOT. BTEST( wall_flags_total_0(k,j,i), 1   ) )                                  &
    23912239                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 15 )
    23922240!
    23932241!--          Downward facing wall on v grid
    2394              IF ( BTEST( wall_flags_total_0(k-1,j,i), 2 )  .AND.                     &
    2395             .NOT. BTEST( wall_flags_total_0(k,j,i), 2   ) )                          &
     2242             IF (       BTEST( wall_flags_total_0(k-1,j,i), 2 )  .AND.                             &
     2243                  .NOT. BTEST( wall_flags_total_0(k,j,i), 2   ) )                                  &
    23962244                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 17 )
    23972245!
    23982246!--          Downward facing wall on w grid
    2399              IF ( BTEST( wall_flags_total_0(k-1,j,i), 3 )  .AND.                     &
    2400             .NOT. BTEST( wall_flags_total_0(k,j,i), 3 ) )                            &
     2247             IF (       BTEST( wall_flags_total_0(k-1,j,i), 3 )  .AND.                             &
     2248                  .NOT. BTEST( wall_flags_total_0(k,j,i), 3 ) )                                    &
    24012249                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 19 )
    24022250          ENDDO
     
    24062254!
    24072255!--          Upward facing wall on scalar grid
    2408              IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.               &
    2409                         BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                    &
     2256             IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                             &
     2257                        BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                  &
    24102258                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 12 )
    24112259!
    24122260!--          Upward facing wall on u grid
    2413              IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   1 )  .AND.               &
    2414                         BTEST( wall_flags_total_0(k+1,j,i), 1 ) )                    &
     2261             IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   1 )  .AND.                             &
     2262                        BTEST( wall_flags_total_0(k+1,j,i), 1 ) )                                  &
    24152263                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 14 )
    24162264
    2417 !   
     2265!
    24182266!--          Upward facing wall on v grid
    2419              IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   2 )  .AND.               &
    2420                         BTEST( wall_flags_total_0(k+1,j,i), 2 ) )                    &
     2267             IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   2 )  .AND.                             &
     2268                        BTEST( wall_flags_total_0(k+1,j,i), 2 ) )                                  &
    24212269                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 16 )
    2422    
     2270
    24232271!
    24242272!--          Upward facing wall on w grid
    2425              IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   3 )  .AND.               &
    2426                         BTEST( wall_flags_total_0(k+1,j,i), 3 ) )                    &
     2273             IF ( .NOT. BTEST( wall_flags_total_0(k,j,i),   3 )  .AND.                             &
     2274                        BTEST( wall_flags_total_0(k+1,j,i), 3 ) )                                  &
    24272275                wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 18 )
    24282276!
    24292277!--          Special flag on scalar grid, former nzb_s_inner
    2430              IF ( BTEST( wall_flags_total_0(k,j,i), 0 )  .OR.                        &
    2431                   BTEST( wall_flags_total_0(k,j,i), 12 ) .OR.                        &
    2432                   BTEST( wall_flags_total_0(k,j,i), 13 ) )                           &
     2278             IF ( BTEST( wall_flags_total_0(k,j,i), 0 )  .OR.                                      &
     2279                  BTEST( wall_flags_total_0(k,j,i), 12 ) .OR.                                      &
     2280                  BTEST( wall_flags_total_0(k,j,i), 13 ) )                                         &
    24332281                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 22 )
    24342282!
    2435 !--          Special flag on scalar grid, nzb_diff_s_inner - 1, required for 
     2283!--          Special flag on scalar grid, nzb_diff_s_inner - 1, required for
    24362284!--          flow_statistics
    24372285             IF ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
    2438                 IF ( BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                  &
    2439                      BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                       &
     2286                IF ( BTEST( wall_flags_total_0(k,j,i),   0 )  .AND.                                &
     2287                     BTEST( wall_flags_total_0(k+1,j,i), 0 ) )                                     &
    24402288                  wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 23 )
    24412289             ELSE
    2442                 IF ( BTEST( wall_flags_total_0(k,j,i), 22 ) )                        &
     2290                IF ( BTEST( wall_flags_total_0(k,j,i), 22 ) )                                      &
    24432291                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 23 )
    24442292             ENDIF
    2445    
     2293
    24462294
    24472295          ENDDO
     
    24492297          wall_flags_total_0(nzt+1,j,i) = IBSET( wall_flags_total_0(nzt+1,j,i), 23 )
    24502298!
    2451 !--       Set flags indicating that topography is close by in horizontal
    2452 !--       direction, i.e. flags that infold the topography. These will be used
    2453 !--       to set advection flags for passive scalars, where due to large
    2454 !--       gradients near buildings stationary numerical oscillations can produce
    2455 !--       unrealistically high concentrations. This is only necessary if
    2456 !--       WS-scheme is applied for scalar advection. Note, these flags will be
    2457 !--       only used for passive scalars such as chemical species or aerosols.
     2299!--       Set flags indicating that topography is close by in horizontal direction, i.e. flags that
     2300!--       infold the topography. These will be used to set advection flags for passive scalars,
     2301!--       where due to large gradients near buildings stationary numerical oscillations can produce
     2302!--       unrealistically high concentrations. This is only necessary if WS-scheme is applied for
     2303!--       scalar advection. Note, these flags will be only used for passive scalars such as chemical
     2304!--       species or aerosols.
    24582305          IF ( scalar_advec == 'ws-scheme' )  THEN
    24592306             DO k = nzb, nzt
    2460                 IF ( BTEST( wall_flags_total_0(k,j,i), 0 )  .AND. (                  &
    2461                      ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i-1), 0 ) )  .OR.&
    2462                      ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i-2), 0 ) )  .OR.&
    2463                      ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i-3), 0 ) )  .OR.&
    2464                      ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i+1), 0 ) )  .OR.&
    2465                      ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i+2), 0 ) )  .OR.&
    2466                      ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i+3), 0 ) )  .OR.&
    2467                      ANY( .NOT. BTEST( wall_flags_total_0(k,j-1,i-3:i+3), 0 ) )  .OR.&
    2468                      ANY( .NOT. BTEST( wall_flags_total_0(k,j-2,i-3:i+3), 0 ) )  .OR.&
    2469                      ANY( .NOT. BTEST( wall_flags_total_0(k,j-3,i-3:i+3), 0 ) )  .OR.&
    2470                      ANY( .NOT. BTEST( wall_flags_total_0(k,j+1,i-3:i+3), 0 ) )  .OR.&
    2471                      ANY( .NOT. BTEST( wall_flags_total_0(k,j+2,i-3:i+3), 0 ) )  .OR.&
    2472                      ANY( .NOT. BTEST( wall_flags_total_0(k,j+3,i-3:i+3), 0 ) )      &
    2473                                                             ) )                      &
     2307                IF ( BTEST( wall_flags_total_0(k,j,i), 0 )  .AND. (                                &
     2308                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i-1), 0 ) )  .OR.              &
     2309                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i-2), 0 ) )  .OR.              &
     2310                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i-3), 0 ) )  .OR.              &
     2311                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i+1), 0 ) )  .OR.              &
     2312                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i+2), 0 ) )  .OR.              &
     2313                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3:j+3,i+3), 0 ) )  .OR.              &
     2314                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-1,i-3:i+3), 0 ) )  .OR.              &
     2315                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-2,i-3:i+3), 0 ) )  .OR.              &
     2316                     ANY( .NOT. BTEST( wall_flags_total_0(k,j-3,i-3:i+3), 0 ) )  .OR.              &
     2317                     ANY( .NOT. BTEST( wall_flags_total_0(k,j+1,i-3:i+3), 0 ) )  .OR.              &
     2318                     ANY( .NOT. BTEST( wall_flags_total_0(k,j+2,i-3:i+3), 0 ) )  .OR.              &
     2319                     ANY( .NOT. BTEST( wall_flags_total_0(k,j+3,i-3:i+3), 0 ) )                    &
     2320                                                                  )                                &
     2321                   )                                                                               &
    24742322                   wall_flags_total_0(k,j,i) = IBSET( wall_flags_total_0(k,j,i), 31 )
    2475                      
    24762323             ENDDO
    24772324          ENDIF
     
    24802327!
    24812328!-- Finally, set identification flags indicating natural terrain or buildings.
    2482 !-- Natural terrain grid points. Information on the type of the surface is
    2483 !-- stored in bit 1 of 3D Integer array topo. However, this bit is only set
    2484 !-- when topography is read from file. In order to run the land-surface model
    2485 !-- also without topography information, set bit 1 explicitely in this case.
    2486 !-- 
     2329!-- Natural terrain grid points. Information on the type of the surface is stored in bit 1 of
     2330!-- 3D Integer array topo. However, this bit is only set when topography is read from file. In order
     2331!-- to run the land-surface model also without topography information, set bit 1 explicitely in this
     2332!-- case.
     2333!--
    24872334!-- Natural terrain grid points
    24882335!-- If no topography is initialized, the land-surface is at k = nzb.
     
    24932340          DO j = nys, nyn
    24942341             DO k = nzb, nzt+1
    2495 !         
     2342!
    24962343!--             Natural terrain grid point
    2497                 IF ( BTEST( topo(k,j,i), 1 ) )                                 &
     2344                IF ( BTEST( topo(k,j,i), 1 ) )                                                     &
    24982345                   wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 5 )
    24992346             ENDDO
     
    25062353       DO j = nys, nyn
    25072354          DO k = nzb, nzt+1
    2508              IF ( BTEST( topo(k,j,i), 2 ) )                                    &
     2355             IF ( BTEST( topo(k,j,i), 2 ) )                                                        &
    25092356                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 6 )
    25102357          ENDDO
     
    25162363       DO j = nys, nyn
    25172364          DO k = nzb, nzt+1
    2518              IF ( BTEST( topo(k,j,i), 4 ) )                                    &
     2365             IF ( BTEST( topo(k,j,i), 4 ) )                                                        &
    25192366                wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 4 )
    25202367          ENDDO
    25212368       ENDDO
    25222369    ENDDO
    2523    
     2370
    25242371    CALL exchange_horiz_int( wall_flags_static_0, nys, nyn, nxl, nxr, nzt, nbgp )
    2525    
     2372
    25262373    DO i = nxl, nxr
    25272374       DO j = nys, nyn
     
    25352382    CALL exchange_horiz_int( wall_flags_total_0, nys, nyn, nxl, nxr, nzt, nbgp )
    25362383!
    2537 !-- Set boundary conditions also for flags. Can be interpreted as Neumann
    2538 !-- boundary conditions for topography.
     2384!-- Set boundary conditions also for flags. Can be interpreted as Neumann boundary conditions for
     2385!-- topography.
    25392386    IF ( .NOT. bc_ns_cyc )  THEN
    25402387       IF ( nys == 0  )  THEN
    2541           DO  i = 1, nbgp     
     2388          DO  i = 1, nbgp
    25422389             wall_flags_total_0(:,nys-i,:)   = wall_flags_total_0(:,nys,:)
    25432390          ENDDO
    25442391       ENDIF
    25452392       IF ( nyn == ny )  THEN
    2546           DO  i = 1, nbgp 
     2393          DO  i = 1, nbgp
    25472394             wall_flags_total_0(:,nyn+i,:) = wall_flags_total_0(:,nyn,:)
    25482395          ENDDO
     
    25512398    IF ( .NOT. bc_lr_cyc )  THEN
    25522399       IF ( nxl == 0  )  THEN
    2553           DO  i = 1, nbgp   
     2400          DO  i = 1, nbgp
    25542401             wall_flags_total_0(:,:,nxl-i)   = wall_flags_total_0(:,:,nxl)
    25552402          ENDDO
    25562403       ENDIF
    2557        IF ( nxr == nx )  THEN 
    2558           DO  i = 1, nbgp   
    2559              wall_flags_total_0(:,:,nxr+i) = wall_flags_total_0(:,:,nxr)     
    2560           ENDDO
    2561        ENDIF     
     2404       IF ( nxr == nx )  THEN
     2405          DO  i = 1, nbgp
     2406             wall_flags_total_0(:,:,nxr+i) = wall_flags_total_0(:,:,nxr)
     2407          ENDDO
     2408       ENDIF
    25622409    ENDIF
    25632410!
    2564 !-- Pre-calculate topography top indices (former get_topography_top_index 
     2411!-- Pre-calculate topography top indices (former get_topography_top_index
    25652412!-- function)
    25662413    ALLOCATE( topo_top_ind(nysg:nyng,nxlg:nxrg,0:4) )
     
    25682415!-- Uppermost topography index on scalar grid
    25692416    ibit = 12
    2570     topo_top_ind(:,:,0) = MAXLOC(                                              &
    2571                                   MERGE( 1, 0,                                 &
    2572                                     BTEST( wall_flags_total_0(:,:,:), ibit )   &
    2573                                        ), DIM = 1                              &
    2574                                 ) - 1
    2575 !
    2576 !-- Uppermost topography index on u grid
     2417    topo_top_ind(:,:,0) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
     2418                          - 1
     2419!
     2420!-- Uppermost topography index on u grid
    25772421    ibit = 14
    2578     topo_top_ind(:,:,1) = MAXLOC(                                              &
    2579                                   MERGE( 1, 0,                                 &
    2580                                     BTEST( wall_flags_total_0(:,:,:), ibit )   &
    2581                                        ), DIM = 1                              &
    2582                                 ) - 1
    2583 !
    2584 !-- Uppermost topography index on v grid
     2422    topo_top_ind(:,:,1) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
     2423                          - 1
     2424!
     2425!-- Uppermost topography index on v grid
    25852426    ibit = 16
    2586     topo_top_ind(:,:,2) = MAXLOC(                                              &
    2587                                   MERGE( 1, 0,                                 &
    2588                                     BTEST( wall_flags_total_0(:,:,:), ibit )   &
    2589                                        ), DIM = 1                              &
    2590                                 ) - 1
     2427    topo_top_ind(:,:,2) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
     2428                          - 1
    25912429!
    25922430!-- Uppermost topography index on w grid
    25932431    ibit = 18
    2594     topo_top_ind(:,:,3) = MAXLOC(                                              &
    2595                                   MERGE( 1, 0,                                 &
    2596                                     BTEST( wall_flags_total_0(:,:,:), ibit )   &
    2597                                        ), DIM = 1                              &
    2598                                 ) - 1
     2432    topo_top_ind(:,:,3) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
     2433                          - 1
    25992434!
    26002435!-- Uppermost topography index on scalar outer grid
    26012436    ibit = 24
    2602     topo_top_ind(:,:,4) = MAXLOC(                                              &
    2603                                   MERGE( 1, 0,                                 &
    2604                                     BTEST( wall_flags_total_0(:,:,:), ibit )   &
    2605                                        ), DIM = 1                              &
    2606                                 ) - 1
     2437    topo_top_ind(:,:,4) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,:,:), ibit ) ), DIM=1 ) &
     2438                          - 1
    26072439
    26082440 END SUBROUTINE set_topo_flags
Note: See TracChangeset for help on using the changeset viewer.